diff --git a/src/stages/4-ast_typed/.gitignore b/src/stages/4-ast_typed/.gitignore
index 39f5407d5..189a4ee60 100644
--- a/src/stages/4-ast_typed/.gitignore
+++ b/src/stages/4-ast_typed/.gitignore
@@ -1,2 +1,3 @@
 /generated_fold.ml
-
+/generated_map.ml
+/generated_o.ml
diff --git a/src/stages/4-ast_typed/PP_generic.ml b/src/stages/4-ast_typed/PP_generic.ml
index c36fcebcb..502ee88fa 100644
--- a/src/stages/4-ast_typed/PP_generic.ml
+++ b/src/stages/4-ast_typed/PP_generic.ml
@@ -1,3 +1,4 @@
+open Types
 open Fold
 open Format
 open PP_helpers
diff --git a/src/stages/4-ast_typed/ast.ml b/src/stages/4-ast_typed/ast.ml
index be7a7a287..c9f17ac5f 100644
--- a/src/stages/4-ast_typed/ast.ml
+++ b/src/stages/4-ast_typed/ast.ml
@@ -1,6 +1,12 @@
 [@@@warning "-30"]
 
-include Types_utils
+open Types_utils
+
+(* pseudo-typeclasses: interfaces that must be provided for arguments
+   of the givent polymmorphic types. For now, only one typeclass can
+   be specified for a given polymorphic type. *)
+(*@ typeclass poly_unionfind comparable *)
+(*@ typeclass poly_set       comparable *)
 
 type type_constant =
     | TC_unit
diff --git a/src/stages/4-ast_typed/dune b/src/stages/4-ast_typed/dune
index 874a19c0a..b2993c400 100644
--- a/src/stages/4-ast_typed/dune
+++ b/src/stages/4-ast_typed/dune
@@ -1,7 +1,7 @@
 (rule
-  (target generated_fold.ml)
-  (deps ../adt_generator/generator.raku types.ml)
-  (action (with-stdout-to generated_fold.ml (run perl6 ../adt_generator/generator.raku types.ml)))
+  (targets generated_fold.ml generated_map.ml generated_o.ml)
+  (deps ../adt_generator/generator.raku ast.ml)
+  (action (run perl6 ../adt_generator/generator.raku ast.ml Generated_o generated_o.ml generated_fold.ml generated_map.ml))
   (mode (promote (until-clean) (only *)))
 )
 
@@ -19,5 +19,6 @@
   (preprocess
     (pps ppx_let bisect_ppx --conditional)
   )
+;;  (modules_without_implementation generated_fold_x)
   (flags (:standard -open Simple_utils))
 )
diff --git a/src/stages/4-ast_typed/fold.ml b/src/stages/4-ast_typed/fold.ml
index 271974820..f1a08e4cb 100644
--- a/src/stages/4-ast_typed/fold.ml
+++ b/src/stages/4-ast_typed/fold.ml
@@ -1 +1,3 @@
 include Generated_fold
+module M1 = struct include Generated_map end
+module M2 = struct include Generated_o end
diff --git a/src/stages/4-ast_typed/types.ml b/src/stages/4-ast_typed/types.ml
new file mode 100644
index 000000000..6f4ee13b2
--- /dev/null
+++ b/src/stages/4-ast_typed/types.ml
@@ -0,0 +1,5 @@
+(* The content of types.ml has been split into Ast which contains only
+   type declarations, and Types_utils which contains some alias
+   declarations and other definitions used by the fold generator. *)
+include Types_utils
+include Ast
diff --git a/src/stages/4-ast_typed/types_utils.ml b/src/stages/4-ast_typed/types_utils.ml
index 2c77f5c7d..337e76ba0 100644
--- a/src/stages/4-ast_typed/types_utils.ml
+++ b/src/stages/4-ast_typed/types_utils.ml
@@ -32,6 +32,10 @@ type packed_internal_operation = Memory_proto_alpha.Protocol.Alpha_context.packe
 type location = Location.t
 type inline = bool
 
+type 'a extra_info__comparable = {
+  compare : 'a -> 'a -> int ;
+}
+
 let fold_map__constructor_map : type a new_a state . (state -> a -> (state * new_a) result) -> state -> a constructor_map -> (state * new_a constructor_map) result =
   fun f state m ->
   let aux k v acc =
@@ -93,9 +97,9 @@ type 'v typeVariableMap = (type_variable, 'v) RedBlackTrees.PolyMap.t
 
 type 'a poly_set = 'a RedBlackTrees.PolySet.t
 
-let fold_map__poly_unionfind : type a state new_a . (state -> a -> (state * new_a) result) -> state -> a poly_unionfind -> (state * new_a poly_unionfind) Simple_utils.Trace.result =
-  fun f state l ->
-  ignore (f, state, l) ; failwith "TODO
+let fold_map__poly_unionfind : type a state new_a . new_a extra_info__comparable -> (state -> a -> (state * new_a) result) -> state -> a poly_unionfind -> (state * new_a poly_unionfind) Simple_utils.Trace.result =
+  fun extra_info f state l ->
+  ignore (extra_info, f, state, l) ; failwith "TODO
   let aux acc element =
     let%bind state , l = acc in
     let%bind (state , new_element) = f state element in ok (state , new_element :: l) in
