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

View File

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

View File

@ -58,7 +58,8 @@
,(pattern->match-pattern fields-pat '_)))]
[(CompoundPattern-tuple named-pats)
(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)
(maybe-dest dest-pat-stx
(if (null? fixed-named-pats)