- let f qs = f (id, qs) in
- if is_local then Cps.list_rev_append f st.path ~tail:qs else f qs
-
-let resolve_gref f st lenv gref =
- let rec get_local f i = function
- | [] -> f None
- | (name, _) :: _ when name = gref -> f (Some i)
- | _ :: tl -> get_local f (succ i) tl
- in
- let rec get_global f = function
- | [] -> f None
- | (args, name, _, _) :: _ when name = gref -> f (Some args)
- | _ :: tl -> get_global f tl
- in
- let g = function
- | Some args -> f (Global args)
- | None -> f Unresolved
- in
- let f = function
- | Some i -> f (Local i)
- | None -> get_global g st.genv
- in
- get_local f 0 lenv
+ let f qs = f (mk_qid st id qs) in
+ let f path = C.list_rev_append f path ~tail:qs in
+ let rec skip f = function
+ | phd :: ptl, qshd :: _ when phd = qshd -> f ptl
+ | _ :: ptl, _ :: _ -> skip f (ptl, qs)
+ | _ -> f []
+ in
+ if is_local then f st.path else skip f (st.path, qs)
+
+let relax_qid f st (_, id, path) =
+ let f path = f (mk_qid st id path) in
+ let f = function
+ | _ :: tl -> C.list_rev f tl
+ | [] -> assert false
+ in
+ C.list_rev f path
+
+let relax_opt_qid f st = function
+ | None -> f None
+ | 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
+ | [] -> f None
+ | (name, _) :: _ when name = id -> f (Some (M.LRef (l, i)))
+ | _ :: tl -> aux f (succ i) tl
+ in
+ aux f 0 lenv
+
+let resolve_lref_strict f st l lenv id =
+ let f = function
+ | Some t -> f t
+ | None -> assert false
+ in
+ resolve_lref f st l lenv id
+
+let resolve_gref f st qid =
+ try let args = H.find henv (uri_of_qid qid) in f qid (Some args)
+ with Not_found -> f qid None
+
+let resolve_gref_relaxed f st qid =
+(* this is not tail recursive *)
+ let rec g qid = function
+ | None -> relax_qid (resolve_gref g st) st qid
+ | Some args -> f qid args
+ in
+ resolve_gref g st qid
+
+let get_pars f st = function
+ | None -> f [] None
+ | Some qid as node ->
+ try let pars = H.find hcnt (uri_of_qid qid) in f pars None
+ with Not_found -> f [] (Some node)