diff --git a/implementations/racket/preserves/preserves-schema/compiler.rkt b/implementations/racket/preserves/preserves-schema/compiler.rkt index fe5fa26..d5c1a32 100644 --- a/implementations/racket/preserves/preserves-schema/compiler.rkt +++ b/implementations/racket/preserves/preserves-schema/compiler.rkt @@ -88,10 +88,10 @@ (define (embedded-defs schema) (match (Schema-embeddedType schema) - [(EmbeddedTypeName-false) `((define :parse-embedded values) - (define :embedded->preserves values))] - [(EmbeddedTypeName-Ref r) `((define :parse-embedded ,(Ref-parser-name r)) - (define :embedded->preserves ,(Ref-unparser-name r)))])) + [(EmbeddedTypeName-false) `((define :decode-embedded values) + (define :encode-embedded values))] + [(EmbeddedTypeName-Ref r) `((define :decode-embedded ,(Ref-parser!-name r)) + (define :encode-embedded ,(Ref-unparser-name r)))])) (define (struct-defs schema) (fold-Schema-definitions @@ -133,9 +133,9 @@ (schema-check-problems! schema #:name name) (define options (schema-compiler-options name lookup-module-path translation-paths)) `(module ,name racket/base - (provide (except-out (all-defined-out) :parse-embedded :embedded->preserves) - (rename-out [:parse-embedded ,(format-symbol ":parse-embedded:~a" name)] - [:embedded->preserves ,(format-symbol ":embedded->preserves:~a" name)])) + (provide (except-out (all-defined-out) :decode-embedded :encode-embedded) + (rename-out [:decode-embedded ,(format-symbol "decode-embedded:~a" name)] + [:encode-embedded ,(format-symbol "encode-embedded:~a" name)])) ,@(module-imports name schema lookup-module-path translation-paths) ,@(embedded-defs schema) (require preserves) diff --git a/implementations/racket/preserves/preserves-schema/gen/schema.rkt b/implementations/racket/preserves/preserves-schema/gen/schema.rkt index 31eb92e..d311e6f 100644 --- a/implementations/racket/preserves/preserves-schema/gen/schema.rkt +++ b/implementations/racket/preserves/preserves-schema/gen/schema.rkt @@ -1,10 +1,10 @@ (module gen-schema racket/base - (provide (except-out (all-defined-out) :parse-embedded :embedded->preserves) + (provide (except-out (all-defined-out) :decode-embedded :encode-embedded) (rename-out - (:parse-embedded :parse-embedded:gen-schema) - (:embedded->preserves :embedded->preserves:gen-schema))) - (define :parse-embedded values) - (define :embedded->preserves values) + (:decode-embedded decode-embedded:gen-schema) + (:encode-embedded encode-embedded:gen-schema))) + (define :decode-embedded values) + (define :encode-embedded values) (require preserves) (require preserves-schema/support) (require racket/match) @@ -99,8 +99,8 @@ ((and dest (record 'bundle - (list (app parse-Modules (and $modules (not (== eof))))))) - (Bundle $modules)) + (list (app parse-Modules (and ?modules (not (== eof))))))) + (Bundle ?modules)) (_ eof))) (define parse-Bundle! (parse-success-or-error 'parse-Bundle parse-Bundle))) (begin @@ -111,30 +111,30 @@ (record 'rec (list - (app parse-NamedPattern (and $label (not (== eof)))) - (app parse-NamedPattern (and $fields (not (== eof))))))) - (CompoundPattern-rec $label $fields)) + (app parse-NamedPattern (and ?label (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)))) + (app parse-NamedPattern (and ?patterns (not (== eof)))) ...)))) - (CompoundPattern-tuple $patterns)) + (CompoundPattern-tuple ?patterns)) ((and dest (record 'tuple* (list - (list (app parse-NamedPattern (and $fixed (not (== eof)))) ...) - (app parse-NamedSimplePattern (and $variable (not (== eof))))))) - (CompoundPattern-tuple* $fixed $variable)) + (list (app parse-NamedPattern (and ?fixed (not (== eof)))) ...) + (app parse-NamedSimplePattern (and ?variable (not (== eof))))))) + (CompoundPattern-tuple* ?fixed ?variable)) ((and dest (record 'dict (list - (app parse-DictionaryEntries (and $entries (not (== eof))))))) - (CompoundPattern-dict $entries)) + (app parse-DictionaryEntries (and ?entries (not (== eof))))))) + (CompoundPattern-dict ?entries)) (_ eof))) (define parse-CompoundPattern! (parse-success-or-error 'parse-CompoundPattern parse-CompoundPattern))) @@ -147,23 +147,23 @@ 'or (list (list* - (app parse-NamedAlternative (and $pattern0 (not (== eof)))) - (app parse-NamedAlternative (and $pattern1 (not (== eof)))) + (app parse-NamedAlternative (and ?pattern0 (not (== eof)))) + (app parse-NamedAlternative (and ?pattern1 (not (== eof)))) (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 (record 'and (list (list* - (app parse-NamedPattern (and $pattern0 (not (== eof)))) - (app parse-NamedPattern (and $pattern1 (not (== eof)))) + (app parse-NamedPattern (and ?pattern0 (not (== eof)))) + (app parse-NamedPattern (and ?pattern1 (not (== eof)))) (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)) (_ eof))) @@ -240,9 +240,9 @@ input ((and dest (list - (and $variantLabel (? string?)) - (app parse-Pattern (and $pattern (not (== eof)))))) - (NamedAlternative $variantLabel $pattern)) + (and ?variantLabel (? string?)) + (app parse-Pattern (and ?pattern (not (== eof)))))) + (NamedAlternative ?variantLabel ?pattern)) (_ eof))) (define parse-NamedAlternative! (parse-success-or-error 'parse-NamedAlternative parse-NamedAlternative))) @@ -278,9 +278,9 @@ (record 'named (list - (and $name (? symbol?)) - (app parse-SimplePattern (and $pattern (not (== eof))))))) - (NamedSimplePattern_ $name $pattern)) + (and ?name (? symbol?)) + (app parse-SimplePattern (and ?pattern (not (== eof))))))) + (NamedSimplePattern_ ?name ?pattern)) (_ eof))) (define parse-NamedSimplePattern_! (parse-success-or-error @@ -305,9 +305,9 @@ (record 'ref (list - (app parse-ModulePath (and $module (not (== eof)))) - (and $name (? symbol?))))) - (Ref $module $name)) + (app parse-ModulePath (and ?module (not (== eof)))) + (and ?name (? symbol?))))) + (Ref ?module ?name)) (_ eof))) (define parse-Ref! (parse-success-or-error 'parse-Ref parse-Ref))) (begin @@ -320,15 +320,15 @@ (list (hash-table ('definitions - (app parse-Definitions (and $definitions (not (== eof))))) + (app parse-Definitions (and ?definitions (not (== eof))))) ('embeddedType (app parse-EmbeddedTypeName - (and $embeddedType (not (== eof))))) - ('version (app parse-Version (and $version (not (== eof))))) + (and ?embeddedType (not (== eof))))) + ('version (app parse-Version (and ?version (not (== eof))))) (_ _) ...)))) - (Schema $definitions $embeddedType $version)) + (Schema ?definitions ?embeddedType ?version)) (_ eof))) (define parse-Schema! (parse-success-or-error 'parse-Schema parse-Schema))) (begin @@ -339,32 +339,32 @@ ((and dest (record 'atom - (list (app parse-AtomKind (and $atomKind (not (== eof))))))) - (SimplePattern-atom $atomKind)) + (list (app parse-AtomKind (and ?atomKind (not (== eof))))))) + (SimplePattern-atom ?atomKind)) ((and dest (record 'embedded (list - (app parse-SimplePattern (and $interface (not (== eof))))))) - (SimplePattern-embedded $interface)) - ((and dest (record 'lit (list $value))) (SimplePattern-lit $value)) + (app parse-SimplePattern (and ?interface (not (== eof))))))) + (SimplePattern-embedded ?interface)) + ((and dest (record 'lit (list ?value))) (SimplePattern-lit ?value)) ((and dest (record 'seqof - (list (app parse-SimplePattern (and $pattern (not (== eof))))))) - (SimplePattern-seqof $pattern)) + (list (app parse-SimplePattern (and ?pattern (not (== eof))))))) + (SimplePattern-seqof ?pattern)) ((and dest (record 'setof - (list (app parse-SimplePattern (and $pattern (not (== eof))))))) - (SimplePattern-setof $pattern)) + (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))))))) - (SimplePattern-dictof $key $value)) + (app parse-SimplePattern (and ?key (not (== eof)))) + (app parse-SimplePattern (and ?value (not (== eof))))))) + (SimplePattern-dictof ?key ?value)) ((app parse-Ref (and dest (not (== eof)))) (SimplePattern-Ref dest)) (_ eof))) (define parse-SimplePattern! diff --git a/implementations/racket/preserves/preserves-schema/parser.rkt b/implementations/racket/preserves/preserves-schema/parser.rkt index c65bf77..b76f410 100644 --- a/implementations/racket/preserves/preserves-schema/parser.rkt +++ b/implementations/racket/preserves/preserves-schema/parser.rkt @@ -1,7 +1,8 @@ #lang racket/base (provide definition-parsers - Ref-parser-name) + Ref-parser-name + Ref-parser!-name) (require preserves) (require racket/match) @@ -66,7 +67,7 @@ [(AtomKind-ByteString) 'bytes?] [(AtomKind-Symbol) 'symbol?])))] [(SimplePattern-embedded _interface) - `(embedded (app :parse-embedded ,(maybe-dest dest-pat-stx `(not (== eof)))))] + `(embedded ,(maybe-dest dest-pat-stx `_))] [(SimplePattern-lit v) (maybe-dest dest-pat-stx (literal->pattern v))] [(SimplePattern-seqof variable-pat) `(list ,(pattern->match-pattern variable-pat dest-pat-stx) ...)] @@ -111,6 +112,10 @@ (match-define (Ref module-path name) r) (format-symbol "~aparse-~a" (module-path-prefix module-path) name)) +(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 diff --git a/implementations/racket/preserves/preserves-schema/unparser.rkt b/implementations/racket/preserves/preserves-schema/unparser.rkt index b8ddd88..c2a1829 100644 --- a/implementations/racket/preserves/preserves-schema/unparser.rkt +++ b/implementations/racket/preserves/preserves-schema/unparser.rkt @@ -48,7 +48,7 @@ [(NamedSimplePattern_ n p) (pattern->unparser p (escape n))] [(SimplePattern-any) src-stx] [(SimplePattern-atom _) src-stx] - [(SimplePattern-embedded _interface) `(embedded (:embedded->preserves ,src-stx))] + [(SimplePattern-embedded _interface) `(embedded ,src-stx)] [(SimplePattern-lit v) `',v] [(SimplePattern-seqof variable-pat) `(for/list [(item (in-list ,src-stx))] ,(pattern->unparser variable-pat 'item))]