dont eval macro def args

example.lsp

@@ -6,17 +6,16 @@
 (:macro seq (hd .. tl)
         (:t (':seq hd) (':seq tl)))
 
-(:macro @ (k)
+(:macro @ ( (k(:c-atm _)) )
         (:t k ":"))
 
-(:macro @ (k v)
+(:macro @ ( (k(:c-atm _)) v )
         (:t k ": " v))
 
-(:macro @ (k v .. other)
+(:macro @ ( (k(:c-atm _)) v .. other)
         (k v)
         other)
 
-
 (name "Complex CI/CD Pipeline")
 
 (on

sexpr.ml

@@ -1,15 +1,19 @@
-module Testing = struct
+module type Testing = sig
-  type result = Pass | Fail | Skip
+  val test : string -> ?depends:(string list) -> (unit -> unit) -> unit;;
+end;;
 
-  let testing = ref false
+module Testing : Testing = struct
-  let test_only = ref []
+  type result = Pass | Fail | Skip;;
-  let test_results = ref []
+
+  let testing = ref false;;
+  let test_only = ref [];;
+  let test_results = ref [];;
 
   let rec should_skip test =
     match List.assoc_opt test !test_results with
       Some Fail
     | Some Skip -> true
-    | _         -> false
+    | _         -> false;;
 
   let test name ?(depends = []) run =
     let test_only = !test_only in
@@ -33,7 +37,7 @@ module Testing = struct
           Fail
       end; in
       test_results := (name, res) :: !test_results
-    end
+    end;;
 
   let () =
     let rec proc args =
@@ -49,9 +53,9 @@ module Testing = struct
       | hd :: tl ->
           proc tl
       end
-    in proc @@ Array.to_list Sys.argv
+    in proc @@ Array.to_list Sys.argv;;
-end
+end;;
-let test = Testing.test
+let test = Testing.test;;
 
 
 module PC = struct
@@ -668,6 +672,7 @@ end
 module SExprMacroExp = struct
   exception Misformated_Macro of SExpr.t
   exception Macro_Doesnt_App
+  exception Not_Valid_Macro_Arg_Syntax
   exception FIXME of SExpr.t
 
   let assoc_all k li =
@@ -687,15 +692,23 @@ module SExprMacroExp = struct
 
   let rec eval (ctx: (string * (SExpr.t * SExpr.t)) list) s =
     let open SExpr in
-    let s, ch1, ctx = if is_list s then begin
+    let aggr_eval ctx s = 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
+    end in
-      s, false, ctx
+    let s, ch1, ctx = match s with
+      Cons(Id ":macro", Cons(name, Cons(margs, rr))) ->
+        let rr, ch, ctx = aggr_eval ctx rr in
+        Cons(Id ":macro", Cons(name, Cons(margs, rr))), ch, ctx
+    | s when is_list s -> begin
+        aggr_eval ctx s
+      end
+    | _ ->
+        s, false, ctx
     in
     let s, ch2, ctx = check_expands ctx s in
     s, (ch1 || ch2), ctx
@@ -703,7 +716,7 @@ module SExprMacroExp = struct
   and check_expands ctx s =
     let open SExpr in
     match s with
-      Cons(Id(":macro"), r) -> begin
+      Cons(Id ":macro", r) -> begin
         let a = match r with
           Cons(Id(l), Cons(a,b)) -> l, (a,b)
         | _ -> raise @@ Misformated_Macro s
@@ -713,7 +726,36 @@ module SExprMacroExp = struct
         in
         Nil, false, ctx
       end
-    | Cons(Id(i), r) when String.starts_with ~prefix:":" i ->
+    | Cons(Id ":atm-to-str", Cons(Id x, Nil))
+    | Cons(Id ":atm-to-str", Cons(Str x, Nil)) ->
+        li1 (Str x), true, ctx
+    | Cons(Id ":atm-to-str", Cons(Int x, Nil)) ->
+        li1 (Str (Int.to_string x)), true, ctx
+    | Cons(Id ":atm-to-str", Cons(Flt x, Nil)) ->
+        li1 (Str (Float.to_string x)), true, ctx
+    | Cons(Id ":str-cat", Cons(Str l, Cons(Str r, Nil))) ->
+        li1 (Str (l ^ r)), true, ctx
+    | Cons(Id ":c-eq", Cons(l, Cons(r, Nil))) when l = r ->
+        Nil, true, ctx
+    | Cons(Id ":c-int", Cons(Int _, Nil)) ->
+        Nil, true, ctx
+    | Cons(Id ":c-float", Cons(Flt _, Nil)) ->
+        Nil, true, ctx
+    | Cons(Id ":c-num", Cons(Int _, Nil))
+    | Cons(Id ":c-num", Cons(Flt _, Nil)) ->
+        Nil, true, ctx
+    | Cons(Id ":c-str", Cons(Str _, Nil)) ->
+        Nil, true, ctx
+    | Cons(Id ":c-id", Cons(Id _, Nil)) ->
+        Nil, true, ctx
+    | Cons(Id ":c-list", Cons(x, Nil)) when is_list x ->
+        Nil, true, ctx
+    | Cons(Id ":c-atm", Cons(Int _, Nil))
+    | Cons(Id ":c-atm", Cons(Flt _, Nil))
+    | Cons(Id ":c-atm", Cons(Str _, Nil))
+    | Cons(Id ":c-atm", Cons(Id _, Nil)) ->
+        Nil, true, ctx
+    | Cons(Id i, r) when String.starts_with ~prefix:":" i ->
         let i = String.sub i 1 ((String.length i) - 1) in
         check_expands_macro i ctx r s
     | Cons(_) ->
@@ -726,26 +768,33 @@ module SExprMacroExp = struct
         [] -> li1 s, false, ctx
       | hd :: tl ->
           try
-            expand_macro r hd, true, ctx
+            expand_macro r hd ctx, true, ctx
           with Macro_Doesnt_App ->
             test tl ctx
       end
     in
     test (assoc_all i ctx) ctx
-  and match_macro_arg args margs =
+  and match_macro_arg args margs ctx =
     let open SExpr in
     match args, margs with
-      Nil,        Nil                               -> []
+      Nil,        Nil                                  -> []
-    | Cons(_),    Cons(Id(".."), Cons(Id(rem),Nil)) -> [rem, args]
+    | Cons(_),    Cons(Id(".."), Cons(Id(rem),Nil))    -> [rem, args]
-    | Cons(v,rl), Cons(Id(k), rr)                   -> [k,li1 v] @ match_macro_arg rl rr
+    | Cons(v,rl), Cons(Id(k), rr)                      -> [k,li1 v] @ match_macro_arg rl rr ctx
-    | _                                             -> raise Macro_Doesnt_App
+    | Cons(v,rl), Cons(Cons(Id k, Cons(cst, Nil)), rr) ->
+        let cst_exp = expand_macro_eval cst ["_", li1 v] in
+        let cst_exp, _ = eval_while ctx cst_exp in
+        if cst_exp <> Nil then
+          raise Macro_Doesnt_App;
+        [k, li1 v] @ match_macro_arg rl rr ctx
+    | _                                                -> raise Macro_Doesnt_App
   and macro_req_score args =
     let open SExpr in
     match args with
       Nil                               -> 0
     | Cons(Id(".."), Cons(Id(rem),Nil)) -> 1
     | Cons(Id _, rr)                    -> 100 + macro_req_score rr
-    | _                                 -> raise Not_SExpr_List
+    | Cons(Cons(Id _, Cons(_,Nil)), rr) -> 110 + macro_req_score rr
+    | _                                 -> raise Not_Valid_Macro_Arg_Syntax
   and expand_macro_eval expr defs =
     let open SExpr in
     let perfm expr =
@@ -764,23 +813,21 @@ module SExprMacroExp = struct
       flat_map perfm expr
     else
       perfm expr
-  and expand_macro args macro =
+  and expand_macro args macro ctx =
     let margs, mbody = macro in
-    let defs = match_macro_arg args margs in
+    let defs = match_macro_arg args margs ctx in
     expand_macro_eval mbody defs
-
+  and eval_while ctx s = begin
-  let do_eval s = begin
+    let s, ch, ctx = eval ctx s in
-    let rec inner ctx s = begin
+    if ch then
-      let s, ch, ctx = eval ctx s in
+      SExpr.aggr_flat_map eval_while ctx s
-      if ch then
+    else
-        SExpr.aggr_flat_map inner ctx s
+      s, ctx
-      else
-        s, ctx
-    end in
-    inner [] s
-      |> fst
   end
 
+  let do_eval s =
+    eval_while [] s |> fst
+
   (* only use this for testing! *)
   let sparse src =
     PC.doparse