- let rec make_aux root (lo,_,ct as opts) compiled failed deps =
- let todo = List.filter (is_buildable opts compiled deps) deps in
- let todo = List.filter (fun (f,_,_,_)->not (List.mem f failed)) todo in
- if todo <> [] then
- let compiled, failed =
- let todo =
- let local, remote =
- List.partition (fun (_,_,froot,_) -> froot = Some root) todo
+ let is_not_ro (opts,_,_,_,_) (f,_,_,r,_) =
+ match r with
+ | Some root -> not (F.is_readonly_buri_of opts f)
+ | None -> assert false
+ ;;
+
+(* FG: new sorting algorithm ************************************************)
+
+ let rec make_aux root opts ok deps =
+ List.fold_left (make_one root opts) ok deps
+
+ and make_one root opts ok what =
+ let lo, _, ct, cc, cd = opts in
+ let t, path, deps, froot, tgt = what in
+ let str = F.string_of_source_object t in
+ let map (okd, okt) d =
+ let (_, _, _, _, tgtd) as whatd = (Hashtbl.find cd d) in
+ 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 ->
+ let okd, okt = List.fold_left map (true, modified_before_s_t opts t tgt) deps in
+ let res =
+ if okd then
+ if okt then true else
+ let build path = match froot with
+ | Some froot when froot = root ->
+ if is_not_ro opts what then F.build lo path else
+ (HLog.error ("Read only baseuri for: " ^ str ^
+ ", I won't compile it even if it is out of date");
+ false)
+ | Some froot -> make froot [path]
+ | None -> HLog.error ("No root for: " ^ str); false