| None -> None :: context)
context []
+let apply_subst_metasenv subst metasenv =
+ List.map
+ (fun (n, context, ty) ->
+ (n, apply_subst_context subst context, apply_subst subst ty))
+ (List.filter
+ (fun (i, _, _) -> not (List.exists (fun (j, _) -> (j = i)) subst))
+ metasenv)
+
let ppterm subst term = CicPp.ppterm (apply_subst subst term)
let ppcontext ?(sep = "\n") subst context =
and sort_of_prod subst metasenv context (name,s) (t1, t2) =
let module C = Cic in
- (* ti could be a metavariable in the domain of the substitution *)
- let t1' = CicMetaSubst.apply_subst subst t1 in
- let t2' = CicMetaSubst.apply_subst subst t2 in
- let t1'' = CicMetaSubst.whd subst context t1' in
- let t2'' =
- CicMetaSubst.whd subst ((Some (name,C.Decl s))::context) t2'
- in
+ let t1'' = CicMetaSubst.whd subst context t1 in
+ let t2'' = CicMetaSubst.whd subst ((Some (name,C.Decl s))::context) t2 in
match (t1'', t2'') with
(C.Sort s1, C.Sort s2)
when (s2 = C.Prop or s2 = C.Set or s2 = C.CProp) -> (* different than Coq manual!!! *)
(function (i,_,_) -> not (List.exists (function (j,_) -> j=i) subst'))
metasenv'
in
- CicMetaSubst.apply_subst subst' t,
- CicMetaSubst.apply_subst subst' ty,
- subst', metasenv''
+ (CicMetaSubst.apply_subst subst' t,
+ CicMetaSubst.apply_subst subst' ty,
+ CicMetaSubst.apply_subst_metasenv subst' metasenv'')
;;
(* DEBUGGING ONLY *)
let type_of_aux' metasenv context term =
try
- let (t,ty,s,m) = type_of_aux' metasenv context term in
+ let (t,ty,m) = type_of_aux' metasenv context term in
debug_print
("@@@ REFINE SUCCESSFUL: " ^ CicPp.ppterm t ^ " : " ^ CicPp.ppterm ty);
(*
- debug_print
- ("@@@ REFINE SUCCESSFUL (subst):\n" ^ CicMetaSubst.ppsubst s);
debug_print
("@@@ REFINE SUCCESSFUL (metasenv):\n" ^ CicMetaSubst.ppmetasenv m s);
*)
- (t,ty,s,m)
+ (t,ty,m)
with
| CicUnification.AssertFailure msg as e ->
debug_print "@@@ REFINE FAILED: CicUnification.AssertFailure:";
(* type_of_aux' metasenv context term *)
(* refines [term] and returns the refined form of [term], *)
(* its type, the computed substitution and the new metasenv. *)
-(* The substitution returned is already unwinded *)
val type_of_aux':
Cic.metasenv -> Cic.context -> Cic.term ->
- Cic.term * Cic.term * CicMetaSubst.substitution * Cic.metasenv
+ Cic.term * Cic.term * Cic.metasenv