- else
- match (t1,t2) with
- | C.Appl [_], _ | _, C.Appl [_] | C.Appl [], _ | _, C.Appl []
- | C.Appl (C.Appl _::_), _ | _, C.Appl (C.Appl _::_) ->
- prerr_endline "Appl [Appl _;_] or Appl [] or Appl [_] invariant";
- assert false
- | (C.Sort (C.Type a), C.Sort (C.Type b)) when not test_eq_only ->
- let a, b = if swap then b,a else a,b in
- if NCicEnvironment.universe_leq a b then metasenv, subst
- else raise (UnificationFailure (mk_msg metasenv subst context t1 t2))
- | (C.Sort (C.Type a), C.Sort (C.Type b)) ->
- if NCicEnvironment.universe_eq a b then metasenv, subst
- else raise (UnificationFailure (mk_msg metasenv subst context t1 t2))
- | (C.Sort C.Prop,C.Sort (C.Type _)) when not swap ->
- if (not test_eq_only) then metasenv, subst
- else raise (UnificationFailure (mk_msg metasenv subst context t1 t2))
- | (C.Sort (C.Type _), C.Sort C.Prop) when swap ->
- if (not test_eq_only) then metasenv, subst
- else raise (UnificationFailure (mk_msg metasenv subst context t1 t2))
-
- | (C.Lambda (name1,s1,t1), C.Lambda(_,s2,t2))
- | (C.Prod (name1,s1,t1), C.Prod(_,s2,t2)) ->
- let metasenv, subst = unify rdb true metasenv subst context s1 s2 swap in
- unify rdb test_eq_only metasenv subst ((name1, C.Decl s1)::context) t1 t2 swap
- | (C.LetIn (name1,ty1,s1,t1), C.LetIn(_,ty2,s2,t2)) ->
- let metasenv,subst=unify rdb test_eq_only metasenv subst context ty1 ty2 swap in
- let metasenv,subst=unify rdb test_eq_only metasenv subst context s1 s2 swap in
- let context = (name1, C.Def (s1,ty1))::context in
- unify rdb test_eq_only metasenv subst context t1 t2 swap
-
- | (C.Meta (n1,(s1,l1 as lc1)),C.Meta (n2,(s2,l2 as lc2))) when n1 = n2 ->
- (try
- let l1 = NCicUtils.expand_local_context l1 in
- let l2 = NCicUtils.expand_local_context l2 in
- let metasenv, subst, to_restrict, _ =
- List.fold_right2
- (fun t1 t2 (metasenv, subst, to_restrict, i) ->
- try
- let metasenv, subst =
- unify rdb (*test_eq_only*) true metasenv subst context
- (NCicSubstitution.lift s1 t1) (NCicSubstitution.lift s2 t2)
- swap
- in
- metasenv, subst, to_restrict, i-1
- with UnificationFailure _ | Uncertain _ ->
- metasenv, subst, i::to_restrict, i-1)
- l1 l2 (metasenv, subst, [], List.length l1)
- in
- if to_restrict <> [] then
- let metasenv, subst, _, _ =
- NCicMetaSubst.restrict metasenv subst n1 to_restrict
- in
- metasenv, subst
- else metasenv, subst
- with
- | Invalid_argument _ -> assert false
- | NCicMetaSubst.MetaSubstFailure msg ->
- try
- let _,_,term,_ = NCicUtils.lookup_subst n1 subst in
- let term1 = NCicSubstitution.subst_meta lc1 term in
- let term2 = NCicSubstitution.subst_meta lc2 term in
- unify rdb test_eq_only metasenv subst context term1 term2 swap
- with NCicUtils.Subst_not_found _-> raise (UnificationFailure msg))
-
- | NCic.Appl (NCic.Meta (i,_)::_ as l1),
- NCic.Appl (NCic.Meta (j,_)::_ as l2) when i=j ->
- (try
- List.fold_left2
- (fun (metasenv, subst) t1 t2 ->
- unify rdb (*test_eq_only*) true metasenv subst context t1
- t2 swap)
- (metasenv,subst) l1 l2
- with Invalid_argument _ ->
- raise (UnificationFailure (mk_msg metasenv subst context t1 t2)))
-
- | _, NCic.Meta (n, _) when is_locked n subst && not swap->
- (let (metasenv, subst), i =
- match NCicReduction.whd ~subst context t1 with
- | NCic.Appl (NCic.Meta (i,l) as meta :: args) ->
- let metasenv, lambda_Mj =
- lambda_intros rdb metasenv subst context (List.length args)
- (NCicTypeChecker.typeof ~metasenv ~subst context meta)
- in
- unify rdb test_eq_only metasenv subst context
- (C.Meta (i,l)) lambda_Mj false,
- i
- | NCic.Meta (i,_) -> (metasenv, subst), i
- | _ ->
- raise (UnificationFailure (lazy "Locked term vs non
- flexible term; probably not saturated enough yet!"))
- in
- let t1 = NCicReduction.whd ~subst context t1 in
- let j, lj =
- match t1 with NCic.Meta (j,l) -> j, l | _ -> assert false
- in
+ else
+ match (t1,t2) with
+ | C.Appl [_], _ | _, C.Appl [_] | C.Appl [], _ | _, C.Appl []
+ | C.Appl (C.Appl _::_), _ | _, C.Appl (C.Appl _::_) ->
+ prerr_endline "Appl [Appl _;_] or Appl [] or Appl [_] invariant";
+ assert false
+ | (C.Sort (C.Type a), C.Sort (C.Type b)) when not test_eq_only ->
+ let a, b = if swap then b,a else a,b in
+ if NCicEnvironment.universe_leq a b then metasenv, subst
+ else raise (UnificationFailure (mk_msg status metasenv subst context t1 t2))
+ | (C.Sort (C.Type a), C.Sort (C.Type b)) ->
+ if NCicEnvironment.universe_eq a b then metasenv, subst
+ else raise (UnificationFailure (mk_msg status metasenv subst context t1 t2))
+ | (C.Sort C.Prop,C.Sort (C.Type _)) when not swap ->
+ if (not test_eq_only) then metasenv, subst
+ else raise (UnificationFailure (mk_msg status metasenv subst context t1 t2))
+ | (C.Sort (C.Type _), C.Sort C.Prop) when swap ->
+ if (not test_eq_only) then metasenv, subst
+ else raise (UnificationFailure (mk_msg status metasenv subst context t1 t2))
+
+ | (C.Lambda (name1,s1,t1), C.Lambda(_,s2,t2))
+ | (C.Prod (name1,s1,t1), C.Prod(_,s2,t2)) ->
+ let metasenv, subst = unify status true metasenv subst context s1 s2 swap in
+ unify status test_eq_only metasenv subst ((name1, C.Decl s1)::context) t1 t2 swap
+ | (C.LetIn (name1,ty1,s1,t1), C.LetIn(_,ty2,s2,t2)) ->
+ let metasenv,subst=unify status test_eq_only metasenv subst context ty1 ty2 swap in
+ let metasenv,subst=unify status test_eq_only metasenv subst context s1 s2 swap in
+ let context = (name1, C.Def (s1,ty1))::context in
+ unify status test_eq_only metasenv subst context t1 t2 swap
+
+ | (C.Meta (n1,(s1,l1 as lc1)),C.Meta (n2,(s2,l2 as lc2))) when n1 = n2 ->
+ (try
+ let l1 = NCicUtils.expand_local_context l1 in
+ let l2 = NCicUtils.expand_local_context l2 in
+ let metasenv, subst, to_restrict, _ =
+ List.fold_right2
+ (fun t1 t2 (metasenv, subst, to_restrict, i) ->
+ try