module B = Librarian
module H = HExtlib
+module M = MacLexer
+
let unsupported protocol =
failwith (P.sprintf "probe: unsupported protocol: %s" protocol)
let missing path =
failwith (P.sprintf "probe: missing path: %s" path)
-let unrooted path =
- failwith (P.sprintf "probe: missing root: %s" path)
+let unrooted path roots =
+ failwith (P.sprintf "probe: missing root: %s (found roots: %u)" path (L.length roots))
let out_int i = P.printf "%u\n" i
let get_uri str =
let str = H.normalize_path str in
let dir, file =
- if H.is_regular str && F.check_suffix str ".ma"
+ if H.is_regular str && F.check_suffix str ".ma"
then F.dirname str, F.chop_extension (F.basename str)
else if H.is_dir str then str, ""
else missing str
in
let rec aux bdir file = match B.find_roots_in_dir bdir with
- | [root] ->
- let buri = L.assoc "baseuri" (B.load_root_file root) in
+ | [root] ->
+ let buri = L.assoc "baseuri" (B.load_root_file root) in
F.concat bdir file, F.concat buri file
- | _ ->
- if bdir = F.current_dir_name || bdir = F.dir_sep then unrooted dir else
+ | roots ->
+ if bdir = F.current_dir_name || bdir = F.dir_sep then unrooted dir roots else
aux (F.dirname bdir) (F.concat (F.basename bdir) file)
in
aux dir file
+
+let mac fname =
+ let ich = open_in fname in
+ let lexbuf = Lexing.from_channel ich in
+ M.token lexbuf; close_in ich
+