X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Flibrary%2Flibrarian.ml;h=62a8a892c3887f5b965266e49077846456ffa227;hb=d7f3ff62899afb162cb2825af91de72fe6d8dc85;hp=8b8991bfc48f14fa8e03ed9430fd93c142f3f71b;hpb=5c474bdfb28196a7dc6009addccb47c08925887b;p=helm.git diff --git a/helm/software/components/library/librarian.ml b/helm/software/components/library/librarian.ml index 8b8991bfc..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,6 +211,10 @@ module Make = functor (F:Format) -> struct 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 @@ -222,12 +228,20 @@ module Make = functor (F:Format) -> struct | x -> x with Not_found -> assert false in - match a, b with + let r = match a, b with | 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 = + 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 @@ -252,11 +266,19 @@ module Make = functor (F:Format) -> struct | x -> x with Not_found -> assert false in - match a, b with - | Some a, Some b -> - a <= b - | _ -> false - ;; + 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 roots, rest = @@ -380,8 +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 + time_stamp ("L : processing " ^ str); try let r = Hashtbl.find cc t in + time_stamp ("L : " ^ string_of_bool r ^ " " ^ str); ok && r (* say "already built" *) with Not_found -> @@ -398,13 +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 + time_stamp ("L : " ^ string_of_bool res ^ " " ^ str); Hashtbl.add cc t res; ok && res (****************************************************************************) @@ -423,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