summaryrefslogtreecommitdiff
path: root/plugins/subtac/subtac_cases.ml
diff options
context:
space:
mode:
Diffstat (limited to 'plugins/subtac/subtac_cases.ml')
-rw-r--r--plugins/subtac/subtac_cases.ml22
1 files changed, 10 insertions, 12 deletions
diff --git a/plugins/subtac/subtac_cases.ml b/plugins/subtac/subtac_cases.ml
index 28cedc8a..f6f8695b 100644
--- a/plugins/subtac/subtac_cases.ml
+++ b/plugins/subtac/subtac_cases.ml
@@ -7,7 +7,7 @@
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(* $Id$ *)
+(* $Id: subtac_cases.ml 13332 2010-07-26 22:12:43Z msozeau $ *)
open Cases
open Util
@@ -23,13 +23,11 @@ open Sign
open Reductionops
open Typeops
open Type_errors
-
open Rawterm
open Retyping
open Pretype_errors
open Evarutil
open Evarconv
-
open Subtac_utils
(************************************************************************)
@@ -125,7 +123,7 @@ type tomatch_stack = tomatch_status list
originating from a subterm in which case real args are not dependent;
it accounts for n+1 binders if dep or n binders if not dep
- [PrProd] types abstracted term ([Abstract]); it accounts for one binder
- - [PrCcl] types the right-hand-side
+ - [PrCcl] types the right-hand side
- Aliases [Alias] have no trace in [predicate_signature]
*)
@@ -1152,7 +1150,7 @@ let rec generalize_problem pb = function
tomatch = Abstract d :: tomatch;
pred = Option.map (generalize_predicate i d) pb'.pred }
-(* No more patterns: typing the right-hand-side of equations *)
+(* No more patterns: typing the right-hand side of equations *)
let build_leaf pb =
let rhs = extract_rhs pb in
let tycon = match pb.pred with
@@ -1514,11 +1512,11 @@ let eq_id avoid id =
let hid' = next_ident_away hid avoid in
hid'
-let mk_eq typ x y = mkApp (Lazy.force eq_ind, [| typ; x ; y |])
-let mk_eq_refl typ x = mkApp (Lazy.force eq_refl, [| typ; x |])
+let mk_eq typ x y = mkApp (delayed_force eq_ind, [| typ; x ; y |])
+let mk_eq_refl typ x = mkApp (delayed_force eq_refl, [| typ; x |])
let mk_JMeq typ x typ' y =
- mkApp (Lazy.force Subtac_utils.jmeq_ind, [| typ; x ; typ'; y |])
-let mk_JMeq_refl typ x = mkApp (Lazy.force Subtac_utils.jmeq_refl, [| typ; x |])
+ mkApp (delayed_force Subtac_utils.jmeq_ind, [| typ; x ; typ'; y |])
+let mk_JMeq_refl typ x = mkApp (delayed_force Subtac_utils.jmeq_refl, [| typ; x |])
let hole = RHole (dummy_loc, Evd.QuestionMark (Evd.Define true))
@@ -1610,7 +1608,7 @@ let vars_of_ctx ctx =
| Some t' when kind_of_term t' = Rel 0 ->
prev,
(RApp (dummy_loc,
- (RRef (dummy_loc, Lazy.force refl_ref)), [hole; RVar (dummy_loc, prev)])) :: vars
+ (RRef (dummy_loc, delayed_force refl_ref)), [hole; RVar (dummy_loc, prev)])) :: vars
| _ ->
match na with
Anonymous -> raise (Invalid_argument "vars_of_ctx")
@@ -1651,7 +1649,7 @@ let build_ineqs prevpatterns pats liftsign =
lift_rel_context len ppat_sign @ sign,
len',
succ n, (* nth pattern *)
- mkApp (Lazy.force eq_ind,
+ mkApp (delayed_force eq_ind,
[| lift (len' + liftsign) curpat_ty;
liftn (len + liftsign) (succ lens) ppat_c ;
lift len' curpat_c |]) ::
@@ -1929,7 +1927,7 @@ let compile_cases loc style (typing_fun, isevars) (tycon : Evarutil.type_constra
let typing_fun tycon env = typing_fun tycon env isevars in
- (* We build the matrix of patterns and right-hand-side *)
+ (* We build the matrix of patterns and right-hand side *)
let matx = matx_of_eqns env eqns in
(* We build the vector of terms to match consistently with the *)