WIP on finfing usages

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

tools/Makefile

@@ -0,0 +1,36 @@
+.PHONY: clean
+
+GTD = gtd.exe
+
+LAMA_CMXES = ../src/Language.cmx
+OCAMLC = ocamlfind c
+OCAMLOPT = ocamlfind opt
+BFLAGS += -package GT,ostap,re,str -I ../src -rectypes -g
+#GENERATED = Pprint_gt.ml Pprint_default.ml
+
+all: $(GTD) $(OUT2)
+
+demo_infix.cmx bench_main.cmx: Pprint_gt.cmx Pprint_default.cmx
+
+$(GTD): gtd_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 > $@

tools/gtd_main.ml

@@ -0,0 +1,104 @@
+open Language
+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 = Map.Make(String)
+
+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 (l,c) = Introduced.find name map in
+        raise (DefinitionFound (name,(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 inh e names r =
+      let map = ListLabels.fold_left ~init:inh names ~f:(fun acc (fname,(_,info)) ->
+        let acc = Introduced.add fname (Loc.get_exn fname) acc in
+        match info with
+        | `Variable _ ->  acc
+        | `Fun (args, _body) ->
+            List.fold_left (fun acc name -> Introduced.add name (Loc.get_exn name) acc) acc args
+        )
+      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
+    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 inh e names r =
+      (* if we hide interesting name, then we stop the search *)
+      if List.exists (fun (n,_) -> String.equal n def_name) (names : (string * _) list)
+      then inh
+      else super#c_Scope inh e names r
+  end in
+
+  let (_,fold_t) = Expr.fix_decl Expr.foldl_decl_0 ooo in
+  fold_t [] 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 ->
+              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%!"