ocamlspot / cmt.ml

(***********************************************************************)
(*                                                                     *)
(*                            OCamlSpotter                             *)
(*                                                                     *)
(*                             Jun FURUSE                              *)
(*                                                                     *)
(*   Copyright 2008-2012 Jun Furuse. All rights reserved.              *)
(*   This file is distributed under the terms of the GNU Library       *)
(*   General Public License, with the special exception on linking     *)
(*   described in file LICENSE.                                        *)
(*                                                                     *)
(***********************************************************************)
open Utils

open Cmt_format

let source_path file = 
  Option.map file.cmt_sourcefile ~f:(fun f -> file.cmt_builddir ^/ f)

(* xxx.{ml,cmo,cmx,spot} => xxx.cmt
   xxx.{mli,cmi,spit}    => xxx.cmti *)
let of_path path =
  let dirname, filename =
    try
      let slash = String.rindex path '/' in
      Some (String.sub path 0 slash),
      String.sub path (slash + 1) (String.length path - slash - 1)
    with
    | Not_found -> None, path
  in
  let filename =
    match Filename.split_extension filename with
    | body, (".cmi" | ".mli" | ".cmti" | ".spit") -> body ^ ".cmti"
    | body, _ -> body ^ ".cmt"
  in
  match dirname with
  | None -> filename
  | Some d -> d ^/ filename

(* CR jfuruse: this is a dirty workaround. It should be nice if we could know cmt is created by opt or byte *)          
let is_opt cmt = 
  (* We cannot guess this simply by the compiler name "ocamlc" or "ocamlopt", 
     since someone can create a modified compiler like gcaml *)
  List.exists (fun x -> match Filename.split_extension x with 
    | (_, ".cmx") -> true 
    | _ -> false) (Array.to_list cmt.cmt_args)

(* CR jfuruse: This module should be removed once OCaml compilier-libs has the env restoration function *)
module Envaux = struct (* copied from debugger/envaux.ml *)
  open Misc
  open Types
  open Env

  type error =
      Module_not_found of Path.t
  
  exception Error of error
  
  let env_cache =
    (Hashtbl.create 59 : ((Env.summary * Subst.t), Env.t) Hashtbl.t)

  let cntr = ref 0 (* a counter to measure the cache efficiency *)

  let reset_cache () =
    Hashtbl.clear env_cache;
    cntr := 0;
    Env.reset_cache()
  
  let extract_sig env mty =
    match Mtype.scrape env mty with
      Mty_signature sg -> sg
    | _ -> fatal_error "Envaux.extract_sig"
  
  let rec env_from_summary sum subst =
    try
      Hashtbl.find env_cache (sum, subst)
    with Not_found ->
      let env =
        match sum with
          Env_empty ->
            Env.empty
        | Env_value(s, id, desc) ->
            Env.add_value id (Subst.value_description subst desc) (env_from_summary s subst)
        | Env_type(s, id, desc) ->
            Env.add_type id (Subst.type_declaration subst desc) (env_from_summary s subst)
        | Env_exception(s, id, desc) ->
            Env.add_exception id (Subst.exception_declaration subst desc) (env_from_summary s subst)
        | Env_module(s, id, desc) ->
            Env.add_module id (Subst.modtype subst desc) (env_from_summary s subst)
        | Env_modtype(s, id, desc) ->
            Env.add_modtype id (Subst.modtype_declaration subst desc) (env_from_summary s subst)
        | Env_class(s, id, desc) ->
            Env.add_class id (Subst.class_declaration subst desc) (env_from_summary s subst)
        | Env_cltype (s, id, desc) ->
            Env.add_cltype id (Subst.cltype_declaration subst desc) (env_from_summary s subst)
        | Env_open(s, path) ->
            let env = env_from_summary s subst in
            let path' = Subst.module_path subst path in
            let mty =
              try
                Env.find_module path' env
              with Not_found ->
                raise (Error (Module_not_found path'))
            in
            Env.open_signature path' (extract_sig env mty) env
      in
      Hashtbl.add env_cache (sum, subst) env;
      env
end 

let reset_env_cache () = Envaux.reset_cache ()

let recover_env env = Envaux.env_from_summary (Env.summary env) Subst.identity
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.