@@ -114,12 +118,13 @@ let fold_map__PolyMap : type k v state new_v . (state -> v -> (state * new_v) re
 let fold_map__typeVariableMap : type a state new_a . (state -> a -> (state * new_a) result) -> state -> a typeVariableMap -> (state * new_a typeVariableMap) result =
   fold_map__PolyMap
 
-let fold_map__poly_set : type a state new_a . (state -> a -> (state * new_a) result) -> state -> a poly_set -> (state * new_a poly_set) result =
-  fun f state s ->
-  let new_compare : (new_a -> new_a -> int) = failwith "TODO: thread enough information about the target AST so that we may compare things here." in
+let fold_map__poly_set : type a state new_a . new_a extra_info__comparable -> (state -> a -> (state * new_a) result) -> state -> a poly_set -> (state * new_a poly_set) result =
+  fun extra_info f state s ->
+  let new_compare : (new_a -> new_a -> int) = extra_info.compare in
   let aux elt ~acc =
     let%bind (state , s) = acc in
     let%bind (state , new_elt) = f state elt in
     ok (state , PolySet.add new_elt s) in
   let%bind (state , m) = PolySet.fold_inc aux s ~init:(ok (state, PolySet.create ~cmp:new_compare)) in
   ok (state , m)
+
diff --git a/src/stages/adt_generator/generator.raku b/src/stages/adt_generator/generator.raku
index 8b323c157..99c5c1a56 100644
--- a/src/stages/adt_generator/generator.raku
+++ b/src/stages/adt_generator/generator.raku
@@ -8,17 +8,27 @@ use worries;
 # TODO: shorthand for `foo list` etc. in field and constructor types
 # TODO: error when reserved names are used ("state", … please list them here)
 
-my $moduleName = @*ARGS[0].subst(/\.ml$/, '').samecase("A_");
+my $inputADTfile         = @*ARGS[0];
+my $oModuleName          = @*ARGS[1];
+my $combinators_filename = @*ARGS[2];
+my $folder_filename      = @*ARGS[3];
+my $mapper_filename      = @*ARGS[4];
+
+my $moduleName = $inputADTfile.subst(/\.ml$/, '').samecase("A_");
 my $variant = "_ _variant";
 my $record = "_ _ record";
 sub poly { $^type_name }
 
-my $l = @*ARGS[0].IO.lines;
+my $l = $inputADTfile.IO.lines;
 $l = $l.map(*.subst: /(^\s+|\s+$)/, "");
 $l = $l.list.cache;
 my $statement_re = /^((\(\*\s+)?(open|include)\s|\[\@\@\@warning\s)/;
 my $statements = $l.grep($statement_re);
 $l             = $l.grep(none $statement_re);
+$l = $l.list.cache;
+my $typeclass_re = /^\(\*\@ \s* typeclass \s+ (\w+) \s+ (\w+) \s* \*\)/;
+my $typeclasses = %($l.grep($typeclass_re).map({ do given $_ { when $typeclass_re { %{ "$/[0]" => "$/[1]" } } } }).flat);
+$l              = $l.grep(none $typeclass_re);
 $statements    = $statements.map(*.subst(/^\(\*\s+/, '').subst(/\s+\*\)$/, ''));
 $l = $l.cache.map(*.subst: /^type\s+/, "\nand ");
 # TODO: find a better way to write [\*] (anything but a star), the Raku form I found <-[\*]> is very verbose.
@@ -50,424 +60,440 @@ $l = $l.map: {
       "kind"          => $kind ,
       "ctorsOrFields" => $ctorsOrFields
     }
-    # $_[0].subst: , '' }
 };
-# $l.perl.say;
-# exit;
-
-# ($cf, $isBuiltin, $type) 
-       # {
-       #     name      => $cf ,
-       #     newName   => "$cf'" ,
-       #     isBuiltin => $isBuiltin ,
-       #     type      => $type ,
-       #     newType   => $isBuiltin ?? $type !! "$type'"
-       # }
-
-
-
-# my @adts_raw = [
-#     # typename, kind, fields_or_ctors
-#     ["root", $variant, [
-#          # ctor, builtin?, type
-#          ["A", False, "rootA"],
-#          ["B", False, "rootB"],
-#          ["C", True, "string"],
-#      ]],
-#     ["a", $record, [
-#          # field, builtin?, type
-#          ["a1", False, "ta1"],
-#          ["a2", False, "ta2"],
-#      ]],
-#     ["ta1", $variant, [
-#          ["X", False, "root"],
-#          ["Y", False, "ta2"],
-#      ]],
-#     ["ta2", $variant, [
-#          ["Z", False, "ta2"],
-#          ["W", True, "unit"],
-#      ]],
-#     # polymorphic type
-#     ["rootA", poly("list"),
-#      [
-#       # Position (0..n-1), builtin?, type argument
-#       [0, False, "a"],
-#      ],
-#     ],
-#     ["rootB", poly("list"),
-#      [
-#       # Position (0..n-1), builtin?, type argument
-#       [0, True, "int"],
-#      ],
-#     ],
-#     ];
-
-# # say $adts_raw.perl;
-# my $adts = (map -> ($name , $kind, @ctorsOrFields) {
-#   {
-#    "name"          => $name ,
-#    "newName"       => "$name'" ,
-#    "kind"          => $kind ,
-#    "ctorsOrFields" => @(map -> ($cf, $isBuiltin, $type) {
-#        {
-#            name      => $cf ,
-#            newName   => "$cf'" ,
-#            isBuiltin => $isBuiltin ,
-#            type      => $type ,
-#            newType   => $isBuiltin ?? $type !! "$type'"
-#        }
-#    }, @ctorsOrFields),
-#   }
-# }, @adts_raw).list;
 
 my $adts = (map -> (:$name , :$kind, :@ctorsOrFields) {
   {
    "name"          => $name ,
-   "newName"       => "{$name}__'" ,
+   "oNewName"      => "O.{$name}", # ($kind ne $record && $kind ne $variant) ?? "$name" !! "O.{$name}",
+   "newName"       => $name ,
    "kind"          => $kind ,
    "ctorsOrFields" => @(map -> ($cf, $type) {
-       my $isBuiltin = (! $type) || (! $l.cache.first({ $_<name> eq $type }));
+       my $resolvedType = $type && $l.cache.first({ $_<name> eq $type });
+       my $isBuiltin = (! $type) || (! $resolvedType);
+       # my $isPoly = $resolvedType && $resolvedType<kind> ne $record && $resolvedType<kind> ne $variant;
        {
            name      => $cf ,
-           newName   => "{$cf}__'" ,
+           oNewName  => "O.{$cf}" ,
+           newName   => $cf ,
            isBuiltin => $isBuiltin ,
            type      => $type ,
-           newType   => $isBuiltin ?? "$type" !! "{$type}__'"
+           oNewType  => $isBuiltin ?? "$type" !! "O.{$type}" ,
+           newType   => $type ,
        }
    }, @ctorsOrFields),
   }
 }, @$l.cache).list;
 
-# say $adts.perl;
 
-# say $adts.perl ;
-
-say "(* This is an auto-generated file. Do not edit. *)";
-
-say "";
-for $statements -> $statement {
-  say "$statement"
-}
-say "open Adt_generator.Common;;";
-say "open $moduleName;;";
-
-say "";
-say "(* must be provided by one of the open or include statements: *)";
-for $adts.grep({$_<kind> ne $record && $_<kind> ne $variant}).map({$_<kind>}).unique -> $poly
-{ say "let fold_map__$poly : type a new_a state . (state -> a -> (state * new_a, _) monad) -> state -> a $poly -> (state * new_a $poly , _) monad = fold_map__$poly;;"; }
-
-say "";
-for $adts.kv -> $index, $t {
-  my $typeOrAnd = $index == 0 ?? "type" !! "and";
-  say "$typeOrAnd $t<newName> =";
-  if ($t<kind> eq $variant) {
-      for $t<ctorsOrFields>.list -> $c {
-          given $c<type> {
-              when '' { say "  | $c<newName>" }
-              default { say "  | $c<newName> of $c<newType>" }
-          }
-      }
-      say "";
-  } elsif ($t<kind> eq $record) {
-      say '  {';
-      for $t<ctorsOrFields>.list -> $f
-      { say "    $f<newName> : $f<newType> ;"; }
-      say '  }';
-  } else {
-      print "  ";
-      for $t<ctorsOrFields>.list -> $a
-      { print "$a<newType> "; }
-      print "$t<kind>";
-      say "";
-  }
-}
-say ";;";
-
-say "";
-for $adts.list -> $t {
-    say "type ('state, 'err) _continue_fold_map__$t<name> = \{";
-        say "    node__$t<name> : 'state -> $t<name> -> ('state * $t<newName> , 'err) monad ;";
-    for $t<ctorsOrFields>.list -> $c
-    { say "    $t<name>__$c<name> : 'state -> {$c<type> || 'unit'} -> ('state * {$c<newType> || 'unit'} , 'err) monad ;" }
-    say '  };;';
-}
-
-say "type ('state , 'err) _continue_fold_map__$moduleName = \{";
-for $adts.list -> $t {
-    say "    $t<name> : ('state , 'err) _continue_fold_map__$t<name> ;";
-}
-say '  };;';
-
-say "";
-for $adts.list -> $t
-{ say "type ('state, 'err) fold_map_config__$t<name> = \{";
-  say "    node__$t<name> : 'state -> $t<name> -> ('state, 'err) _continue_fold_map__$moduleName -> ('state * $t<newName> , 'err) monad ;"; # (*Adt_info.node_instance_info ->*)
-  say "    node__$t<name>__pre_state : 'state -> $t<name> -> ('state, 'err) monad ;"; # (*Adt_info.node_instance_info ->*)
-  say "    node__$t<name>__post_state : 'state -> $t<name> -> $t<newName> -> ('state, 'err) monad ;"; # (*Adt_info.node_instance_info ->*)
-  for $t<ctorsOrFields>.list -> $c
-  { say "    $t<name>__$c<name> : 'state -> {$c<type> || 'unit'} -> ('state, 'err) _continue_fold_map__$moduleName -> ('state * {$c<newType> || 'unit'} , 'err) monad ;"; # (*Adt_info.ctor_or_field_instance_info ->*)
-  }
-  say '};;' }
-
-say "type ('state, 'err) fold_map_config__$moduleName =";
-say '  {';
-for $adts.list -> $t
-{ say "    $t<name> : ('state, 'err) fold_map_config__$t<name>;" }
-say '  };;';
-
-say "include Adt_generator.Generic.BlahBluh";
-say "type ('state , 'adt_info_node_instance_info) _fold_config =";
-say '  {';
-say "    generic : 'state -> 'adt_info_node_instance_info -> 'state;";
-# look for builtins, filtering out the "implicit unit-like fake argument of emtpy constructors" (represented by '')
-for $adts.map({ $_<ctorsOrFields> })[*;*].grep({$_<isBuiltin> && $_<type> ne ''}).map({$_<type>}).unique -> $builtin
-{ say "    $builtin : ('state , 'adt_info_node_instance_info) _fold_config -> 'state -> $builtin -> 'state;"; }
-# look for built-in polymorphic types
-for $adts.grep({$_<kind> ne $record && $_<kind> ne $variant}).map({$_<kind>}).unique -> $poly
-{ say "    $poly : 'a . ('state , 'adt_info_node_instance_info) _fold_config -> ('state -> 'a -> 'state) -> 'state -> 'a $poly -> 'state;"; }
-say '  };;';
-say "module Arg = struct";
-say "  type nonrec ('state , 'adt_info_node_instance_info) fold_config = ('state , 'adt_info_node_instance_info) _fold_config;;";
-say "end;;";
-say "module Adt_info = Adt_generator.Generic.Adt_info (Arg);;";
-say "include Adt_info;;";
-say "type 'state fold_config = ('state , 'state Adt_info.node_instance_info) _fold_config;;";
-
-say "";
-say 'type blahblah = {';
-for $adts.list -> $t
-{ say "  fold__$t<name> : 'state . blahblah -> 'state fold_config -> 'state -> $t<name> -> 'state;";
-  for $t<ctorsOrFields>.list -> $c
-  { say "  fold__$t<name>__$c<name> : 'state . blahblah -> 'state fold_config -> 'state -> { $c<type> || 'unit' } -> 'state;"; } }
-say '};;';
-
-# generic programming info about the nodes and fields
-say "";
-for $adts.list -> $t
-{ for $t<ctorsOrFields>.list -> $c
-  { say "(* info for field or ctor $t<name>.$c<name> *)";
-    say "let info__$t<name>__$c<name> : Adt_info.ctor_or_field = \{";
-    say "  name = \"$c<name>\";";
-    say "  is_builtin = {$c<isBuiltin> ?? 'true' !! 'false'};";
-    say "  type_ = \"$c<type>\";";
-    say '}';
-    say "";
-    say "let continue_info__$t<name>__$c<name> : type qstate . blahblah -> qstate fold_config -> {$c<type> || 'unit'} -> qstate Adt_info.ctor_or_field_instance = fun blahblah visitor x -> \{";
-    say "  cf = info__$t<name>__$c<name>;";
-    say "  cf_continue = (fun state -> blahblah.fold__$t<name>__$c<name> blahblah visitor state x);";
-    say "  cf_new_fold = (fun visitor state -> blahblah.fold__$t<name>__$c<name> blahblah visitor state x);";
-    say '};;';
-    say ""; }
-  say "(* info for node $t<name> *)";
-  say "let info__$t<name> : Adt_info.node = \{";
-  my $kind = do given $t<kind> {
-    when $record { "Record" }
-    when $variant { "Variant" }
-    default { "Poly \"$_\"" }
-  };
-  say "  kind = $kind;";
-  say "  declaration_name = \"$t<name>\";";
-  print "  ctors_or_fields = [ ";
-  for $t<ctorsOrFields>.list -> $c { print "info__$t<name>__$c<name> ; "; }
-  say "];";
-  say '};;';
-  say "";
-  # TODO: factor out some of the common bits here.
-  say "let continue_info__$t<name> : type qstate . blahblah -> qstate fold_config -> $t<name> -> qstate Adt_info.instance = fun blahblah visitor x ->";
-  say '{';
-  say "  instance_declaration_name = \"$t<name>\";";
-  do given $t<kind> {
-    when $record {
-        say '  instance_kind = RecordInstance {';
-        print "    fields = [ ";
-        for $t<ctorsOrFields>.list -> $c { print "continue_info__$t<name>__$c<name> blahblah visitor x.$c<name> ; "; }
-        say "  ];";
-        say '};';
-    }
-    when $variant {
-        say '  instance_kind = VariantInstance {';
-        say "    constructor = (match x with";
-        for $t<ctorsOrFields>.list -> $c { say "    | $c<name> { $c<type> ?? 'v ' !! '' }-> continue_info__$t<name>__$c<name> blahblah visitor { $c<type> ?? 'v' !! '()' }"; }
-        say "  );";
-        print "    variant = [ ";
-        for $t<ctorsOrFields>.list -> $c { print "info__$t<name>__$c<name> ; "; }
-        say "];";
-        say '};';
-    }
-    default {
-        say '  instance_kind = PolyInstance {';
-        say "    poly = \"$_\";";
-        print "    arguments = [";
-        # TODO: sort by c<name> (currently we only have one-argument
-        # polymorphic types so it happens to work but should be fixed.
-        for $t<ctorsOrFields>.list -> $c { print "\"$c<type>\""; }
-        say "];";
-        print "    poly_continue = (fun state -> visitor.$_ visitor (";
-        print $t<ctorsOrFields>
-            .map(-> $c { "(fun state x -> (continue_info__$t<name>__$c<name> blahblah visitor x).cf_continue state)" })
-            .join(", ");
-        say ") state x);";
-        say '};';
-    }
-  };
-  say '};;';
-  say ""; }
-
-say "";
-say "(* info for adt $moduleName *)";
-print "let whole_adt_info : unit -> Adt_info.adt = fun () -> [ ";
-for $adts.list -> $t
-{ print "info__$t<name> ; "; }
-say "];;";
-
-# fold functions
-say "";
-for $adts.list -> $t
-{ say "let fold__$t<name> : type qstate . blahblah -> qstate fold_config -> qstate -> $t<name> -> qstate = fun blahblah visitor state x ->";
-  # TODO: add a non-generic continue_fold.
-  say '  let node_instance_info : qstate Adt_info.node_instance_info = {';
-  say "    adt = whole_adt_info () ;";
-  say "    node_instance = continue_info__$t<name> blahblah visitor x";
-  say '  } in';
-  # say "  let (state, new_x) = visitor.$t<name>.node__$t<name> x (fun () -> whole_adt_info, info__$t<name>) state continue_fold in";
-  say "  visitor.generic state node_instance_info;;";
-  say "";
-  for $t<ctorsOrFields>.list -> $c
-  { say "let fold__$t<name>__$c<name> : type qstate . blahblah -> qstate fold_config -> qstate -> { $c<type> || 'unit' } -> qstate = fun blahblah { $c<type> ?? 'visitor' !! '_visitor' } state { $c<type> ?? 'x' !! '()' } ->";
-    # say "  let ctor_or_field_instance_info : qstate Adt_info.ctor_or_field_instance_info = whole_adt_info (), info__$t<name>, continue_info__$t<name>__$c<name> visitor x in";
-    if ($c<type> eq '') {
-        # nothing to do, this constructor has no arguments.
-        say "  ignore blahblah; state;;";
-    } elsif ($c<isBuiltin>) {
-        say "  ignore blahblah; visitor.$c<type> visitor state x;;"; # (*visitor.generic_ctor_or_field ctor_or_field_instance_info*) 
-    } else {
-        say "  blahblah.fold__$c<type> blahblah visitor state x;;"; # (*visitor.generic_ctor_or_field ctor_or_field_instance_info*)
-    }
-    # say "  visitor.$t<name>.$t<name>__$c<name> x (fun () -> whole_adt_info, info__$t<name>, info__$t<name>__$c<name>) state continue_fold";
-    say ""; }
-}
-
-say "";
-say 'let blahblah : blahblah = {';
-for $adts.list -> $t
-{ say "  fold__$t<name>;";
-  for $t<ctorsOrFields>.list -> $c
-  { say "  fold__$t<name>__$c<name>;" } }
-say '};;';
-
-# Tying the knot
-say "";
-for $adts.list -> $t
-{ say "let fold__$t<name> : type qstate . qstate fold_config -> qstate -> $t<name> -> qstate = fun visitor state x -> fold__$t<name> blahblah visitor state x;;";
-  for $t<ctorsOrFields>.list -> $c
-  { say "let fold__$t<name>__$c<name> : type qstate . qstate fold_config -> qstate -> { $c<type> || 'unit' } -> qstate = fun visitor state x -> fold__$t<name>__$c<name> blahblah visitor state x;;" } }
-
-
-say "";
-say "type ('state, 'err) mk_continue_fold_map = \{";
-say "  fn : ('state, 'err) mk_continue_fold_map -> ('state, 'err) fold_map_config__$moduleName -> ('state, 'err) _continue_fold_map__$moduleName";
-say '};;';
-
-
-# fold_map functions
-say "";
-for $adts.list -> $t
-{ say "let _fold_map__$t<name> : type qstate err . (qstate,err) mk_continue_fold_map -> (qstate,err) fold_map_config__$moduleName -> qstate -> $t<name> -> (qstate * $t<newName>, err) monad = fun mk_continue_fold_map visitor state x ->";
-  say "  let continue_fold_map : (qstate,err) _continue_fold_map__$moduleName = mk_continue_fold_map.fn mk_continue_fold_map visitor in";
-  say "  visitor.$t<name>.node__$t<name>__pre_state state x >>? fun state ->"; # (*(fun () -> whole_adt_info, info__$t<name>)*)
-  say "  visitor.$t<name>.node__$t<name> state x continue_fold_map >>? fun (state, new_x) ->"; # (*(fun () -> whole_adt_info, info__$t<name>)*)
-  say "  visitor.$t<name>.node__$t<name>__post_state state x new_x >>? fun state ->"; # (*(fun () -> whole_adt_info, info__$t<name>)*)
-  say "  return (state, new_x);;";
-  say "";
-  for $t<ctorsOrFields>.list -> $c
-  { say "let _fold_map__$t<name>__$c<name> : type qstate err . (qstate,err) mk_continue_fold_map -> (qstate,err) fold_map_config__$moduleName -> qstate -> { $c<type> || 'unit' } -> (qstate * { $c<newType> || 'unit' }, err) monad = fun mk_continue_fold_map visitor state x ->";
-    say "  let continue_fold_map : (qstate,err) _continue_fold_map__$moduleName = mk_continue_fold_map.fn mk_continue_fold_map visitor in";
-    say "  visitor.$t<name>.$t<name>__$c<name> state x continue_fold_map;;"; # (*(fun () -> whole_adt_info, info__$t<name>, info__$t<name>__$c<name>)*)
-    say ""; } }
-
-# make the "continue" object
-say "";
-say '(* Curries the "visitor" argument to the folds (non-customizable traversal functions). *)';
-say "let mk_continue_fold_map : 'state 'err . ('state,'err) mk_continue_fold_map = \{ fn = fun self visitor ->";
-say '  {';
-for $adts.list -> $t
-{ say "    $t<name> = \{";
-  say "        node__$t<name> = (fun state x -> _fold_map__$t<name> self visitor state x) ;";
-  for $t<ctorsOrFields>.list -> $c
-  { say "        $t<name>__$c<name> = (fun state x -> _fold_map__$t<name>__$c<name> self visitor state x) ;"; }
-  say '    };' }
-say '  }';
-say '};;';
-say "";
-
-# fold_map functions : tying the knot
-say "";
-for $adts.list -> $t
-{ say "let fold_map__$t<name> : type qstate err . (qstate,err) fold_map_config__$moduleName -> qstate -> $t<name> -> (qstate * $t<newName>,err) monad =";
-  say "  fun visitor state x -> _fold_map__$t<name> mk_continue_fold_map visitor state x;;";
-  for $t<ctorsOrFields>.list -> $c
-  { say "let fold_map__$t<name>__$c<name> : type qstate err . (qstate,err) fold_map_config__$moduleName -> qstate -> { $c<type> || 'unit' } -> (qstate * { $c<newType> || 'unit' },err) monad =";
-    say "  fun visitor state x -> _fold_map__$t<name>__$c<name> mk_continue_fold_map visitor state x;;"; } }
-
-
-for $adts.list -> $t
+# Auto-generated fold functions
+$*OUT = open $folder_filename, :w;
 {
-   say "let no_op_node__$t<name> : type state . state -> $t<name> -> (state,_) _continue_fold_map__$moduleName -> (state * $t<newName>,_) monad =";
-  say "  fun state v continue ->"; # (*_info*)
-  say "    match v with";
-  if ($t<kind> eq $variant) {
-    for $t<ctorsOrFields>.list -> $c
-    { given $c<type> {
-        when '' { say "    | $c<name> -> continue.$t<name>.$t<name>__$c<name> state () >>? fun (state , ()) -> return (state , $c<newName>)"; }
-        default { say "    | $c<name> v -> continue.$t<name>.$t<name>__$c<name> state v >>? fun (state , v) -> return (state , $c<newName> v)"; } } }
-  } elsif ($t<kind> eq $record) {
-    print '      { ';
-    for $t<ctorsOrFields>.list -> $f
-    { print "$f<name>; "; }
-    say "} ->";
-    for $t<ctorsOrFields>.list -> $f
-    { say "      continue.$t<name>.$t<name>__$f<name> state $f<name> >>? fun (state , $f<newName>) ->"; }
-    print '      return (state , ({ ';
-    for $t<ctorsOrFields>.list -> $f
-    { print "$f<newName>; "; }
-    say "\} : $t<newName>))";
-  } else {
-    print "      v -> fold_map__$t<kind> ( ";
-    print ( "continue.$t<name>.$t<name>__$_<name>" for $t<ctorsOrFields>.list ).join(", ");
-    say " ) state v;;";
-  }
+    say "(* This is an auto-generated file. Do not edit. *)";
+    say "";
+    for $statements -> $statement { say "$statement" }
+    say "open $moduleName;;";
+
+    say "";
+    say "  include Adt_generator.Generic.BlahBluh";
+    say "  type ('state , 'adt_info_node_instance_info) _fold_config = \{";
+    say "      generic : 'state -> 'adt_info_node_instance_info -> 'state;";
+    # look for builtins, filtering out the "implicit unit-like fake argument of emtpy constructors" (represented by '')
+    for $adts.map({ $_<ctorsOrFields> })[*;*].grep({$_<isBuiltin> && $_<type> ne ''}).map({$_<type>}).unique -> $builtin
+    { say "      $builtin : ('state , 'adt_info_node_instance_info) _fold_config -> 'state -> $builtin -> 'state;"; }
+    # look for built-in polymorphic types
+    for $adts.grep({$_<kind> ne $record && $_<kind> ne $variant}).map({$_<kind>}).unique -> $poly
+    { say "      $poly : 'a . ('state , 'adt_info_node_instance_info) _fold_config -> ('state -> 'a -> 'state) -> 'state -> 'a $poly -> 'state;"; }
+    say '    };;';
+
+    say "";
+    say "  module Adt_info = Adt_generator.Generic.Adt_info (struct";
+    say "    type nonrec ('state , 'adt_info_node_instance_info) fold_config = ('state , 'adt_info_node_instance_info) _fold_config;;";
+    say "  end);;";
+    say "  include Adt_info;;";
+    say "  type 'state fold_config = ('state , 'state Adt_info.node_instance_info) _fold_config;;";
+
+    say "";
+    say '  type the_folds = {';
+    for $adts.list -> $t
+    { say "      fold__$t<name> : 'state . the_folds -> 'state fold_config -> 'state -> $t<name> -> 'state;";
+      for $t<ctorsOrFields>.list -> $c
+      { say "      fold__$t<name>__$c<name> : 'state . the_folds -> 'state fold_config -> 'state -> { $c<type> || 'unit' } -> 'state;"; } }
+    say '    };;';
+
+    # generic programming info about the nodes and fields
+    say "";
+    for $adts.list -> $t
+    { for $t<ctorsOrFields>.list -> $c
+      { say "  (* info for field or ctor $t<name>.$c<name> *)";
+        say "  let info__$t<name>__$c<name> : Adt_info.ctor_or_field = \{";
+        say "      name = \"$c<name>\";";
+        say "      is_builtin = {$c<isBuiltin> ?? 'true' !! 'false'};";
+        say "      type_ = \"$c<type>\";";
+        say '    };;';
+        # say "";
+        say "  let continue_info__$t<name>__$c<name> : type qstate . the_folds -> qstate fold_config -> {$c<type> || 'unit'} -> qstate Adt_info.ctor_or_field_instance = fun the_folds visitor x -> \{";
+        say "        cf = info__$t<name>__$c<name>;";
+        say "        cf_continue = (fun state -> the_folds.fold__$t<name>__$c<name> the_folds visitor state x);";
+        say "        cf_new_fold = (fun visitor state -> the_folds.fold__$t<name>__$c<name> the_folds visitor state x);";
+        say '      };;';
+        # say "";
+      }
+      say "  (* info for node $t<name> *)";
+      say "  let info__$t<name> : Adt_info.node = \{";
+      my $kind = do given $t<kind> {
+          when $record { "Record" }
+          when $variant { "Variant" }
+          default { "Poly \"$_\"" }
+      };
+      say "      kind = $kind;";
+      say "      declaration_name = \"$t<name>\";";
+      print "      ctors_or_fields = [ ";
+      for $t<ctorsOrFields>.list -> $c { print "info__$t<name>__$c<name> ; "; }
+      say "];";
+      say '    };;';
+      # say "";
+      # TODO: factor out some of the common bits here.
+      say "  let continue_info__$t<name> : type qstate . the_folds -> qstate fold_config -> $t<name> -> qstate Adt_info.instance = fun the_folds visitor x ->";
+      say '    {';
+      say "      instance_declaration_name = \"$t<name>\";";
+      do given $t<kind> {
+          when $record {
+              say '      instance_kind = RecordInstance {';
+              print "      fields = [ ";
+              for $t<ctorsOrFields>.list -> $c { print "continue_info__$t<name>__$c<name> the_folds visitor x.$c<name> ; "; }
+              say "      ];";
+              say '  };';
+          }
+          when $variant {
+              say "      instance_kind =";
+              say '        VariantInstance {';
+              say "            constructor =";
+              say "              (match x with";
+              for $t<ctorsOrFields>.list -> $c { say "               | $c<name> { $c<type> ?? 'v ' !! '' }-> continue_info__$t<name>__$c<name> the_folds visitor { $c<type> ?? 'v' !! '()' }"; }
+              say "              );";
+              print "            variant = [ ";
+              for $t<ctorsOrFields>.list -> $c { print "info__$t<name>__$c<name> ; "; }
+              say "];";
+              say '          };';
+          }
+          default {
+              say "      instance_kind =";
+              say '        PolyInstance {';
+              say "            poly = \"$_\";";
+              print "            arguments = [";
+              # TODO: sort by c<name> (currently we only have one-argument
+              # polymorphic types so it happens to work but should be fixed.
+              for $t<ctorsOrFields>.list -> $c { print "\"$c<type>\""; }
+              say "];";
+              print "            poly_continue = (fun state -> visitor.$_ visitor (";
+              print $t<ctorsOrFields>
+                  .map(-> $c { "(fun state x -> (continue_info__$t<name>__$c<name> the_folds visitor x).cf_continue state)" })
+                  .join(", ");
+              say ") state x);";
+              say '          };';
+          }
+      };
+      say '    };;';
+      # say "";
+    }
+
+    say "";
+    say "  (* info for adt $moduleName *)";
+    print "  let whole_adt_info : unit -> Adt_info.adt = fun () -> [ ";
+    for $adts.list -> $t
+    { print "info__$t<name> ; "; }
+    say "];;";
+
+    # fold functions
+    say "";
+    for $adts.list -> $t
+    { say "  let fold__$t<name> : type qstate . the_folds -> qstate fold_config -> qstate -> $t<name> -> qstate = fun the_folds visitor state x ->";
+      # TODO: add a non-generic continue_fold.
+      say '    let node_instance_info : qstate Adt_info.node_instance_info = {';
+      say "        adt = whole_adt_info () ;";
+      say "        node_instance = continue_info__$t<name> the_folds visitor x";
+      say '      } in';
+      # say "  let (state, new_x) = visitor.$t<name>.node__$t<name> x (fun () -> whole_adt_info, info__$t<name>) state continue_fold in";
+      say "    visitor.generic state node_instance_info;;";
+      # say "";
+      for $t<ctorsOrFields>.list -> $c
+      { say "  let fold__$t<name>__$c<name> : type qstate . the_folds -> qstate fold_config -> qstate -> { $c<type> || 'unit' } -> qstate = fun the_folds { $c<type> ?? 'visitor' !! '_visitor' } state { $c<type> ?? 'x' !! '()' } ->";
+        # say "  let ctor_or_field_instance_info : qstate Adt_info.ctor_or_field_instance_info = whole_adt_info (), info__$t<name>, continue_info__$t<name>__$c<name> visitor x in";
+        if ($c<type> eq '') {
+            # nothing to do, this constructor has no arguments.
+            say "    ignore the_folds; state;;";
+        } elsif ($c<isBuiltin>) {
+            say "    ignore the_folds; visitor.$c<type> visitor state x;;"; # (*visitor.generic_ctor_or_field ctor_or_field_instance_info*)
+        } else {
+            say "    the_folds.fold__$c<type> the_folds visitor state x;;"; # (*visitor.generic_ctor_or_field ctor_or_field_instance_info*)
+        }
+        # say "  visitor.$t<name>.$t<name>__$c<name> x (fun () -> whole_adt_info, info__$t<name>, info__$t<name>__$c<name>) state continue_fold";
+        # say "";
+      }
+    }
+
+    say "";
+    say '  let the_folds : the_folds = {';
+    for $adts.list -> $t
+    { say "    fold__$t<name>;";
+      for $t<ctorsOrFields>.list -> $c
+      { say "    fold__$t<name>__$c<name>;" } }
+    say '  };;';
+
+    # Tying the knot
+    say "";
+    for $adts.list -> $t
+    { say "  let fold__$t<name> : type qstate . qstate fold_config -> qstate -> $t<name> -> qstate = fun visitor state x -> fold__$t<name> the_folds visitor state x;;";
+      for $t<ctorsOrFields>.list -> $c
+      { say "  let fold__$t<name>__$c<name> : type qstate . qstate fold_config -> qstate -> { $c<type> || 'unit' } -> qstate = fun visitor state x -> fold__$t<name>__$c<name> the_folds visitor state x;;" } }
+
+    say "";
+    say "  module Folds (M : sig type state type 'a t val f : (state fold_config -> state -> 'a -> state) -> 'a t  end) = struct";
+    for $adts.list -> $t
+    { say "  let $t<name> = M.f fold__$t<name>;;"; }
+    say "  end";
 }
 
-for $adts.list -> $t
-{ say "let no_op__$t<name> : type state . (state,_) fold_map_config__$t<name> = \{";
-  say "  node__$t<name> = no_op_node__$t<name>;";
-  say "  node__$t<name>__pre_state = (fun state v -> ignore v; return state) ;"; # (*_info*)
-  say "  node__$t<name>__post_state = (fun state v new_v -> ignore (v, new_v); return state) ;"; # (*_info*)
-  for $t<ctorsOrFields>.list -> $c
-  { print "  $t<name>__$c<name> = (fun state v continue -> "; # (*_info*)
-    if ($c<isBuiltin>) {
-      print "ignore continue; return (state , v)";
-    } else {
-      print "continue.$c<type>.node__$c<type> state v";
+# auto-generated fold_map functions
+$*OUT = open $mapper_filename, :w;
+{
+    say "(* This is an auto-generated file. Do not edit. *)";
+    say "";
+    for $statements -> $statement { say "$statement" }
+    say "open Adt_generator.Common;;";
+    say "open $moduleName;;";
+
+    say "";
+    say "module type OSig = sig";
+    for $adts.list -> $t {
+        say "  type $t<newName>;;";
     }
-    say ") ;"; }
-  say '  }' }
 
-say "let no_op : type state . (state,_) fold_map_config__$moduleName = \{";
-for $adts.list -> $t
-{ say "  $t<name> = no_op__$t<name>;" }
-say '};;';
+    for $adts.list -> $t {
+        if ($t<kind> eq $variant) {
+            for $t<ctorsOrFields>.list -> $c {
+                say "  val make__$t<newName>__$c<newName> : {$c<type> ne '' ?? "$c<newType> " !! 'unit'} -> $t<newName>;;";
+            }
+        } elsif ($t<kind> eq $record) {
+            print "  val make__$t<newName>";
+            say ' :';
+            for $t<ctorsOrFields>.list -> $f
+            { say "    {$f<newName>}:{$f<newType>} ->"; }
+            say "    $t<newName>;;";
+        } else {
+            print "  val make__$t<newName> : (";
+            print $t<ctorsOrFields>.map({$_<newType>}).join(" , ");
+            say ") $t<kind> -> $t<newName>;;";
+        }
+    }
 
-say "";
-for $adts.list -> $t
-{ say "let with__$t<name> : _ -> _ fold_map_config__$moduleName -> _ fold_map_config__$moduleName = (fun node__$t<name> op -> \{ op with $t<name> = \{ op.$t<name> with node__$t<name> \} \});;";
-  say "let with__$t<name>__pre_state : _ -> _ fold_map_config__$moduleName -> _ fold_map_config__$moduleName = (fun node__$t<name>__pre_state op -> \{ op with $t<name> = \{ op.$t<name> with node__$t<name>__pre_state \} \});;";
-  say "let with__$t<name>__post_state : _ -> _ fold_map_config__$moduleName -> _ fold_map_config__$moduleName = (fun node__$t<name>__post_state op -> \{ op with $t<name> = \{ op.$t<name> with node__$t<name>__post_state \} \});;";
-  for $t<ctorsOrFields>.list -> $c
-  { say "let with__$t<name>__$c<name> : _ -> _ fold_map_config__$moduleName -> _ fold_map_config__$moduleName = (fun $t<name>__$c<name> op -> \{ op with $t<name> = \{ op.$t<name> with $t<name>__$c<name> \} \});;"; } }
+    say "";
+    for $adts.grep({$_<kind> ne $record && $_<kind> ne $variant && $typeclasses{$_<kind>}}).unique(:as({$_<ctorsOrFields>, $_<kind>})) -> $t
+    { my $ty = $t<ctorsOrFields>[0]<type>;
+      my $tc = $typeclasses{$t<kind>};
+      say "  val extra_info__{$ty}__$tc : $ty extra_info__$tc;;"; }
+    say "end";
 
-say "";
-say "module Folds (M : sig type state type 'a t val f : (state fold_config -> state -> 'a -> state) -> 'a t  end) = struct";
-for $adts.list -> $t
-{ say "let $t<name> = M.f fold__$t<name>;;"; }
-say "end";
+    say "";
+    say "module Mapper (* O : OSig  Functors are too slow and consume a lot of memory when compiling large files with OCaml. We're hardcoding the O module below for now. *) = struct";
+    say "  module O : OSig = $oModuleName";
+    say "";
+    say "  (* must be provided by one of the open or include statements: *)";
+    say "  module CheckInputSignature = struct";
+    for $adts.grep({$_<kind> ne $record && $_<kind> ne $variant}).map({$_<kind>}).unique -> $poly
+    { say "    let fold_map__$poly : type a new_a state err .{ $typeclasses{$poly} ?? " new_a extra_info__{$typeclasses{$poly}} ->" !! "" } (state -> a -> (state * new_a, err) monad) -> state -> a $poly -> (state * new_a $poly , err) monad = fold_map__$poly;;"; }
+    say "  end";
+
+    say "";
+    for $adts.list -> $t {
+        say "  type ('state, 'err) _continue_fold_map__$t<name> = \{";
+        say "      node__$t<name> : 'state -> $t<name> -> ('state * $t<oNewName> , 'err) monad ;";
+        for $t<ctorsOrFields>.list -> $c
+        { say "      $t<name>__$c<name> : 'state -> {$c<type> || 'unit'} -> ('state * {$c<oNewType> || 'unit'} , 'err) monad ;" }
+        say '    };;';
+    }
+
+    say "  type ('state , 'err) _continue_fold_map__$moduleName = \{";
+    for $adts.list -> $t {
+        say "      $t<name> : ('state , 'err) _continue_fold_map__$t<name> ;";
+    }
+    say '    };;';
+
+    say "";
+    for $adts.list -> $t
+    { say "  type ('state, 'err) fold_map_config__$t<name> = \{";
+      say "      node__$t<name> : 'state -> $t<name> -> ('state, 'err) _continue_fold_map__$moduleName -> ('state * $t<oNewName> , 'err) monad ;"; # (*Adt_info.node_instance_info ->*)
+      say "      node__$t<name>__pre_state : 'state -> $t<name> -> ('state, 'err) monad ;"; # (*Adt_info.node_instance_info ->*)
+      say "      node__$t<name>__post_state : 'state -> $t<name> -> $t<oNewName> -> ('state, 'err) monad ;"; # (*Adt_info.node_instance_info ->*)
+      for $t<ctorsOrFields>.list -> $c
+      { say "      $t<name>__$c<name> : 'state -> {$c<type> || 'unit'} -> ('state, 'err) _continue_fold_map__$moduleName -> ('state * {$c<oNewType> || 'unit'} , 'err) monad ;"; # (*Adt_info.ctor_or_field_instance_info ->*)
+      }
+      say '  };;' }
+
+    say "  type ('state, 'err) fold_map_config__$moduleName = \{";
+    for $adts.list -> $t
+    { say "      $t<name> : ('state, 'err) fold_map_config__$t<name>;" }
+    say '    };;';
+
+    say "";
+    say "  type ('state, 'err) mk_continue_fold_map = \{";
+    say "      fn : ('state, 'err) mk_continue_fold_map -> ('state, 'err) fold_map_config__$moduleName -> ('state, 'err) _continue_fold_map__$moduleName";
+    say '    };;';
+
+
+    # fold_map functions
+    say "";
+    for $adts.list -> $t
+    { say "  let _fold_map__$t<name> : type qstate err . (qstate,err) mk_continue_fold_map -> (qstate,err) fold_map_config__$moduleName -> qstate -> $t<name> -> (qstate * $t<oNewName>, err) monad = fun mk_continue_fold_map visitor state x ->";
+      say "    let continue_fold_map : (qstate,err) _continue_fold_map__$moduleName = mk_continue_fold_map.fn mk_continue_fold_map visitor in";
+      say "    visitor.$t<name>.node__$t<name>__pre_state state x >>? fun state ->"; # (*(fun () -> whole_adt_info, info__$t<name>)*)
+      say "    visitor.$t<name>.node__$t<name> state x continue_fold_map >>? fun (state, new_x) ->"; # (*(fun () -> whole_adt_info, info__$t<name>)*)
+      say "    visitor.$t<name>.node__$t<name>__post_state state x new_x >>? fun state ->"; # (*(fun () -> whole_adt_info, info__$t<name>)*)
+      say "    return (state, new_x);;";
+      # say "";
+      for $t<ctorsOrFields>.list -> $c
+      { say "  let _fold_map__$t<name>__$c<name> : type qstate err . (qstate,err) mk_continue_fold_map -> (qstate,err) fold_map_config__$moduleName -> qstate -> { $c<type> || 'unit' } -> (qstate * { $c<oNewType> || 'unit' }, err) monad = fun mk_continue_fold_map visitor state x ->";
+        say "    let continue_fold_map : (qstate,err) _continue_fold_map__$moduleName = mk_continue_fold_map.fn mk_continue_fold_map visitor in";
+        say "    visitor.$t<name>.$t<name>__$c<name> state x continue_fold_map;;"; # (*(fun () -> whole_adt_info, info__$t<name>, info__$t<name>__$c<name>)*)
+        # say "";
+      }
+    }
+
+    # make the "continue" object
+    say "";
+    say '  (* Curries the "visitor" argument to the folds (non-customizable traversal functions). *)';
+    say "  let mk_continue_fold_map : 'state 'err . ('state,'err) mk_continue_fold_map = \{";
+    say "      fn =";
+    say "        fun self visitor ->";
+    say '        {';
+    for $adts.list -> $t
+    { say "          $t<name> = \{";
+      say "              node__$t<name> = (fun state x -> _fold_map__$t<name> self visitor state x) ;";
+      for $t<ctorsOrFields>.list -> $c
+      { say "              $t<name>__$c<name> = (fun state x -> _fold_map__$t<name>__$c<name> self visitor state x) ;"; }
+      say '            };' }
+    say '    }';
+    say '  };;';
+    say "";
+
+    # fold_map functions : tying the knot
+    say "";
+    for $adts.list -> $t
+    { say "  let fold_map__$t<name> : type qstate err . (qstate,err) fold_map_config__$moduleName -> qstate -> $t<name> -> (qstate * $t<oNewName>,err) monad =";
+      say "    fun visitor state x -> _fold_map__$t<name> mk_continue_fold_map visitor state x;;";
+      for $t<ctorsOrFields>.list -> $c
+      { say "  let fold_map__$t<name>__$c<name> : type qstate err . (qstate,err) fold_map_config__$moduleName -> qstate -> { $c<type> || 'unit' } -> (qstate * { $c<oNewType> || 'unit' },err) monad =";
+        say "    fun visitor state x -> _fold_map__$t<name>__$c<name> mk_continue_fold_map visitor state x;;"; } }
+
+    say "";
+    for $adts.list -> $t
+    {
+        say "  let no_op_node__$t<name> : type state . state -> $t<name> -> (state,_) _continue_fold_map__$moduleName -> (state * $t<oNewName>,_) monad =";
+        say "    fun state v continue ->"; # (*_info*)
+        say "      match v with";
+        if ($t<kind> eq $variant) {
+            for $t<ctorsOrFields>.list -> $c
+            { given $c<type> {
+                when '' { say "      | $c<name> -> continue.$t<name>.$t<name>__$c<name> state () >>? fun (state , ()) -> return (state , O.make__$t<newName>__$c<newName> ())"; }
+                default { say "      | $c<name> v -> continue.$t<name>.$t<name>__$c<name> state v >>? fun (state , v) -> return (state , O.make__$t<newName>__$c<newName> v)"; } } }
+        } elsif ($t<kind> eq $record) {
+            print '        { ';
+            for $t<ctorsOrFields>.list -> $f
+            { print "$f<name>; "; }
+            say "} ->";
+            for $t<ctorsOrFields>.list -> $f
+            { say "        continue.$t<name>.$t<name>__$f<name> state $f<name> >>? fun (state , $f<newName>) ->"; }
+            print "        return (state , (O.make__$t<newName>";
+            for $t<ctorsOrFields>.list -> $f
+            { print " ~$f<newName>"; }
+            say " : $t<oNewName>))";
+        } else {
+            print "        v -> (fold_map__$t<kind>";
+            if ($t<kind> ne $record && $t<kind> ne $variant && $typeclasses{$t<kind>}) {
+                for  $t<ctorsOrFields>.list -> $a
+                { print " O.extra_info__$a<type>__{$typeclasses{$t<kind>}}"; }
+            }
+            print " ( ";
+            print ( "continue.$t<name>.$t<name>__$_<name>" for $t<ctorsOrFields>.list ).join(", ");
+            say " ) state v)";
+            say "        >>? fun (state, x) -> return (state, O.make__$t<name> x);;";
+        }
+    }
+
+    for $adts.list -> $t
+    { say "  let no_op__$t<name> : type state . (state,_) fold_map_config__$t<name> = \{";
+      say "    node__$t<name> = no_op_node__$t<name>;";
+      say "    node__$t<name>__pre_state = (fun state v -> ignore v; return state) ;"; # (*_info*)
+      say "    node__$t<name>__post_state = (fun state v new_v -> ignore (v, new_v); return state) ;"; # (*_info*)
+      for $t<ctorsOrFields>.list -> $c
+      { print "    $t<name>__$c<name> = (fun state v continue -> "; # (*_info*)
+        if ($c<isBuiltin>) {
+            print "ignore continue; return (state , v)";
+        } else {
+            print "continue.$c<type>.node__$c<type> state v";
+        }
+        say ") ;"; }
+      say '    }' }
+
+    say "  let no_op : type state . (state,_) fold_map_config__$moduleName = \{";
+    for $adts.list -> $t
+    { say "    $t<name> = no_op__$t<name>;" }
+    say '  };;';
+
+    say "";
+    for $adts.list -> $t
+    { say "  let with__$t<name> : _ -> _ fold_map_config__$moduleName -> _ fold_map_config__$moduleName = (fun node__$t<name> op -> \{ op with $t<name> = \{ op.$t<name> with node__$t<name> \} \});;";
+      say "  let with__$t<name>__pre_state : _ -> _ fold_map_config__$moduleName -> _ fold_map_config__$moduleName = (fun node__$t<name>__pre_state op -> \{ op with $t<name> = \{ op.$t<name> with node__$t<name>__pre_state \} \});;";
+      say "  let with__$t<name>__post_state : _ -> _ fold_map_config__$moduleName -> _ fold_map_config__$moduleName = (fun node__$t<name>__post_state op -> \{ op with $t<name> = \{ op.$t<name> with node__$t<name>__post_state \} \});;";
+      for $t<ctorsOrFields>.list -> $c
+      { say "  let with__$t<name>__$c<name> : _ -> _ fold_map_config__$moduleName -> _ fold_map_config__$moduleName = (fun $t<name>__$c<name> op -> \{ op with $t<name> = \{ op.$t<name> with $t<name>__$c<name> \} \});;"; } }
+    say "end";
+}
+
+$*OUT = open $combinators_filename, :w;
+{
+    say "(* This is an auto-generated file. Do not edit. *)";
+    say "";
+    for $statements -> $statement { say "$statement" }
+    say "open $moduleName;;";
+    say "";
+    for $adts.list -> $t {
+        say "type nonrec $t<name> = $t<name>;;";
+    }
+
+    for $adts.list -> $t {
+        if ($t<kind> eq $variant) {
+            for $t<ctorsOrFields>.list -> $c {
+                say "let make__$t<name>__$c<name> : {$c<type> ne '' ?? "$c<newType> " !! 'unit'} -> $t<name> = fun {$c<type> ne '' ?? 'v' !! '()'} -> $c<name> {$c<type> ne '' ?? 'v ' !! ''};;";
+            }
+        } elsif ($t<kind> eq $record) {
+            print "let make__$t<name>";
+            print ' :';
+            for $t<ctorsOrFields>.list -> $f
+            { print "  {$f<newName>}:{$f<newType>} ->"; }
+            print "  $t<newName> = fun";
+            for $t<ctorsOrFields>.list -> $f
+            { print "  ~{$f<newName>}"; }
+            print " -> \{";
+            for $t<ctorsOrFields>.list -> $f
+            { print " {$f<newName>} ;"; }
+            say " \};;";
+        } else {
+            print "let make__$t<newName> : (";
+            print $t<ctorsOrFields>.map({$_<newType>}).join(" , ");
+            print ") $t<kind> -> $t<newName> = ";
+            print "fun x -> x";
+            say ";;";
+        }
+    }
+
+    say "";
+    for $adts.grep({$_<kind> ne $record && $_<kind> ne $variant && $typeclasses{$_<kind>}}).unique(:as({$_<ctorsOrFields>, $_<kind>})) -> $t
+    { my $ty = $t<ctorsOrFields>[0]<type>;
+      my $tc = $typeclasses{$t<kind>};
+      say "let extra_info__{$ty}__$tc : $ty extra_info__$tc = \{ compare = (fun a b -> let () = failwith \"TODO\" in Pervasives.compare a b) \};;"; }
+    # Check that we won't have a cyclic module dependency when using the Folder to auto-generate the compare:
+    say "(* Check that we won't have a cyclic module dependency when using the Folder to auto-generate the compare: *)";
+    say "module DummyTest_ = Generated_fold;;";
+}
diff --git a/src/stages/adt_generator/generic.ml b/src/stages/adt_generator/generic.ml
index c48ca1ac1..46b014be6 100644
--- a/src/stages/adt_generator/generic.ml
+++ b/src/stages/adt_generator/generic.ml
@@ -1,13 +1,13 @@
 module BlahBluh = struct
-module StringMap = Map.Make(String);;
-(* generic folds for nodes *)
-type 'state generic_continue_fold_node = {
-  continue                 : 'state -> 'state ;
-  (* generic folds for each field *)
-  continue_ctors_or_fields : ('state -> 'state) StringMap.t ;
-};;
-(* map from node names to their generic folds *)
-type 'state generic_continue_fold = ('state generic_continue_fold_node) StringMap.t;;
+  module StringMap = Map.Make(String);;
+  (* generic folds for nodes *)
+  type 'state generic_continue_fold_node = {
+      continue                 : 'state -> 'state ;
+      (* generic folds for each field *)
+      continue_ctors_or_fields : ('state -> 'state) StringMap.t ;
+    };;
+  (* map from node names to their generic folds *)
+  type 'state generic_continue_fold = ('state generic_continue_fold_node) StringMap.t;;
 end
 
 module Adt_info (M : sig type ('state , 'adt_info_node_instance_info) fold_config end) = struct
