recrec.ml

(*
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"