*)
exception Meta_not_found of int
+exception Subst_not_found of int
+
let lookup_meta index metasenv =
try
List.find (fun (index', _, _) -> index = index') metasenv
with Not_found -> raise (Meta_not_found index)
+let lookup_subst n subst =
+ try
+ List.assoc n subst
+ with Not_found -> raise (Subst_not_found n)
+
let exists_meta index = List.exists (fun (index', _, _) -> (index = index'))
+(* clean_up_meta take a substitution, a metasenv a meta_inex and a local
+context l and clean up l with respect to the hidden hipothesis in the
+canonical context *)
+
+let clean_up_local_context subst metasenv n l =
+ let cc =
+ (try
+ let (cc,_) = lookup_subst n subst in cc
+ with Subst_not_found _ ->
+ try
+ let (_,cc,_) = lookup_meta n metasenv in cc
+ with Meta_not_found _ -> assert false) in
+ (try
+ List.map2
+ (fun t1 t2 ->
+ match t1,t2 with
+ None , _ -> None
+ | _ , t -> t) cc l
+ with
+ Invalid_argument _ -> assert false)
+
let is_closed =
let module C = Cic in
let rec is_closed k =
in
is_closed 0
;;
+
+(* CPS iterators on Cic.term ************************************************)
+
+let rec visit_l visit_t map f r = function
+ | [] -> f r
+ | h :: tail ->
+ let f r = visit_l visit_t map f r tail in
+ visit_t f r (map h)
+
+let meta_closed t =
+ let rec visit_t f r = function
+ | Cic.Meta _ -> raise Exit
+ | Cic.Implicit _
+ | Cic.Sort _
+ | Cic.Rel _ -> f r
+ | Cic.Cast (t, u)
+ | Cic.Prod (_, t, u)
+ | Cic.Lambda (_, t, u)
+ | Cic.LetIn (_, t, u) ->
+ let f r = visit_t f r u in visit_t f r t
+ | Cic.Appl tl ->
+ visit_l visit_t (fun x -> x) f r tl
+ | Cic.Fix (_, tl) ->
+ let f r = visit_l visit_t (fun (_, _, _, u) -> u) f r tl in
+ visit_l visit_t (fun (_, _, t, _) -> t) f r tl
+ | Cic.CoFix (_, tl) ->
+ let f r = visit_l visit_t (fun (_, _, u) -> u) f r tl in
+ visit_l visit_t (fun (_, t, _) -> t) f r tl
+ | Cic.Var (k, tl)
+ | Cic.Const (k, tl)
+ | Cic.MutInd (k, _, tl)
+ | Cic.MutConstruct (k, _, _, tl) ->
+ visit_l visit_t (fun (_, u) -> u) f r tl
+ | Cic.MutCase (_, _, t, u, tl) ->
+ let f r = visit_l visit_t (fun u -> u) f r tl in
+ let f r = visit_t f r u in
+ visit_t f r t
+ in
+ try visit_t (fun x -> x) () t; false with Exit -> true