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

finish splitting modules, and start using ninja

Browse Source
This commit is contained in:
Alexander Nutz
2025-09-03 15:21:13 +02:00
parent afd552bd09
commit 87e845cee5
10 changed files with 670 additions and 494 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
.gitignore vendored
View File

@@ -1,7 +1,11 @@
build.ninja
.ninja_log
build/
core core
*.cmx *.cmx
*.cml *.cml
*.cmi *.cmi
*.cmo *.cmo
*.o *.o
*.d
a.out a.out

BIN
.ninja_deps Normal file
View File

Binary file not shown.

129
configure vendored Normal file
View File

@@ -0,0 +1,129 @@
#!/bin/bash
args="$@" # backup for ninja regen
OCAMLC=ocamlc
OCAMLDEP=ocamldep
OCAMLC_ARGS=
OCAMLDEP_ARGS=-bytecode
OBJEXT=cmo
while [[ $# -gt 0 ]]; do
case $1 in
*=*)
eval "$1"
shift 1
;;
--help|-help|-h|--h)
echo "Usage: ./configure [options] key=value ..."
echo ""
echo "Options:"
echo " --help"
echo ""
echo "Varaibles:"
echo " OBJEXT = $OBJEXT"
echo " OCAMLC = $OCAMLC"
echo " OCAMLDEP = $OCAMLDEP"
echo " OCAMLC_ARGS = $OCAMLC_ARGS"
echo " OCAMLDEP_ARGS = $OCAMLDEP_ARGS"
exit 0
;;
*)
echo "Unexpected argument: $1"
exit 1
;;
esac
done
mkdir -p build
echo '# generated from ../configure
OCAMLDEP=$1
shift
echo ninja_dyndep_version = 1
$OCAMLDEP -one-line $@ | while read d; do
outs="$(echo "$d" | cut -d":" -f1)"
ins="$(echo "$d" | cut -d":" -f2)"
echo -ne "build build/$outs : dyndep |"
for f in $ins; do
echo -ne " build/$f"
done
echo
done
' > build/deps.sh
if ! [ -f project ]; then
touch project
echo "# ocaml project description" >> project
echo "# (this is a bash script)" >> project
echo "#" >> project
echo "# functions:" >> project
echo "# application [name]" >> project
echo "# create module from \$name.ml" >> project
echo "#" >> project
echo "# module [name]" >> project
echo "# create module from \$name.ml and \$name.mli" >> project
echo "#" >> project
echo "# include [path]" >> project
echo "# include other config path." >> project
echo "# prefer this over regular 'source', because this also adds" >> project
echo "# a dependency to the ninja build file" >> project
echo ""
echo "# put in project configuration here" >> project
fi
project_files=""
module() {
true
}
application() {
true
}
include() {
project_files+=" $1"
source "$1"
}
include "project"
rm -f build.ninja
touch build.ninja
echo "rule regen" >> build.ninja
echo " command = ./configure $args" >> build.ninja
echo " generator = 1" >> build.ninja
echo "build build.ninja | build/deps.sh: regen | configure $project_files" >> build.ninja
echo "" >> build.ninja
echo "rule ocamlc" >> build.ninja
echo " command = $OCAMLC $OCAMLC_ARGS -nocwd -I build -c \$in -o \$out" >> build.ninja
echo "" >> build.ninja
echo "rule ocamldep" >> build.ninja
echo " command = sh build/deps.sh $OCAMLDEP $OCAMLDEP_ARGS \$in > \$out" >> build.ninja
module() {
echo "" >> build.ninja
echo "build build/$1.dd : ocamldep $1.ml $1.mli || build/deps.sh" >> build.ninja
echo "build build/$1.cmi : ocamlc $1.mli || build/$1.dd" >> build.ninja
echo " dyndep = build/$1.dd" >> build.ninja
echo "build build/$1.$OBJEXT : ocamlc $1.ml | build/$1.cmi || build/$1.dd " >> build.ninja
echo " dyndep = build/$1.dd" >> build.ninja
}
application() {
echo > /dev/null
# TODO
}
include() {
project_files+=" $1"
source "$1"
}
for f in $project_files; do
source "$f"
done
echo Configuration Done!
echo Run \"ninja\" to start build

