- let ic = open_in ma_file in
- let istream = Ulexing.from_utf8_channel ic in
- let dependencies = DependenciesParser.parse_dependencies istream in
- close_in ic;
- List.iter
- (function
- | DependenciesParser.UriDep uri ->
- let uri = UriManager.string_of_uri uri in
- if not (Http_getter_storage.is_legacy uri) then
- Hashtbl.add uri_deps ma_file uri
- | DependenciesParser.BaseuriDep uri ->
- let uri = Http_getter_misc.strip_trailing_slash uri in
- Hashtbl.add baseuri_of ma_file uri;
- Hashtbl.add baseuri_of_inv uri ma_file
- | DependenciesParser.IncludeDep path ->
- try
- let baseuri = baseuri_of_script path in
- if not (Http_getter_storage.is_legacy baseuri) then
- (let moo_file = obj_file_of_baseuri false baseuri in
- Hashtbl.add include_deps ma_file moo_file;
- Hashtbl.add include_deps_dot ma_file baseuri)
- with Sys_error _ ->
- HLog.warn
- ("Unable to find " ^ path ^ " that is included in " ^ ma_file))
- dependencies)
- ma_files;
- Hashtbl.iter
- (fun file alias ->
- try
- let dep = resolve alias (Hashtbl.find baseuri_of file) in
- match dep with
- | None -> ()
- | Some u ->
- Hashtbl.add include_deps file (obj_file_of_baseuri false u)
- with Not_found ->
- prerr_endline ("File "^ file^" has no baseuri. Use set baseuri");
- exit 1)
- uri_deps;
- let gcp x y =
- (* explode and implode from the OCaml Expert FAQ. *)
- let explode s =
- let rec exp i l =
- if i < 0 then l else exp (i - 1) (s.[i] :: l) in
- exp (String.length s - 1) []
- in
- let implode l =
- let res = String.create (List.length l) in
- let rec imp i = function
- | [] -> res
- | c :: l -> res.[i] <- c; imp (i + 1) l in
- imp 0 l
- in
- let rec aux = function
- | x::tl1,y::tl2 when x = y -> x::(aux (tl1,tl2))
- | _ -> []
- in
- implode (aux (explode x,explode y))
+ let _ = if Filename.check_suffix ma_file ".mma" then
+ let generated = Filename.chop_suffix ma_file ".mma" ^ ".ma" in
+ Hashtbl.add include_deps generated ma_file;
+ in
+ let ma_baseuri = baseuri_of_script ma_file in
+ let dependencies =
+ try DependenciesParser.deps_of_file ma_file
+ with Sys_error _ -> []
+ in
+ let handle_uri uri =
+ if not (Http_getter_storage.is_legacy uri) then
+ let dep = resolve uri ma_baseuri in
+ match dep with
+ | None -> ()
+ | Some u ->
+ match script_of_baseuri ma_file u with
+ | Some d -> Hashtbl.add include_deps ma_file d
+ | None -> ()
+ in
+ let handle_script path =
+ ignore (baseuri_of_script path);
+ Hashtbl.add include_deps ma_file path