From 9b1e66622a0a896f9d644e4a3e107b2028fab972 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Suzanne=20Dup=C3=A9ron?= <ligo@suzanne.soy>
Date: Mon, 27 Apr 2020 13:16:33 +0100
Subject: [PATCH] Functor for applying a fold over any ADT node (e.g. generate
 all print functions in one go)

---
 src/stages/4-ast_typed/PP_generic.ml    | 8 +++++---
 src/stages/adt_generator/generator.raku | 6 ++++++
 2 files changed, 11 insertions(+), 3 deletions(-)

diff --git a/src/stages/4-ast_typed/PP_generic.ml b/src/stages/4-ast_typed/PP_generic.ml
index 2b82c6241..8138d70c0 100644
--- a/src/stages/4-ast_typed/PP_generic.ml
+++ b/src/stages/4-ast_typed/PP_generic.ml
@@ -106,6 +106,8 @@ let op ppf = {
 let print : (unit fold_config -> unit -> 'a -> unit) -> formatter -> 'a -> unit = fun fold ppf v ->
   fold (op ppf) () v
 
-let program = print fold__program
-let type_expression = print fold__type_expression
-let full_environment = print fold__full_environment
+include Fold.Folds(struct
+  type state = unit ;;
+  type 'a t = formatter -> 'a -> unit ;;
+  let f = print ;;
+end)
diff --git a/src/stages/adt_generator/generator.raku b/src/stages/adt_generator/generator.raku
index 725b59415..8b323c157 100644
--- a/src/stages/adt_generator/generator.raku
+++ b/src/stages/adt_generator/generator.raku
@@ -465,3 +465,9 @@ for $adts.list -> $t
   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 "";
+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";