+ let (_,_,meta_type) = CicUtil.lookup_meta n metasenv' in
+ (try
+ let tyt =
+ type_of_aux' metasenv' subst'' context t
+ in
+ fo_unif_subst
+ test_equality_only
+ subst'' context metasenv' tyt (S.lift_meta l meta_type)
+ with AssertFailure _ ->
+ (* TODO huge hack!!!!
+ * we keep on unifying/refining in the hope that the problem will be
+ * eventually solved. In the meantime we're breaking a big invariant:
+ * the terms that we are unifying are no longer well typed in the
+ * current context (in the worst case we could even diverge)
+ *)
+(*
+prerr_endline "********* FROM NOW ON EVERY REASONABLE INVARIANT IS BROKEN.";
+prerr_endline "********* PROCEED AT YOUR OWN RISK. AND GOOD LUCK." ;
+*)
+ (subst'', metasenv'))
+ | (C.Var (uri1,exp_named_subst1),C.Var (uri2,exp_named_subst2))
+ | (C.Const (uri1,exp_named_subst1),C.Const (uri2,exp_named_subst2)) ->
+ if UriManager.eq uri1 uri2 then
+ fo_unif_subst_exp_named_subst test_equality_only subst context metasenv
+ exp_named_subst1 exp_named_subst2
+ else
+ raise (UnificationFailure (sprintf
+ "Can't unify %s with %s due to different constants"
+ (CicMetaSubst.ppterm subst t1) (CicMetaSubst.ppterm subst t2)))
+ | C.MutInd (uri1,i1,exp_named_subst1),C.MutInd (uri2,i2,exp_named_subst2) ->
+ if UriManager.eq uri1 uri2 && i1 = i2 then
+ fo_unif_subst_exp_named_subst test_equality_only subst context metasenv
+ exp_named_subst1 exp_named_subst2
+ else
+ raise (UnificationFailure (sprintf
+ "Can't unify %s with %s due to different inductive principles"
+ (CicMetaSubst.ppterm subst t1) (CicMetaSubst.ppterm subst t2)))
+ | C.MutConstruct (uri1,i1,j1,exp_named_subst1),
+ C.MutConstruct (uri2,i2,j2,exp_named_subst2) ->
+ if UriManager.eq uri1 uri2 && i1 = i2 && j1 = j2 then
+ fo_unif_subst_exp_named_subst test_equality_only subst context metasenv
+ exp_named_subst1 exp_named_subst2
+ else
+ raise (UnificationFailure (sprintf
+ "Can't unify %s with %s due to different inductive constructors"
+ (CicMetaSubst.ppterm subst t1) (CicMetaSubst.ppterm subst t2)))
+ | (C.Implicit _, _) | (_, C.Implicit _) -> assert false
+ | (C.Cast (te,ty), t2) -> fo_unif_subst test_equality_only
+ subst context metasenv te t2
+ | (t1, C.Cast (te,ty)) -> fo_unif_subst test_equality_only
+ subst context metasenv t1 te
+ | (C.Prod (n1,s1,t1), C.Prod (_,s2,t2)) ->
+ (* TASSI: this is the only case in which we want == *)
+ let subst',metasenv' = fo_unif_subst true
+ subst context metasenv s1 s2 in
+ fo_unif_subst test_equality_only
+ subst' ((Some (n1,(C.Decl s1)))::context) metasenv' t1 t2
+ | (C.Lambda (n1,s1,t1), C.Lambda (_,s2,t2)) ->
+ (* TASSI: ask someone a reason for not putting true here *)
+ let subst',metasenv' = fo_unif_subst test_equality_only
+ subst context metasenv s1 s2 in
+ fo_unif_subst test_equality_only
+ subst' ((Some (n1,(C.Decl s1)))::context) metasenv' t1 t2
+ | (C.LetIn (_,s1,t1), t2)
+ | (t2, C.LetIn (_,s1,t1)) ->
+ fo_unif_subst
+ test_equality_only subst context metasenv t2 (S.subst s1 t1)
+ | (C.Appl l1, C.Appl l2) ->
+ let lr1 = List.rev l1 in
+ let lr2 = List.rev l2 in
+ let rec fo_unif_l test_equality_only subst metasenv =
+ function
+ [],_
+ | _,[] -> assert false
+ | ([h1],[h2]) ->
+ fo_unif_subst test_equality_only subst context metasenv h1 h2
+ | ([h],l)
+ | (l,[h]) ->
+ fo_unif_subst
+ test_equality_only subst context metasenv h (C.Appl (List.rev l))
+ | ((h1::l1),(h2::l2)) ->
+ let subst', metasenv' =
+ fo_unif_subst test_equality_only subst context metasenv h1 h2
+ in
+ fo_unif_l test_equality_only subst' metasenv' (l1,l2)