Added Demo about infix

Signed-off-by: Kakadu <Kakadu@pm.me>

bench/.gitignore

@@ -1,4 +1,3 @@
-/bench.exe
+/*.exe
 /Pprint_gt.ml
 /Pprint_default.ml
-

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)
 

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

bench/demo.lama

@@ -0,0 +1,6 @@
+public infix +++ at + (x, y) {
+  case x of
+    {}     -> y
+  | x : xs -> x : xs +++ y
+  esac
+}

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);
+  ()