diff options
| author | Matthieu Sozeau | 2014-05-16 21:09:48 +0200 |
|---|---|---|
| committer | Matthieu Sozeau | 2014-05-16 21:12:03 +0200 |
| commit | 1588a84a71c3df3007296bdafbb29b6a0d15435b (patch) | |
| tree | b6bc6ccb9496bd5935f1f6a7648946c3ed540abd | |
| parent | 0f6a9c150b1a93358f6e9f8de5072fff52625ab9 (diff) | |
More fixes of unification with primitive projections (missed cases during the merge).
Obligations are not necessarily opaque.
| -rw-r--r-- | pretyping/evarconv.ml | 9 | ||||
| -rw-r--r-- | toplevel/g_obligations.ml4 | 2 |
2 files changed, 7 insertions, 4 deletions
diff --git a/pretyping/evarconv.ml b/pretyping/evarconv.ml index aaf7ff65cc..86bd36a30b 100644 --- a/pretyping/evarconv.ml +++ b/pretyping/evarconv.ml @@ -270,6 +270,9 @@ let exact_ise_stack2 env evd f sk1 sk2 = (fun i -> ise_array2 i (fun ii -> f (push_rec_types recdef1 env) ii CONV) bds1 bds2); (fun i -> ise_stack2 i a1 a2)] else UnifFailure (i,NotSameHead) + | Stack.Proj (n1,a1,p1)::q1, Stack.Proj (n2,a2,p2)::q2 -> + if eq_constant p1 p2 then ise_stack2 i q1 q2 + else (UnifFailure (i, NotSameHead)) | Stack.Update _ :: _, _ | Stack.Shift _ :: _, _ | _, Stack.Update _ :: _ | _, Stack.Shift _ :: _ -> assert false | Stack.App _ :: _, Stack.App _ :: _ -> @@ -388,7 +391,7 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty ev lF apprM i and f3 i = switch (evar_eqappr_x ts env i pbty) (apprF,cstsF) - (whd_betaiota_deltazeta_for_iota_state ts env i cstsM (vM, skM)) + (whd_betaiota_deltazeta_for_iota_state ts env i cstsM vM) in ise_try evd [f1; (consume_stack on_left apprF apprM); f3] in let flex_rigid on_left ev (termF, skF as apprF) (termR, skR as apprR) = @@ -439,10 +442,10 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty ise_try evd [f1; f2] | Flexible ev1, MaybeFlexible (v2,sk2) -> - flex_maybeflex true ev1 (appr1,csts1) ((term2,sk2),csts2) v2 + flex_maybeflex true ev1 (appr1,csts1) (appr2,csts2) (v2,sk2) | MaybeFlexible (v1,sk1), Flexible ev2 -> - flex_maybeflex false ev2 (appr2,csts2) ((term1,sk1),csts1) v1 + flex_maybeflex false ev2 (appr2,csts2) (appr1,csts1) (v1,sk1) | MaybeFlexible (v1,sk1), MaybeFlexible (v2,sk2) -> begin match kind_of_term term1, kind_of_term term2 with diff --git a/toplevel/g_obligations.ml4 b/toplevel/g_obligations.ml4 index 2354aa3325..6ed0c24b54 100644 --- a/toplevel/g_obligations.ml4 +++ b/toplevel/g_obligations.ml4 @@ -54,7 +54,7 @@ GEXTEND Gram open Obligations -let classify_obbl _ = Vernacexpr.(VtStartProof ("Classic",GuaranteesOpacity,[]), VtLater) +let classify_obbl _ = Vernacexpr.(VtStartProof ("Classic",Doesn'tGuaranteeOpacity,[]), VtLater) VERNAC COMMAND EXTEND Obligations CLASSIFIED BY classify_obbl | [ "Obligation" integer(num) "of" ident(name) ":" lconstr(t) withtac(tac) ] -> |