val string_of_target_object: target_object -> string
val build: options -> source_object -> bool
val root_and_target_of:
- options -> source_object -> string option * target_object
+ options -> source_object ->
+ (* root, writeable target, read only target *)
+ string option * target_object * target_object
val mtime_of_source_object: source_object -> float option
val mtime_of_target_object: target_object -> float option
val is_readonly_buri_of: options -> source_object -> bool
let fst4 = function (x,_,_,_) -> x;;
let modified_before_s_t (_,cs, ct, _, _) a b =
-(*
+(*
time_stamp ("L s_t: a " ^ F.string_of_source_object a);
time_stamp ("L s_t: b " ^ F.string_of_target_object b);
-*)
+*)
let a = try Hashtbl.find cs a with Not_found -> assert false in
let b =
try
| Some a, Some b -> a <= b
| _ -> false
in
-(*
+(*
time_stamp ("L s_t: " ^ string_of_bool r);
-*)
+*)
r
let modified_before_t_t (_,_,ct, _, _) a b =
-(*
+(*
time_stamp ("L t_t: a " ^ F.string_of_target_object a);
time_stamp ("L t_t: b " ^ F.string_of_target_object b);
-*)
+*)
let a =
try
match Hashtbl.find ct a with
in
let r = match a, b with
| Some a, Some b ->
-(*
+(*
time_stamp ("tt: a " ^ string_of_float a);
time_stamp ("tt: b " ^ string_of_float b);
-*)
+*)
a <= b
| _ -> false
in
-(*
+(*
time_stamp ("L t_t: " ^ string_of_bool r);
-*)
+*)
r
let rec purge_unwanted_roots wanted deps =
let res = F.build lo t in
time_stamp ("L : DONE " ^ str); res
end else begin
- Hashtbl.remove ct tgt;
- Hashtbl.add ct tgt None;
- HLog.warn("Read only baseuri for: "^ str^
- ", assuming it is aleary built."); true
+ HLog.error ("Read only baseuri for: "^ str^
+ ", I won't compile it even if it is out of date");
+ false
end
| Some froot -> make froot [t]
| None ->
let deps =
List.map
(fun (file,d) ->
- let r,tgt = F.root_and_target_of local_options file in
+ let r,wtgt,rotgt = F.root_and_target_of local_options file in
Hashtbl.add caches file (F.mtime_of_source_object file);
- Hashtbl.add cachet tgt (F.mtime_of_target_object tgt);
- Hashtbl.add cached file (file, d, r, tgt);
- (file, d, r, tgt)
+ (* if a read only target exists, we use that one, otherwise
+ we use the writeable one that may be compiled *)
+ let _,_,_, tgt as tuple =
+ match F.mtime_of_target_object rotgt with
+ | Some _ as mtime ->
+ Hashtbl.add cachet rotgt mtime;
+ (file, d, r, rotgt)
+ | None ->
+ Hashtbl.add cachet wtgt (F.mtime_of_target_object wtgt);
+ (file, d, r, wtgt)
+ in
+ Hashtbl.add cached file tuple;
+ tuple
)
deps
in
let root,baseuri,_,_ =
Librarian.baseuri_of_script ~include_paths mafile
in
- let obj =
+ let obj_writeable, obj_read_only =
if Filename.check_suffix mafile ".mma" then
+ Filename.chop_suffix mafile ".mma" ^ ".ma",
Filename.chop_suffix mafile ".mma" ^ ".ma"
else
LibraryMisc.obj_file_of_baseuri
- ~must_exist:false ~baseuri ~writable:true
+ ~must_exist:false ~baseuri ~writable:true,
+ LibraryMisc.obj_file_of_baseuri
+ ~must_exist:false ~baseuri ~writable:false
in
- Some root, obj
- with Librarian.NoRootFor x -> None, ""
+ Some root, obj_writeable, obj_read_only
+ with Librarian.NoRootFor x -> None, "", ""
;;
let mtime_of_source_object s =