diff --git a/example.lsp b/example.lsp index b4867d0..45cfb31 100644 --- a/example.lsp +++ b/example.lsp @@ -1,96 +1,15 @@ -(:macro seq ()) +(:cfg + (name "Complex CI/CD Pipeline") -(:macro c-not ( c ) - ) -; works because this has a higher constraints score: -(:macro c-not ( (c (:c-eq () _)) ) - ()) + (on + (push + (branches + (:seq "main" "release/*"))) + (pull_requests + (types + (:seq opened synchronize reopened))) + (workflow_dispatch)) -(: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 (':seq-exp hd))) -(:macro seq (hd .. tl) - (':t (':seq-exp hd tl))) - -(:macro c-paren-eval ()) -(:macro c-paren-eval (x) - (':c-atm x) - (':c-not (':c-colon-id x))) - -(:macro @ ( (k(:c-paren-eval _)) ) - (':t (':str-cat (':t2ot-elt k) ":"))) - -(: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") - -(on - (push - (branches - (:seq "main" "release/*"))) - (pull_requests - (types - (:seq opened synchronize reopened))) - (workflow_dispatch)) - -(env - (NODE_VERSION 20) - (PYTHON_VERSION "3.11")) + (env + (NODE_VERSION 20) + (PYTHON_VERSION "3.11"))) diff --git a/sexpr.ml b/sexpr.ml index 5e0b2b1..4149e07 100644 --- a/sexpr.ml +++ b/sexpr.ml @@ -605,7 +605,7 @@ module SExpr = struct (just ")") in let x_list = (nd_of3 - (just "(") + (padded (just "(")) (repeat expr |> map (fun li -> List.fold_right (fun x acc -> Cons(x,acc)) li Nil)) @@ -774,7 +774,9 @@ module SExprMacroExp = struct [] -> li1 s, false, ctx | hd :: tl -> try - expand_macro r hd ctx, true, ctx + let o = expand_macro r hd ctx, true, ctx in + (* Format.printf "expanded: %s, with: %a\n%!" i SExpr.pp_t r; *) + o with Macro_Doesnt_App -> test tl ctx end @@ -832,9 +834,10 @@ module SExprMacroExp = struct end and eval_root_while ctx s = begin let s, ch, ctx = eval ctx s in - if ch then + if ch then begin + (* Format.printf "%a\n%!" SExpr.pp_t s; *) SExpr.aggr_flat_map eval_root_while ctx s - else + end else s, ctx end diff --git a/yaml.lsp b/yaml.lsp new file mode 100644 index 0000000..9652020 --- /dev/null +++ b/yaml.lsp @@ -0,0 +1,80 @@ +(: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 (':seq-exp hd))) +(:macro seq (hd .. tl) + (':t (':seq-exp hd tl))) + +(:macro c-paren-eval (x) + (':c-atm x) + (':c-not (':c-colon-id x))) + +(:macro @ ( (k(:c-paren-eval _)) ) + (':t (':str-cat (':t2ot-elt k) ":"))) + +(: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))))) diff --git a/yaml_finish.lsp b/yaml_finish.lsp new file mode 100644 index 0000000..9ee7212 --- /dev/null +++ b/yaml_finish.lsp @@ -0,0 +1,28 @@ +(:macro dict-key ( x ) + (':str-cat x ":")) + +(:macro yot ( x ) + x) + +(:macro tree ( a b ) + (':reduce-cat a "\n" b)) + +(:macro c-paren-eval (x) + (':c-not (':c-colon-id x))) + +(:macro @ ( (x(:c-paren-eval _)) .. tl ) + (':reduce-cat x tl )) + +(:macro reduce-cat ( x ) + x) + +(:macro reduce-cat ( x .. tl ) + (':str-cat x + (':reduce-cat tl))) + +(:macro cfg ( ) + "") +(:macro cfg ( x ) + x) +(:macro cfg ( x .. tl ) + (':tree x (':cfg tl)))