Bring racket schema impl into line with spec 0.4
This commit is contained in:
parent
07b7739d00
commit
4f75d6d5a3
|
@ -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)))
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Reference in New Issue