diff --git a/example.lsp b/example.lsp index 2942415..30a4d2a 100644 --- a/example.lsp +++ b/example.lsp @@ -4,7 +4,7 @@ (:t "- " hd)) (:macro seq (hd .. tl) - (':seq hd) (':seq tl)) + (:t (':seq hd) (':seq tl))) (:macro @ (k) (:t k ":")) diff --git a/sexpr.ml b/sexpr.ml index 9b91245..a0ba3da 100644 --- a/sexpr.ml +++ b/sexpr.ml @@ -687,12 +687,18 @@ module SExprMacroExp = struct let rec eval (ctx: (string * (SExpr.t * SExpr.t)) list) s = let open SExpr in - let s, ctx = if is_list s then - aggr_flat_map eval ctx s - else - s, ctx + let s, ch1, ctx = if is_list s then begin + let s, (ch,ctx) = aggr_flat_map (fun aggr s -> + let ch1, ctx = aggr in + let s, ch2, ctx = eval ctx s in + s, ((ch1 || ch2), ctx) + ) (false, ctx) s in + s, ch, ctx + end else + s, false, ctx in - check_expands_while ctx s + let s, ch2, ctx = check_expands ctx s in + s, (ch1 || ch2), ctx (* expr -> list(new exprs) * bool:changed * ctx *) and check_expands ctx s = let open SExpr in @@ -726,12 +732,6 @@ module SExprMacroExp = struct end in test (assoc_all i ctx) ctx - and check_expands_while ctx s = - let s', c, ctx' = check_expands ctx s in - if c then - SExpr.aggr_flat_map check_expands_while ctx' s' - else - s', ctx' and match_macro_arg args margs = let open SExpr in match args, margs with @@ -765,12 +765,21 @@ module SExprMacroExp = struct else perfm expr and expand_macro args macro = - let (margs, mbody) = macro in + let margs, mbody = macro in let defs = match_macro_arg args margs in expand_macro_eval mbody defs - let do_eval s = - eval [] s - |> fst + + let do_eval s = begin + let rec inner ctx s = begin + let s, ch, ctx = eval ctx s in + if ch then + SExpr.aggr_flat_map inner ctx s + else + s, ctx + end in + inner [] s + |> fst + end (* only use this for testing! *) let sparse src =