Commits

camlspotter committed 6fcce50 Merge

merged with default

Comments (0)

Files changed (20)

 cmt.cmi :
 command.cmi :
 dotfile.cmi :
+fileident.cmi :
 locident.cmi :
 name.cmi :
 pathreparse.cmi : spot.cmi
-spot.cmi : utils.cmi
+spot.cmi : utils.cmi ttfold.cmo
 spotconfig.cmi : spotconfig_intf.cmo
 spoteval.cmi : utils.cmi spot.cmi
 spotfile.cmi : spoteval.cmi spot.cmi
 dotfile.cmx : utils.cmx dotfile.cmi
 ext.cmo : xprinttyp.cmi xpath.cmi xlongident.cmi xident.cmi
 ext.cmx : xprinttyp.cmx xpath.cmx xlongident.cmx xident.cmx
+fileident.cmo : utils.cmi fileident.cmi
+fileident.cmx : utils.cmx fileident.cmi
 locident.cmo : locident.cmi
 locident.cmx : locident.cmi
 name.cmo : name.cmi
 treeset.cmx : xset.cmx treeset.cmi
 ttfold.cmo :
 ttfold.cmx :
-ttfold.out.cmo :
-ttfold.out.cmx :
-ttfoldx.cmo :
-ttfoldx.cmx :
 typeFix.cmo : utils.cmi name.cmi typeFix.cmi
 typeFix.cmx : utils.cmx name.cmx typeFix.cmi
 typeexpand.cmo : utils.cmi typeexpand.cmi
+2.0.2
+--------------
+
+- ocamlspot-samewindow: default is now nil. (The author prefers nil!)
+- Cmt.recover_env used too much memory sometimes.
+
+2.0.1
+--------------
+
+- Several elisp bug fixes
+- ocamlspot-samewindow custom elisp var not to split windows at spotting
+
 2.0.0
 --------------
 
 # Requires unix!
 COMPFLAGS= -g $(INCLUDES_DEP) -I +unix
 
-MODULES= utils checksum dotfile xset treeset command typeexpand \
+MODULES= utils checksum fileident dotfile xset treeset command typeexpand \
 	xlongident name xident xpath locident typeFix xprinttyp ext ttfold cmt spot spoteval spotconfig_intf spotconfig spotfile pathreparse ocamlspot
 
 OBJS=		$(addsuffix .cmo, $(MODULES))
 
 * ocaml-<version-name> : compilable against the given OCaml version
     * ocaml-4.00.0 : the latest "stable" version
-    * ocaml-4.00.0-rc1 : no longer maintained
-    * ocaml-4.00.0-beta2 : no longer maintained
-* default : Development version. Probably not for you.
+    * ocaml-4.00.1 : the latest "stable" version
+* default : Development version. Sometimes not compilable. Not for you.
 
 Versions
 ================
   open Misc
   open Types
   open Env
-
+  
   type error =
       Module_not_found of Path.t
   
   
   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 =
             in
             Env.open_signature path' (extract_sig env mty) env
       in
-      Hashtbl.add env_cache (sum, subst) env;
-      env
+        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
+let recover_env env = 
+  Envaux.reset_cache (); (* reset required for machines with small memory... *)
+  Envaux.env_from_summary (Env.summary env) Subst.identity
 val recover_env : Env.t -> Env.t
 (** Type environments in cmt are simplified and just have env summaries.
     If we want the real environment, we need to recover it from the summary. *)
-val reset_env_cache : unit -> unit
-(** Reset the environment restoration cache *)
+(***********************************************************************)
+(*                                                                     *)
+(*                            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.                                        *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* File identity by device+inode or md5sum of contents 
+
+   In Mingw, inode does not work. We use md5sum of the contents instead.
+*)
+
+open Utils
+
+type t = 
+  | Dev_inode of int * int
+  | Md5sum of Digest.t
+
+let get = Hashtbl.memoize (Hashtbl.create 107) (fun path ->
+  let ident = 
+    try
+      let st = Unix.lstat path in
+      if st.Unix.st_ino = 0 then (* Mingw *)
+        Some (Md5sum (Digest.file path))
+      else 
+        Some (Dev_inode (st.Unix.st_dev, st.Unix.st_ino))
+    with
+    | _ -> None
+  in
+  path, ident)
+  
+(***********************************************************************)
+(*                                                                     *)
+(*                            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.                                        *)
+(*                                                                     *)
+(***********************************************************************)
+
+(** File identity by device+inode or md5sum of contents 
+
+   In Mingw, inode does not work. We use md5sum of the contents instead.
+*)
+
+type t = 
+  | Dev_inode of int * int 
+  | Md5sum of Digest.t
+
+val get : string -> string * t option
+(** [get path] returns its file identification with cons-hashed path *)
   "*Turn on ocamlspot debug output."
   :type 'boolean :group 'ocamlspot)
 
