c

example.lsp

@@ -1,20 +1,84 @@
 (:macro seq ())
 
+(:macro c-not ( c )
+        )
+; works because this has a higher constraints score:
+(:macro c-not ( (c (:c-eq () _)) )
+        ())
+
+(:macro seq-exp (hd)
+        (':ot (':str-cat "- " (':t2ot-elt hd))))
+(:macro seq-exp (hd .. tl)
+        (':seq-exp hd) (':seq-exp tl))
+
 (:macro seq (hd)
-        (:t "- " hd))
-
+        (':t (':seq-exp hd)))
 (:macro seq (hd .. tl)
-        (:t (':seq hd) (':seq tl)))
+        (':t (':seq-exp hd tl)))
 
-(:macro @ ( (k(:c-atm _)) )
-        (:t k ":"))
+(:macro c-paren-eval ())
+(:macro c-paren-eval (x)
+        (':c-atm x)
+        (':c-not (':c-colon-id x)))
 
-(:macro @ ( (k(:c-atm _)) v )
-        (:t k ": " v))
+(:macro @ ( (k(:c-paren-eval _)) )
+        (':t (':str-cat (':t2ot-elt k) ":")))
 
-(:macro @ ( (k(:c-atm _)) v .. other)
-        (k v)
-        other)
+(:macro @ ( (k(:c-paren-eval _)) v )
+        (':t (':dict-key (':atm-to-str k)) v))
+
+(:macro @ ( (k(:c-paren-eval _)) (v(:c-paren-eval _)) )
+        (':t (':str-cat (':str-cat (':atm-to-str k) ": ") (':atm-to-str v) )))
+
+(:macro @ ( (k(:c-paren-eval _)) v .. other)
+        (':t (':dict-key (':atm-to-str k)) v other))
+
+(:macro t2ot-elt ( hd )
+        (':atm-to-str hd))
+
+(:macro t2ot-elt ( hd .. tl )
+        (':tree
+         (':t2ot-elt hd)
+         (':t2ot-elt tl)))
+
+(:macro t () (':ot))
+(:macro t ( .. tl )
+        (':ot
+          (':t2ot-elt tl)))
+
+(:macro ot ( x )
+        (':yot (':indent x)))
+
+(:macro indent ( (x(:c-str _)) )
+        (':str-cat "  " x))
+
+(:macro indent ( (hd(:c-atm _)) .. tl )
+        (':indent hd)
+        (':indent tl))
+
+(:macro indent-each ())
+
+(:macro indent-each ( hd )
+        (':indent hd))
+
+(:macro indent-each ( hd .. tl )
+        (':indent hd)
+        (':indent-each tl))
+
+(:macro rm-first (x .. tl)
+        tl)
+
+(:macro indent ( (x(:c-li0-eq _ :tree)) )
+        (':tree (':indent-each (':rm-first (':unpack x)))))
+
+(:macro indent ( (x(:c-li0-eq _ :atm-to-str)) )
+        (':atm-to-str (':indent-each (':rm-first (':unpack x)))))
+
+(:macro indent ( (x(:c-li0-eq _ :yot)) )
+        (':yot (':indent-each (':rm-first (':unpack x)))))
+
+(:macro indent ( (x(:c-li0-eq _ :dict-key)) )
+        (':dict-key (':indent-each (':rm-first (':unpack x)))))
 
 (name "Complex CI/CD Pipeline")
 

sexpr.ml

@@ -735,8 +735,12 @@ module SExprMacroExp = struct
         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 ":unpack", Cons(x, Nil)) when is_list x ->
+        x, true, ctx
     | Cons(Id ":c-eq", Cons(l, Cons(r, Nil))) when l = r ->
         Nil, true, ctx
+    | Cons(Id ":c-li0-eq", Cons( 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)) ->
@@ -748,6 +752,8 @@ module SExprMacroExp = struct
         Nil, true, ctx
     | Cons(Id ":c-id", Cons(Id _, Nil)) ->
         Nil, true, ctx
+    | Cons(Id ":c-colon-id", Cons(Id x, Nil)) when String.contains x ':' ->
+        Nil, true, ctx
     | Cons(Id ":c-list", Cons(x, Nil)) when is_list x ->
         Nil, true, ctx
     | Cons(Id ":c-atm", Cons(Int _, Nil))
@@ -824,11 +830,17 @@ module SExprMacroExp = struct
     else
       s, ctx
   end
+  and eval_root_while ctx s = begin
+    let s, ch, ctx = eval ctx s in
+    if ch then
+      SExpr.aggr_flat_map eval_root_while ctx s
+    else
+      s, ctx
+  end
 
   let do_eval s =
-    eval_while [] s |> fst
+    eval_root_while [] s |> fst
 
-  (* only use this for testing! *)
   let sparse src =
     PC.doparse
       Format.err_formatter
@@ -919,13 +931,8 @@ let read_all_stdin () =
 
 
 let () =
-  let parsr = SExpr.parse_top () in
   let src = read_all_stdin () in
-  let v = PC.doparse
-    Format.err_formatter
-    { source = src; path = "top" }
-    parsr in
-  let v = Option.get v in
+  let v = SExprMacroExp.sparse src in
   let v = SExprMacroExp.do_eval v in
 
   Format.set_margin 40;