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

Merge branch 'angle-records' into 'master' 

Switch Racket code to using angle bracket records

See merge request preserves/preserves!1
This commit is contained in:
Christopher Lemmer Webber 2019-08-18 12:25:47 +00:00
parent c9a624839f ba20012bba
commit 8bb473177e
1 changed files with 42 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

89
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,47 @@
(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)
(define head
(read-value))
(define args
(read-sequence #\>))
(build-record head args)]
[(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))