Commits

camlspotter committed 88b2880

spot module cache was not cleared

Comments (0)

Files changed (4)

 let ocaml_version = "4.00.0"
 let version = "2.0.0"
 
-module Location_bound = struct
-  open Location
-  let upperbound loc by = { loc with loc_end = by.loc_start }
-end
-
 module Kind = struct
   type t = 
     | Value | Type | Exception 
   open Typedtree
   open Asttypes
 
-  (* CR jfuruse: cache never cleaned! *)
   let cache_module_expr = Module_expr.Table.create 31
   let cache_structure_item = Structure_item.Table.create 31
 
     | Ttype_abstract -> []
     | Ttype_variant lst -> List.map (fun (id, {loc=_loc}, _, _) -> AStr_type id) lst
     | Ttype_record lst -> List.map (fun (id, {loc=_loc}, _, _, _) -> AStr_type id) lst
+
+  let top_structure str = clear_cache (); structure str
+  let top_signature sg =  clear_cache (); signature sg
 end
 
 let protect' name f v = try f v with e ->
 val ocaml_version : string
 val version : string
 
-module Location_bound : sig
-  val upperbound : Location.t -> Location.t -> Location.t
-end
-
 module Kind : sig
   type t = 
     | Value | Type | Exception 
 
   val ident_of_structure_item : structure_item -> (Kind.t * Ident.t) option
 
-  val structure : Typedtree.structure -> module_expr
-  val signature : Typedtree.signature -> module_expr
+  val top_structure : Typedtree.structure -> module_expr
+  val top_signature : Typedtree.signature -> module_expr
 
   val clear_cache : unit -> unit
 
       
   module Binding = struct
     type t = binding
-    let error () = raise (Failure "Binding: premature")
+    let error () = failwith "Binding: premature"
     let with_check f t = 
       match !t with
       | None -> error ()
     and env e = binding e.binding
     and binding b =
       match !b with
-      | None -> raise (Failure "Enforcer.binding: binding is premature")
+      | None -> failwith "Enforcer.binding: binding is premature"
       | Some str -> structure str
     and structure str = List.iter structure_item str
     and structure_item (_, (_, zt)) = z zt
 (*                                                                     *)
 (***********************************************************************)
 
-(* module names may corride in different source/spot files *)
-
 open Format
 open Utils
 
 open Spoteval
 
 module Make(Spotconfig : Spotconfig_intf.S) = struct
-  (* open Abstraction *)
 
   module Load : sig
     exception Old_cmt of string (* cmt *) * string (* source *)
           Hashtbl.find cache path
         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 ->
-                  failwith (Printf.sprintf "failed to find cmt file %s" 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;
+              Hashtbl.replace cache path file;
+              file
+            with
+            | Not_found ->
+                failwith (Printf.sprintf "failed to find cmt file %s" path)
 
     let find_in_path load_paths body ext =
       let body_ext = body ^ ext in
           try
             load ~load_paths spitname
           with
-          | Failure s' ->
-                (* CR jfuruse: ugly! *)
-              raise (Failure (s ^ "\n" ^ s'))
+          | Failure s' -> failwithf "%s\n%s" s s'
   end
 
   include Load