diff --git a/bench/.gitignore b/bench/.gitignore index 6265c420a..015d7e2bc 100644 --- a/bench/.gitignore +++ b/bench/.gitignore @@ -1,4 +1,3 @@ -/bench.exe +/*.exe /Pprint_gt.ml /Pprint_default.ml - diff --git a/bench/Makefile b/bench/Makefile index 17ba14f4b..06d18e1ed 100644 --- a/bench/Makefile +++ b/bench/Makefile @@ -1,19 +1,23 @@ .PHONY: clean OUT = bench.exe +OUT2 = demo_infix.exe LAMA_CMXES = ../src/Language.cmx OCAMLC = ocamlfind c OCAMLOPT = ocamlfind opt BFLAGS += -package GT,ostap,re,benchmark,str -I ../src -rectypes -g GENERATED = Pprint_gt.ml Pprint_default.ml -all: $(OUT) +all: $(OUT) $(OUT2) -bench_main.cmx: Pprint_gt.cmx Pprint_default.cmx +demo_infix.cmx 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 $@ +$(OUT2): Pprint_gt.cmx Pprint_default.cmx demo_infix.cmx + $(OCAMLOPT) $(BFLAGS) $(LAMA_CMXES) -linkpkg $^ -o $@ + clean: $(RM) *.cmi *.cmo *.cmx *.annot *.o *.opt *.byte *~ .depend $(OUT) $(GENERATED) diff --git a/bench/README.md b/bench/README.md index 53c7c6f9a..16044fb48 100644 --- a/bench/README.md +++ b/bench/README.md @@ -1,8 +1,26 @@ -##### Benchmark suite for pretty printing +#### Benchmark suite for pretty printing Files: -- `bench_main.ml` -- runner of benhcmark -- `p.ml` -- an implementation of pretty-printer +- `p.ml` -- an implementation of pretty-printer in meta-language - `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 +- `bench_main.ml` -- runner of benhcmark1 +- `demo_infix.ml` -- demo about infix operator pretty printing + +Compilation: hit `make`. + +###### Benchmark `bench.exe` + +Searches for input files in `../stdlib` or `./stdlib` and measures two pretty-printers: + +- straightforward one from `Pprint_default.ml` (generated by `pp_default.m4` from `p.ml`) +- the one using our approach: `Pprint_gt.ml` (generated by `pp_gt.m4` from `p.ml`) + + +###### demo `demo_infix.exe` + +Pretty prints a small piece of code by two approaches: + +- generated using our approach: `Pprint_gt.ml` +- modified `Pprint_gt.ml`: we are printing infix names in a prettier way. It is not possible to modify straightforward approach without pain diff --git a/bench/demo.lama b/bench/demo.lama new file mode 100644 index 000000000..c618269bf --- /dev/null +++ b/bench/demo.lama @@ -0,0 +1,6 @@ +public infix +++ at + (x, y) { + case x of + {} -> y + | x : xs -> x : xs +++ y + esac +} diff --git a/bench/demo_infix.ml b/bench/demo_infix.ml new file mode 100644 index 000000000..693d7b6ae --- /dev/null +++ b/bench/demo_infix.ml @@ -0,0 +1,86 @@ +open Benchmark + +let dirname,filename = + let dirname = + let path1 = "./stdlib" in + let path2 = "../stdlib" in + if Sys.(file_exists path1 && is_directory path1) then path1 + else if Sys.(file_exists path2 && is_directory path2) then path2 + else failwith (Printf.sprintf "Can't find a directory '%s' or '%s'" path1 path2) + in + let filename = + let path1 = "./demo.lama" in + let path2 = "./bench/demo.lama" in + if Sys.file_exists path1 then path1 + else if Sys.file_exists path2 then path2 + else failwith (Printf.sprintf "Can't find an input file both in '%s' and '%s'" path1 path2) + in + (dirname,filename) + +let infix_prefix = "i__Infix_" +let looks_like_infix s = + Str.first_chars s (String.length infix_prefix) = infix_prefix + +let rewrite_infix s = + if not (looks_like_infix s) + then s + else + let b = Buffer.create 3 in + let s = String.sub s (String.length infix_prefix) String.(length s - length infix_prefix) in + let rec loop i = + if i >= String.length s then () + else + let num c = Char.code c - Char.code '0' in + let c = Char.chr (num s.[i] * 10 + num s.[i+1]) in + (* Printf.printf "Got char '%c'\n" c; *) + Buffer.add_char b c; + loop (i+2) + in + let () = loop 0 in + Buffer.contents b + +class my_pp_e pp_decl fself = object + inherit Pprint_gt.pp_e pp_decl fself as super + method! c_Call ppf e f args = + match f,args with + | (Var s, [l; r]) when looks_like_infix s -> + super#c_Call ppf e (Var (rewrite_infix s)) args (* CHANGE 1 *) + | _ -> super#c_Call ppf e f args +end + +let fix decl0 t0 = + let open Language in + let rec decl (name,ppf) subj = + let inh = (rewrite_infix name, ppf) in (* CHANGE 2 *) + Expr.gcata_decl (decl0 decl expr) inh subj + and expr inh subj = + Expr.gcata_t (t0 decl expr) inh subj + in + (decl, expr) + +let pp fmt s = + let open Pprint_gt in + snd (fix (new pp_d) (new my_pp_e)) fmt s + +let options = object + method is_workaround = false + method get_infile = filename + method get_include_paths = [dirname; Printf.sprintf "%s/../runtime" dirname] +end + +let () = + let ast = + Format.printf "Parsing input file `%s'\n%!" options#get_infile; + 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 + + Format.printf "Default printer:\n%a\n\n%!" Pprint_gt.pp (snd ast); + Format.printf "Modified printer:\n%a\n\n%!" pp (snd ast); + ()