diff options
Diffstat (limited to 'pretyping/unification.ml')
| -rw-r--r-- | pretyping/unification.ml | 13 |
1 files changed, 9 insertions, 4 deletions
diff --git a/pretyping/unification.ml b/pretyping/unification.ml index 01e1154e..24e06007 100644 --- a/pretyping/unification.ml +++ b/pretyping/unification.ml @@ -93,7 +93,7 @@ let abstract_list_all env evd typ c l = let l_with_all_occs = List.map (function a -> (LikeFirst,a)) l in let p,evd = abstract_scheme env evd c l_with_all_occs ctxt in let evd,typp = - try Typing.e_type_of env evd p + try Typing.type_of env evd p with | UserError _ -> error_cannot_find_well_typed_abstraction env evd p l None @@ -676,7 +676,11 @@ let rec unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb | Evar (evk,_ as ev), Evar (evk',_) when not (Evar.Set.mem evk flags.frozen_evars) && Evar.equal evk evk' -> - sigma,metasubst,((curenv,ev,cN)::evarsubst) + let sigma',b = constr_cmp cv_pb sigma flags cM cN in + if b then + sigma',metasubst,evarsubst + else + sigma,metasubst,((curenv,ev,cN)::evarsubst) | Evar (evk,_ as ev), _ when not (Evar.Set.mem evk flags.frozen_evars) && not (occur_evar evk cN) -> @@ -1150,7 +1154,7 @@ let applyHead env evd n c = apprec (n-1) (mkApp(c,[|evar|])) (subst1 evar c2) evd' | _ -> error "Apply_Head_Then" in - apprec n c (Typing.type_of env evd c) evd + apprec n c (Typing.unsafe_type_of env evd c) evd let is_mimick_head ts f = match kind_of_term f with @@ -1528,7 +1532,8 @@ let make_abstraction_core name (test,out) env sigma c ty occs check_occs concl = let ids = ids_of_named_context (named_context env) in if name == Anonymous then next_ident_away_in_goal x ids else if mem_named_context x (named_context env) then - error ("The variable "^(Id.to_string x)^" is already declared.") + errorlabstrm "Unification.make_abstraction_core" + (str "The variable " ++ Nameops.pr_id x ++ str " is already declared.") else x in |