From a24a5b19f586ebf98f43444c5f7f2a591e339ceb Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Tue, 25 May 2021 11:06:40 +0200 Subject: [PATCH] Regenerate metaschema --- .../preserves/preserves-schema/gen/schema.rkt | 814 ++++++++++-------- 1 file changed, 437 insertions(+), 377 deletions(-) diff --git a/implementations/racket/preserves/preserves-schema/gen/schema.rkt b/implementations/racket/preserves/preserves-schema/gen/schema.rkt index a6c784f..8666c19 100644 --- a/implementations/racket/preserves/preserves-schema/gen/schema.rkt +++ b/implementations/racket/preserves/preserves-schema/gen/schema.rkt @@ -5,10 +5,64 @@ (require racket/match) (require racket/set) (require racket/dict) + (struct AtomKind-Symbol () #:prefab) + (struct AtomKind-ByteString () #:prefab) + (struct AtomKind-String () #:prefab) + (struct AtomKind-SignedInteger () #:prefab) + (struct AtomKind-Double () #:prefab) + (struct AtomKind-Float () #:prefab) + (struct AtomKind-Boolean () #:prefab) + (define (AtomKind? p) + (or (AtomKind-Boolean? p) + (AtomKind-Float? p) + (AtomKind-Double? p) + (AtomKind-SignedInteger? p) + (AtomKind-String? p) + (AtomKind-ByteString? p) + (AtomKind-Symbol? p))) + (struct Bundle (modules) #:prefab) + (struct CompoundPattern-dict (entries) #:prefab) + (struct CompoundPattern-tuple* (fixed variable) #:prefab) + (struct CompoundPattern-tuple (patterns) #:prefab) + (struct CompoundPattern-rec (label fields) #:prefab) + (define (CompoundPattern? p) + (or (CompoundPattern-rec? p) + (CompoundPattern-tuple? p) + (CompoundPattern-tuple*? p) + (CompoundPattern-dict? p))) + (struct Definition-Pattern (value) #:prefab) + (struct Definition-and (pattern0 pattern1 patternN) #:prefab) + (struct Definition-or (pattern0 pattern1 patternN) #:prefab) + (define (Definition? p) + (or (Definition-or? p) (Definition-and? p) (Definition-Pattern? p))) + (struct EmbeddedTypeName-false () #:prefab) + (struct EmbeddedTypeName-Ref (value) #:prefab) + (define (EmbeddedTypeName? p) + (or (EmbeddedTypeName-Ref? p) (EmbeddedTypeName-false? p))) + (struct NamedAlternative (variantLabel pattern) #:prefab) + (struct NamedPattern-anonymous (value) #:prefab) + (struct NamedPattern-named (value) #:prefab) (define (NamedPattern? p) (or (NamedPattern-named? p) (NamedPattern-anonymous? p))) - (struct NamedPattern-named (value) #:prefab) - (struct NamedPattern-anonymous (value) #:prefab) + (struct NamedSimplePattern-anonymous (value) #:prefab) + (struct NamedSimplePattern-named (value) #:prefab) + (define (NamedSimplePattern? p) + (or (NamedSimplePattern-named? p) (NamedSimplePattern-anonymous? p))) + (struct NamedSimplePattern_ (name pattern) #:prefab) + (struct Pattern-CompoundPattern (value) #:prefab) + (struct Pattern-SimplePattern (value) #:prefab) + (define (Pattern? p) + (or (Pattern-SimplePattern? p) (Pattern-CompoundPattern? p))) + (struct Ref (module name) #:prefab) + (struct Schema (definitions embeddedType version) #:prefab) + (struct SimplePattern-Ref (value) #:prefab) + (struct SimplePattern-dictof (key value) #:prefab) + (struct SimplePattern-setof (pattern) #:prefab) + (struct SimplePattern-seqof (pattern) #:prefab) + (struct SimplePattern-lit (value) #:prefab) + (struct SimplePattern-embedded () #:prefab) + (struct SimplePattern-atom (atomKind) #:prefab) + (struct SimplePattern-any () #:prefab) (define (SimplePattern? p) (or (SimplePattern-any? p) (SimplePattern-atom? p) @@ -18,346 +72,312 @@ (SimplePattern-setof? p) (SimplePattern-dictof? p) (SimplePattern-Ref? p))) - (struct SimplePattern-any () #:prefab) - (struct SimplePattern-atom (atomKind) #:prefab) - (struct SimplePattern-embedded () #:prefab) - (struct SimplePattern-lit (value) #:prefab) - (struct SimplePattern-seqof (pattern) #:prefab) - (struct SimplePattern-setof (pattern) #:prefab) - (struct SimplePattern-dictof (key value) #:prefab) - (struct SimplePattern-Ref (value) #:prefab) - (struct NamedAlternative (variantLabel pattern) #:prefab) - (struct Schema (definitions embeddedType version) #:prefab) - (define (Pattern? p) - (or (Pattern-SimplePattern? p) (Pattern-CompoundPattern? p))) - (struct Pattern-SimplePattern (value) #:prefab) - (struct Pattern-CompoundPattern (value) #:prefab) - (define (CompoundPattern? p) - (or (CompoundPattern-rec? p) - (CompoundPattern-tuple? p) - (CompoundPattern-tuple*? p) - (CompoundPattern-dict? p))) - (struct CompoundPattern-rec (label fields) #:prefab) - (struct CompoundPattern-tuple (patterns) #:prefab) - (struct CompoundPattern-tuple* (fixed variable) #:prefab) - (struct CompoundPattern-dict (entries) #:prefab) - (struct Ref (module name) #:prefab) - (struct Bundle (modules) #:prefab) - (struct NamedSimplePattern_ (name pattern) #:prefab) - (define (Definition? p) - (or (Definition-or? p) (Definition-and? p) (Definition-Pattern? p))) - (struct Definition-or (pattern0 pattern1 patternN) #:prefab) - (struct Definition-and (pattern0 pattern1 patternN) #:prefab) - (struct Definition-Pattern (value) #:prefab) - (define (NamedSimplePattern? p) - (or (NamedSimplePattern-named? p) (NamedSimplePattern-anonymous? p))) - (struct NamedSimplePattern-named (value) #:prefab) - (struct NamedSimplePattern-anonymous (value) #:prefab) - (define (EmbeddedTypeName? p) - (or (EmbeddedTypeName-Ref? p) (EmbeddedTypeName-false? p))) - (struct EmbeddedTypeName-Ref (value) #:prefab) - (struct EmbeddedTypeName-false () #:prefab) - (define (AtomKind? p) - (or (AtomKind-Boolean? p) - (AtomKind-Float? p) - (AtomKind-Double? p) - (AtomKind-SignedInteger? p) - (AtomKind-String? p) - (AtomKind-ByteString? p) - (AtomKind-Symbol? p))) - (struct AtomKind-Boolean () #:prefab) - (struct AtomKind-Float () #:prefab) - (struct AtomKind-Double () #:prefab) - (struct AtomKind-SignedInteger () #:prefab) - (struct AtomKind-String () #:prefab) - (struct AtomKind-ByteString () #:prefab) - (struct AtomKind-Symbol () #:prefab) - (define (parse-NamedPattern input) - (match - input - ((app parse-NamedSimplePattern_ (and dest (not (== eof)))) - (NamedPattern-named dest)) - ((app parse-Pattern (and dest (not (== eof)))) - (NamedPattern-anonymous dest)) - (_ eof))) - (define (parse-SimplePattern input) - (match - input - ((and dest 'any) (SimplePattern-any)) - ((and dest - (record - 'atom - (list (app parse-AtomKind (and $atomKind (not (== eof))))))) - (SimplePattern-atom $atomKind)) - ((and dest (record 'embedded (list))) (SimplePattern-embedded)) - ((and dest (record 'lit (list $value))) (SimplePattern-lit $value)) - ((and dest - (record - 'seqof - (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)) - ((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-Ref (and dest (not (== eof)))) (SimplePattern-Ref dest)) - (_ eof))) - (define (parse-NamedAlternative input) - (match - input - ((and dest - (list - (and $variantLabel (? string?)) - (app parse-Pattern (and $pattern (not (== eof)))))) - (NamedAlternative $variantLabel $pattern)) - (_ eof))) - (define (parse-Definitions input) - (match - input - ((parse-sequence - dict? - dict->list - (cons - (and key (? symbol?)) - (app parse-Definition (and value (not (== eof))))) - (cons key value) - make-immutable-hash - dest) - dest) - (_ eof))) - (define (parse-Schema input) - (match - input - ((and dest - (record - 'schema - (list - (hash-table - ('definitions - (app parse-Definitions (and $definitions (not (== eof))))) - ('embeddedType - (app parse-EmbeddedTypeName (and $embeddedType (not (== eof))))) - ('version (app parse-Version (and $version (not (== eof))))) - (_ _) - ...)))) - (Schema $definitions $embeddedType $version)) - (_ eof))) - (define (parse-Pattern input) - (match - input - ((app parse-SimplePattern (and dest (not (== eof)))) - (Pattern-SimplePattern dest)) - ((app parse-CompoundPattern (and dest (not (== eof)))) - (Pattern-CompoundPattern dest)) - (_ eof))) - (define (parse-CompoundPattern input) - (match - input - ((and dest - (record - 'rec - (list - (app parse-NamedPattern (and $label (not (== eof)))) - (app parse-NamedPattern (and $fields (not (== eof))))))) - (CompoundPattern-rec $label $fields)) - ((and dest - (record - 'tuple - (list + (begin + (define (parse-AtomKind input) + (match + input + ((and dest 'Boolean) (AtomKind-Boolean)) + ((and dest 'Float) (AtomKind-Float)) + ((and dest 'Double) (AtomKind-Double)) + ((and dest 'SignedInteger) (AtomKind-SignedInteger)) + ((and dest 'String) (AtomKind-String)) + ((and dest 'ByteString) (AtomKind-ByteString)) + ((and dest 'Symbol) (AtomKind-Symbol)) + (_ eof))) + (define parse-AtomKind! + (parse-success-or-error 'parse-AtomKind parse-AtomKind))) + (begin + (define (parse-Bundle input) + (match + input + ((and dest + (record + 'bundle + (list (app parse-Modules (and $modules (not (== eof))))))) + (Bundle $modules)) + (_ eof))) + (define parse-Bundle! (parse-success-or-error 'parse-Bundle parse-Bundle))) + (begin + (define (parse-CompoundPattern input) + (match + input + ((and dest + (record + 'rec + (list + (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)))) + ...)))) + (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)) + ((and dest + (record + 'dict + (list + (app parse-DictionaryEntries (and $entries (not (== eof))))))) + (CompoundPattern-dict $entries)) + (_ eof))) + (define parse-CompoundPattern! + (parse-success-or-error 'parse-CompoundPattern parse-CompoundPattern))) + (begin + (define (parse-Definition input) + (match + input + ((and dest + (record + 'or + (list + (list* + (app parse-NamedAlternative (and $pattern0 (not (== eof)))) + (app parse-NamedAlternative (and $pattern1 (not (== eof)))) + (list + (app parse-NamedAlternative (and $patternN (not (== eof)))) + ...))))) + (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)))) + (list + (app parse-NamedPattern (and $patternN (not (== eof)))) + ...))))) + (Definition-and $pattern0 $pattern1 $patternN)) + ((app parse-Pattern (and dest (not (== eof)))) + (Definition-Pattern dest)) + (_ eof))) + (define parse-Definition! + (parse-success-or-error 'parse-Definition parse-Definition))) + (begin + (define (parse-Definitions input) + (match + input + ((parse-sequence + dict? + dict->list + (cons + (and key (? symbol?)) + (app parse-Definition (and value (not (== eof))))) + (cons key value) + make-immutable-hash + dest) + dest) + (_ eof))) + (define parse-Definitions! + (parse-success-or-error 'parse-Definitions parse-Definitions))) + (begin + (define (parse-DictionaryEntries input) + (match + input + ((parse-sequence + dict? + dict->list + (cons key (app parse-NamedSimplePattern (and value (not (== eof))))) + (cons key value) + make-immutable-hash + dest) + dest) + (_ eof))) + (define parse-DictionaryEntries! + (parse-success-or-error + 'parse-DictionaryEntries + parse-DictionaryEntries))) + (begin + (define (parse-EmbeddedTypeName input) + (match + input + ((app parse-Ref (and dest (not (== eof)))) (EmbeddedTypeName-Ref dest)) + ((and dest (== '#f)) (EmbeddedTypeName-false)) + (_ eof))) + (define parse-EmbeddedTypeName! + (parse-success-or-error 'parse-EmbeddedTypeName parse-EmbeddedTypeName))) + (begin + (define (parse-ModulePath input) + (match input ((list (and dest (? symbol?)) ...) dest) (_ eof))) + (define parse-ModulePath! + (parse-success-or-error 'parse-ModulePath parse-ModulePath))) + (begin + (define (parse-Modules input) + (match + input + ((parse-sequence + dict? + dict->list + (cons + (app parse-ModulePath (and key (not (== eof)))) + (app parse-Schema (and value (not (== eof))))) + (cons key value) + make-immutable-hash + dest) + dest) + (_ eof))) + (define parse-Modules! + (parse-success-or-error 'parse-Modules parse-Modules))) + (begin + (define (parse-NamedAlternative input) + (match + input + ((and dest (list - (app parse-NamedPattern (and $patterns (not (== eof)))) - ...)))) - (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)) - ((and dest - (record - 'dict - (list - (app parse-DictionaryEntries (and $entries (not (== eof))))))) - (CompoundPattern-dict $entries)) - (_ eof))) - (define (parse-Modules input) - (match - input - ((parse-sequence - dict? - dict->list - (cons - (app parse-ModulePath (and key (not (== eof)))) - (app parse-Schema (and value (not (== eof))))) - (cons key value) - make-immutable-hash - dest) - dest) - (_ eof))) - (define (parse-Ref input) - (match - input - ((and dest - (record - 'ref - (list - (app parse-ModulePath (and $module (not (== eof)))) - (and $name (? symbol?))))) - (Ref $module $name)) - (_ eof))) - (define (parse-Bundle input) - (match - input - ((and dest - (record - 'bundle - (list (app parse-Modules (and $modules (not (== eof))))))) - (Bundle $modules)) - (_ eof))) - (define (parse-NamedSimplePattern_ input) - (match - input - ((and dest - (record - 'named - (list - (and $name (? symbol?)) - (app parse-SimplePattern (and $pattern (not (== eof))))))) - (NamedSimplePattern_ $name $pattern)) - (_ eof))) - (define (parse-Definition input) - (match - input - ((and dest - (record - 'or - (list - (list* - (app parse-NamedAlternative (and $pattern0 (not (== eof)))) - (app parse-NamedAlternative (and $pattern1 (not (== eof)))) + (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))) + (begin + (define (parse-NamedPattern input) + (match + input + ((app parse-NamedSimplePattern_ (and dest (not (== eof)))) + (NamedPattern-named dest)) + ((app parse-Pattern (and dest (not (== eof)))) + (NamedPattern-anonymous dest)) + (_ eof))) + (define parse-NamedPattern! + (parse-success-or-error 'parse-NamedPattern parse-NamedPattern))) + (begin + (define (parse-NamedSimplePattern input) + (match + input + ((app parse-NamedSimplePattern_ (and dest (not (== eof)))) + (NamedSimplePattern-named dest)) + ((app parse-SimplePattern (and dest (not (== eof)))) + (NamedSimplePattern-anonymous dest)) + (_ eof))) + (define parse-NamedSimplePattern! + (parse-success-or-error + 'parse-NamedSimplePattern + parse-NamedSimplePattern))) + (begin + (define (parse-NamedSimplePattern_ input) + (match + input + ((and dest + (record + 'named (list - (app parse-NamedAlternative (and $patternN (not (== eof)))) - ...))))) - (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)))) + (and $name (? symbol?)) + (app parse-SimplePattern (and $pattern (not (== eof))))))) + (NamedSimplePattern_ $name $pattern)) + (_ eof))) + (define parse-NamedSimplePattern_! + (parse-success-or-error + 'parse-NamedSimplePattern_ + parse-NamedSimplePattern_))) + (begin + (define (parse-Pattern input) + (match + input + ((app parse-SimplePattern (and dest (not (== eof)))) + (Pattern-SimplePattern dest)) + ((app parse-CompoundPattern (and dest (not (== eof)))) + (Pattern-CompoundPattern dest)) + (_ eof))) + (define parse-Pattern! + (parse-success-or-error 'parse-Pattern parse-Pattern))) + (begin + (define (parse-Ref input) + (match + input + ((and dest + (record + 'ref (list - (app parse-NamedPattern (and $patternN (not (== eof)))) - ...))))) - (Definition-and $pattern0 $pattern1 $patternN)) - ((app parse-Pattern (and dest (not (== eof)))) (Definition-Pattern dest)) - (_ eof))) - (define (parse-NamedSimplePattern input) + (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 + (define (parse-Schema input) + (match + input + ((and dest + (record + 'schema + (list + (hash-table + ('definitions + (app parse-Definitions (and $definitions (not (== eof))))) + ('embeddedType + (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))) + (begin + (define (parse-SimplePattern input) + (match + input + ((and dest 'any) (SimplePattern-any)) + ((and dest + (record + 'atom + (list (app parse-AtomKind (and $atomKind (not (== eof))))))) + (SimplePattern-atom $atomKind)) + ((and dest (record 'embedded (list))) (SimplePattern-embedded)) + ((and dest (record 'lit (list $value))) (SimplePattern-lit $value)) + ((and dest + (record + 'seqof + (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)) + ((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-Ref (and dest (not (== eof)))) (SimplePattern-Ref dest)) + (_ eof))) + (define parse-SimplePattern! + (parse-success-or-error 'parse-SimplePattern parse-SimplePattern))) + (begin + (define (parse-Version input) + (match input ((and dest (== '1)) (void)) (_ eof))) + (define parse-Version! + (parse-success-or-error 'parse-Version parse-Version))) + (define (AtomKind->preserves input) (match input - ((app parse-NamedSimplePattern_ (and dest (not (== eof)))) - (NamedSimplePattern-named dest)) - ((app parse-SimplePattern (and dest (not (== eof)))) - (NamedSimplePattern-anonymous dest)) - (_ eof))) - (define (parse-EmbeddedTypeName input) + ((AtomKind-Boolean) 'Boolean) + ((AtomKind-Float) 'Float) + ((AtomKind-Double) 'Double) + ((AtomKind-SignedInteger) 'SignedInteger) + ((AtomKind-String) 'String) + ((AtomKind-ByteString) 'ByteString) + ((AtomKind-Symbol) 'Symbol))) + (define (Bundle->preserves input) (match input - ((app parse-Ref (and dest (not (== eof)))) (EmbeddedTypeName-Ref dest)) - ((and dest (== '#f)) (EmbeddedTypeName-false)) - (_ eof))) - (define (parse-ModulePath input) - (match input ((list (and dest (? symbol?)) ...) dest) (_ eof))) - (define (parse-AtomKind input) - (match - input - ((and dest 'Boolean) (AtomKind-Boolean)) - ((and dest 'Float) (AtomKind-Float)) - ((and dest 'Double) (AtomKind-Double)) - ((and dest 'SignedInteger) (AtomKind-SignedInteger)) - ((and dest 'String) (AtomKind-String)) - ((and dest 'ByteString) (AtomKind-ByteString)) - ((and dest 'Symbol) (AtomKind-Symbol)) - (_ eof))) - (define (parse-DictionaryEntries input) - (match - input - ((parse-sequence - dict? - dict->list - (cons key (app parse-NamedSimplePattern (and value (not (== eof))))) - (cons key value) - make-immutable-hash - dest) - dest) - (_ eof))) - (define (parse-Version input) - (match input ((and dest (== '1)) (void)) (_ eof))) - (define (NamedPattern->preserves input) - (match - input - ((NamedPattern-named src) (NamedSimplePattern_->preserves src)) - ((NamedPattern-anonymous src) (Pattern->preserves src)))) - (define (SimplePattern->preserves input) - (match - input - ((SimplePattern-any) 'any) - ((SimplePattern-atom $atomKind) - (record 'atom (list (AtomKind->preserves $atomKind)))) - ((SimplePattern-embedded) (record 'embedded (list))) - ((SimplePattern-lit $value) (record 'lit (list $value))) - ((SimplePattern-seqof $pattern) - (record 'seqof (list (SimplePattern->preserves $pattern)))) - ((SimplePattern-setof $pattern) - (record 'setof (list (SimplePattern->preserves $pattern)))) - ((SimplePattern-dictof $key $value) - (record - 'dictof - (list - (SimplePattern->preserves $key) - (SimplePattern->preserves $value)))) - ((SimplePattern-Ref src) (Ref->preserves src)))) - (define (NamedAlternative->preserves input) - (match - input - ((NamedAlternative $variantLabel $pattern) - (list $variantLabel (Pattern->preserves $pattern))))) - (define (Definitions->preserves input) - (match - input - (src - (for/hash - (((key value) (in-dict src))) - (values key (Definition->preserves value)))))) - (define (Schema->preserves input) - (match - input - ((Schema $definitions $embeddedType $version) - (record - 'schema - (list - (hash - 'definitions - (Definitions->preserves $definitions) - 'embeddedType - (EmbeddedTypeName->preserves $embeddedType) - 'version - (Version->preserves $version))))))) - (define (Pattern->preserves input) - (match - input - ((Pattern-SimplePattern src) (SimplePattern->preserves src)) - ((Pattern-CompoundPattern src) (CompoundPattern->preserves src)))) + ((Bundle $modules) + (record 'bundle (list (Modules->preserves $modules)))))) (define (CompoundPattern->preserves input) (match input @@ -382,28 +402,6 @@ (NamedSimplePattern->preserves $variable)))) ((CompoundPattern-dict $entries) (record 'dict (list (DictionaryEntries->preserves $entries)))))) - (define (Modules->preserves input) - (match - input - (src - (for/hash - (((key value) (in-dict src))) - (values (ModulePath->preserves key) (Schema->preserves value)))))) - (define (Ref->preserves input) - (match - input - ((Ref $module $name) - (record 'ref (list (ModulePath->preserves $module) $name))))) - (define (Bundle->preserves input) - (match - input - ((Bundle $modules) - (record 'bundle (list (Modules->preserves $modules)))))) - (define (NamedSimplePattern_->preserves input) - (match - input - ((NamedSimplePattern_ $name $pattern) - (record 'named (list $name (SimplePattern->preserves $pattern)))))) (define (Definition->preserves input) (match input @@ -428,28 +426,13 @@ ((item (in-list $patternN))) (NamedPattern->preserves item)))))) ((Definition-Pattern src) (Pattern->preserves src)))) - (define (NamedSimplePattern->preserves input) + (define (Definitions->preserves input) (match input - ((NamedSimplePattern-named src) (NamedSimplePattern_->preserves src)) - ((NamedSimplePattern-anonymous src) (SimplePattern->preserves src)))) - (define (EmbeddedTypeName->preserves input) - (match - input - ((EmbeddedTypeName-Ref src) (Ref->preserves src)) - ((EmbeddedTypeName-false) '#f))) - (define (ModulePath->preserves input) - (match input (src (for/list ((item (in-list src))) item)))) - (define (AtomKind->preserves input) - (match - input - ((AtomKind-Boolean) 'Boolean) - ((AtomKind-Float) 'Float) - ((AtomKind-Double) 'Double) - ((AtomKind-SignedInteger) 'SignedInteger) - ((AtomKind-String) 'String) - ((AtomKind-ByteString) 'ByteString) - ((AtomKind-Symbol) 'Symbol))) + (src + (for/hash + (((key value) (in-dict src))) + (values key (Definition->preserves value)))))) (define (DictionaryEntries->preserves input) (match input @@ -457,4 +440,81 @@ (for/hash (((key value) (in-dict src))) (values key (NamedSimplePattern->preserves value)))))) + (define (EmbeddedTypeName->preserves input) + (match + input + ((EmbeddedTypeName-Ref src) (Ref->preserves src)) + ((EmbeddedTypeName-false) '#f))) + (define (ModulePath->preserves input) + (match input (src (for/list ((item (in-list src))) item)))) + (define (Modules->preserves input) + (match + input + (src + (for/hash + (((key value) (in-dict src))) + (values (ModulePath->preserves key) (Schema->preserves value)))))) + (define (NamedAlternative->preserves input) + (match + input + ((NamedAlternative $variantLabel $pattern) + (list $variantLabel (Pattern->preserves $pattern))))) + (define (NamedPattern->preserves input) + (match + input + ((NamedPattern-named src) (NamedSimplePattern_->preserves src)) + ((NamedPattern-anonymous src) (Pattern->preserves src)))) + (define (NamedSimplePattern->preserves input) + (match + input + ((NamedSimplePattern-named src) (NamedSimplePattern_->preserves src)) + ((NamedSimplePattern-anonymous src) (SimplePattern->preserves src)))) + (define (NamedSimplePattern_->preserves input) + (match + input + ((NamedSimplePattern_ $name $pattern) + (record 'named (list $name (SimplePattern->preserves $pattern)))))) + (define (Pattern->preserves input) + (match + input + ((Pattern-SimplePattern src) (SimplePattern->preserves src)) + ((Pattern-CompoundPattern src) (CompoundPattern->preserves src)))) + (define (Ref->preserves input) + (match + input + ((Ref $module $name) + (record 'ref (list (ModulePath->preserves $module) $name))))) + (define (Schema->preserves input) + (match + input + ((Schema $definitions $embeddedType $version) + (record + 'schema + (list + (hash + 'definitions + (Definitions->preserves $definitions) + 'embeddedType + (EmbeddedTypeName->preserves $embeddedType) + 'version + (Version->preserves $version))))))) + (define (SimplePattern->preserves input) + (match + input + ((SimplePattern-any) 'any) + ((SimplePattern-atom $atomKind) + (record 'atom (list (AtomKind->preserves $atomKind)))) + ((SimplePattern-embedded) (record 'embedded (list))) + ((SimplePattern-lit $value) (record 'lit (list $value))) + ((SimplePattern-seqof $pattern) + (record 'seqof (list (SimplePattern->preserves $pattern)))) + ((SimplePattern-setof $pattern) + (record 'setof (list (SimplePattern->preserves $pattern)))) + ((SimplePattern-dictof $key $value) + (record + 'dictof + (list + (SimplePattern->preserves $key) + (SimplePattern->preserves $value)))) + ((SimplePattern-Ref src) (Ref->preserves src)))) (define (Version->preserves input) (match input ((? void?) '1))))