alexander.nutz/ocaml-sexpr
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

finally generating yaml

Browse Source
This commit is contained in:
Alexander Nutz
2025-08-31 12:52:03 +02:00
parent 71fa80acba
commit f1be675f10
4 changed files with 128 additions and 98 deletions
Download Patch File Download Diff File Expand all files Collapse all files

107
example.lsp
View File

@@ -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")))

11
sexpr.ml
View File

@@ -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

80
yaml.lsp Normal file
View File

@@ -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)))))

28
yaml_finish.lsp Normal file
View File

@@ -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)))