still broken

sexpr.ml

@@ -491,6 +491,16 @@ module SExpr = struct
     assert (flat_map (fun x -> Cons(x, Cons((match x with Int(n) -> Int(n + 1) | x -> x) , Nil))) a = p)
   end
 
+  let rec aggr_flat_map fn acc li =
+    match li with
+      Nil          -> Nil, acc
+    | Cons(x, rem) ->
+        let x, acc = fn acc x in
+        let vv, acc = aggr_flat_map fn acc rem in
+        append vv x, acc
+    | _  -> raise Not_Sexpr_List
+
+  (* TODO: test aggr_flat_map *)
 
   (* a "list" here is: 
    *   ( e1 . ( e2 . ( e3 . NIL ) ) )
@@ -670,63 +680,62 @@ module SExprMacroExp = struct
     assert (assoc_all "key" li = ["v1";"v3"])
   end
 
-  let rec eval (ctx: (string * (SExpr.t * SExpr.t)) list ref) s =
+  let rec eval (ctx: (string * (SExpr.t * SExpr.t)) list) s =
     let open SExpr in
-    let sli = match s with
+    let sli, ctx = match s with
       Cons(l,r) ->
         (* Cons(1, Cons(2, Nil)) 
            l: Cons(1, Nil)
            r: Cons(Cons(2, Nil), Nil)
            append r l: Cons(1, Cons(Cons(2, Nil), Nil))
            *)
-        let l = eval ctx l in
+        let l, ctx = eval ctx l in
-        let r = eval ctx r in
+        let r, ctx = eval ctx r in
         begin match append r l with
           Cons(l, Cons(r, Nil)) -> li1 @@ Cons(l,r)
         | Nil -> Nil
         | x   -> raise (FIXME x)
-        end
+        end, ctx
-    | s -> li1 s
+    | s -> li1 s, ctx
     in
-    flat_map (check_expands_while ctx) sli
+    aggr_flat_map check_expands_while ctx sli
-  (* expr -> list(new exprs) * bool:changed *)
+  (* expr -> list(new exprs) * bool:changed * ctx *)
   and check_expands ctx s =
     let open SExpr in
-    (* Format.printf "checking: %a\n%!" pp_t s; *)
+    Format.printf "checking: %a\n%!" pp_t s;
     match s with
       Cons(Id(":macro"), r) -> begin
         let a = match r with
           Cons(Id(l), Cons(a,b)) -> l, (a,b)
         | _ -> raise @@ Misformated_Macro s
         in
-        (* Format.printf "define: %s%a -> %a\n%!" (fst a) pp_t (fst (snd a)) pp_t (snd (snd a)); *)
+        Format.printf "define: %s%a -> %a\n%!" (fst a) pp_t (fst (snd a)) pp_t (snd (snd a));
-        ctx := a :: !ctx;
+        Nil, false, (a :: ctx)
-        Nil, false
       end
     | Cons(Id(i), r) -> begin
         let i = if String.starts_with ~prefix:":" i then
           String.sub i 1 ((String.length i) - 1)
         else "@" in
-        (* Format.printf "consider expand %s %a\n%!" i pp_t r; *)
+        Format.printf "consider expand %s%a\n%!" i pp_t r;
-        let rec test opt =
+        let rec test opt ctx =
           begin match opt with
-            [] -> li1 s, false
+            [] -> li1 s, false, ctx
           | hd :: tl ->
               try
-                expand_macro r hd, true
+                expand_macro r hd, true, ctx
               with Macro_Doesnt_App ->
-                test tl
+                test tl ctx
           end
         in
-        test (assoc_all i !ctx)
+        test (assoc_all i ctx) ctx
       end
-    | s -> li1 s, false
+    | s -> li1 s, false, ctx
   and check_expands_while ctx s =
-    let v, c = check_expands ctx s in
+    let v, c, ctx = check_expands ctx s in
     if c then
       check_expands_while ctx v
     else
-      v
+      v, ctx
   and match_macro_arg args margs =
     let open SExpr in
     match args, margs with
@@ -740,7 +749,8 @@ module SExprMacroExp = struct
     raise @@ Macro_App_TODO (defs, mbody);
     args
   let do_eval s =
-    eval (ref []) s
+    eval [] s
+    |> fst
 
   let () = test "SExprMacroExp.do_eval.unchanged_num" @@ begin fun () ->
     let open SExpr in