-(defcustom ocamlspot-samewindow t
+(defcustom ocamlspot-samewindow nil
   "Use current window to show the spot."
   :type 'boolean :group 'ocamlspot)
 
 	(* Find the innermost module *)
         let find_module_path treepath = List.concat_map (fun { Regioned.value = annots } ->
           List.filter_map (function 
-            | Annot.Str (Abstraction.AStr_module (id, _)) -> Some id
+            | Annot.Str_item (Abstraction.AStr_module (id, _)) -> Some id
             | _ -> None) annots) treepath
         in
         printf "In_module: %s@."
 	file.Unit.path 
 	(Position.to_string pos);
       match List.find_map_opt (function 
-	| Annot.Str str_item -> 
-	    begin match Abstraction.ident_of_structure_item str_item with
-	    | Some v -> Some (`Def v)
-	    | None -> None
-	    end
+	| Annot.Str_item str_item -> 
+	    Some (`Def (Abstraction.ident_of_structure_item str_item))
 	| Annot.Use (kind, path) -> Some (`Use (kind, path))
 	| _ -> None) (query_by_pos file file.Unit.path pos)
       with
Add a comment to this file

opam/ocamlspot.4.00.0.2.0.1/url

File contents unchanged.

 open Format
 
 let magic_number = "OCamlSpot"
-let ocaml_version = "4.00.0"
+let ocaml_version = "4.00.0" (* 4.00.1 also works *)
 let version = "2.0.1"
 
+(** Kind of ``object`` *)
 module Kind = struct
   type t =
     | Value | Type | Exception
     | _ -> raise Not_found
 end
 
-(* CR jfuruse: ultimately we do not need this *)
+(** module definition abstraction *)
 module Abstraction = struct
-  (* module definition abstraction *)
 
-  (* CR jfuruse: types may be incompatible between compiler versions *)
+  (* Types may be incompatible between compiler versions *)
   type module_expr =
     | AMod_ident      of Path.t (* module M = N *)
     | AMod_packed     of string (* full path *)
     | AMod_abstract (* used for Tmodtype_abstract *)
     | AMod_functor_parameter
 
-  (* structure abstraction : name - defloc asoc list *)
   and structure = structure_item list
 
-  (* modtype must be identified from module, since they can have the
-     same name *)
-
   and structure_item =
     | AStr_value      of Ident.t
     | AStr_type       of Ident.t
     | AStr_included   of Ident.t * module_expr * Kind.t * Ident.t
 
   let rec format_module_expr ppf = function
-    | AMod_ident p -> fprintf ppf "%s" (Path.name p)
-    | AMod_packed s -> fprintf ppf "packed(%s)" s
+    | AMod_ident p       -> fprintf ppf "%s" (Path.name p)
+    | AMod_packed s      -> fprintf ppf "packed(%s)" s
     | AMod_structure str -> format_structure ppf str
     | AMod_functor (id, mty, mexp) ->
         fprintf ppf "@[<4>\\(%s : %a) ->@ %a@]"
         fprintf ppf "@[%a@ :@ @[%a@]@]"
           format_module_expr mexp
           (Printtyp.modtype ~with_pos:true) mty
-    | AMod_abstract -> fprintf ppf "<abst>"
+    | AMod_abstract          -> fprintf ppf "<abst>"
     | AMod_functor_parameter -> fprintf ppf "<functor_parameter>"
     | AMod_unpack mty ->
         fprintf ppf "@[unpack@ : @[%a@]@]"
       (list ";@," format_structure_item) items
 
   and format_structure_item ppf = function
-    | AStr_value id -> fprintf ppf "val %s" (Ident.name id)
-    | AStr_type id -> fprintf ppf "type %s" (Ident.name id) (* CR jfuruse: todo *)
+    | AStr_value id     -> fprintf ppf "val %s" (Ident.name id)
+    | AStr_type id      -> fprintf ppf "type %s" (Ident.name id) (* CR jfuruse: todo *)
     | AStr_exception id -> fprintf ppf "exception %s" (Ident.name id)
     | AStr_module (id, mexp) ->
         fprintf ppf "@[<v4>module %s =@ %a@]"
         fprintf ppf "@[<v4>module type %s =@ %a@]"
           (Ident.name id)
           format_module_expr mexp
-    | AStr_class id -> fprintf ppf "class %s" (Ident.name id)
+    | AStr_class id      -> fprintf ppf "class %s" (Ident.name id)
     | AStr_class_type id -> fprintf ppf "class type %s" (Ident.name id)
     | AStr_included (id, mexp, kind, id') ->
         fprintf ppf "@[<v4>included %s %a = %a@ { @[<v>%a@] }@]"
           Ident.format id'
           format_module_expr mexp
 
-  let ident_of_structure_item : structure_item -> (Kind.t * Ident.t) option = function
-    | AStr_value id        -> Some (Kind.Value, id)
-    | AStr_type id         -> Some (Kind.Type, id)
-    | AStr_exception id    -> Some (Kind.Exception, id)
-    | AStr_module (id, _)  -> Some (Kind.Module, id)
-    | AStr_modtype (id, _) -> Some (Kind.Module_type, id)
-    | AStr_class id        -> Some (Kind.Class, id)
-    | AStr_class_type id   -> Some (Kind.Class_type, id)
-    | AStr_included (id, _, kind, _) -> Some (kind, id)
+  let ident_of_structure_item : structure_item -> (Kind.t * Ident.t) = function
+    | AStr_value id                  -> (Kind.Value, id)
+    | AStr_type id                   -> (Kind.Type, id)
+    | AStr_exception id              -> (Kind.Exception, id)
+    | AStr_module (id, _)            -> (Kind.Module, id)
+    | AStr_modtype (id, _)           -> (Kind.Module_type, id)
+    | AStr_class id                  -> (Kind.Class, id)
+    | AStr_class_type id             -> (Kind.Class_type, id)
+    | AStr_included (id, _, kind, _) -> (kind, id)
 
   module Module_expr = struct
     (* cache key is Typedtree.module_expr *)
 
   module T = struct
     let kident_of_sigitem = function
-      | Sig_value (id, _)         -> Kind.Value, id
-      | Sig_exception (id, _)     -> Kind.Exception, id
-      | Sig_module (id, _, _)     -> Kind.Module, id
-      | Sig_type (id, _, _)       -> Kind.Type, id
-      | Sig_modtype (id, _)       -> Kind.Module_type, id
-      | Sig_class (id, _, _)      -> Kind.Class, id
-      | Sig_class_type (id, _, _) -> Kind.Class_type, id
+      | Sig_value (id, _)         -> Kind.Value       , id
+      | Sig_exception (id, _)     -> Kind.Exception   , id
+      | Sig_module (id, _, _)     -> Kind.Module      , id
+      | Sig_type (id, _, _)       -> Kind.Type        , id
+      | Sig_modtype (id, _)       -> Kind.Module_type , id
+      | Sig_class (id, _, _)      -> Kind.Class       , id
+      | Sig_class_type (id, _, _) -> Kind.Class_type  , id
 
     let rec signature sg = AMod_structure (List.map signature_item sg)
 
     and signature_item = function
-      | Sig_value (id, _) -> AStr_value id
-      | Sig_type (id, _, _) -> AStr_type id
-      | Sig_exception (id, _) -> AStr_exception id
-      | Sig_module (id, mty, _) -> AStr_module (id, module_type mty)
-      | Sig_modtype (id, mdtd) -> AStr_modtype (id, modtype_declaration mdtd)
-      | Sig_class (id, _, _) -> AStr_class id
+      | Sig_value (id, _)         -> AStr_value id
+      | Sig_type (id, _, _)       -> AStr_type id
+      | Sig_exception (id, _)     -> AStr_exception id
+      | Sig_module (id, mty, _)   -> AStr_module (id, module_type mty)
+      | Sig_modtype (id, mdtd)    -> AStr_modtype (id, modtype_declaration mdtd)
+      | Sig_class (id, _, _)      -> AStr_class id
       | Sig_class_type (id, _, _) -> AStr_class_type id
 
     and module_type = function
     res
 
   let aliases_of_include mexp ids =
-    let sg = try match Mtype.scrape (Cmt.recover_env mexp.mod_env) mexp.mod_type with Mty_signature sg -> sg | _ -> assert false with _ -> assert false in
+    let env' = try Cmt.recover_env mexp.mod_env with e -> 
+      Format.eprintf "recover_env: %s@." (Printexc.to_string e);
+      assert false 
+    in 
+    let sg = try match Mtype.scrape env' mexp.mod_type with 
+      | Mty_signature sg -> sg 
+      | _ -> prerr_endline "strange!";assert false 
+      with _ -> assert false 
+    in
     aliases_of_include' true sg ids
 
   let rec module_expr mexp =
         List.map (fun (id, (k, id')) -> AStr_included (id, m, k, id')) id_kid_list
 
 
-  (* CR jfuruse: caching like module_expr_sub *)
+  (* CR jfuruse: TODO: caching like module_expr_sub *)
   and module_type mty = module_type_desc mty.mty_desc
 
   and module_type_desc = function
     | Use               of Kind.t * Path.t
     | Type              of Types.type_expr * Env.t * [`Expr of Path.t option | `Pattern of Ident.t option ]
     | Mod_type          of Types.module_type
-    | Str               of Abstraction.structure_item  (* CRjfuruse: Should be Sitem *)
+    | Str_item          of Abstraction.structure_item
     | Module            of Abstraction.module_expr
     | Functor_parameter of Ident.t
     | Non_expansive     of bool
   let equal t1 t2 = match t1, t2 with
     | Type (t1, _, _), Type (t2, _, _) -> t1 == t2
     | Mod_type mty1, Mod_type mty2 -> mty1 == mty2
-    | Str sitem1, Str sitem2 -> Abstraction.Structure_item.equal sitem1 sitem2
+    | Str_item sitem1, Str_item sitem2 -> Abstraction.Structure_item.equal sitem1 sitem2
     | Module mexp1, Module mexp2 -> mexp1 == mexp2
     | Use (k1,p1), Use (k2,p2) -> k1 = k2 && p1 = p2
     | Non_expansive b1, Non_expansive b2 -> b1 = b2
     | Functor_parameter id1, Functor_parameter id2 -> id1 = id2
-    | (Type _ | Str _ | Module _ | Functor_parameter _ | Use _ | Non_expansive _
+    | (Type _ | Str_item _ | Module _ | Functor_parameter _ | Use _ | Non_expansive _
           | Mod_type _),
-      (Type _ | Str _ | Module _ | Functor_parameter _ | Use _ | Non_expansive _
+      (Type _ | Str_item _ | Module _ | Functor_parameter _ | Use _ | Non_expansive _
           | Mod_type _) -> false
 
   module Record = struct
-    open Asttypes
     open Typedtree
     open Abstraction
     module K = Kind
 
+    open Location
+
     (* CR jfuruse: A Location.t contains a filename, though it is always
        unique. Waste of 4xn bytes. *)
-  (*
+    (*
     let recorded = (Hashtbl.create 1023 : (Location.t, (int * t list)) Hashtbl.t)
-
     let clear () = Hashtbl.clear recorded
-  *)
+    *)
 
     type location_property = Wellformed | Flipped | Over_files | Illformed
 
     let check_location loc =
-      if loc.Location.loc_start == Lexing.dummy_pos || loc.Location.loc_end == Lexing.dummy_pos then Illformed
-      else if loc.Location.loc_start = Lexing.dummy_pos || loc.Location.loc_end = Lexing.dummy_pos then Illformed
+      if loc.loc_start == Lexing.dummy_pos || loc.loc_end == Lexing.dummy_pos then Illformed
+      else if loc.loc_start = Lexing.dummy_pos || loc.loc_end = Lexing.dummy_pos then Illformed
       else
         (* If the file name is different between the start and the end, we cannot tell the wellformedness. *)
-        if loc.Location.loc_start.Lexing.pos_fname <> loc.Location.loc_end.Lexing.pos_fname then Over_files
+        if loc.loc_start.Lexing.pos_fname <> loc.loc_end.Lexing.pos_fname then Over_files
         else
           (* P4 creates some flipped locations where loc_start > loc_end *)
-          match compare loc.Location.loc_start.Lexing.pos_cnum loc.Location.loc_end.Lexing.pos_cnum
+          match compare loc.loc_start.Lexing.pos_cnum loc.loc_end.Lexing.pos_cnum
           with
           | -1 | 0 -> Wellformed
           | _ -> Flipped
 
     let record tbl loc t =
       let really_record () =
-        let records =
-          try Hashtbl.find tbl loc with Not_found -> []
-        in
+        let records = try Hashtbl.find tbl loc with Not_found -> [] in
 (*
         (* CR jfuruse: I am not really sure the below is correct now,
            but I remember the huge compilation slow down... *)
       match check_location loc with
       | Wellformed -> really_record ()
       | Flipped ->
-          if not loc.Location.loc_ghost then Format.eprintf "%aWarning: Flipped location.@." Location.print loc;
+          if not loc.loc_ghost then Format.eprintf "%aWarning: Flipped location.@." Location.print loc;
           really_record ()
       | Illformed ->
-          if not loc.Location.loc_ghost then Format.eprintf "%aWarning: Ill-formed location.@." Location.print loc
+          if not loc.loc_ghost then Format.eprintf "%aWarning: Ill-formed location.@." Location.print loc
       | Over_files -> ()
 
     let record_record tbl loc typ =
 
     class fold tbl =
       let record = record tbl in
-      let record_def loc sitem = record loc (Str sitem)
+      let record_def loc sitem = record loc (Str_item sitem)
       and record_use loc kind path = record loc (Use (kind, path)) in
     object
       inherit Ttfold.fold as super
     | Mod_type mty ->
 	fprintf ppf "Type: %a@ " (Printtyp.modtype ~with_pos:false) mty;
 	fprintf ppf "XType: %a" (Printtyp.modtype ~with_pos:true) mty
-    | Str str ->
-	fprintf ppf "Str: %a"
+    | Str_item str ->
+	fprintf ppf "Str_item: %a"
 	  Abstraction.format_structure_item str
     | Use (use, path) ->
 	fprintf ppf "Use: %s, %s"
     | Mod_type _mty ->
 	fprintf ppf "Type: ...@ ";
 	fprintf ppf "XType: ..."
-    | Str _str ->
-	fprintf ppf "Str: ..."
+    | Str_item _str ->
+	fprintf ppf "Str_item: ..."
     | Use (use, path) ->
 	fprintf ppf "Use: %s, %s"
 	  (String.capitalize (Kind.name use)) (Path.name path)
 module Region : sig
 
   type t = private {
-    fname : (string * (int * int) option) option;
-    (* filename and device/inode. None = "_none_" *)
+    fname : (string * Fileident.t option) option;
     start : Position.t;
     end_ : Position.t
   }
 
 end = struct
 
+  (* CR jfuruse: I heard that inode is not a good idea; mingw has no inode *)
   type t = {
-    fname : (string * (int * int) option) option;
-    (* filename and device/inode. None = "_none_" *)
+    fname : (string * Fileident.t option) option;
     start : Position.t;
     end_ : Position.t
   }
     | "_none_" -> None
     | s ->
         let s =
-          if Filename.is_relative s then
-            Unix.getcwd () ^/ s
+          if Filename.is_relative s then Unix.getcwd () ^/ s
           else s
         in
-        try
-          Hashtbl.find cache s
-        with
-        | Not_found ->
-            let dev_inode = Unix.dev_inode s in
-            if dev_inode = None then Format.eprintf "%s does not exist@." s;
-            let v = Some (s, dev_inode) in
-            Hashtbl.replace cache s v;
-            v
+        Some (Fileident.get s)
 
   let to_string t =
     Printf.sprintf "%s:%s:%s"
-      (match t.fname with Some (fname, _) -> fname | None -> "_none_")
+      (match t.fname with Some fname -> fst fname | None -> "_none_")
       (Position.to_string t.start)
       (Position.to_string t.end_)
 
     | _ -> { fname; start = end_; end_ = start }
 
   let compare l1 l2 =
-    let compare_fnames f1 f2 =
-      let same_files =
-        f1 == f2
-        || match f1, f2 with
-          | Some (_, Some di1), Some (_, Some di2) -> di1 = di2
-          | Some (f1, _), Some (f2, _) -> f1 = f2 (* weak guess *)
-          | None, None -> true (* ouch *)
-          | _ -> false
-      in
-      if same_files then 0
-      else match f1, f2 with
-      | Some (f1, _), Some (f2, _) -> compare f1 f2
-      | Some _, None -> 1
-      | None, Some _ -> -1
-      | None, None -> 0
-    in
+    let compare_fnames f1 f2 = if f1 == f2 then 0 else compare f1 f2 in
     (* CR jfuruse: this can be merged with same_files as compare *)
     match compare_fnames l1.fname l2.fname with
     | 1 -> `Left
       let tbl = Hashtbl.create 1023 in
       Hashtbl.iter (fun loc annots ->
         List.iter (function
-          | Annot.Str sitem ->
-              Option.iter (Abstraction.ident_of_structure_item sitem) ~f:(fun (_kind, id) ->
-                Hashtbl.add tbl id (Region.of_parsing f.F.builddir loc))
+          | Annot.Str_item sitem ->
+              let _kind,id = Abstraction.ident_of_structure_item sitem in
+              Hashtbl.add tbl id (Region.of_parsing f.F.builddir loc)
           | _ -> ()) annots) loc_annots;
       tbl)
     in
     (* CR jfuruse: it is almost the same as id_def_regions_list *)
     let flat = lazy (Hashtbl.fold (fun _loc annots st ->
       List.filter_map (function
-        | Annot.Str sitem -> Some sitem
+        | Annot.Str_item sitem -> Some sitem
         | _ -> None) annots @ st) loc_annots [])
     in
     { modname    = f.F.modname;
     | AStr_class_type of Ident.t
     | AStr_included   of Ident.t * module_expr * Kind.t * Ident.t
 
-  val ident_of_structure_item : structure_item -> (Kind.t * Ident.t) option
+  val ident_of_structure_item : structure_item -> (Kind.t * Ident.t)
 
   val top_structure : Typedtree.structure -> module_expr
   val top_signature : Typedtree.signature -> module_expr
     | Use of Kind.t * Path.t
     | Type of Types.type_expr * Env.t * [`Expr of Path.t option | `Pattern of Ident.t option ]
     | Mod_type of Types.module_type
-    | Str of Abstraction.structure_item 
+    | Str_item of Abstraction.structure_item 
     | Module of Abstraction.module_expr
     | Functor_parameter of Ident.t
     | Non_expansive of bool
 
 module Region : sig
 
-  type t = private { fname : (string * (int * int) option) option; 
-                     (* filename and device/inode. None = "_none_" *)
+  type t = private { fname : (string * Fileident.t option) option; 
                      start : Position.t; 
                      end_ : Position.t; }
   
     (* CR jfuruse: aaa.mll creates cmt with aaa.ml as source, but
        aaa.ml is often removed by the build system.
     *)
-    let stat_cmt = Unix.stat cmt in
+    let stat_cmt = try Unix.stat cmt with _ -> assert false in
     try
       let stat_source = Unix.stat source in
         (* Needs = : for packed modules, .cmt and the source .cmo are written 
         true
 
   let find_alternative_source ~cmt source =
-      (* if [source] is not found, we try finding files with the same basename
-         in
+      (* if [source] is not found, we try finding files with the same basename in
          - the directory of [cmt]
          - the directory of [cmt] points to (if [cmt] is symlink)
        *)
     let source_dirs =
         Filename.dirname cmt ::
         begin 
-          let stat_cmt = Unix.lstat cmt in
+          let stat_cmt = try Unix.lstat cmt with _ -> assert false in
           if stat_cmt.Unix.st_kind = Unix.S_LNK then
-            [ Filename.dirname (Unix.readlink cmt) ]
+            [ Filename.dirname (try Unix.readlink cmt with _ -> assert false) ]
           else []
         end
-      in
-      List.find Sys.file_exists 
-        (List.map (fun d -> d ^/ source_base) source_dirs)
+    in
+    List.find Sys.file_exists 
+      (List.map (fun d -> d ^/ source_base) source_dirs)
 
   let load_cmt_file file = snd (Cmt_format.read file)
 
   let load_directly path : Unit.t =
     Debug.format "cmt loading from %s@." path;
     match load_cmt_file path with
-    | Some cmt -> 
-        Spot.Unit.of_file (Spot.File.of_cmt path cmt)
+    | Some cmt -> Spot.Unit.of_file (Spot.File.of_cmt path cmt)
     | None -> failwithf "load_directly failed: %s" path
 
   exception Old_cmt of string (* cmt *) * string (* source *)
   (* CR jfuruse: exception *)
   (* CRv2 jfuruse: add and check cache time stamp *)
   let load_directly_with_cache : string -> Unit.t = 
-    let cache = Hashtbl.create 17 in
-    fun path ->
-      try 
-        Hashtbl.find cache path
+    Hashtbl.memoize (Hashtbl.create 17 ) (fun path ->
+      try
+        let file = load_directly path in
+        if not (check_time_stamp ~cmt:path file.Unit.path) then 
+          if Spotconfig.strict_time_stamp then 
+            raise (Old_cmt (path, file.Unit.path))
+          else
+            eprintf "Warning: source %s is newer than the cmt@." file.Unit.path;
+        file
       with
       | Not_found ->
-          try
-            let file = load_directly path in
-            if not (check_time_stamp ~cmt:path file.Unit.path) then 
-              if Spotconfig.strict_time_stamp then 
-                raise (Old_cmt (path, file.Unit.path))
-              else
-                eprintf "Warning: source %s is newer than the cmt@." file.Unit.path;
-            Hashtbl.replace cache path file;
-            file
-          with
-          | Not_found ->
-              failwithf "failed to find cmt file %s" path
+          failwithf "failed to find cmt file %s" path)
 
   let find_in_path load_paths body ext =
     let body_ext = body ^ ext in
     let find_in_path load_paths name = 
-      Debug.format "@[<2>searching %s in@ pwd=%s@ paths=[@[%a@]]@]@." 
+      Debug.format "@[<2>find_in_path: searching %s in@ pwd=%s@ paths=[@[%a@]]@]@." 
         name
         (Sys.getcwd ())
         (Format.list "; " (fun ppf x -> fprintf ppf "%S" x)) 
 
 Makefile.targets: *.ml *.mll *.mli */*.ml
 	echo TARGETS= \\ > $@
-	ls *.ml *.mli *.mll | sed -e 's/mli$$/cmi/' -e 's/ml$$/cmo/' -e 's/mll$$/cmo/' -e 's/$$/ \\/'	 >> $@
+	ls *.ml *.mli *.mll | sed -e 's/mli$$/cmi/' -e 's/ml$$/cmo/' -e 's/mll$$/cmo/' -e 's/$$/ \\/'	| grep -v partial >> $@
 
 .PHONY: clean install installopt beforedepend depend
 

tests/Makefile.targets

 override_x.cmo \
 packed.cmo \
 packed_alias.cmo \
-partial.cmo \
 pathname.cmo \
 perv.cmo \
 predef.cmo \

tests/ocamlbuild/Makefile

+hello.native: hello.ml
+	ocamlbuild hello.native
+
+clean:
+	ocamlbuild -clean

tests/ocamlbuild/hello.ml

+let _ =
+  Printf.printf "Hello, %s ! My name is %s\n"
+    (if Array.length Sys.argv > 1 then Sys.argv.(1) else "stranger")
+    Sys.argv.(0)
+;;
 
 module Hashtbl = struct
   include Hashtbl
+
   let of_list size kvs =
     let tbl = Hashtbl.create size in
     List.iter (fun (k,v) ->
       Hashtbl.replace tbl k v) kvs;
     tbl
+
+  let memoize tbl f k =
+    try 
+      Hashtbl.find tbl k 
+    with
+    | Not_found ->
+        let v = f k in
+        Hashtbl.replace tbl k v;
+        v
 end
 
 module Hashset = struct
 module Hashtbl : sig
   include module type of Hashtbl with type ('a,'b) t = ('a, 'b) Hashtbl.t
   val of_list : int -> ('a * 'b) list -> ('a, 'b) Hashtbl.t
+  val memoize : ('a, 'b) Hashtbl.t -> ('a -> 'b) -> 'a -> 'b
 end
 
 module Hashset : sig
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.