syndicate-lang
/
preserves
mirror of https://gitlab.com/preserves/preserves.git
1
0
Fork 1
Code Releases Activity

Read angle-bracket delimited records in the Racket implementation

This commit is contained in:
Tony Garnock-Jones 2019-08-18 13:40:59 +01:00
parent c9a624839f
commit 9974002cad
1 changed files with 40 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

87
implementations/racket/preserves/main.rkt
View File

@ -332,7 +332,7 @@
(define (read-raw-symbol acc)
(match (peek-char i)
[(or (? eof-object?)
(? char? (or #\( #\) #\{ #\} #\[ #\]
(? char? (or #\( #\) #\{ #\} #\[ #\] #\< #\>
#\" #\; #\, #\# #\: (== PIPE)
(? char-whitespace?))))
(if (null? acc)
@ -479,16 +479,6 @@
(push-child-annotation! (compute-key acc next) next-anns)
(loop new-acc)])))
(define (collect-fields head)
(match (peek-char i)
[#\( (read-char i)
(collect-fields (build-record head (read-sequence #\))))]
[#\[ (read-char i)
(collect-fields (build-record head (list (read-sequence #\]))))]
[#\{ (read-char i)
(collect-fields (build-record head (list (read-dictionary-or-set (hash)))))]
[_ head]))
(define (read-value/annotations)
(if skip-annotations
(values (eof-guard (read-value)) empty-annotations)
@ -512,42 +502,45 @@
(define (read-value)
(skip-whitespace)
(collect-fields
(match (peek-char i)
[(? eof-object? o) o]
[#\{ (read-char i) (read-dictionary-or-set #f)]
[#\[ (read-char i) (read-sequence #\])]
[(or #\- #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) (read-number)]
[#\" (read-char i) (read-string #\")]
[(== PIPE) (read-char i) (string->symbol (read-string PIPE))]
[#\@ (read-char i)
(define-values (a aa) (read-value/annotations))
(define v (eof-guard (read-value)))
(push-here-annotation! a aa v)]
[#\# (match i
[(px #px#"^#set\\{" (list _))
(sequence-fold (set) set-add (lambda (acc v) v) values #\})]
[(px #px#"^#value" (list _))
(define-values (bs anns) (read-value/annotations))
(when (not (bytes? bs)) (parse-error "ByteString must follow #value"))
(when (not (empty-annotations? anns))
(parse-error "Annotations not permitted after #value"))
(decode bs)]
[(px #px#"^#true" (list _))
#t]
[(px #px#"^#false" (list _))
#f]
[(px #px#"^#\"" (list _))
(read-literal-binary)]
[(px #px#"^#hex\\{" (list _))
(read-hex-binary '())]
[(px #px#"^#base64\\{" (list _))
(read-base64-binary '())]
[_
(read-char i)
(parse-error "Invalid preserve value")])]
[#\: (read-char i) (parse-error "Unexpected key/value separator between items")]
[_ (read-raw-symbol '())])))
(match (peek-char i)
[(? eof-object? o) o]
[#\{ (read-char i) (read-dictionary-or-set #f)]
[#\[ (read-char i) (read-sequence #\])]
[#\< (read-char i)
(match (read-sequence #\>)
['() (parse-error "Missing record label")]
[(cons head fields) (build-record head fields)])]
[(or #\- #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) (read-number)]
[#\" (read-char i) (read-string #\")]
[(== PIPE) (read-char i) (string->symbol (read-string PIPE))]
[#\@ (read-char i)
(define-values (a aa) (read-value/annotations))
(define v (eof-guard (read-value)))
(push-here-annotation! a aa v)]
[#\# (match i
[(px #px#"^#set\\{" (list _))
(sequence-fold (set) set-add (lambda (acc v) v) values #\})]
[(px #px#"^#value" (list _))
(define-values (bs anns) (read-value/annotations))
(when (not (bytes? bs)) (parse-error "ByteString must follow #value"))
(when (not (empty-annotations? anns))
(parse-error "Annotations not permitted after #value"))
(decode bs)]
[(px #px#"^#true" (list _))
#t]
[(px #px#"^#false" (list _))
#f]
[(px #px#"^#\"" (list _))
(read-literal-binary)]
[(px #px#"^#hex\\{" (list _))
(read-hex-binary '())]
[(px #px#"^#base64\\{" (list _))
(read-base64-binary '())]
[_
(read-char i)
(parse-error "Invalid preserve value")])]
[#\: (read-char i) (parse-error "Unexpected key/value separator between items")]
[_ (read-raw-symbol '())]))
(read-value/annotations))