- let rec get_status opts what =
- let _, _, _, cc, cd = opts in
- let t, dependencies, root, tgt = what in
- try Done (Hashtbl.find cc t)
-(* say "already built" *)
- with Not_found ->
- let map st d = match st with
- | Done false -> st
- | Ready false -> st
- | _ ->
- let whatd = Hashtbl.find cd d in
- let _, _, _, tgtd = whatd in
- begin match st, get_status opts whatd with
- | _, Done false -> Hashtbl.add cc t false; Done false
- | Done true, Done true ->
- if younger_t_t opts tgt tgtd then Ready true else Done true
-(* say (F.string_of_source_object t^" depends on "^F.string_of_target_object unsat^" and "^F.string_of_source_object t^".o is younger than "^ F.string_of_target_object unsat^", thus needs to be built") *)
- | Done true, Ready _ -> Ready false
- | Ready true, Ready _ -> Ready false
-(* say (F.string_of_source_object t^" depends on "^ F.string_of_source_object (fst4 unsat)^ " that is not built, thus is not ready") *)
- | Ready true, Done true -> Ready true
- | _ -> st
- end
- in
- let st = if younger_s_t opts t tgt then Done true else Ready true in
- match List.fold_left map st dependencies with
- | Done true -> Hashtbl.add cc t true; Done true
-(* say(F.string_of_source_object t^" is built" *)
- | st -> st
-
- let list_partition_filter_rev filter l =
- let rec aux l1 l2 = function
- | [] -> l1, l2
- | hd :: tl ->
- begin match filter hd with
- | None -> aux l1 l2 tl
- | Some true -> aux (hd :: l1) l2 tl
- | Some false -> aux l1 (hd :: l2) tl
- end
- in
- aux [] [] l
-
- let rec make_aux root (lo,_,ct, cc, _ as opts) ok deps =
- timestamp "filter get_status: begin";
- let map what = match get_status opts what with
- | Done _ -> None
- | Ready b -> Some b
- in
- let todo, deps = list_partition_filter_rev map deps in
- timestamp "filter get_status: end";
- let todo =
- let local, remote =
- List.partition (fun (_,_,froot,_) -> froot = Some root) todo
- in
- let local, skipped = List.partition (is_not_ro opts) local in
- List.iter
- (fun x ->
- HLog.warn("Read only baseuri for: "^F.string_of_source_object(fst4 x)))
- skipped;
- remote @ local
+(* 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