Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
(*
ocamlfind ocamlopt -o recrec -package compiler-libs.common -linkpkg recrec.ml
*)
open List
open Format
let (&) = (@@)
module I() = TypedtreeIter.MakeIterator(struct
include TypedtreeIter.DefaultIteratorArgument
open Typedtree
module IdMap = Map.Make(struct
type t = Ident.t
let compare = compare
end)
let let_rec_level = ref 0
let map = ref IdMap.empty
let removers = ref []
let enter_expression e =
begin match !removers with
| (e',f)::rs when e == e' ->
removers := rs;
f()
| _ ->()
end;
match e.exp_desc with
| Texp_let (Recursive, vbs, e') ->
incr let_rec_level;
let lev = !let_rec_level in
let ids = let_bound_idents vbs in
(* This map must be only available in the bindings, not in e' *)
map := fold_left (fun map id -> IdMap.add id lev map) !map ids;
let remover () =
map := fold_left (fun map id -> IdMap.remove id map) !map ids;
decr let_rec_level
in
removers := (e', remover) :: !removers
| Texp_ident (Pident id, _, _) ->
begin try
let lev = IdMap.find id !map in
if lev < !let_rec_level then
eprintf "%a: %s@." Location.print_loc e.exp_loc (Ident.name id)
with
| Not_found -> ()
end
| _ -> ()
end)
let () = Arg.parse [] (fun s ->
match Cmt_format.read s with
| _, Some cmt ->
begin match cmt.Cmt_format.cmt_annots with
| Implementation str ->
let module I' = I() in
I'.iter_structure str
| _ -> eprintf "%s: does not provide full structure@." s
end
| _ -> eprintf "%s: no cmt@." s)
"recrec cmt"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.