X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Flibrary%2Flibrarian.ml;h=62a8a892c3887f5b965266e49077846456ffa227;hb=33fbecf99c187fb4fc84a68ee9f479da046e9df9;hp=9b08f46145c6879a745aa9de619d6a1e84cdd4da;hpb=8cc0cbeba5135742b519cc6fb990221e847a12fa;p=helm.git diff --git a/helm/software/components/library/librarian.ml b/helm/software/components/library/librarian.ml index 9b08f4614..62a8a892c 100644 --- a/helm/software/components/library/librarian.ml +++ b/helm/software/components/library/librarian.ml @@ -191,7 +191,9 @@ module type Format = 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 @@ -209,8 +211,10 @@ module Make = functor (F:Format) -> struct let fst4 = function (x,_,_,_) -> x;; let modified_before_s_t (_,cs, ct, _, _) a b = - prerr_endline ("L s_t: a " ^ F.string_of_source_object a); - prerr_endline ("L s_t: b " ^ F.string_of_target_object 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 @@ -228,13 +232,17 @@ module Make = functor (F:Format) -> struct | Some a, Some b -> a <= b | _ -> false in - prerr_endline ("L s_t: " ^ string_of_bool r); r +(* + time_stamp ("L s_t: " ^ string_of_bool r); +*) + r - let modified_before_t_t (_,_,ct, _, _) a b = -(* - prerr_endline ("L t_t: a " ^ F.string_of_target_object a); - prerr_endline ("L t_t: b " ^ F.string_of_target_object b); -*) let a = + 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 | Some _ as x -> x @@ -259,15 +267,18 @@ module Make = functor (F:Format) -> struct with Not_found -> assert false in let r = match a, b with - | Some a, Some b -> -(* - prerr_endline ("tt: a " ^ string_of_float a); - prerr_endline ("tt: b " ^ string_of_float b); -*) - a <= b - | _ -> false + | Some a, Some b -> +(* + time_stamp ("tt: a " ^ string_of_float a); + time_stamp ("tt: b " ^ string_of_float b); +*) + a <= b + | _ -> false in - prerr_endline ("L t_t: " ^ string_of_bool r); r +(* + time_stamp ("L t_t: " ^ string_of_bool r); +*) + r let rec purge_unwanted_roots wanted deps = let roots, rest = @@ -391,10 +402,10 @@ module Make = functor (F:Format) -> struct let r = make_one root opts okd whatd in r, okt && modified_before_t_t opts tgtd tgt in - prerr_endline ("L : processing " ^ str); + time_stamp ("L : processing " ^ str); try let r = Hashtbl.find cc t in - prerr_endline ("L : " ^ string_of_bool r ^ " " ^ str); + time_stamp ("L : " ^ string_of_bool r ^ " " ^ str); ok && r (* say "already built" *) with Not_found -> @@ -411,14 +422,16 @@ module Make = functor (F:Format) -> struct let res = F.build lo t in time_stamp ("L : DONE " ^ str); res end else begin - HLog.warn("Read only baseuri for: "^ str); false + 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 -> HLog.error ("No root for: " ^ str); false else false in - prerr_endline ("L : " ^ string_of_bool res ^ " " ^ str); + time_stamp ("L : " ^ string_of_bool res ^ " " ^ str); Hashtbl.add cc t res; ok && res (****************************************************************************) @@ -437,11 +450,21 @@ module Make = functor (F:Format) -> struct 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