12
deps.sh Normal file
View File

@@ -0,0 +1,12 @@
OCAMLDEP=$1
shift
echo ninja_dyndep_version = 1
$OCAMLDEP -one-line $@ | while read d; do
outs="$(echo "$d" | cut -d':' -f1)"
ins="$(echo "$d" | cut -d':' -f2)"
echo -ne "build build/$outs : dyndep |"
for f in $ins; do
echo -ne " build/$f"
done
echo
done

24
main.ml Normal file
View File

@@ -0,0 +1,24 @@
let read_all_stdin () =
let buf = Buffer.create 4096 in
try
while true do
let line = input_line stdin in
Buffer.add_string buf line;
Buffer.add_char buf '\n';
done;
Buffer.contents buf
with End_of_file ->
Buffer.contents buf
let () =
let src = read_all_stdin () in
let v = Sexpr_macro.sparse src in
let v = Sexpr_macro.do_eval v in
Format.printf "; number of macro expansions: %d\n%!" !Sexpr_macro.num_expands;
Format.set_margin 40;
Format.printf "%a@.@?" Sexpr.pp_t v;
exit 0

5
project Normal file
View File

@@ -0,0 +1,5 @@
application main
module pc
module sexpr
module sexpr_macro
module testing

284
sexpr.ml
View File

