diff --git a/implementations/racket/preserves/preserves-schema/gen-schema.rkt b/implementations/racket/preserves/preserves-schema/gen-schema.rkt
new file mode 100644
index 0000000..46a05c0
--- /dev/null
+++ b/implementations/racket/preserves/preserves-schema/gen-schema.rkt
@@ -0,0 +1,428 @@
+(module gen-schema racket/base
+  (provide (all-defined-out))
+  (require preserves)
+  (require preserves-schema/support)
+  (require racket/match)
+  (require racket/set)
+  (require racket/dict)
+  (struct NamedPattern-named (value) #:prefab)
+  (struct NamedPattern-anonymous (value) #:prefab)
+  (struct SimplePattern-any () #:prefab)
+  (struct SimplePattern-atom (atomKind) #:prefab)
+  (struct SimplePattern-embedded () #:prefab)
+  (struct SimplePattern-lit (value) #:prefab)
+  (struct SimplePattern-Ref (value) #:prefab)
+  (struct NamedAlternative (variantLabel pattern) #:prefab)
+  (struct Schema (version embeddedType definitions) #:prefab)
+  (struct Pattern-SimplePattern (value) #:prefab)
+  (struct Pattern-CompoundPattern (value) #:prefab)
+  (struct CompoundPattern-rec (label fields) #:prefab)
+  (struct CompoundPattern-tuple (patterns) #:prefab)
+  (struct CompoundPattern-tuple* (fixed variable) #:prefab)
+  (struct CompoundPattern-setof (pattern) #:prefab)
+  (struct CompoundPattern-dictof (key value) #:prefab)
+  (struct CompoundPattern-dict (entries) #:prefab)
+  (struct Ref (module name) #:prefab)
+  (struct Bundle (modules) #:prefab)
+  (struct NamedSimplePattern_ (name pattern) #:prefab)
+  (struct Definition-or (pattern0 pattern1 patternN) #:prefab)
+  (struct Definition-and (pattern0 pattern1 patternN) #:prefab)
+  (struct Definition-Pattern (value) #:prefab)
+  (struct NamedSimplePattern-named (value) #:prefab)
+  (struct NamedSimplePattern-anonymous (value) #:prefab)
+  (struct EmbeddedTypeName-Ref (value) #:prefab)
+  (struct EmbeddedTypeName-false () #:prefab)
+  (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))
+     ((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
+              ('version (app parse-Version (and $version (not (== eof)))))
+              ('embeddedType
+               (app parse-EmbeddedTypeName (and $embeddedType (not (== eof)))))
+              ('definitions
+               (app parse-Definitions (and $definitions (not (== eof)))))
+              (_ _)
+              ...))))
+      (Schema $version $embeddedType $definitions))
+     (_ 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
+             (list*
+              (list
+               (app parse-NamedPattern (and $patterns (not (== eof))))
+               ...)))))
+      (CompoundPattern-tuple $patterns))
+     ((and dest
+           (record
+            'tuple*
+            (list
+             (list*
+              (list (app parse-NamedPattern (and $fixed (not (== eof)))) ...))
+             (app parse-NamedSimplePattern (and $variable (not (== eof)))))))
+      (CompoundPattern-tuple* $fixed $variable))
+     ((and dest
+           (record
+            'setof
+            (list (app parse-SimplePattern (and $pattern (not (== eof)))))))
+      (CompoundPattern-setof $pattern))
+     ((and dest
+           (record
+            'dictof
+            (list
+             (app parse-SimplePattern (and $key (not (== eof))))
+             (app parse-SimplePattern (and $value (not (== eof)))))))
+      (CompoundPattern-dictof $key $value))
+     ((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))))
+              (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-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-EmbeddedTypeName 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
+     ((parse-sequence list? values (and item (? symbol?)) item values dest)
+      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-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 $version $embeddedType $definitions)
+      (record
+       'schema
+       (list
+        (hash
+         'version
+         (Version->preserves $version)
+         'embeddedType
+         (EmbeddedTypeName->preserves $embeddedType)
+         'definitions
+         (Definitions->preserves $definitions)))))))
+  (define (Pattern->preserves input)
+    (match
+     input
+     ((Pattern-SimplePattern src) (SimplePattern->preserves src))
+     ((Pattern-CompoundPattern src) (CompoundPattern->preserves src))))
+  (define (CompoundPattern->preserves input)
+    (match
+     input
+     ((CompoundPattern-rec $label $fields)
+      (record
+       'rec
+       (list
+        (NamedPattern->preserves $label)
+        (NamedPattern->preserves $fields))))
+     ((CompoundPattern-tuple $patterns)
+      (record
+       'tuple
+       (list
+        (list*
+         (for/list
+          ((item (in-list $patterns)))
+          (NamedPattern->preserves item))))))
+     ((CompoundPattern-tuple* $fixed $variable)
+      (record
+       'tuple*
+       (list
+        (list*
+         (for/list ((item (in-list $fixed))) (NamedPattern->preserves item)))
+        (NamedSimplePattern->preserves $variable))))
+     ((CompoundPattern-setof $pattern)
+      (record 'setof (list (SimplePattern->preserves $pattern))))
+     ((CompoundPattern-dictof $key $value)
+      (record
+       'dictof
+       (list
+        (SimplePattern->preserves $key)
+        (SimplePattern->preserves $value))))
+     ((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
+     ((Definition-or $pattern0 $pattern1 $patternN)
+      (record
+       'or
+       (list
+        (list*
+         (NamedAlternative->preserves $pattern0)
+         (NamedAlternative->preserves $pattern1)
+         (for/list
+          ((item (in-list $patternN)))
+          (NamedAlternative->preserves item))))))
+     ((Definition-and $pattern0 $pattern1 $patternN)
+      (record
+       'and
+       (list
+        (list*
+         (NamedPattern->preserves $pattern0)
+         (NamedPattern->preserves $pattern1)
+         (for/list
+          ((item (in-list $patternN)))
+          (NamedPattern->preserves item))))))
+     ((Definition-Pattern src) (Pattern->preserves src))))
+  (define (NamedSimplePattern->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)))
+  (define (DictionaryEntries->preserves input)
+    (match
+     input
+     (src
+      (for/hash
+       (((key value) (in-dict src)))
+       (values key (NamedSimplePattern->preserves value))))))
+  (define (Version->preserves input) (match input ((? void?) '1))))