-(* FG: Old sorting algorithm ************************************************)
-(*
- 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 modified_before_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 modified_before_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 =
- time_stamp "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
- time_stamp "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
- in
- if todo <> [] then begin
- let ok = List.fold_left
- (fun ok (file,_,froot,tgt) ->
- let rc =
- match froot with
- | Some froot when froot = root ->
- Hashtbl.remove ct tgt;
- Hashtbl.add ct tgt None;
- time_stamp "building";
- let r = F.build lo file in
- time_stamp "done"; r
- | Some froot -> make froot [file]
- | None ->
- HLog.error ("No root for: "^F.string_of_source_object file);
- false
- in
- Hashtbl.add cc file rc;
- ok && rc
- )
- ok (List.rev todo)
- in
- make_aux root opts ok (List.rev deps)
- end
- else
- ok
-*)