diff options
| author |  Hugo Herbelin <Hugo.Herbelin@inria.fr> | 2018-02-21 18:29:04 +0100 |
|---|---|---|
| committer | Hugo Herbelin <Hugo.Herbelin@inria.fr> | 2018-03-09 15:27:40 +0100 |
| commit | e6046a681a36695b9d522c29c76f86fe088d4ec0 (patch) | |
| tree | 0efe2b28b241b00e4f0a677cfecf5679cb0be876 /pretyping/typing.ml | |
| parent | 2069c0aec44a50031e33bcb9f7d86c1535ef6b84 (diff) | |
Adding a missing unification in typing.ml.
Diffstat (limited to 'pretyping/typing.ml')
| -rw-r--r-- | pretyping/typing.ml | 56 |
1 files changed, 30 insertions, 26 deletions
diff --git a/pretyping/typing.ml b/pretyping/typing.ml index 542bf775f..4c834f2f8 100644 --- a/pretyping/typing.ml +++ b/pretyping/typing.ml @@ -59,19 +59,21 @@ let e_judge_of_applied_inductive_knowing_parameters env evdref funj ind argjv = let ar = inductive_type_knowing_parameters env !evdref ind argjv in hnf_prod_appvect env !evdref (EConstr.of_constr ar) (Array.map j_val argjv) } | hj::restjl -> - match EConstr.kind !evdref (whd_all env !evdref typ) with - | Prod (_,c1,c2) -> - if Evarconv.e_cumul env evdref hj.uj_type c1 then - apply_rec (n+1) (subst1 hj.uj_val c2) restjl - else - error_cant_apply_bad_type env !evdref (n, c1, hj.uj_type) funj argjv - | Evar ev -> - let (evd',t) = Evardefine.define_evar_as_product !evdref ev in - evdref := evd'; - let (_,_,c2) = destProd evd' t in - apply_rec (n+1) (subst1 hj.uj_val c2) restjl - | _ -> - error_cant_apply_not_functional env !evdref funj argjv + let (c1,c2) = + match EConstr.kind !evdref (whd_all env !evdref typ) with + | Prod (_,c1,c2) -> (c1,c2) + | Evar ev -> + let (evd',t) = Evardefine.define_evar_as_product !evdref ev in + evdref := evd'; + let (_,c1,c2) = destProd evd' t in + (c1,c2) + | _ -> + error_cant_apply_not_functional env !evdref funj argjv + in + if Evarconv.e_cumul env evdref hj.uj_type c1 then + apply_rec (n+1) (subst1 hj.uj_val c2) restjl + else + error_cant_apply_bad_type env !evdref (n, c1, hj.uj_type) funj argjv in apply_rec 1 funj.uj_type (Array.to_list argjv) @@ -81,19 +83,21 @@ let e_judge_of_apply env evdref funj argjv = { uj_val = mkApp (j_val funj, Array.map j_val argjv); uj_type = typ } | hj::restjl -> - match EConstr.kind !evdref (whd_all env !evdref typ) with - | Prod (_,c1,c2) -> - if Evarconv.e_cumul env evdref hj.uj_type c1 then - apply_rec (n+1) (subst1 hj.uj_val c2) restjl - else - error_cant_apply_bad_type env !evdref (n, c1, hj.uj_type) funj argjv - | Evar ev -> - let (evd',t) = Evardefine.define_evar_as_product !evdref ev in - evdref := evd'; - let (_,_,c2) = destProd evd' t in - apply_rec (n+1) (subst1 hj.uj_val c2) restjl - | _ -> - error_cant_apply_not_functional env !evdref funj argjv + let (c1,c2) = + match EConstr.kind !evdref (whd_all env !evdref typ) with + | Prod (_,c1,c2) -> (c1,c2) + | Evar ev -> + let (evd',t) = Evardefine.define_evar_as_product !evdref ev in + evdref := evd'; + let (_,c1,c2) = destProd evd' t in + (c1,c2) + | _ -> + error_cant_apply_not_functional env !evdref funj argjv + in + if Evarconv.e_cumul env evdref hj.uj_type c1 then + apply_rec (n+1) (subst1 hj.uj_val c2) restjl + else + error_cant_apply_bad_type env !evdref (n, c1, hj.uj_type) funj argjv in apply_rec 1 funj.uj_type (Array.to_list argjv) |