diff options
Diffstat (limited to 'pretyping')
| -rw-r--r-- | pretyping/coercion.ml | 2 | ||||
| -rw-r--r-- | pretyping/pretyping.ml | 13 | ||||
| -rw-r--r-- | pretyping/typing.ml | 6 |
3 files changed, 12 insertions, 9 deletions
diff --git a/pretyping/coercion.ml b/pretyping/coercion.ml index 9e93c470b1..2329b87acc 100644 --- a/pretyping/coercion.ml +++ b/pretyping/coercion.ml @@ -434,7 +434,7 @@ let inh_tosort_force ?loc env evd j = try let t,p = lookup_path_to_sort_from env evd j.uj_type in let evd,j1 = apply_coercion env evd p j t in - let j2 = on_judgment_type (whd_evar evd) j1 in + let j2 = Environ.on_judgment_type (whd_evar evd) j1 in (evd,type_judgment env evd j2) with Not_found | NoCoercion -> error_not_a_type ?loc env evd j diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml index 46e463512d..a92b245b91 100644 --- a/pretyping/pretyping.ml +++ b/pretyping/pretyping.ml @@ -103,6 +103,12 @@ let search_guard ?loc env possible_indexes fixdefs = user_err ?loc ~hdr:"search_guard" (Pp.str errmsg) with Found indexes -> indexes) +let esearch_guard ?loc env sigma indexes fix = + let fix = nf_fix sigma fix in + try search_guard ?loc env indexes fix + with TypeError (env,err) -> + raise (PretypeError (env,sigma,TypingError (map_ptype_error of_constr err))) + (* To force universe name declaration before use *) let is_strict_universe_declarations = @@ -597,11 +603,8 @@ let rec pretype ~program_mode k0 resolve_tc (tycon : type_constraint) (env : Glo vn) in let fixdecls = (names,ftys,fdefs) in - let indexes = - search_guard - ?loc !!env possible_indexes (nf_fix sigma fixdecls) - in - make_judge (mkFix ((indexes,i),fixdecls)) ftys.(i) + let indexes = esearch_guard ?loc !!env sigma possible_indexes fixdecls in + make_judge (mkFix ((indexes,i),fixdecls)) ftys.(i) | GCoFix i -> let fixdecls = (names,ftys,fdefs) in let cofix = (i, fixdecls) in diff --git a/pretyping/typing.ml b/pretyping/typing.ml index e8d935fcbb..2e50e1ab3f 100644 --- a/pretyping/typing.ml +++ b/pretyping/typing.ml @@ -244,10 +244,10 @@ let judge_of_type u = uj_type = EConstr.mkType uu } let judge_of_relative env v = - Termops.on_judgment EConstr.of_constr (judge_of_relative env v) + Environ.on_judgment EConstr.of_constr (judge_of_relative env v) let judge_of_variable env id = - Termops.on_judgment EConstr.of_constr (judge_of_variable env id) + Environ.on_judgment EConstr.of_constr (judge_of_variable env id) let judge_of_projection env sigma p cj = let pty = lookup_projection p env in @@ -307,7 +307,7 @@ let type_of_constructor env sigma ((ind,_ as ctor),u) = sigma, (EConstr.of_constr (rename_type ty (Names.GlobRef.ConstructRef ctor))) let judge_of_int env v = - Termops.on_judgment EConstr.of_constr (judge_of_int env v) + Environ.on_judgment EConstr.of_constr (judge_of_int env v) (* cstr must be in n.f. w.r.t. evars and execute returns a judgement where both the term and type are in n.f. *) |