Commits

camlspotter  committed b3c91e2

ocamlbuld build dir browsing support 1st version

  • Participants
  • Parent commits ebf35b4

Comments (0)

Files changed (6)

 (* 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
+  let module FP = Filepath in
+  (* CR jfuruse: we should create a function for this *)
+  let path = if Filename.is_relative path then Unix.getcwd () ^/ path else path in
+  let fp = FP.of_string path in
+  match FP.dirbase fp with
+  | _, None -> failwithf "Error: %s is not a normal file path" path
+  | dir, Some base ->
+      let rec find = function
+        | [] -> assert false
+        | [fp] -> FP.to_string fp
+        | fp::fps -> 
+            let path = FP.to_string fp in
+            if Sys.file_exists path then  path
+            else find fps
+      in
+      find (match Filename.split_extension base with
+      | body, (".cmi" | ".cmti" | ".spit") -> [ FP.(^/) dir (body ^ ".cmti") ]
+      | body, (".cmo" | ".cmx" | ".cmt" | ".spot") -> [ FP.(^/) dir (body ^ ".cmt") ]
+      | body, ".mli" -> 
+          [ FP.(^/) (Compdir.comp_dir dir ) (body ^ ".cmti");
+            FP.(^/) dir (body ^ ".cmti"); ]
+      | body, _ (* .ml, mll, mly *) -> 
+          [ FP.(^/) (Compdir.comp_dir dir ) (body ^ ".cmt");
+            FP.(^/) dir (body ^ ".cmt") ])
 
 (* 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 = 
       else None
     in
     match diropt with
-    | Some dir -> Some (FP.(^/) fp (Filename.concats (dir :: List.rev rev_bases)))
+    | Some _ -> Some (FP.(^/) fp (Filename.concats ("_build" :: List.rev rev_bases)))
     | None ->
         if FP.is_root fp then Some fp0
         else match FP.dirbase fp with

File ocamlspot.ml

 
   let load path =
 
-    let file = File.load ~load_paths: ["."] path in
+    prerr_endline ("load " ^ path);
+    let file = File.load_directly_with_cache path in
     
     if C.dump_file    then Dump.unit    file; (* CR jfuruse: to be fixed *)
     if C.dump_tree    then Dump.tree    file;
         eprintf "Error: source %s is newer than the spot@." source;
         bye 1
     | e ->
-        eprintf "uncaught exception: %s@." (Printexc.to_string e);
+        eprintf "Uncaught exception: %s@.%s@." (Printexc.to_string e) (Printexc.get_backtrace ());
         bye 1
 
   let use path spec targets =
   let fname = function
     | "_none_" -> None
     | s ->
-        let s =
+        let module FP = Filepath in
+        let s = (* CR jfuruse: we must make it a function *)
           if Filename.is_relative s then Unix.getcwd () ^/ s
           else s
         in
+        let fp = FP.of_string s in
+        let s = 
+          match FP.dirbase fp with
+          | _, None -> failwithf "Error: %s is not a normal file path" s
+          | dir, Some base -> 
+              FP.to_string (FP.(^/) (Compdir.src_dir dir) base)
+        in
         Some (Fileident.get s)
 
   let to_string t =
   exception Old_cmt of string (* cmt *) * string (* source *)
   val load : load_paths:string list -> string -> Unit.t
   val load_module : ?spit:bool -> cwd:string -> load_paths:string list -> string -> Unit.t
+  val load_directly_with_cache : string -> Unit.t
 end = struct
 
   let check_time_stamp ~cmt source =

File spotfile.mli

 exception Old_cmt of string * string
 val load : load_paths:string list -> string -> Unit.t
 val load_module : ?spit:bool -> cwd:string -> load_paths:string list -> string -> Unit.t (* CR jfuruse: spit *)
+val load_directly_with_cache : string -> Unit.t
 
 val initial_env   : Unit.t -> Env.t
 val invalid_env : Unit.t -> Env.t