node: context_node; (* current context node *)
nodes: context_node list; (* context node list *)
line: int; (* line number *)
- explicit: bool (* need explicit context root? *)
+ cover: string (* initial segment of URI hierarchy *)
}
type resolver = Local of int
(* Internal functions *******************************************************)
-let initial_status size = {
- path = []; node = None; nodes = []; line = 1; explicit = true;
+let initial_status size cover = {
+ path = []; node = None; nodes = []; line = 1; cover = cover;
henv = H.create size; hcnt = H.create size
}
let id_of_name (id, _, _) = id
-let mk_qid id path =
- let str = String.concat "/" path in
- let str = Filename.concat str id in
+let mk_qid st id path =
+ let uripath = if st.cover = "" then path else st.cover :: path in
+ let str = String.concat "/" uripath in
+ let str = Filename.concat str id in
U.uri_of_string ("ld:/" ^ str), id, path
let uri_of_qid (uri, _, _) = uri
let complete_qid f st (id, is_local, qs) =
- let f qs = f (mk_qid id qs) in
+ let f qs = f (mk_qid st id qs) in
let f path = Cps.list_rev_append f path ~tail:qs in
let rec skip f = function
| phd :: ptl, qshd :: _ when phd = qshd -> f ptl
in
if is_local then f st.path else skip f (st.path, qs)
-let relax_qid f (_, id, path) =
- let f path = f (mk_qid id path) in
+let relax_qid f st (_, id, path) =
+ let f path = f (mk_qid st id path) in
let f = function
| _ :: tl -> Cps.list_rev f tl
| [] -> assert false
in
Cps.list_rev f path
-let relax_opt_qid f = function
+let relax_opt_qid f st = function
| None -> f None
- | Some qid -> let f qid = f (Some qid) in relax_qid f qid
+ | Some qid -> let f qid = f (Some qid) in relax_qid f st qid
let resolve_lref f st l lenv id =
let rec aux f i = function
let resolve_gref_relaxed f st qid =
let rec g qid = function
- | None -> relax_qid (resolve_gref g st) qid
+ | None -> relax_qid (resolve_gref g st) st qid
| Some args -> f qid args
in
resolve_gref g st qid
let get_pars_relaxed f st =
let rec g pars = function
| None -> f pars
- | Some node -> relax_opt_qid (get_pars g st) node
+ | Some node -> relax_opt_qid (get_pars g st) st node
in
get_pars g st st.node
resolve_lref f st l lenv (id_of_name name)
let xlate_item f st = function
- | A.Section (Some name) ->
+ | A.Section (Some (_, name)) ->
f {st with path = name :: st.path; nodes = st.node :: st.nodes} None
| A.Section None ->
begin match st.path, st.nodes with
(* Interface functions ******************************************************)
-let initial_status = initial_status hsize
+let initial_status ?(cover="") () =
+ initial_status hsize cover
let meta_of_aut = xlate_item