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

Bring racket schema impl into line with spec 0.4

This commit is contained in:
Tony Garnock-Jones 2024-04-04 13:37:12 +02:00
parent 07b7739d00
commit 4f75d6d5a3
2 changed files with 50 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
implementations/racket/preserves/preserves-schema/gen/schema.rkt
View File

@ -105,7 +105,9 @@
'named 'named
(list (list
(and ?name (? symbol?)) (and ?name (? symbol?))
(app parse-SimplePattern (and ?pattern (not (== eof))))))) (app parse-SimplePattern (and ?pattern (not (== eof))))
_
...)))
(Binding ?name ?pattern)) (Binding ?name ?pattern))
(_ eof))) (_ eof)))
(define parse-Binding! (parse-success-or-error 'parse-Binding parse-Binding)) (define parse-Binding! (parse-success-or-error 'parse-Binding parse-Binding))
@ -126,7 +128,7 @@
((and dest ((and dest
(record (record
'bundle 'bundle
(list (app parse-Modules (and ?modules (not (== eof))))))) (list (app parse-Modules (and ?modules (not (== eof)))) _ ...)))
(Bundle ?modules)) (Bundle ?modules))
(_ eof))) (_ eof)))
(define parse-Bundle! (parse-success-or-error 'parse-Bundle parse-Bundle)) (define parse-Bundle! (parse-success-or-error 'parse-Bundle parse-Bundle))
@ -198,28 +200,34 @@
'rec 'rec
(list (list
(app parse-NamedPattern (and ?label (not (== eof)))) (app parse-NamedPattern (and ?label (not (== eof))))
(app parse-NamedPattern (and ?fields (not (== eof))))))) (app parse-NamedPattern (and ?fields (not (== eof))))
_
...)))
(CompoundPattern-rec ?label ?fields)) (CompoundPattern-rec ?label ?fields))
((and dest ((and dest
(record (record
'tuple 'tuple
(list (list
(list (list (app parse-NamedPattern (and ?patterns (not (== eof)))) ...)
(app parse-NamedPattern (and ?patterns (not (== eof)))) _
...)))) ...)))
(CompoundPattern-tuple ?patterns)) (CompoundPattern-tuple ?patterns))
((and dest ((and dest
(record (record
'tuplePrefix 'tuplePrefix
(list (list
(list (app parse-NamedPattern (and ?fixed (not (== eof)))) ...) (list (app parse-NamedPattern (and ?fixed (not (== eof)))) ...)
(app parse-NamedSimplePattern (and ?variable (not (== eof))))))) (app parse-NamedSimplePattern (and ?variable (not (== eof))))
_
...)))
(CompoundPattern-tuplePrefix ?fixed ?variable)) (CompoundPattern-tuplePrefix ?fixed ?variable))
((and dest ((and dest
(record (record
'dict 'dict
(list (list
(app parse-DictionaryEntries (and ?entries (not (== eof))))))) (app parse-DictionaryEntries (and ?entries (not (== eof))))
_
...)))
(CompoundPattern-dict ?entries)) (CompoundPattern-dict ?entries))
(_ eof))) (_ eof)))
(define parse-CompoundPattern! (define parse-CompoundPattern!
@ -283,7 +291,9 @@
(app parse-NamedAlternative (and ?pattern1 (not (== eof)))) (app parse-NamedAlternative (and ?pattern1 (not (== eof))))
(list (list
(app parse-NamedAlternative (and ?patternN (not (== eof)))) (app parse-NamedAlternative (and ?patternN (not (== eof))))
...))))) ...))
_
...)))
(Definition-or ?pattern0 ?pattern1 ?patternN)) (Definition-or ?pattern0 ?pattern1 ?patternN))
((and dest ((and dest
(record (record
@ -294,7 +304,9 @@
(app parse-NamedPattern (and ?pattern1 (not (== eof)))) (app parse-NamedPattern (and ?pattern1 (not (== eof))))
(list (list
(app parse-NamedPattern (and ?patternN (not (== eof)))) (app parse-NamedPattern (and ?patternN (not (== eof))))
...))))) ...))
_
...)))
(Definition-and ?pattern0 ?pattern1 ?patternN)) (Definition-and ?pattern0 ?pattern1 ?patternN))
((app parse-Pattern (and dest (not (== eof)))) (Definition-Pattern dest)) ((app parse-Pattern (and dest (not (== eof)))) (Definition-Pattern dest))
(_ eof))) (_ eof)))
@ -452,7 +464,9 @@
((and dest ((and dest
(list (list
(and ?variantLabel (? string?)) (and ?variantLabel (? string?))
(app parse-Pattern (and ?pattern (not (== eof)))))) (app parse-Pattern (and ?pattern (not (== eof))))
_
...))
(NamedAlternative ?variantLabel ?pattern)) (NamedAlternative ?variantLabel ?pattern))
(_ eof))) (_ eof)))
(define parse-NamedAlternative! (define parse-NamedAlternative!
@ -569,7 +583,9 @@
'ref 'ref
(list (list
(app parse-ModulePath (and ?module (not (== eof)))) (app parse-ModulePath (and ?module (not (== eof))))
(and ?name (? symbol?))))) (and ?name (? symbol?))
_
...)))
(Ref ?module ?name)) (Ref ?module ?name))
(_ eof))) (_ eof)))
(define parse-Ref! (parse-success-or-error 'parse-Ref parse-Ref)) (define parse-Ref! (parse-success-or-error 'parse-Ref parse-Ref))
@ -608,7 +624,9 @@
(app parse-EmbeddedTypeName (and ?embeddedType (not (== eof))))) (app parse-EmbeddedTypeName (and ?embeddedType (not (== eof)))))
('version (app parse-Version (and ?version (not (== eof))))) ('version (app parse-Version (and ?version (not (== eof)))))
(_ _) (_ _)
...)))) ...)
_
...)))
(Schema ?definitions ?embeddedType ?version)) (Schema ?definitions ?embeddedType ?version))
(_ eof))) (_ eof)))
(define parse-Schema! (parse-success-or-error 'parse-Schema parse-Schema)) (define parse-Schema! (parse-success-or-error 'parse-Schema parse-Schema))
@ -718,30 +736,41 @@
((and dest ((and dest
(record (record
'atom 'atom
(list (app parse-AtomKind (and ?atomKind (not (== eof))))))) (list (app parse-AtomKind (and ?atomKind (not (== eof)))) _ ...)))
(SimplePattern-atom ?atomKind)) (SimplePattern-atom ?atomKind))
((and dest ((and dest
(record (record
'embedded 'embedded
(list (app parse-SimplePattern (and ?interface (not (== eof))))))) (list
(app parse-SimplePattern (and ?interface (not (== eof))))
_
...)))
(SimplePattern-embedded ?interface)) (SimplePattern-embedded ?interface))
((and dest (record 'lit (list ?value))) (SimplePattern-lit ?value)) ((and dest (record 'lit (list ?value _ ...))) (SimplePattern-lit ?value))
((and dest ((and dest
(record (record
'seqof 'seqof
(list (app parse-SimplePattern (and ?pattern (not (== eof))))))) (list
(app parse-SimplePattern (and ?pattern (not (== eof))))
_
...)))
(SimplePattern-seqof ?pattern)) (SimplePattern-seqof ?pattern))
((and dest ((and dest
(record (record
'setof 'setof
(list (app parse-SimplePattern (and ?pattern (not (== eof))))))) (list
(app parse-SimplePattern (and ?pattern (not (== eof))))
_
...)))
(SimplePattern-setof ?pattern)) (SimplePattern-setof ?pattern))
((and dest ((and dest
(record (record
'dictof 'dictof
(list (list
(app parse-SimplePattern (and ?key (not (== eof)))) (app parse-SimplePattern (and ?key (not (== eof))))
(app parse-SimplePattern (and ?value (not (== eof))))))) (app parse-SimplePattern (and ?value (not (== eof))))
_
...)))
(SimplePattern-dictof ?key ?value)) (SimplePattern-dictof ?key ?value))
((app parse-Ref (and dest (not (== eof)))) (SimplePattern-Ref dest)) ((app parse-Ref (and dest (not (== eof)))) (SimplePattern-Ref dest))
(_ eof))) (_ eof)))

3
implementations/racket/preserves/preserves-schema/parser.rkt
View File

@ -58,7 +58,8 @@
,(pattern->match-pattern fields-pat '_)))] ,(pattern->match-pattern fields-pat '_)))]
[(CompoundPattern-tuple named-pats) [(CompoundPattern-tuple named-pats)
(maybe-dest dest-pat-stx (maybe-dest dest-pat-stx
`(list ,@(map (lambda (p) (pattern->match-pattern p '_)) named-pats)))] `(list ,@(map (lambda (p) (pattern->match-pattern p '_)) named-pats)
_ ...))]
[(CompoundPattern-tuplePrefix fixed-named-pats variable-named-pat) [(CompoundPattern-tuplePrefix fixed-named-pats variable-named-pat)
(maybe-dest dest-pat-stx (maybe-dest dest-pat-stx
(if (null? fixed-named-pats) (if (null? fixed-named-pats)