diff --git a/tools/Makefile b/tools/Makefile new file mode 100644 index 000000000..2e81e3670 --- /dev/null +++ b/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 > $@ diff --git a/tools/gtd_main.ml b/tools/gtd_main.ml new file mode 100644 index 000000000..ae0e0a23d --- /dev/null +++ b/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%!"