96 lines
4.0 KiB
Racket
96 lines
4.0 KiB
Racket
#lang racket/base
|
|
|
|
(provide read-preserve/text
|
|
string->preserve)
|
|
|
|
(require racket/match)
|
|
(require racket/set)
|
|
(require "record.rkt")
|
|
(require "read-text-generic.rkt")
|
|
(require syntax/readerr)
|
|
|
|
(define *reader-name* 'read-preserve/text)
|
|
|
|
(define (string->preserve s
|
|
#:read-syntax? [read-syntax? #f]
|
|
#:decode-embedded [decode-embedded #f]
|
|
#:source [source "<string>"])
|
|
(define p (open-input-string s))
|
|
(when read-syntax? (port-count-lines! p))
|
|
(define v (read-preserve/text p
|
|
#:read-syntax? read-syntax?
|
|
#:decode-embedded decode-embedded
|
|
#:source source))
|
|
(when (eof-object? v)
|
|
(parse-error #:raise-proc raise-read-eof-error *reader-name* p source "Unexpected end of input"))
|
|
(skip-whitespace p)
|
|
(when (not (eof-object? (peek-char p)))
|
|
(parse-error *reader-name* p source "Unexpected text following preserve"))
|
|
v)
|
|
|
|
(define text-reader
|
|
(make-preserve-text-reader
|
|
#:reader-name *reader-name*
|
|
#:on-hash (lambda (in-port source next parse-error* default)
|
|
(match-lambda
|
|
[#\{ (sequence-fold in-port
|
|
source
|
|
next
|
|
skip-whitespace/commas
|
|
(set)
|
|
(lambda (s e)
|
|
(when (set-member? s e)
|
|
(parse-error* "Duplicate set element: ~v" e))
|
|
(set-add s e))
|
|
values
|
|
#\})]
|
|
[c (default c)]))
|
|
#:on-char (lambda (in-port source next parse-error* default)
|
|
(match-lambda
|
|
[#\< (match (read-sequence in-port source next skip-whitespace #\>)
|
|
['() (parse-error* "Missing record label")]
|
|
[(cons label fields) (record label fields)])]
|
|
[#\[ (read-sequence in-port source next skip-whitespace/commas #\])]
|
|
[#\{ (read-dictionary in-port source next parse-error*)]
|
|
|
|
[#\; (parse-error* "Semicolon is reserved syntax")]
|
|
[#\: (parse-error* "Unexpected key/value separator between items")]
|
|
[#\> (parse-error* "Unexpected >")]
|
|
[#\] (parse-error* "Unexpected ]")]
|
|
[#\} (parse-error* "Unexpected }")]
|
|
[#\, (parse-error* "Unexpected ,")]
|
|
|
|
[c (default c)]))))
|
|
|
|
(define (sequence-fold in-port source next skip-ws acc accumulate-one finish terminator-char)
|
|
(let loop ((acc acc))
|
|
(skip-ws in-port)
|
|
(match (eof-guard *reader-name* in-port source (peek-char in-port))
|
|
[(== terminator-char) (read-char in-port) (finish acc)]
|
|
[_ (loop (accumulate-one acc (next)))])))
|
|
|
|
(define (read-sequence in-port source next skip-ws terminator)
|
|
(sequence-fold in-port source next skip-ws '() (lambda (acc v) (cons v acc)) reverse terminator))
|
|
|
|
(define (read-dictionary in-port source next parse-error*)
|
|
(sequence-fold in-port
|
|
source
|
|
next
|
|
skip-whitespace/commas
|
|
(hash)
|
|
(lambda (acc k)
|
|
(skip-whitespace in-port)
|
|
(match (peek-char in-port)
|
|
[#\: (read-char in-port)
|
|
(when (hash-has-key? acc k) (parse-error* "Duplicate key: ~v" k))
|
|
(hash-set acc k (next))]
|
|
[_ (parse-error* "Missing expected key/value separator")]))
|
|
values
|
|
#\}))
|
|
|
|
(define (read-preserve/text [in-port (current-input-port)]
|
|
#:read-syntax? [read-syntax? #f]
|
|
#:decode-embedded [decode-embedded #f]
|
|
#:source [source (object-name in-port)])
|
|
(text-reader in-port source read-syntax? decode-embedded))
|