diff --git a/src/test/adt_generator/.gitignore b/src/test/adt_generator/.gitignore
index c1c657206..189a4ee60 100644
--- a/src/test/adt_generator/.gitignore
+++ b/src/test/adt_generator/.gitignore
@@ -1 +1,3 @@
 /generated_fold.ml
+/generated_map.ml
+/generated_o.ml
diff --git a/src/test/adt_generator/amodule.ml b/src/test/adt_generator/amodule.ml
index ad8035380..abd5490ae 100644
--- a/src/test/adt_generator/amodule.ml
+++ b/src/test/adt_generator/amodule.ml
@@ -1,3 +1,4 @@
+[@@@warning "-33"]
 (* open Amodule_utils *)
 
 type root =
diff --git a/src/test/adt_generator/dune b/src/test/adt_generator/dune
index 1f82e7ad0..16af71a00 100644
--- a/src/test/adt_generator/dune
+++ b/src/test/adt_generator/dune
@@ -1,7 +1,7 @@
 (rule
-  (target generated_fold.ml)
+  (targets generated_fold.ml generated_map.ml generated_o.ml)
   (deps ../../../src/stages/adt_generator/generator.raku amodule.ml)
-  (action (with-stdout-to generated_fold.ml (run perl6 ../../../src/stages/adt_generator/generator.raku amodule.ml)))
+  (action (run perl6 ../../../src/stages/adt_generator/generator.raku amodule.ml Generated_o generated_o.ml generated_fold.ml generated_map.ml))
   (mode (promote (until-clean) (only *)))
 )
 
