Commits

camlspotter  committed 4e0e0a6

support packed

  • Participants
  • Parent commits d0fa0e4

Comments (0)

Files changed (7)

 spotconfig.cmx : utils.cmx spot.cmx ext.cmx spotconfig.cmi
 spotconfig_intf.cmo : spot.cmi ext.cmo
 spotconfig_intf.cmx : spot.cmx ext.cmx
-spoteval.cmo : utils.cmi spot.cmi spoteval.cmi
-spoteval.cmx : utils.cmx spot.cmx spoteval.cmi
+spoteval.cmo : utils.cmi spot.cmi ext.cmo spoteval.cmi
+spoteval.cmx : utils.cmx spot.cmx ext.cmx spoteval.cmi
 spotfile.cmo : utils.cmi spoteval.cmi spotconfig_intf.cmo spot.cmi \
     dotfile.cmo spotfile.cmi
 spotfile.cmx : utils.cmx spoteval.cmx spotconfig_intf.cmx spot.cmx \
 
   let format ppf id =
     fprintf ppf "%s%s" 
-      (if id.path = "" then ""
-        else 
-          (let len = String.length id.path in
-          if len > 20 then
-            "..." ^ String.sub id.path (len - 20) 20 
-          else id.path) ^ ":")
-        (match id.ident with
-        | Some id -> Ident.name id
-        | None -> "TOP")
+      (match id.path with
+      | "" -> ""
+      | p -> 
+          (let len = String.length p in
+           if len > 20 then
+             "..." ^ String.sub p (len - 20) 20 
+           else p) ^ ":")
+      (match id.ident with
+      | Some id -> Ident.name id
+      | None -> "TOP")
 end
 
 module Value : sig
         | None -> 
             if Ident.global id then
               lazy begin try
-                let path, str = 
-                  !str_of_global_ident ~load_paths:env.load_paths id
-                in
+                let path, str = !str_of_global_ident ~load_paths:env.load_paths id in
                 let str = Structure ( { PIdent.path = path; ident = None }, 
                                       str,
                                       None (* CR jfuruse: todo (read .mli *))
     end
 
   and module_expr env idopt : module_expr -> Value.z = function
-    | AMod_functor_parameter -> eager (Parameter { PIdent.path= env.path; ident = idopt })
+    | AMod_functor_parameter -> 
+        eager (Parameter { PIdent.path= env.path; ident = idopt })
     | AMod_abstract -> eager (Error (Failure "abstract"))
     | AMod_ident p -> find_path env (Kind.Module, p)
     | AMod_packed s -> lazy (!packed env s)

File spoteval.mli

 
 module PIdent : sig
   (** Identifier with file name path *)
-  type t = { path : string; ident : Ident.t option; }
+  type t = { path : string;
+             ident : Ident.t option; }
   val format : Format.formatter -> t -> unit
 end
 
 
 type file = {
   cmt            : Cmt_format.cmt_infos;
-  path           : string;
+  path           : string; (** source path. If packed, the .cmo itself *)
   flat           : Abstraction.structure;
   top            : Abstraction.structure;
   id_def_regions : (Ident.t, Region.t) Hashtbl.t;
 }
 
 let source_path_of_cmt file = match file.cmt_sourcefile with 
-  | Some f -> Filename.concat file.cmt_builddir f
-  | None -> assert false
+  | Some f -> Some (Filename.concat file.cmt_builddir f)
+  | None -> None
 
 let dump_file file =
   eprintf "@[<v2>{ module= %S;@ path= %S;@ source= %S;@ builddir= %S;@ loadpath= [ @[%a@] ];@ argv= [| @[%a@] |];@ ... }@]@."
       | Abstraction.AMod_structure str -> str, loc_annots
       | _ -> assert false
       end
+  | Packed (_sg, files) ->
+      (List.map (fun file ->
+        let fullpath = if Filename.is_relative file then Filename.concat cmt.cmt_builddir file else file in
+        let modname = match Filename.split_extension (Filename.basename file) with 
+          | modname, ".cmo" -> String.capitalize modname
+          | _ -> assert false
+        in
+        Abstraction.AStr_module (Ident.create modname (* stamp is bogus *),
+                                 Abstraction.AMod_packed fullpath)) files),
+      []
   | Partial_implementation _parts | Partial_interface _parts -> assert false
-  | _ -> assert false
 
 let abstraction_of_cmt cmt = 
   try abstraction_of_cmt cmt with e -> 
   open Abstraction
 
   module Load : sig
-  exception Old_cmt of string (* cmt *) * string (* source *)
+    exception Old_cmt of string (* cmt *) * string (* source *)
     val load : load_paths:string list -> string -> file
     val load_module : ?spit:bool -> load_paths:string list -> string -> file
   end = struct
           Debug.format "cmt loaded now extracting things from %s ...@." path;
           let str, loc_annots = abstraction_of_cmt cmt in
           Debug.format "cmt loaded: abstraction extracted from %s@." path;
-          let path = source_path_of_cmt cmt in
+          let path = Option.default (Filename.chop_extension path ^ ".cmo") (source_path_of_cmt cmt) in
           let rannots = List.map (fun (loc, annot) -> 
             { Regioned.region = Region.of_parsing loc;  value = annot }) loc_annots
           in
         | Not_found ->
               try
                 let file = load_directly path in
-                begin match file.path with 
-                | "" -> ()
-                | source -> 
-                    if not (check_time_stamp ~cmt:path source) then 
-                      if Spotconfig.strict_time_stamp then 
-                        raise (Old_cmt (path, source))
-                      else
-                        eprintf "Warning: source %s is newer than the cmt@." source
-                end;
+                if not (check_time_stamp ~cmt:path file.path) then 
+                  if Spotconfig.strict_time_stamp then 
+                    raise (Old_cmt (path, file.path))
+                  else
+                    eprintf "Warning: source %s is newer than the cmt@." file.path;
                 Hashtbl.replace cache path file;
                 file
               with
     let find_loc pid =
       match  pid.PIdent.path with
       | "" -> Predefined
-      | _ ->
+      | path ->
           (* CR jfuruse: loading twice... *)
           Debug.format "Finding %a@." PIdent.format pid;
-          let file = 
-            Load.load ~load_paths:[] (cmt_of_file pid.PIdent.path) 
-          in
+          let file = Load.load ~load_paths:[] (cmt_of_file path) in
           match pid.PIdent.ident with
           | None -> File_itself (* the whole file *)
           | Some id -> 

File spotfile.mli

 
 type file = {
   cmt            : Cmt_format.cmt_infos;
-  path           : string;
+  path           : string; (** cmt file itself if packed *)
   flat           : Abstraction.structure;
   top            : Abstraction.structure;
   id_def_regions : (Ident.t, Region.t) Utils.Hashtbl.t;
   tree           : Tree.t lazy_t
 }
 
-val source_path_of_cmt : cmt_infos -> string
+val source_path_of_cmt : cmt_infos -> string option
 val dump_file : file -> unit
 val cmt_of_file : string -> string
 val abstraction_of_cmt : cmt_infos -> Abstraction.structure * (Location.t * Annot.t) list
   let iter ~f = function
     | None -> ()
     | Some v -> f v
+
+  let default dv = function
+    | None -> dv
+    | Some v -> v
 end
 
 exception Finally of exn * exn
   val map : f:('a -> 'b) -> 'a option -> 'b option
   val bind : 'a option -> ('a -> 'b option) -> 'b option
   val iter : f:('a -> unit) -> 'a option -> unit
+  val default : 'a -> 'a option -> 'a 
 end
 
 exception Finally of exn * exn