mirror of
https://github.com/ProgramSnail/Lama.git
synced 2025-12-06 06:48:48 +00:00
104 lines
3.4 KiB
OCaml
104 lines
3.4 KiB
OCaml
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%!"
|