@@ -1,6 +1,5 @@
let test = Testing.test;; let test = Testing.test
module SExpr = struct
type t = type t =
Nil Nil
| Int of int | Int of int
@@ -234,284 +233,3 @@ module SExpr = struct
List.fold_right (fun x acc -> Cons(x,acc)) li Nil) List.fold_right (fun x acc -> Cons(x,acc)) li Nil)
let parser_tests = [] let parser_tests = []
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 num_expands = ref 0;;
let assoc_all k li =
li
|> List.find_all (fun (x, _) -> x = k)
|> List.map (fun (_, v) -> v)
let () = test "SExprMacroExp.assoc_all" @@ begin fun () ->
let li = [
"asye","v4";
"key","v1";
"notkey","v2";
"key","v3"
] in
assert (assoc_all "key" li = ["v1";"v3"])
end
let rec eval (ctx: (string * (SExpr.t * SExpr.t)) list) s =
let open SExpr in
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 in
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
(* expr -> list(new exprs) * bool:changed * ctx *)
and check_expands ctx s =
let open SExpr in
match s with
Cons(Id ":macro", r) -> begin
let a = match r with
Cons(Id(l), Cons(a,b)) -> l, (a,b)
| _ -> raise @@ Misformated_Macro s
in
let ctx = (a :: ctx)
|> List.sort (fun a b -> macro_req_score (fst (snd b)) - macro_req_score (fst (snd a)))
in
Nil, false, ctx
end
| 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 ":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)) ->
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-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))
| 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(_) ->
check_expands_macro "@" ctx s s
| s -> li1 s, false, ctx
and check_expands_macro i ctx r s =
let open SExpr in
let rec test opt ctx =
begin match opt with
[] -> li1 s, false, ctx
| hd :: tl ->
try
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
in
test (assoc_all i ctx) ctx
and match_macro_arg args margs ctx =
let open SExpr in
match args, margs with
Nil, Nil -> []
| Cons(_), Cons(Id(".."), Cons(Id(rem),Nil)) -> [rem, args]
| Cons(v,rl), Cons(Id(k), rr) -> [k,li1 v] @ match_macro_arg rl rr ctx
| 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
| 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 =
begin match expr with
Id(i) when String.starts_with ~prefix:"'" i ->
li1 @@ Id(String.sub i 1 (String.length i - 1))
| Id(i) -> begin match List.assoc_opt i defs with
Some x -> x
| None -> li1 expr
end
| x when is_list x -> li1 (expand_macro_eval x defs)
| x -> li1 x
end
in
if is_list expr then
flat_map perfm expr
else
perfm expr
and expand_macro args macro ctx =
let margs, mbody = macro in
let defs = match_macro_arg args margs ctx in
num_expands := !num_expands + 1;
expand_macro_eval mbody defs
and eval_while ctx s = begin
let s, ch, ctx = eval ctx s in
if ch then
SExpr.aggr_flat_map eval_while ctx s
else
s, ctx
end
and eval_root_while ctx s = begin
let s, ch, ctx = eval ctx s in
if ch then begin
(* Format.printf "%a\n%!" SExpr.pp_t s; *)
SExpr.aggr_flat_map eval_root_while ctx s
end else
s, ctx
end
let do_eval s =
eval_root_while [] s |> fst
let sparse src =
Pc.doparse
Format.err_formatter
{ source = src; path = "top" }
(SExpr.parse_top ())
|> Option.get
let () = test "SExprMacroExp.do_eval.unchanged_num" @@ begin fun () ->
let open SExpr in
let a = Int 1 in
assert (do_eval a = li1 a)
end
let () = test "SExprMacroExp.do_eval.unchanged_list" ~depends:["SExprMacroExp.do_eval.unchanged_num"] @@ begin fun () ->
let open SExpr in
let a = Cons(Int 1, Cons(Int 2, Nil)) in
assert (do_eval a = li1 a)
end
let () = test "SExprMacroExp.do_eval.unchanged_nested_list" ~depends:["SExprMacroExp.do_eval.unchanged_list"] @@ begin fun () ->
let open SExpr in
let a = Cons(Int 1, Cons( Cons(Int 10, Cons(Int 20, Nil)), Cons(Int 3, Nil))) in
assert (do_eval a = li1 a)
end
let () = test "SExprMacroExp.do_eval.macro_no_body" ~depends:SExpr.parser_tests @@ begin fun () ->
let open SExpr in
let a = "(:macro one()) (:one)"
and p = "()" in
assert (do_eval (sparse a) = sparse p)
end
let () = test "SExprMacroExp.do_eval.macro_body" ~depends:SExpr.parser_tests @@ begin fun () ->
let open SExpr in
let a = "(:macro a() 1 2) (:a)"
and p = "(1 2)" in
assert (do_eval (sparse a) = sparse p)
end
let () = test "SExprMacroExp.do_eval.macro_arg" ~depends:SExpr.parser_tests @@ begin fun () ->
let open SExpr in
let a = "(:macro a(arg) 1 arg) (:a 2)"
and p = "(1 2)" in
assert (do_eval (sparse a) = sparse p)
end
let () = test "SExprMacroExp.do_eval.macro_args" ~depends:SExpr.parser_tests @@ begin fun () ->
let open SExpr in
let a = "(:macro a(arg arg2) arg2 1 arg) (:a 2 0)"
and p = "(0 1 2)" in
assert (do_eval (sparse a) = sparse p)
end
let () = test "SExprMacroExp.do_eval.macro_varargs" ~depends:SExpr.parser_tests @@ begin fun () ->
let open SExpr in
let a = "(:macro a(arg .. rem) arg 1 rem) (:a 0 2 3)"
and p = "(0 1 2 3)" in
assert (do_eval (sparse a) = sparse p)
end
let () = test "SExprMacroExp.do_eval.macro_varargs_notmatch_none" ~depends:SExpr.parser_tests @@ begin fun () ->
let open SExpr in
let a = "(:macro a(arg .. rem) arg 1 rem) (:a 0)"
and p = "((:a 0))" in
assert (do_eval (sparse a) = sparse p)
end
let () = test "SExprMacroExp.do_eval.macro_body_paren" ~depends:SExpr.parser_tests @@ begin fun () ->
let open SExpr in
let a = "(:macro a() (1)) (:a)"
and p = "((1))" in
assert (do_eval (sparse a) = sparse p)
end
end
let read_all_stdin () =
let buf = Buffer.create 4096 in
try
while true do
let line = input_line stdin in
Buffer.add_string buf line;
Buffer.add_char buf '\n';
done;
Buffer.contents buf
with End_of_file ->
Buffer.contents buf
let () =
let src = read_all_stdin () in
let v = SExprMacroExp.sparse src in
let v = SExprMacroExp.do_eval v in
Format.printf "; number of macro expansions: %d\n%!" !SExprMacroExp.num_expands;
Format.set_margin 40;
Format.printf "%a@.@?" SExpr.pp_t v;
exit 0

