- let to_be_restricted = ref [] in
- let rec deliftaux k =
- let module C = Cic in
- function
- C.Rel m ->
- if m <=k then
- C.Rel m (*CSC: che succede se c'e' un Def? Dovrebbe averlo gia' *)
- (*CSC: deliftato la regola per il LetIn *)
- else
- (match List.nth context (m-k-1) with
- Some (_,C.Def t) -> deliftaux k (S.lift m t)
- | Some (_,C.Decl t) ->
- (* It may augment to_be_restricted *)
- ignore (deliftaux k (S.lift m t)) ;
- C.Rel ((position (m-k) l) + k)
- | None -> raise RelToHiddenHypothesis)
- | C.Var _ as t -> t
- | C.Meta (i, l1) as t ->
- let rec deliftl j =
- function
- [] -> []
- | None::tl -> None::(deliftl (j+1) tl)
- | (Some t)::tl ->
- let l1' = (deliftl (j+1) tl) in
- try
- Some (deliftaux k t)::l1'
- with
- RelToHiddenHypothesis
- | NotInTheList ->
- to_be_restricted := (i,j)::!to_be_restricted ; None::l1'
- in
- let l' = deliftl 1 l1 in
- C.Meta(i,l')
- | C.Sort _ as t -> t
- | C.Implicit as t -> t
- | C.Cast (te,ty) -> C.Cast (deliftaux k te, deliftaux k ty)
- | C.Prod (n,s,t) -> C.Prod (n, deliftaux k s, deliftaux (k+1) t)
- | C.Lambda (n,s,t) -> C.Lambda (n, deliftaux k s, deliftaux (k+1) t)
- | C.LetIn (n,s,t) -> C.LetIn (n, deliftaux k s, deliftaux (k+1) t)
- | C.Appl l -> C.Appl (List.map (deliftaux k) l)
- | C.Const _ as t -> t
- | C.Abst _ as t -> t
- | C.MutInd _ as t -> t
- | C.MutConstruct _ as t -> t
- | C.MutCase (sp,cookingsno,i,outty,t,pl) ->
- C.MutCase (sp, cookingsno, i, deliftaux k outty, deliftaux k t,
- List.map (deliftaux k) pl)
- | C.Fix (i, fl) ->
- let len = List.length fl in
- let liftedfl =
- List.map
- (fun (name, i, ty, bo) ->
- (name, i, deliftaux k ty, deliftaux (k+len) bo))
- fl
- in
- C.Fix (i, liftedfl)
- | C.CoFix (i, fl) ->
- let len = List.length fl in
- let liftedfl =
- List.map
- (fun (name, ty, bo) -> (name, deliftaux k ty, deliftaux (k+len) bo))
- fl
- in
- C.CoFix (i, liftedfl)
- in
- let res = deliftaux 0 t in
- res, restrict !to_be_restricted metasenv
-;;
+ let module C = Cic in
+ let rec aux metasenv subst n context t' =
+ try
+ let subst,metasenv =
+ fo_unif_subst test_equality_only subst context metasenv arg t'
+ in
+ subst,metasenv,C.Rel (1 + n)
+ with
+ Uncertain _
+ | UnificationFailure _ ->
+ match t' with
+ | C.Rel m -> subst,metasenv, if m <= n then C.Rel m else C.Rel (m+1)
+ | C.Var (uri,exp_named_subst) ->
+ let subst,metasenv,exp_named_subst' =
+ aux_exp_named_subst metasenv subst n context exp_named_subst
+ in
+ subst,metasenv,C.Var (uri,exp_named_subst')
+ | C.Meta (i,l) as t->
+ (try
+ let t' = List.assoc i subst in
+ aux metasenv subst n context t'
+ with
+ Not_found -> subst,metasenv,t)
+ | C.Sort _
+ | C.Implicit _ as t -> subst,metasenv,t
+ | C.Cast (te,ty) ->
+ let subst,metasenv,te' = aux metasenv subst n context te in
+ let subst,metasenv,ty' = aux metasenv subst n context ty in
+ subst,metasenv,C.Cast (te', ty')
+ | C.Prod (nn,s,t) ->
+ let subst,metasenv,s' = aux metasenv subst n context s in
+ let subst,metasenv,t' =
+ aux metasenv subst (n+1) ((Some (nn, C.Decl s))::context) t
+ in
+ subst,metasenv,C.Prod (nn, s', t')
+ | C.Lambda (nn,s,t) ->
+ let subst,metasenv,s' = aux metasenv subst n context s in
+ let subst,metasenv,t' =
+ aux metasenv subst (n+1) ((Some (nn, C.Decl s))::context) t
+ in
+ subst,metasenv,C.Lambda (nn, s', t')
+ | C.LetIn (nn,s,t) ->
+ let subst,metasenv,s' = aux metasenv subst n context s in
+ let subst,metasenv,t' =
+ aux metasenv subst (n+1) ((Some (nn, C.Def (s,None)))::context) t
+ in
+ subst,metasenv,C.LetIn (nn, s', t')
+ | C.Appl l ->
+ let subst,metasenv,revl' =
+ List.fold_left
+ (fun (subst,metasenv,appl) t ->
+ let subst,metasenv,t' = aux metasenv subst n context t in
+ subst,metasenv,t'::appl
+ ) (subst,metasenv,[]) l
+ in
+ subst,metasenv,C.Appl (List.rev revl')
+ | C.Const (uri,exp_named_subst) ->
+ let subst,metasenv,exp_named_subst' =
+ aux_exp_named_subst metasenv subst n context exp_named_subst
+ in
+ subst,metasenv,C.Const (uri,exp_named_subst')
+ | C.MutInd (uri,i,exp_named_subst) ->
+ let subst,metasenv,exp_named_subst' =
+ aux_exp_named_subst metasenv subst n context exp_named_subst
+ in
+ subst,metasenv,C.MutInd (uri,i,exp_named_subst')
+ | C.MutConstruct (uri,i,j,exp_named_subst) ->
+ let subst,metasenv,exp_named_subst' =
+ aux_exp_named_subst metasenv subst n context exp_named_subst
+ in
+ subst,metasenv,C.MutConstruct (uri,i,j,exp_named_subst')
+ | C.MutCase (sp,i,outt,t,pl) ->
+ let subst,metasenv,outt' = aux metasenv subst n context outt in
+ let subst,metasenv,t' = aux metasenv subst n context t in
+ let subst,metasenv,revpl' =
+ List.fold_left
+ (fun (subst,metasenv,pl) t ->
+ let subst,metasenv,t' = aux metasenv subst n context t in
+ subst,metasenv,t'::pl
+ ) (subst,metasenv,[]) pl
+ in
+ subst,metasenv,C.MutCase (sp,i,outt', t', List.rev revpl')
+ | C.Fix (i,fl) ->
+(*CSC: not implemented
+ let tylen = List.length fl in
+ let substitutedfl =
+ List.map
+ (fun (name,i,ty,bo) -> (name, i, aux n ty, aux (n+tylen) bo))
+ fl
+ in
+ C.Fix (i, substitutedfl)
+*) subst,metasenv,CicMetaSubst.lift subst 1 t'
+ | C.CoFix (i,fl) ->
+(*CSC: not implemented
+ let tylen = List.length fl in
+ let substitutedfl =
+ List.map
+ (fun (name,ty,bo) -> (name, aux n ty, aux (n+tylen) bo))
+ fl
+ in
+ C.CoFix (i, substitutedfl)
+*) subst,metasenv,CicMetaSubst.lift subst 1 t'