+ end
+
+and compute_from_dname vdeps rdeps dname =
+ if !debug land 4 > 0 then Printf.printf " (%u) compute dep: %s\n%!" (List.length vdeps) dname;
+ if !debug land 8 > 0 then Printf.printf " vdeps: %s\n%!" (String.concat " " vdeps);
+ let file = Hashtbl.find graph dname in
+ let rdeps = StringSet.add dname rdeps in
+ StringSet.union (compute_from_file vdeps dname file) rdeps
+
+and compute_from_ddeps vdeps ddeps =
+ List.fold_left (compute_from_dname vdeps) StringSet.empty ddeps
+
+and redundant vdeps fname ddeps dname =
+ let rdeps = compute_from_ddeps vdeps (purge dname ddeps) in
+ if !show_check && StringSet.mem dname rdeps then
+ Printf.printf "%S: redundant %S\n%!" fname dname
+
+let check () =
+ let iter fname file = ignore (compute_from_file [] fname file) in
+ Hashtbl.iter iter graph
+
+let get_unions () =
+ let map1 ddeps dname = StringSet.add dname ddeps in
+ let map2 fname file (fnames, ddeps) =
+ StringSet.add fname fnames, List.fold_left map1 ddeps file.ddeps
+ in
+ Hashtbl.fold map2 graph (StringSet.empty, StringSet.empty)
+
+let get_leafs () =
+ let map fname file fnames =
+ if file.ddeps = [] then StringSet.add fname fnames else fnames
+ in
+ Hashtbl.fold map graph StringSet.empty
+
+let top () =
+ let iter fname = Printf.printf "top: %s\n" fname in
+ let fnames, ddeps = get_unions () in
+ StringSet.iter iter (StringSet.diff fnames ddeps)
+
+let leaf () =
+ let iter fname = Printf.printf "leaf: %s\n" fname in
+ let fnames = get_leafs () in
+ StringSet.iter iter fnames
+
+let rec file_iter map ich =
+ let line = input_line ich in
+ if line <> "" then map line;
+ file_iter map ich
+
+let back name =
+ Printf.printf "\"%s\":\n" name;
+ try match (Hashtbl.find graph name).rdeps with
+ | None -> ()
+ | Some rdeps ->
+ let rdeps =
+ if !iset = StringSet.empty then rdeps
+ else StringSet.inter rdeps !iset
+ in
+ let iter name = Printf.printf " \"%s\"\n" name in
+ StringSet.iter iter rdeps;
+ Printf.printf "\n"
+ with Not_found -> Printf.printf "* not found\n\n"
+
+let back fname =
+ if Librarian.is_uri fname then back fname else
+ let ich = open_in fname in
+ try file_iter back ich with End_of_file -> close_in ich
+
+let set_iset fname =
+ if Librarian.is_uri fname then iset := StringSet.singleton fname else
+ let map name = iset := StringSet.add name !iset in
+ let ich = open_in fname in
+ try file_iter map ich with End_of_file -> close_in ich
+
+let rec read_many ich s =
+ let line = input_line ich in
+ if line = "" then () else begin
+ begin try Scanf.sscanf line " %S" (init s)
+ with Scanf.Scan_failure _ | End_of_file ->
+ Printf.eprintf "unknown line: %s.\n" line
+ end;
+ read_many ich s
+ end
+
+let rec read_deps ich =
+ let line = input_line ich in
+ begin try Scanf.sscanf line "%s@:include %S." init
+ with Scanf.Scan_failure _ | End_of_file ->
+ begin try Scanf.sscanf line "./%s@:include %S." init
+ with Scanf.Scan_failure _ | End_of_file ->
+ begin try Scanf.sscanf line "%s@:(*%s@*)" (fun _ _ -> ())
+ with Scanf.Scan_failure _ | End_of_file ->
+ begin try Scanf.sscanf line "%S:%!" (read_many ich)
+ with Scanf.Scan_failure _ | End_of_file ->
+ begin try Scanf.sscanf line "%S: %S" init
+ with Scanf.Scan_failure _ | End_of_file ->
+ Printf.eprintf "unknown line: %s.\n" line
+ end
+ end
+ end
+ end
+ end;
+ read_deps ich