diff --git a/src/test/adt_generator/fold.ml b/src/test/adt_generator/fold.ml
index 271974820..fd817b4a3 100644
--- a/src/test/adt_generator/fold.ml
+++ b/src/test/adt_generator/fold.ml
@@ -1 +1,2 @@
 include Generated_fold
+include Generated_map.Mapper
diff --git a/src/test/adt_generator/use_a_fold.ml b/src/test/adt_generator/use_a_fold.ml
index 484940341..4ee398516 100644
--- a/src/test/adt_generator/use_a_fold.ml
+++ b/src/test/adt_generator/use_a_fold.ml
@@ -2,6 +2,8 @@ open Amodule
 open Fold
 open Simple_utils.Trace
 
+module O = Fold.O
+
 let (|>) v f = f v
 
 module Errors = struct
@@ -22,9 +24,9 @@ let () =
   let op =
     no_op |>
       with__a (fun state the_a (*_info*) continue_fold ->
-          let%bind state, a1__' = continue_fold.ta1.node__ta1 state the_a.a1 in
-          let%bind state, a2__' = continue_fold.ta2.node__ta2 state the_a.a2 in
-          ok (state + 1, { a1__' ; a2__' }))
+          let%bind state, a1 = continue_fold.ta1.node__ta1 state the_a.a1 in
+          let%bind state, a2 = continue_fold.ta2.node__ta2 state the_a.a2 in
+          ok (state + 1, (O.make__a ~a1 ~a2 : O.a)))
   in
   let state = 0 in
   let%bind (state , _) = fold_map__root op state some_root in