25
sexpr.mli Normal file
View File

@@ -0,0 +1,25 @@
type t =
Nil
| Int of int
| Flt of float
| Cons of t * t
| Id of string
| Str of string
val li1 : t -> t
exception Not_SExpr_List
val is_list : t -> bool
val append : t -> t -> t
val rem_nil : t -> t
val flat_map : (t->t) -> t -> t
val aggr_flat_map : ('a -> t -> t * 'a) -> 'a -> t -> t * 'a
val pp_t : Format.formatter -> t -> unit
val parse_inline : unit -> t Pc.parsr
val parse_inline_end : unit -> t Pc.parsr
val parse_top : unit -> t Pc.parsr
val parser_tests : string list

252
sexpr_macro.ml Normal file
View File

@@ -0,0 +1,252 @@
let test = Testing.test
exception Misformated_Macro of Sexpr.t
exception Macro_Doesnt_App
exception Not_Valid_Macro_Arg_Syntax
exception FIXME of Sexpr.t
let num_expands = ref 0;;
let assoc_all k li =
li
|> List.find_all (fun (x, _) -> x = k)
|> List.map (fun (_, v) -> v)
let () = test "SexprMacroExp.assoc_all" @@ begin fun () ->
let li = [
"asye","v4";
"key","v1";
"notkey","v2";
"key","v3"
] in
assert (assoc_all "key" li = ["v1";"v3"])
end
let rec eval (ctx: (string * (Sexpr.t * Sexpr.t)) list) s =
let open Sexpr in
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 in
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
(* expr -> list(new exprs) * bool:changed * ctx *)
and check_expands ctx s =
let open Sexpr in
match s with
Cons(Id ":macro", r) -> begin
let a = match r with
Cons(Id(l), Cons(a,b)) -> l, (a,b)
| _ -> raise @@ Misformated_Macro s
in
let ctx = (a :: ctx)
|> List.sort (fun a b -> macro_req_score (fst (snd b)) - macro_req_score (fst (snd a)))
in
Nil, false, ctx
end
| 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 ":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)) ->
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-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))
| 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(_) ->
check_expands_macro "@" ctx s s
| s -> li1 s, false, ctx
and check_expands_macro i ctx r s =
let open Sexpr in
let rec test opt ctx =
begin match opt with
[] -> li1 s, false, ctx
| hd :: tl ->
try
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
in
test (assoc_all i ctx) ctx
and match_macro_arg args margs ctx =
let open Sexpr in
match args, margs with
Nil, Nil -> []
| Cons(_), Cons(Id(".."), Cons(Id(rem),Nil)) -> [rem, args]
| Cons(v,rl), Cons(Id(k), rr) -> [k,li1 v] @ match_macro_arg rl rr ctx
| 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
| 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 =
begin match expr with
Id(i) when String.starts_with ~prefix:"'" i ->
li1 @@ Id(String.sub i 1 (String.length i - 1))
| Id(i) -> begin match List.assoc_opt i defs with
Some x -> x
| None -> li1 expr
end
| x when is_list x -> li1 (expand_macro_eval x defs)
| x -> li1 x
end
in
if is_list expr then
flat_map perfm expr
else
perfm expr
and expand_macro args macro ctx =
let margs, mbody = macro in
let defs = match_macro_arg args margs ctx in
num_expands := !num_expands + 1;
expand_macro_eval mbody defs
and eval_while ctx s = begin
let s, ch, ctx = eval ctx s in
if ch then
Sexpr.aggr_flat_map eval_while ctx s
else
s, ctx
end
and eval_root_while ctx s = begin
let s, ch, ctx = eval ctx s in
if ch then begin
(* Format.printf "%a\n%!" Sexpr.pp_t s; *)
Sexpr.aggr_flat_map eval_root_while ctx s
end else
s, ctx
end
let do_eval s =
eval_root_while [] s |> fst
let sparse src =
Pc.doparse
Format.err_formatter
{ source = src; path = "top" }
(Sexpr.parse_top ())
|> Option.get
let () = test "SexprMacroExp.do_eval.unchanged_num" @@ begin fun () ->
let open Sexpr in
let a = Int 1 in
assert (do_eval a = li1 a)
end
let () = test "SexprMacroExp.do_eval.unchanged_list" ~depends:["SexprMacroExp.do_eval.unchanged_num"] @@ begin fun () ->
let open Sexpr in
let a = Cons(Int 1, Cons(Int 2, Nil)) in
assert (do_eval a = li1 a)
end
let () = test "SexprMacroExp.do_eval.unchanged_nested_list" ~depends:["SexprMacroExp.do_eval.unchanged_list"] @@ begin fun () ->
let open Sexpr in
let a = Cons(Int 1, Cons( Cons(Int 10, Cons(Int 20, Nil)), Cons(Int 3, Nil))) in
assert (do_eval a = li1 a)
end
let () = test "SexprMacroExp.do_eval.macro_no_body" ~depends:Sexpr.parser_tests @@ begin fun () ->
let open Sexpr in
let a = "(:macro one()) (:one)"
and p = "()" in
assert (do_eval (sparse a) = sparse p)
end
let () = test "SexprMacroExp.do_eval.macro_body" ~depends:Sexpr.parser_tests @@ begin fun () ->
let open Sexpr in
let a = "(:macro a() 1 2) (:a)"
and p = "(1 2)" in
assert (do_eval (sparse a) = sparse p)
end
let () = test "SexprMacroExp.do_eval.macro_arg" ~depends:Sexpr.parser_tests @@ begin fun () ->
let open Sexpr in
let a = "(:macro a(arg) 1 arg) (:a 2)"
and p = "(1 2)" in
assert (do_eval (sparse a) = sparse p)
end
let () = test "SexprMacroExp.do_eval.macro_args" ~depends:Sexpr.parser_tests @@ begin fun () ->
let open Sexpr in
let a = "(:macro a(arg arg2) arg2 1 arg) (:a 2 0)"
and p = "(0 1 2)" in
assert (do_eval (sparse a) = sparse p)
end
let () = test "SexprMacroExp.do_eval.macro_varargs" ~depends:Sexpr.parser_tests @@ begin fun () ->
let open Sexpr in
let a = "(:macro a(arg .. rem) arg 1 rem) (:a 0 2 3)"
and p = "(0 1 2 3)" in
assert (do_eval (sparse a) = sparse p)
end
let () = test "SexprMacroExp.do_eval.macro_varargs_notmatch_none" ~depends:Sexpr.parser_tests @@ begin fun () ->
let open Sexpr in
let a = "(:macro a(arg .. rem) arg 1 rem) (:a 0)"
and p = "((:a 0))" in
assert (do_eval (sparse a) = sparse p)
end
let () = test "SexprMacroExp.do_eval.macro_body_paren" ~depends:Sexpr.parser_tests @@ begin fun () ->
let open Sexpr in
let a = "(:macro a() (1)) (:a)"
and p = "((1))" in
assert (do_eval (sparse a) = sparse p)
end

7
sexpr_macro.mli Normal file
View File

@@ -0,0 +1,7 @@
exception Misformated_Macro of Sexpr.t
exception Not_Valid_Macro_Arg_Syntax
val num_expands : int ref
val sparse : string -> Sexpr.t
val do_eval : Sexpr.t -> Sexpr.t