Simpler embedded parsing/unparsing
This commit is contained in:
parent
534018e3a4
commit
ab12c6535f
|
@ -73,12 +73,9 @@
|
|||
(match (Schema-embeddedType schema)
|
||||
[(EmbeddedTypeName-false) `((define :parse-embedded values)
|
||||
(define :embedded->preserves values))]
|
||||
[(EmbeddedTypeName-Ref r) `((define (:parse-embedded input)
|
||||
(match input
|
||||
[,(pattern->match-pattern (SimplePattern-Ref r) 'output) output]
|
||||
[_ eof]))
|
||||
(define (:embedded->preserves input)
|
||||
,(pattern->unparser (SimplePattern-Ref r) 'input)))]))
|
||||
[(EmbeddedTypeName-Ref r) `((define :parse-embedded ,(Ref-parser-name r))
|
||||
(define :embedded->preserves ,(Ref-unparser-name r)))]))
|
||||
|
||||
(define (struct-defs schema)
|
||||
(fold-Schema-definitions
|
||||
(lambda (name def acc)
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
#lang racket/base
|
||||
|
||||
(provide definition-parsers
|
||||
pattern->match-pattern)
|
||||
Ref-parser-name)
|
||||
|
||||
(require preserves)
|
||||
(require racket/match)
|
||||
|
@ -83,9 +83,8 @@
|
|||
(cons key value)
|
||||
make-immutable-hash
|
||||
,dest-pat-stx)]
|
||||
[(SimplePattern-Ref (Ref module-path name))
|
||||
`(app ,(format-symbol "~aparse-~a" (module-path-prefix module-path) name)
|
||||
,(maybe-dest dest-pat-stx `(not (== eof))))]
|
||||
[(SimplePattern-Ref r)
|
||||
`(app ,(Ref-parser-name r) ,(maybe-dest dest-pat-stx `(not (== eof))))]
|
||||
[(CompoundPattern-rec label-pat fields-pat)
|
||||
(maybe-dest dest-pat-stx `(record ,(pattern->match-pattern label-pat '_)
|
||||
,(pattern->match-pattern fields-pat '_)))]
|
||||
|
@ -106,6 +105,10 @@
|
|||
(sorted-dict-entries entries))
|
||||
(_ _) ...))]))
|
||||
|
||||
(define (Ref-parser-name r)
|
||||
(match-define (Ref module-path name) r)
|
||||
(format-symbol "~aparse-~a" (module-path-prefix module-path) name))
|
||||
|
||||
(define (literal->pattern v)
|
||||
(if (symbol? v)
|
||||
`',v
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
#lang racket/base
|
||||
|
||||
(provide definition-unparser
|
||||
pattern->unparser)
|
||||
Ref-unparser-name)
|
||||
|
||||
(require preserves)
|
||||
(require racket/match)
|
||||
|
@ -58,8 +58,8 @@
|
|||
`(for/hash [((key value) (in-dict ,src-stx))]
|
||||
(values ,(pattern->unparser key-pat 'key)
|
||||
,(pattern->unparser value-pat 'value)))]
|
||||
[(SimplePattern-Ref (Ref module-path name))
|
||||
`(,(format-symbol "~a~a->preserves" (module-path-prefix module-path) name) ,src-stx)]
|
||||
[(SimplePattern-Ref r)
|
||||
`(,(Ref-unparser-name r) ,src-stx)]
|
||||
[(CompoundPattern-rec label-pat fields-pat)
|
||||
`(record ,(pattern->unparser label-pat src-stx) ,(pattern->unparser fields-pat src-stx))]
|
||||
[(CompoundPattern-tuple named-pats)
|
||||
|
@ -72,3 +72,7 @@
|
|||
(list `',(car entry)
|
||||
(pattern->unparser (cdr entry) src-stx)))
|
||||
(sorted-dict-entries entries)))]))
|
||||
|
||||
(define (Ref-unparser-name r)
|
||||
(match-define (Ref module-path name) r)
|
||||
(format-symbol "~a~a->preserves" (module-path-prefix module-path) name))
|
||||
|
|
Loading…
Reference in New Issue