mirror of
https://github.com/ProgramSnail/Lama.git
synced 2025-12-06 06:48:48 +00:00
Adding benchmarking executable
Signed-off-by: Kakadu <Kakadu@pm.me>
This commit is contained in:
Kakadu
parent
c74757cbb7
commit
62d1aa7316
7 changed files with 321 additions and 7 deletions
34
bench/Makefile
Normal file
34
bench/Makefile
Normal file
|
|
@ -0,0 +1,34 @@
|
|||
.PHONY: clean
|
||||
|
||||
OUT = bench.exe
|
||||
LAMA_CMXES = ../src/Language.cmx
|
||||
OCAMLC = ocamlfind c
|
||||
OCAMLOPT = ocamlfind opt
|
||||
BFLAGS += -package GT,ostap,re,benchmark -I ../src -rectypes -g
|
||||
GENERATED = Pprint_gt.ml Pprint_default.ml
|
||||
|
||||
all: $(OUT)
|
||||
|
||||
bench_main.cmx: Pprint_gt.cmx Pprint_default.cmx
|
||||
|
||||
$(OUT): Pprint_gt.cmx Pprint_default.cmx bench_main.cmx
|
||||
$(OCAMLOPT) $(BFLAGS) $(LAMA_CMXES) -linkpkg $^ -o $@
|
||||
|
||||
clean:
|
||||
$(RM) *.cmi *.cmo *.cmx *.annot *.o *.opt *.byte *~ .depend $(OUT) $(GENERATED)
|
||||
|
||||
%.cmi: %.ml
|
||||
$(OCAMLC) -c $(BFLAGS) $<
|
||||
|
||||
%.cmx: %.ml
|
||||
$(OCAMLOPT) -c $(BFLAGS) $<
|
||||
|
||||
|
||||
###############
|
||||
Pprint_gt.ml: pp_gt.m4 p.ml
|
||||
m4 $< p.ml > $@
|
||||
|
||||
###############
|
||||
Pprint_default.ml: pp_default.m4 p.ml
|
||||
m4 $< p.ml > $@
|
||||
|
||||
8
bench/README.md
Normal file
8
bench/README.md
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
##### Benchmark suite for pretty printing
|
||||
|
||||
Files:
|
||||
|
||||
- `bench_main.ml` -- runner of benhcmark
|
||||
- `p.ml` -- an implementation of pretty-printer
|
||||
- `pp_default.m4` -- macro that converts `p.ml` into strightforward pretty printer
|
||||
- `pp_gt.m4` -- a macro that converts `p.ml` into GT-based pretty printer
|
||||
49
bench/bench_main.ml
Normal file
49
bench/bench_main.ml
Normal file
|
|
@ -0,0 +1,49 @@
|
|||
open Benchmark
|
||||
|
||||
let () =
|
||||
let options = object
|
||||
method is_workaround = false
|
||||
method get_infile = "stdlib/List.lama"
|
||||
method get_include_paths = ["./stdlib"; "runtime"]
|
||||
end in
|
||||
let ast =
|
||||
try match Language.run_parser options with
|
||||
| `Ok r -> r
|
||||
| `Fail s ->
|
||||
Printf.eprintf "Error: %s\n" s;
|
||||
exit 1
|
||||
with Language.Semantic_error s ->
|
||||
Printf.eprintf "Error: %s\n" s;
|
||||
exit 1
|
||||
in
|
||||
|
||||
let () =
|
||||
let s1 = Format.asprintf "%a" Pprint_gt.pp (snd ast) in
|
||||
let s2 = Format.asprintf "%a" Pprint_default.pp (snd ast) in
|
||||
if s1<>s2
|
||||
then begin
|
||||
let wrap name cnt =
|
||||
let ch = open_out name in
|
||||
output_string ch cnt;
|
||||
close_out ch
|
||||
in
|
||||
wrap "/tmp/gt.ml" s1;
|
||||
wrap "/tmp/default.ml" s2;
|
||||
failwith "Two printers doesn't behave the same"
|
||||
end
|
||||
in
|
||||
let run_gt () =
|
||||
let _:string = Format.asprintf "%a" Pprint_gt.pp (snd ast) in
|
||||
()
|
||||
in
|
||||
let run_default () =
|
||||
let _:string = Format.asprintf "%a" Pprint_default.pp (snd ast) in
|
||||
()
|
||||
in
|
||||
|
||||
let res = throughputN ~repeat:1 1
|
||||
[ ("GT", run_gt, ())
|
||||
; ("Default", run_default, ())
|
||||
]
|
||||
in
|
||||
tabulate res
|
||||
159
bench/p.ml
Normal file
159
bench/p.ml
Normal file
|
|
@ -0,0 +1,159 @@
|
|||
open Language
|
||||
|
||||
class pp_pattern fself = object
|
||||
inherit [Pattern.t] Pattern.fmt_t_t fself
|
||||
|
||||
method! c_Wildcard ppf _ = Format.fprintf ppf "_"
|
||||
method! c_Const ppf _ = Format.fprintf ppf "%d"
|
||||
method! c_Named ppf _ name _ =
|
||||
(* TODO: should I ignore another argument? *)
|
||||
Format.fprintf ppf "%s" name
|
||||
method! c_Sexp ppf _ name xs =
|
||||
match name,xs with
|
||||
| "cons", [l; r] ->
|
||||
Format.fprintf ppf "%a@ :@ %a" fself l fself r
|
||||
| _ ->
|
||||
Format.fprintf ppf "@[%s@ (" name;
|
||||
xs |> List.iter (Format.fprintf ppf "%a@ " fself);
|
||||
Format.fprintf ppf ")@] "
|
||||
|
||||
method! c_Array ppf _ xs =
|
||||
Format.fprintf ppf "@[{ ";
|
||||
Format.pp_print_list ~pp_sep:(fun ppf () -> Format.fprintf ppf ", ")
|
||||
fself ppf xs;
|
||||
Format.fprintf ppf " }@]"
|
||||
|
||||
method! c_ArrayTag ppf _ = Format.fprintf ppf "#array"
|
||||
method! c_SexpTag ppf _ = Format.fprintf ppf "#sexp"
|
||||
method! c_ClosureTag ppf _ = Format.fprintf ppf "#fun"
|
||||
end
|
||||
|
||||
let pp_pattern fmt p =
|
||||
GT.transform Pattern.t (new pp_pattern) fmt p
|
||||
|
||||
HEADER_EXPR
|
||||
METH(Const, ppf, n, Const n, Format.fprintf ppf "%d" n)
|
||||
METH(Var, ppf, s, Var s, Format.fprintf ppf "%s" s)
|
||||
METH(Ref, ppf, s, Ref s, Format.fprintf ppf "%s" s)
|
||||
METH(String, ppf, s, String s, Format.fprintf ppf "\"%s\"" s)
|
||||
METH(Array, ppf, xs, Array xs, [[Format.fprintf ppf "@[{@ ";
|
||||
xs |> List.iteri (fun i ->
|
||||
if i<>0 then Format.fprintf ppf ",@ ";
|
||||
fself ppf);
|
||||
Format.fprintf ppf " }@]"]]
|
||||
)
|
||||
METH(Sexp, ppf, name xs, [[Sexp (name,xs)]], [[(match name,xs with
|
||||
| "cons", [l;r] -> Format.fprintf ppf "@[%a : %a@]" fself l fself r
|
||||
| _ ->
|
||||
Format.fprintf ppf "@[%s@ (" name;
|
||||
xs |> List.iteri (fun i x ->
|
||||
if i<>0 then Format.fprintf ppf ", ";
|
||||
fself ppf x
|
||||
);
|
||||
Format.fprintf ppf ")@]")
|
||||
]])
|
||||
METH(Binop, ppf, op l r, Binop (op, l, r), [[Format.fprintf ppf "@[%a@ %s@ %a@]" fself l op fself r]])
|
||||
METH(Elem, ppf, l idx, Elem (l,idx), [[Format.fprintf ppf "%a[%a]" fself l fself idx]])
|
||||
METH(ElemRef, ppf, l idx, ElemRef (l,idx), [[Format.fprintf ppf "%a[%a]" fself l fself idx]])
|
||||
METH(Length, ppf, e, Length e, [[Format.fprintf ppf "@[(%a).length@]" fself e]])
|
||||
|
||||
METH(StringVal, ppf, _x__519_, StringVal _x__519_, [[Format.fprintf ppf "StringVal @[(@,%a@,)@]" fself _x__519_]])
|
||||
|
||||
|
||||
|
||||
METH(Call, ppf, f args, Call (f,args), [[Format.fprintf ppf "@[%a @[(" fself f;
|
||||
args |> List.iteri (fun i arg ->
|
||||
Format.fprintf ppf "%s%a" (if i<>0 then ", " else "") fself arg
|
||||
);
|
||||
Format.fprintf ppf ")@]@]"]])
|
||||
|
||||
METH(Assign, ppf, l r, Assign (l,r), [[Format.fprintf ppf "@[%a@ :=@ %a@]" fself l fself r]])
|
||||
METH(Seq, ppf, l r, Seq (l,r), [[Format.fprintf ppf "@[<v>%a;@ %a@]" fself l fself r]])
|
||||
|
||||
|
||||
METH(Skip, ppf, , Skip, [[ Format.fprintf ppf "skip" ]])
|
||||
|
||||
METH(If, ppf, c th el, If (c,th,el), [[
|
||||
Format.fprintf ppf "@[if %a then @[<v 2>{@,%a@]@ @[<v 2>} else {@,%a@]@ } fi@]"
|
||||
fself c fself th fself el]])
|
||||
|
||||
METH(While, ppf, cond body, While(cond,body), [[
|
||||
Format.fprintf ppf "@[<v 2>";
|
||||
Format.fprintf ppf "while %a do@," fself cond;
|
||||
fself ppf body;
|
||||
Format.fprintf ppf "@]@ ";
|
||||
Format.fprintf ppf "od"]])
|
||||
|
||||
METH(Repeat, ppf, cond body, Repeat(cond,body), [[
|
||||
Format.fprintf ppf "@[<v 2>";
|
||||
Format.fprintf ppf "repeat@,%a" fself body;
|
||||
Format.fprintf ppf "until %a@]" fself cond]])
|
||||
|
||||
METH(Case, ppf, scru cases _ _, Case(scru, cases, _,_), [[
|
||||
Format.fprintf ppf "@[<v>";
|
||||
Format.fprintf ppf "@[case %a of@ @]@," fself scru;
|
||||
Format.fprintf ppf "@[<v 0>";
|
||||
cases |> List.iteri (fun i (p,e) ->
|
||||
Format.fprintf ppf "@[%s %a@ ->@ %a@]@ " (if i=0 then " " else "|") pp_pattern p fself e
|
||||
);
|
||||
Format.fprintf ppf "@]";
|
||||
Format.fprintf ppf "@[esac@]";
|
||||
Format.fprintf ppf "@]"]])
|
||||
|
||||
METH(Return, ppf, e, Return e, [[(match e with
|
||||
| None -> Format.fprintf ppf "return"
|
||||
| Some e -> Format.fprintf ppf "@[return@ %a@]" fself e)]])
|
||||
|
||||
METH(Ignore, ppf, e, Ignore e, Format.fprintf ppf "@[%a@]" fself e)
|
||||
METH(Unit, ppf, , Unit, Format.fprintf ppf "Unit ")
|
||||
METH(Scope, ppf, xs body, Scope(xs,body), [[Format.fprintf ppf "@[<v>";
|
||||
Format.pp_print_list ~pp_sep:(fun fmt () -> ())
|
||||
(fun ppf (name, d) ->
|
||||
Format.fprintf ppf "@[%a@]@," (fun ppf -> pp_decl (name,ppf)) d)
|
||||
ppf xs;
|
||||
fself ppf body;
|
||||
Format.fprintf ppf "@]"]])
|
||||
|
||||
METH(Lambda, ppf, args body, Lambda(args, body), [[
|
||||
Format.fprintf ppf "@[fun (%a) { %a }@]"
|
||||
(Format.pp_print_list ~pp_sep:Format.pp_print_space Format.pp_print_text)
|
||||
args
|
||||
fself
|
||||
body
|
||||
]])
|
||||
|
||||
METH(Leave, ppf, , Leave, Format.fprintf ppf "Leave ")
|
||||
|
||||
METH(Intrinsic, ppf, _x__584_, Intrinsic _, Format.fprintf ppf "Intrinsic ")
|
||||
METH(Control, ppf, _x__584_, Control _, Format.fprintf ppf "Control ")
|
||||
|
||||
FOOTER_EXPR
|
||||
|
||||
let args ppf =
|
||||
Format.fprintf ppf "%a" @@
|
||||
Format.pp_print_list ~pp_sep:(fun ppf () -> Format.fprintf ppf ",")
|
||||
(Format.pp_print_text)
|
||||
|
||||
let pp_qualifier ppf : Expr.qualifier -> _ = function
|
||||
| `Local -> ()
|
||||
| `Extern -> Format.fprintf ppf "extern@ "
|
||||
| `Public -> Format.fprintf ppf "public@ "
|
||||
| `PublicExtern -> Format.fprintf ppf "not implemented %d" __LINE__
|
||||
|
||||
HEADER_DECL
|
||||
METH0(DECL, (name,ppf), (qual,item), [[
|
||||
let _: [`Fun of string list * Expr.t | `Variable of Expr.t GT.option] = item in
|
||||
match item with
|
||||
| `Variable(None) -> Format.fprintf ppf "local %s;" name
|
||||
| `Variable(Some e) ->
|
||||
Format.fprintf ppf "local %s = %a;" name pp_expr e
|
||||
| `Fun (ss,e) ->
|
||||
Format.fprintf ppf "@[<v>";
|
||||
Format.fprintf ppf "@[%afun %s (%a) @]@," pp_qualifier qual name args ss;
|
||||
Format.fprintf ppf "@[<v 2>{@,@[%a@]@]@ " pp_expr e;
|
||||
Format.fprintf ppf "}";
|
||||
Format.fprintf ppf "@]"]]
|
||||
)
|
||||
FOOTER_DECL
|
||||
|
||||
FIX
|
||||
25
bench/pp_default.m4
Normal file
25
bench/pp_default.m4
Normal file
|
|
@ -0,0 +1,25 @@
|
|||
changequote([[,]])
|
||||
define(HEADER_EXPR, [[
|
||||
let rec pp_e pp_decl fself ppf root =
|
||||
let open Expr in
|
||||
match root with]])
|
||||
|
||||
define(METH, [[
|
||||
| $4 ->
|
||||
$5]])
|
||||
define(METH0, [[
|
||||
| $3 ->
|
||||
$4]])
|
||||
define(FOOTER_EXPR, [[]])
|
||||
define(HEADER_DECL, [[
|
||||
let rec pp_d fself pp_expr (name,ppf) root =
|
||||
let open Expr in
|
||||
match root with]])
|
||||
|
||||
|
||||
define(FOOTER_DECL, [[]])
|
||||
|
||||
define(FIX, [[
|
||||
let rec pp_decl ppf = pp_d pp_decl pp ppf
|
||||
and pp ppf = pp_e pp_decl pp ppf
|
||||
]])
|
||||
40
bench/pp_gt.m4
Normal file
40
bench/pp_gt.m4
Normal file
|
|
@ -0,0 +1,40 @@
|
|||
changequote([[,]])
|
||||
define(HEADER_EXPR, [[
|
||||
class pp_e pp_decl fself = object
|
||||
inherit [Format.formatter, Expr.t, unit] Expr.t_t
|
||||
]])
|
||||
|
||||
define(METH, [[
|
||||
method c_$1 $2 _ $3 =
|
||||
$5
|
||||
]])
|
||||
define(METH0, [[
|
||||
method c_$1 $2 $3 =
|
||||
$4]])
|
||||
define(FOOTER_EXPR, [[
|
||||
end (* class *)
|
||||
]])
|
||||
define(HEADER_DECL, [[
|
||||
class pp_d fself pp_expr =
|
||||
let (_: (string*Format.formatter) -> Expr.decl -> unit) = fself in
|
||||
let (_: Format.formatter -> Expr.t -> unit) = pp_expr in
|
||||
object
|
||||
inherit [(string*Format.formatter), _, unit] Expr.decl_t]])
|
||||
|
||||
|
||||
define(FOOTER_DECL, [[
|
||||
end (* class *)
|
||||
]])
|
||||
define(FIX, [[
|
||||
|
||||
let fix_decl decl0 t0 =
|
||||
let rec traitdecl inh subj =
|
||||
Expr.gcata_decl (decl0 traitdecl traitt) inh subj
|
||||
and traitt inh subj =
|
||||
Expr.gcata_t (t0 traitdecl traitt) inh subj
|
||||
in
|
||||
(traitdecl, traitt)
|
||||
|
||||
let pp fmt s =
|
||||
snd (fix_decl (new pp_d) (new pp_e)) fmt s
|
||||
]])
|
||||
Loading…
Add table
Add a link
Reference in a new issue