More of subst

src/passes/4-typer/typer.ml

@@ -939,15 +939,19 @@ let type_program_returns_state (p:I.program) : (environment * Solver.state * O.p
   let () = ignore (env' , state') in
   ok (env', state', declarations)
 
+module TSMap = TMap(Solver.TypeVariable)
+
 let type_program (p : I.program) : (O.program * Solver.state) result =
   let%bind (env, state, program) = type_program_returns_state p in
   let subst_all =
     let assignments = state.structured_dbs.assignments in
-    let aux (v : O.type_name) (expr : Solver.c_constructor_simpl) (p:O.program) =
+    let aux (v : O.type_name) (expr : Solver.c_constructor_simpl) (p:O.program result) =
+      let%bind p = p in
       Typesystem.Misc.Substitution.Pattern.program ~p ~v ~expr in
-    let p = SMap.fold aux assignments program in
+    (* let p = TSMap.bind_fold_Map aux program assignments in *) (* TODO: Module magic: this does not work *)
+    let p = Solver.TypeVariableMap.fold aux assignments (ok program) in
     p in
-  let program = subst_all in
+  let%bind program = subst_all in
   let () = ignore env in        (* TODO: shouldn't we use the `env` somewhere? *)
   ok (program, state)
 

src/stages/typesystem/misc.ml

@@ -6,12 +6,17 @@ module Substitution = struct
 
   module Pattern = struct
 
-    let rec declaration ~(d : Ast_typed.declaration Location.wrap) ~v ~expr : Ast_typed.declaration Location.wrap =
+    open Trace
-      let _TODO = (d, v, expr) in
-      failwith "TODO: subst declaration"
 
-    and program ~(p : Ast_typed.program) ~v ~expr : Ast_typed.program =
+    let rec declaration ~(d : Ast_typed.declaration Location.wrap) ~v ~expr : Ast_typed.declaration Location.wrap result =
-      List.map (fun d -> declaration ~d ~v ~expr) p
+      Trace.bind_map_location (function
+            Ast_typed.Declaration_constant (e, (env1, env2)) ->
+            let _ = v, expr, failwith "TODO: subst" in
+            ok @@ Ast_typed.Declaration_constant (e, (env1, env2))
+        ) d
+
+    and program ~(p : Ast_typed.program) ~v ~expr : Ast_typed.program Trace.result =
+      Trace.bind_map_list (fun d -> declaration ~d ~v ~expr) p
 
     (*
        Computes `P[v := expr]`.

vendors/ligo-utils/simple-utils/trace.ml

@@ -592,6 +592,16 @@ let bind_fold_list f init lst =
   in
   List.fold_left aux (ok init) lst
 
+module TMap(X : Map.OrderedType) = struct
+  module MX = Map.Make(X)
+  let bind_fold_Map f init map =
+    let aux k v x  =
+      x >>? fun x ->
+      f ~x ~k ~v
+    in
+    MX.fold aux map (ok init)
+end
+
 let bind_fold_pair f init (a,b) = 
   let aux x y =
     x >>? fun x ->