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

Simpler embedded parsing/unparsing

This commit is contained in:
Tony Garnock-Jones 2021-05-27 09:53:55 +02:00
parent 534018e3a4
commit ab12c6535f
3 changed files with 17 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
implementations/racket/preserves/preserves-schema/compiler.rkt
View File

@ -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)

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

@ -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

10
implementations/racket/preserves/preserves-schema/unparser.rkt
View File

@ -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))