Merging with origin

2025-12-06 06:48:48 +00:00 · 2021-01-25 01:38:59 +03:00 · 2021-01-25 01:38:59 +03:00 · 7eb3e223b8
commit 7eb3e223b8
parent 2b9adec087 af0c21a06f
24 changed files with 1059 additions and 157 deletions
--- a/.gitignore
+++ b/.gitignore
@ -1,5 +1,7 @@
 *~
 *.cmi
 *.cmx
+*.cmo
 *.o
+.merlin

--- a/2
+++ b/2
@ -31,5 +31,5 @@ clean:
 	make clean -C runtime
 	make clean -C stdlib
 	make clean -C regression
-
+	$(MAKE) clean -C bench

--- a/bench/.gitignore
+++ b/bench/.gitignore
@ -0,0 +1,3 @@
+/*.exe
+/Pprint_gt.ml
+/Pprint_default.ml
--- a/bench/Makefile
+++ b/bench/Makefile
@ -0,0 +1,37 @@
+.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) $(OUT2)
+
+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)
+
+%.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 > $@
--- a/bench/README.md
+++ b/bench/README.md
@ -0,0 +1,26 @@
+#### Benchmark suite for pretty printing
+
+Files:
+
+- `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
--- a/bench/bench_main.ml
+++ b/bench/bench_main.ml
@ -0,0 +1,76 @@
+open Benchmark
+
+(* How many repetitions should be performed *)
+let repeat = 2
+(* How nuch time we should spent on benchmark *)
+let timeout = 2
+
+let dirname,filenames =
+  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
+  Format.printf "Looking for samples from: '%s'\n%!" dirname;
+  let files =
+    let fs = Sys.readdir dirname in
+    let r = Str.regexp ".*\\.lama$" in
+    List.filter (fun s -> (Str.string_match r s 0) && s <> "Ostap.lama") (Array.to_list fs)
+  in
+  Format.printf "Tests found: %s\n%!" (GT.show GT.list (GT.show GT.string) files);
+  (dirname,files)
+
+
+let bench_file file =
+  Format.printf "Benchmarking file `%s`\n%!" file;
+  let options = object
+    method is_workaround = false
+    method get_infile = Printf.sprintf "%s/%s" dirname file
+    method get_include_paths = [dirname; Printf.sprintf "%s/../runtime" dirname]
+  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
+  Gc.full_major ();
+  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 ~style:Nil ~repeat timeout
+    [ ("GT", run_gt, ())
+    ; ("Default", run_default, ())
+    ]
+  in
+  tabulate res
+
+let () = List.iter bench_file filenames
--- a/bench/demo.lama
+++ b/bench/demo.lama
@ -0,0 +1,6 @@
+public infix +++ at + (x, y) {
+  case x of
+    {}     -> y
+  | x : xs -> x : xs +++ y
+  esac
+}
--- a/bench/demo_infix.ml
+++ b/bench/demo_infix.ml
@ -0,0 +1,89 @@
+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
+        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 ->
+        Format.fprintf ppf "@[<h>%a@ %s@ %a@]"
+          fself l
+          (rewrite_infix s)
+          fself r                                                     (* 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);
+  ()
--- a/bench/p.ml
+++ b/bench/p.ml
@ -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
--- a/bench/pp_default.m4
+++ b/bench/pp_default.m4
@ -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
+]])
--- a/bench/pp_gt.m4
+++ b/bench/pp_gt.m4
@ -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
+]])
--- a/runtime/.gitignore
+++ b/runtime/.gitignore
@ -0,0 +1,2 @@
+*.a
+
--- a/src/.gitignore
+++ b/src/.gitignore
@ -0,0 +1,4 @@
+.depend
+lamac
+lamac.byte
+
--- a/src/Driver.ml
+++ b/src/Driver.ml
@ -1,45 +1,11 @@
-open Ostap
-
-let parse cmd =
-  let s   = Util.read cmd#get_infile in
-  let kws = [
-    "skip";      
-    "if"; "then"; "else"; "elif"; "fi";
-    "while"; "do"; "od";
-    "repeat"; "until";
-    "for";
-    "fun"; "local"; "public"; "external"; "return"; "import"; 
-    "length";
-    "string";
-    "case"; "of"; "esac"; "when";
-    "boxed"; "unboxed"; "string"; "sexp"; "array";
-    "infix"; "infixl"; "infixr"; "at"; "before"; "after";
-    "true"; "false"; "lazy"; "eta"; "syntax"]
-  in
-  Util.parse
-    (object
-       inherit Matcher.t s
-       inherit Util.Lexers.decimal s
-       inherit Util.Lexers.string s
-       inherit Util.Lexers.char   s
-       inherit Util.Lexers.infix  s
-       inherit Util.Lexers.lident kws s
-       inherit Util.Lexers.uident kws s
-       inherit Util.Lexers.skip [
-	 Matcher.Skip.whitespaces " \t\n\r";
-	 Matcher.Skip.lineComment "--";
-	 Matcher.Skip.nestedComment "(*" "*)"
-       ] s
-     end
-    )
-    (if cmd#is_workaround then ostap (p:!(Language.constparse cmd) -EOF) else ostap (p:!(Language.parse cmd) -EOF))
-
 exception Commandline_error of string

 class options args =
  let n = Array.length args in
-  let dump_ast  = 1 in
-  let dump_sm   = 2 in
+  let dump_ast  = 0b1 in
+  let dump_sm   = 0b010 in
+  let dump_source = 0b100 in
+  (* Kakadu: binary masks are cool for C code, but for OCaml I don't see any reason to save memory like this *)
  let help_string =
    "Lama compiler. (C) JetBrains Reserach, 2017-2020.\n" ^
    "Usage: lamac <options> <input file>\n\n" ^
@ -51,6 +17,7 @@ class options args =
    "  -i        --- interpret on a source-level interpreter\n" ^
    "  -s        --- compile into stack machine code and interpret on the stack machine initerpreter\n" ^
    "  -dp       --- dump AST (the output will be written into .ast file)\n" ^
+    "  -dsrc     --- dump pretty-printed source code\n" ^
    "  -ds       --- dump stack machine code (the output will be written into .sm file; has no\n" ^
    "                effect if -i option is specfied)\n" ^
    "  -v        --- show version\n" ^
@ -84,6 +51,7 @@ class options args =
            | "-s"  -> self#set_mode `SM
            | "-i"  -> self#set_mode `Eval
            | "-ds" -> self#set_dump dump_sm
+            | "-dsrc" -> self#set_dump dump_source
            | "-dp" -> self#set_dump dump_ast
            | "-h"  -> self#set_help
            | "-v"  -> self#set_version
@ -160,7 +128,11 @@ class options args =
        Buffer.add_string buf "</html>";
        self#dump_file "html" (Buffer.contents buf)
      )
-      else ()
+    method dump_source (ast: Language.Expr.t) =
+      if (!dump land dump_source) > 0
+      then Pprinter.pp Format.std_formatter ast;
+
+
    method dump_SM sm  =
      if (!dump land dump_sm) > 0
      then self#dump_file "sm" (SM.show_prg sm)
@ -182,9 +154,10 @@ let main =
  try
    let cmd = new options Sys.argv in
    cmd#greet;
-    match (try parse cmd with Language.Semantic_error msg -> `Fail msg) with
+    match (try Language.run_parser cmd with Language.Semantic_error msg -> `Fail msg) with
    | `Ok prog ->
       cmd#dump_AST (snd prog);
+       cmd#dump_source (snd prog);
       (match cmd#get_mode with
        | `Default | `Compile ->
            ignore @@ X86.build cmd prog
--- a/src/Language.ml
+++ b/src/Language.ml
@ -41,7 +41,7 @@ exception Semantic_error of string

 module Loc =
  struct
-    @type t = int * int with show, html
+    @type t = int * int with show, html, foldl

    module H = Hashtbl.Make (struct type t = string let hash = Hashtbl.hash let equal = (==) end)

@ -49,13 +49,14 @@ module Loc =

    let attach s loc = H.add tab s loc
    let get          = H.find_opt tab
+    let get_exn      = H.find tab

  end

 let report_error ?(loc=None) str =
  raise (Semantic_error (str ^ match loc with None -> "" | Some (l, c) -> Printf.sprintf " at (%d, %d)" l c));;
  
-@type k = Unmut | Mut | FVal with show, html
+@type k = Unmut | Mut | FVal with show, html, foldl

 (* Values *)
 module Value =
@ -68,7 +69,7 @@ module Value =
    | Arg    of int
    | Access of int
    | Fun    of string
-    with show, html   
+    with show, html, foldl

    @type ('a, 'b) t =
    | Empty
@ -81,7 +82,7 @@ module Value =
    | Closure of string list * 'a * 'b
    | FunRef  of string * string list * 'a * int
    | Builtin of string
-    with show, html
+    with show, html, foldl

    let is_int = function Int _ -> true | _ -> false
                                             
@ -152,7 +153,7 @@ module Builtin =
    let bindings () = List.map (fun name -> name, Value.Builtin name) list
    let names       = List.map (fun name -> name, FVal) list

-    let eval (st, i, o, vs) args = function
+let eval (st, i, o, vs) args = function
    | "read"     -> (match i with z::i' -> (st, i', o, (Value.of_int z)::vs) | _ -> failwith "Unexpected end of input")
    | "write"    -> (st, i, o @ [Value.to_int @@ List.hd args], Value.Empty :: vs)
    | ".elem"    -> let [b; j] = args in
@ -178,7 +179,7 @@ module State =
    | I
    | G of (string * k) list * (string, 'a) arrow
    | L of (string * k) list * (string, 'a) arrow * 'a t
-    with show, html
+    with show, html, foldl

    (* Get the depth level of a state *)
    let rec level = function
@ -298,7 +299,7 @@ module Pattern =
    (* any sexp value   *) | SexpTag
    (* any array value  *) | ArrayTag
    (* any closure      *) | ClosureTag
-    with show, foldl, html
+    with show, foldl, html, fmt

    (* Pattern parser *)
    ostap (
@ -344,12 +345,17 @@ module Expr =
    (* The type of configuration: a state, an input stream, an output stream,
       and a stack of values
    *)
-    @type 'a value  = ('a, 'a value State.t array) Value.t with show, html
-    @type 'a config = 'a value State.t * int list * int list * 'a value list with show, html
+    @type 'a value  = ('a, 'a value State.t array) Value.t with show, html, foldl
+    @type 'a config = 'a value State.t * int list * int list * 'a value list with show, html, foldl
    (* Reff : parsed expression should return value Reff (look for ":=");
       Val : -//- returns simple value;
       Void : parsed expression should not return any value;  *)
-    @type atr = Reff | Void | Val | Weak with show, html
+
+    @type atr = Reff | Void | Val | Weak with show, html, foldl
+
+    @type qualifier = [ `Local | `Public | `Extern | `PublicExtern ]
+        with show, html, foldl
+
    (* The type for expressions. Note, in regular OCaml there is no "@type..."
       notation, it came from GT.
    *)
@ -381,8 +387,8 @@ module Expr =
    (* leave a scope              *) | Leave
    (* intrinsic (for evaluation) *) | Intrinsic of (t config, t config) arrow
    (* control (for control flow) *) | Control   of (t config, t * t config) arrow
-    and decl = [`Local | `Public | `Extern | `PublicExtern ] * [`Fun of string list * t | `Variable of t option]
-    with show, html
+    and decl = qualifier * [`Fun of string list * t | `Variable of t option]
+    with show, html, foldl

    let notRef = function Reff -> false | _ -> true
    let isVoid = function Void | Weak -> true  | _ -> false
@ -1254,3 +1260,38 @@ let parse cmd =
        )
  in
  parse cmd
+
+
+let run_parser cmd =
+  let s   = Util.read cmd#get_infile in
+  let kws = [
+    "skip";
+    "if"; "then"; "else"; "elif"; "fi";
+    "while"; "do"; "od";
+    "repeat"; "until";
+    "for";
+    "fun"; "local"; "public"; "external"; "return"; "import";
+    "length";
+    "string";
+    "case"; "of"; "esac"; "when";
+    "boxed"; "unboxed"; "string"; "sexp"; "array";
+    "infix"; "infixl"; "infixr"; "at"; "before"; "after";
+    "true"; "false"; "lazy"; "eta"; "syntax"]
+  in
+  Util.parse
+    (object
+       inherit Matcher.t s
+       inherit Util.Lexers.decimal s
+       inherit Util.Lexers.string s
+       inherit Util.Lexers.char   s
+       inherit Util.Lexers.infix  s
+       inherit Util.Lexers.lident kws s
+       inherit Util.Lexers.uident kws s
+       inherit Util.Lexers.skip [
+        Matcher.Skip.whitespaces " \t\n\r";
+        Matcher.Skip.lineComment "--";
+        Matcher.Skip.nestedComment "(*" "*)"
+       ] s
+     end
+    )
+    (if cmd#is_workaround then ostap (p:!(constparse cmd) -EOF)  else ostap (p:!(parse cmd) -EOF))
--- a/src/Makefile
+++ b/src/Makefile
@ -2,27 +2,26 @@ TOPFILE = lamac
 OCAMLC = ocamlfind c
 OCAMLOPT = ocamlfind opt
 OCAMLDEP = ocamlfind dep
-SOURCES = version.ml stdpath.ml Language.ml SM.ml X86.ml Driver.ml
+SOURCES = version.ml stdpath.ml Language.ml Pprinter.ml SM.ml X86.ml Driver.ml
 CAMLP5 = -syntax camlp5o -package ostap.syntax,GT.syntax.all
 PXFLAGS = $(CAMLP5)
-BFLAGS = -rectypes -g
+BFLAGS = -rectypes -g -w -13-58 -package ostap,unix
 OFLAGS = $(BFLAGS)
-LIBS = unix.cma

-all: metagen .depend $(TOPFILE)
+all: depend metagen  $(TOPFILE)

 metagen:
 	echo "let version = \"Version `git rev-parse --abbrev-ref HEAD`, `git rev-parse --short HEAD`, `git rev-parse --verify HEAD |git show --no-patch --no-notes --pretty='%cd'`\"" > version.ml
 	echo "let path = \"`opam var share`/Lama\"" > stdpath.ml

-.depend: $(SOURCES)
+depend: $(SOURCES)
 	$(OCAMLDEP) $(PXFLAGS) *.ml > .depend

 $(TOPFILE): $(SOURCES:.ml=.cmx)
-	$(OCAMLOPT) -o $(TOPFILE) $(OFLAGS) $(LIBS:.cma=.cmxa) -linkpkg -package ostap $(SOURCES:.ml=.cmx)
+	$(OCAMLOPT) -o $(TOPFILE) $(OFLAGS) -linkpkg $(SOURCES:.ml=.cmx)

 $(TOPFILE).byte: $(SOURCES:.ml=.cmo)
-	$(OCAMLC) -o $(TOPFILE).byte $(BFLAGS) $(LIBS) -linkpkg -package ostap $(SOURCES:.ml=.cmo) 
+	$(OCAMLC) -o $(TOPFILE).byte $(BFLAGS) -linkpkg $(SOURCES:.ml=.cmo)

 clean:
 	rm -Rf *.cmi *.cmo *.cmx *.annot *.o *.opt *.byte *~ .depend
--- a/src/Pprinter.ml
+++ b/src/Pprinter.ml
@ -0,0 +1,198 @@
+(*
+open Language
+
+class pp_pattern fself = object
+  inherit [Format.formatter, Pattern.t, unit] Pattern.t_t
+
+  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"
+  method c_UnBoxed ppf _ = failwith "not implemented"
+  method c_String ppf _ = failwith "not implemented"
+  method c_StringTag ppf _ = failwith "not implemented"
+  method c_Boxed ppf _ = failwith "not implemented"
+end
+
+let pp_pattern fmt p =
+  GT.transform Pattern.t (new pp_pattern) fmt p
+
+class pp_expr on_decl fself =
+object
+  inherit [Format.formatter, Expr.t, unit] Expr.t_t
+  method c_Const ppf _ = Format.fprintf ppf "%d"
+  method c_Var ppf _ = Format.fprintf ppf "%s"
+  method c_Ref ppf _ = Format.fprintf ppf "%s"
+  method c_Array ppf _ xs =
+    Format.fprintf ppf "@[{@ ";
+    xs |> List.iteri (fun i ->
+      if i<>0 then Format.fprintf ppf ",@ ";
+      fself ppf);
+    Format.fprintf ppf " }@]"
+  method c_String ppf _ s = Format.fprintf ppf "\"%s\"" s
+
+  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.iteri (fun i x ->
+          if i<>0 then Format.fprintf ppf ", ";
+          fself ppf x
+        );
+        Format.fprintf ppf ")@]"
+
+  method c_Binop ppf _ op l r =
+    Format.fprintf ppf "@[%a@ %s@ %a@]" fself l op fself r
+  method c_Elem ppf _ l idx =
+    Format.fprintf ppf "%a[%a]" fself l fself idx
+  method c_ElemRef ppf _ l idx =
+    (* TODO: should Elem and ElemRef be the same? *)
+    Format.fprintf ppf "%a[%a]" fself l fself idx
+  method c_Length ppf _ e =
+    Format.fprintf ppf "@[(%a).length@]" fself e
+  method c_StringVal ppf _ _x__519_ =
+    Format.fprintf ppf "StringVal @[(@,%a@,)@]" fself _x__519_
+  method c_Call ppf _ 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 ")@]@]"
+
+
+  method c_Assign ppf _ l r =
+    Format.fprintf ppf "@[%a@ :=@ %a@]" fself l fself r
+  method c_Seq ppf _ l r =
+    Format.fprintf ppf "@[<v>%a;@ %a@]" fself l fself r
+  method c_Skip ppf _ = Format.fprintf ppf "skip"
+  method c_If ppf _ c th el =
+    Format.fprintf ppf "@[if %a then @[<v 2>{@,%a@]@ @[<v 2>} else {@,%a@]@ } fi@]"
+      fself c fself th fself el
+  method c_While ppf _ 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"
+
+  method c_Repeat ppf _ cond body =
+    Format.fprintf ppf "@[<v 2>";
+    Format.fprintf ppf "repeat@,%a" fself body;
+    Format.fprintf ppf "until %a@]" fself cond
+
+
+  method c_Case ppf _ 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 "@]"
+
+
+  method c_Return ppf _ e =
+    match e with
+    | None -> Format.fprintf ppf "return"
+    | Some e -> Format.fprintf ppf "@[return@ %a@]" fself e
+
+  method c_Ignore ppf _ e =
+    Format.fprintf ppf "@[%a@]" fself e
+  method c_Unit ppf _ = Format.fprintf ppf "Unit "
+  method c_Scope ppf _ xs body =
+    Format.fprintf ppf "@[<v>";
+    Format.pp_print_list ~pp_sep:(fun fmt () -> ())
+      (fun ppf (name, d) ->
+        Format.fprintf ppf "@[%a@]@," (fun ppf -> on_decl (name,ppf)) d)
+      ppf xs;
+    fself ppf body;
+    Format.fprintf ppf "@]"
+
+  method c_Lambda ppf _ 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
+
+  method c_Leave ppf _ = Format.fprintf ppf "Leave "
+  method c_Intrinsic ppf _ _ =
+    Format.fprintf ppf "Intrinsic"
+
+  method c_Control ppf _ _ =
+    Format.fprintf ppf "Control"
+
+end
+
+class pp_decl fself on_expr  = object(self)
+  inherit [ (string*Format.formatter), _, unit] Expr.decl_t
+  method qualifier ppf : Expr.qualifier -> _ = function
+    | `Local -> ()
+    | `Extern -> Format.fprintf ppf "extern@ "
+    | `Public -> Format.fprintf ppf "public@ "
+    | `PublicExtern -> Format.fprintf ppf "not implemented %d" __LINE__
+
+  method args ppf =
+    Format.fprintf ppf "%a" @@
+    Format.pp_print_list ~pp_sep:(fun ppf () -> Format.fprintf ppf ",")
+      (Format.pp_print_text)
+
+  method c_DECL (name,ppf) (qual, (item: [`Fun of string list * Expr.t | `Variable of Expr.t GT.option])) =
+    match item with
+    | `Variable(None) -> Format.fprintf ppf "local %s;" name
+    | `Variable(Some e) ->
+        Format.fprintf ppf "local %s = %a;" name on_expr e
+    | `Fun (ss,e) ->
+        Format.fprintf ppf "@[<v>";
+        Format.fprintf ppf "@[%afun %s (%a) @]@," self#qualifier qual name self#args ss;
+        Format.fprintf ppf "@[<v 2>{@,@[%a@]@]@ " on_expr e;
+        Format.fprintf ppf "}";
+        Format.fprintf ppf "@]"
+
+end
+
+
+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_decl) (new pp_expr)) fmt s
+
+let pp ppf ast =
+  let margin =
+    try int_of_string @@ Sys.getenv "LAMA_MARGIN"
+    with Failure _ | Not_found -> 35
+  in
+  Format.set_margin margin;
+  Format.set_max_indent 15;
+  Format.printf "%a\n%!" pp ast
+*)
+
+let pp: Format.formatter -> _ -> unit = fun _ _ -> failwith "Pretty printer is not implemented"
--- a/src/version.ml
+++ b/src/version.ml
@ -1 +1 @@
-let version = "Version 1.00, eeddb0b25, Tue Jan 12 01:14:18 2021 +0300"
+let version = "Version 1.00, 2b9adec08, Mon Jan 25 01:22:56 2021 +0300"
--- a/stdlib/.gitignore
+++ b/stdlib/.gitignore
@ -0,0 +1,3 @@
+*.i
+*.s
+
--- a/tools/.gitignore
+++ b/tools/.gitignore
@ -0,0 +1,2 @@
+/*.exe
+
--- a/tools/Makefile
+++ b/tools/Makefile
@ -0,0 +1,25 @@
+.PHONY: clean
+
+GTD = tool.exe
+
+LAMA_CMXES = ../src/Language.cmx
+OCAMLC = ocamlfind c
+OCAMLOPT = ocamlfind opt
+BFLAGS += -package GT,ostap,re,str -I ../src -rectypes -g
+
+all: $(GTD) $(OUT2)
+
+
+
+$(GTD): tool.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) $<
--- a/tools/README.md
+++ b/tools/README.md
@ -0,0 +1,41 @@
+##### Утилиты работы  с программами на LaMa
+
+Утилита `tools/tool.exe` принимает следующие параметры командной строки
+
+* `-pos L,C` для указания позиции в исходном тексте, по которой необходимо найди идентификатор и его место определения (resolve)
+* `-use` опциональный параметр, который кроме resolve производит поиск использований этого идентификатора
+
+Пример входного файла:
+
+```
+ 1  public fun foldl (f, acc, l) {
+ 2                --  ^-- (1,19)
+ 3    case l of
+ 4      {}     -> acc
+ 5    | x : xs -> foldl (f, f (acc, x), xs)
+ 6            -- (5,22)--^  ^-- (5,25)
+ 7    esac
+ 8  }
+ 9
+10  public fun filter (f, l) {
+11    case l of
+12      {}    -> {}
+13    | h : t -> if f (h) then h : filter (f, t) else filter (f, t) fi
+14    esac
+15  }
+```
+
+Пример запуска: `LAMA=./runtime tools/tool.exe tools/demo1.lama -pos 5,22 -use`
+
+В выводе утилита находит определение символа `f` на позиции (1,19) и два его использования на позициях (5,25) и (5,22)
+
+```
+found definition for `f` at (1,19)
+Total 2 usages found
+(5,25) (5,22)
+```
+
+###### Поддерживаемые синтаксические конструкции
+
+Утилита работает для определний функций, их аргументов и локальных определений переменных.
+
--- a/tools/demo1.lama
+++ b/tools/demo1.lama
@ -0,0 +1,15 @@
+public fun foldl (f, acc, l) {
+              --  ^-- (1,19)
+  case l of
+    {}     -> acc
+  | x : xs -> foldl (f, f (acc, x), xs)
+          -- (5,22)--^  ^-- (5,25)
+  esac
+}
+
+public fun filter (f, l) {
+  case l of
+    {}    -> {}
+  | h : t -> if f (h) then h : filter (f, t) else filter (f, t) fi
+  esac
+}
--- a/tools/tool.ml
+++ b/tools/tool.ml
@ -0,0 +1,136 @@
+open Language
+
+(* Test using:
+    mkae -C tools && LAMA=./runtime tools/gtd.exe tools/demo1.lama -pos 20,22 -use
+  should give:
+    found definition for `f` at (17,19)
+    Total 2 usages found
+    (5,25) (5,22)
+*)
+type mode = GoToDef | Usages
+type config =
+  { mutable filename : string
+  ; mutable pos : string
+  ; mutable line : int
+  ; mutable col: int
+  ; mutable mode: mode
+  }
+
+let config = { filename= "file.ml"; pos="0,0"; line=0; col=0; mode = GoToDef }
+let parse_loc loc =
+  Scanf.sscanf loc "%d,%d" (fun l c -> config.line <- l; config.col <- c)
+
+let () =
+  Arg.parse
+    [ "-pos", String parse_loc, "L,C when L is line and C is column"
+    ; "-def", Unit (fun () -> config.mode <- GoToDef), "go to definition"
+    ; "-use", Unit (fun () -> config.mode <- Usages), "find usages"
+    ]
+    (fun name -> config.filename <- name)
+    "Help"
+
+
+module Introduced = struct
+  include Map.Make(String)
+  let extend k v map =
+    (* Format.printf "extending '%s' -> (%d,%d)\n%!" k (fst v) (snd v); *)
+    add k (k,v) map
+end
+exception DefinitionFound of (string * Loc.t)
+
+let do_find e =
+  let on_name name map =
+    match Loc.get name with
+    | Some (l,c) when l=config.line && c = config.col ->
+        (* we found what we want *)
+        let (key,(l,c)) = Introduced.find name map in
+        raise (DefinitionFound (key,(l,c)))
+    | _ -> map
+  in
+
+  (* looks for line,col in the tree *)
+  let ooo (foldl_decl, fself) = object
+    inherit [_,_] Language.Expr.foldl_t_t_stub (foldl_decl, fself) as super
+    method! c_Var _inh _ name = on_name name _inh
+    method! c_Ref _inh _ name = on_name name _inh
+    method c_Scope init e names r =
+      let map = ListLabels.fold_left ~init names ~f:(fun acc (fname,(_,info)) ->
+        let acc = Introduced.extend fname (Loc.get_exn fname) acc in
+        match info with
+        | `Variable _ ->  acc
+        | `Fun (args, body) ->
+            let acc2 = List.fold_left (fun acc arg_name -> Introduced.extend arg_name (Loc.get_exn arg_name) acc) acc args in
+            let _ = fself acc2 body in
+            acc
+        )
+      in
+      super#c_Scope map e names r
+  end in
+
+  (* Format.printf "STUB. Ht size = %d\n%!" (Loc.H.length Loc.tab);
+  Loc.H.iter (fun k (l,c) -> Format.printf "%s -> (%d,%d)\n%!" k l c) Loc.tab; *)
+
+  let (_,fold_t) = Expr.fix_decl Expr.foldl_decl_0 ooo in
+  match fold_t Introduced.empty e with
+  | exception (DefinitionFound arg) -> Some arg
+  | _ -> None
+
+
+let find_usages root (def_name,(_,_)) =
+  let on_name name acc =
+    if String.equal def_name name
+    then (Loc.get_exn name) :: acc
+    else acc
+  in
+
+  let ooo (foldl_decl, fself) = object(self)
+    inherit [_,_] Language.Expr.foldl_t_t_stub (foldl_decl, fself) as super
+    method! c_Var (acc,in_scope) _ name =
+      if in_scope then (on_name name acc, in_scope) else (acc, in_scope)
+    method! c_Ref (acc,in_scope) _ name =
+      self#c_Var (acc,in_scope) (Var name) name
+    method c_Scope init e names r =
+      ListLabels.fold_left ~init names ~f:(fun ((acc, in_scope) as inh) (name,info) ->
+        match (in_scope, String.equal def_name name) with
+        | (true, true) -> (acc, false)
+        | (true, _) -> begin
+            match snd info with
+            | `Fun (args, body) when List.mem def_name args ->  inh
+            | `Fun (args, body) -> fself inh body
+            | `Variable (Some rhs) -> fself inh rhs
+            | `Variable None -> inh
+        end
+        | (false, true) -> super#c_Scope (acc,true) e names r
+        | false,false -> begin
+            match snd info with
+            | `Fun (args, body) when List.memq def_name args -> fself (acc,true) body
+            | `Fun (args, body) -> fself inh body
+            | `Variable (Some rhs) -> fself inh rhs
+            | `Variable None -> inh
+        end
+      ) |> (fun acc -> fself acc r)
+  end in
+
+  let (_,fold_t) = Expr.fix_decl Expr.foldl_decl_0 ooo in
+  fold_t ([],false) root
+
+
+let () =
+  let cfg = object
+    method get_include_paths = ["."; "./runtime"] method get_infile = config.filename method is_workaround=false end
+  in
+  match Language.run_parser cfg with
+  | `Fail s -> failwith s
+  | `Ok ((_,_), e) ->
+      (* Format.printf "%s\n%!" (GT.show Expr.t e); *)
+      match do_find e with
+      | None -> Format.printf "Definition not found\n%!"
+      | Some (name,(l,c)) ->
+          match config.mode with
+          | GoToDef -> Format.printf "found definition for `%s` at (%d,%d)\n%!" name l c;
+          | Usages ->
+              Format.printf "found definition for `%s` at (%d,%d)\n%!" name l c;
+              let (locs,_) = find_usages e (name,(l,c)) in
+              Format.printf "Total %d usages found\n%!" (List.length locs);
+              List.iter (fun (l,c) -> Format.printf "(%d,%d) %!" l c) locs;
+              Format.printf "\n%!"