diff --git a/sexpr.ml b/sexpr.ml index 377fdd0..b71613a 100644 --- a/sexpr.ml +++ b/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 r = eval ctx r in + let l, ctx = eval ctx l 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 - | s -> li1 s + end, ctx + | s -> li1 s, ctx in - flat_map (check_expands_while ctx) sli - (* expr -> list(new exprs) * bool:changed *) + aggr_flat_map check_expands_while ctx sli + (* 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)); *) - ctx := a :: !ctx; - Nil, false + Format.printf "define: %s%a -> %a\n%!" (fst a) pp_t (fst (snd a)) pp_t (snd (snd a)); + Nil, false, (a :: ctx) 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; *) - let rec test opt = + Format.printf "consider expand %s%a\n%!" i pp_t r; + 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