diff options
201 files changed, 9534 insertions, 4415 deletions
@@ -49,7 +49,23 @@ RECDIRS += MenhirLib COQINCLUDES += -R MenhirLib MenhirLib endif -COQCOPTS ?= -w -undeclared-scope -w -omega-is-deprecated +# Notes on silenced Coq warnings: +# +# undeclared-scope: +# warning introduced in 8.12 +# suggested change (use `Declare Scope`) supported since 8.12 +# unused-pattern-matching-variable: +# warning introduced in 8.13 +# the code rewrite that avoids the warning is not desirable +# deprecated-ident-entry: +# warning introduced in 8.13 +# suggested change (use `name` instead of `ident`) supported since 8.13 + +COQCOPTS ?= \ + -w -undeclared-scope \ + -w -unused-pattern-matching-variable \ + -w -deprecated-ident-entry + COQC="$(COQBIN)coqc" -q $(COQINCLUDES) $(COQCOPTS) COQDEP="$(COQBIN)coqdep" $(COQINCLUDES) COQDOC="$(COQBIN)coqdoc" @@ -65,6 +81,7 @@ GPATH=$(DIRS) ifeq ($(LIBRARY_FLOCQ),local) FLOCQ=\ + SpecFloatCompat.v \ Raux.v Zaux.v Defs.v Digits.v Float_prop.v FIX.v FLT.v FLX.v FTZ.v \ Generic_fmt.v Round_pred.v Round_NE.v Ulp.v Core.v \ Bracket.v Div.v Operations.v Round.v Sqrt.v \ diff --git a/MenhirLib/Validator_classes.v b/MenhirLib/Validator_classes.v index d8063123..781a6aa6 100644 --- a/MenhirLib/Validator_classes.v +++ b/MenhirLib/Validator_classes.v @@ -17,7 +17,7 @@ Require Import Alphabet. Class IsValidator (P : Prop) (b : bool) := is_validator : b = true -> P. -Hint Mode IsValidator + - : typeclass_instances. +Global Hint Mode IsValidator + - : typeclass_instances. Instance is_validator_true : IsValidator True true. Proof. done. Qed. @@ -55,12 +55,12 @@ Qed. (* We do not use an instance directly here, because we need somehow to force Coq to instantiate b with a lambda. *) -Hint Extern 2 (IsValidator (forall x : ?A, _) _) => +Global Hint Extern 2 (IsValidator (forall x : ?A, _) _) => eapply (is_validator_forall_finite _ _ (fun (x:A) => _)) : typeclass_instances. (* Hint for synthetizing pattern-matching. *) -Hint Extern 2 (IsValidator (match ?u with _ => _ end) ?b0) => +Global Hint Extern 2 (IsValidator (match ?u with _ => _ end) ?b0) => let b := fresh "b" in unshelve notypeclasses refine (let b : bool := _ in _); [destruct u; intros; shelve|]; (* Synthetize `match .. with` in the validator. *) @@ -71,5 +71,5 @@ Hint Extern 2 (IsValidator (match ?u with _ => _ end) ?b0) => (* Hint for unfolding definitions. This is necessary because many hints for IsValidator use [Hint Extern], which do not automatically unfold identifiers. *) -Hint Extern 100 (IsValidator ?X _) => unfold X +Global Hint Extern 100 (IsValidator ?X _) => unfold X : typeclass_instances. diff --git a/MenhirLib/Validator_complete.v b/MenhirLib/Validator_complete.v index 9ba3e53c..ac4dd0c4 100644 --- a/MenhirLib/Validator_complete.v +++ b/MenhirLib/Validator_complete.v @@ -140,7 +140,7 @@ Qed. (* We do not declare this lemma as an instance, and use [Hint Extern] instead, because the typeclass mechanism has trouble instantiating some evars if we do not explicitely call [eassumption]. *) -Hint Extern 2 (IsValidator (state_has_future _ _ _ _) _) => +Global Hint Extern 2 (IsValidator (state_has_future _ _ _ _) _) => eapply is_validator_state_has_future_subset; [eassumption|eassumption || reflexivity|] : typeclass_instances. @@ -171,7 +171,7 @@ Proof. - destruct (b lookahead). by destruct b'. exfalso. by induction l; destruct b'. - eauto. Qed. -Hint Extern 100 (IsValidator _ _) => +Global Hint Extern 100 (IsValidator _ _) => match goal with | H : TerminalSet.In ?lookahead ?lset |- _ => eapply (is_validator_iterate_lset _ (fun lookahead => _) _ _ H); clear H @@ -238,7 +238,7 @@ Proof. revert EQ. unfold future_of_prod=>-> //. Qed. (* We need a hint for expplicitely instantiating b1 and b2 with lambdas. *) -Hint Extern 0 (IsValidator +Global Hint Extern 0 (IsValidator (forall st prod fut lookahead, state_has_future st prod fut lookahead -> _) _) => diff --git a/aarch64/Asm.v b/aarch64/Asm.v index 067d32fb..e5111220 100644 --- a/aarch64/Asm.v +++ b/aarch64/Asm.v @@ -1398,7 +1398,7 @@ Ltac Equalities := split. auto. intros. destruct B; auto. subst. auto. - (* trace length *) red; intros. inv H; simpl. - omega. + lia. eapply external_call_trace_length; eauto. eapply external_call_trace_length; eauto. - (* initial states *) diff --git a/aarch64/Asmexpand.ml b/aarch64/Asmexpand.ml index 8187e077..6863b967 100644 --- a/aarch64/Asmexpand.ml +++ b/aarch64/Asmexpand.ml @@ -47,17 +47,28 @@ let expand_storeptr (src: ireg) (base: iregsp) ofs = (* Determine the number of int registers, FP registers, and stack locations used to pass the fixed parameters. *) +let align n a = (n + a - 1) land (-a) + +let typesize = function + | Tint | Tany32 | Tsingle -> 4 + | Tlong | Tany64 | Tfloat -> 8 + +let reserve_stack stk ty = + match Archi.abi with + | Archi.AAPCS64 -> stk + 8 + | Archi.Apple -> align stk (typesize ty) + typesize ty + let rec next_arg_locations ir fr stk = function | [] -> (ir, fr, stk) - | (Tint | Tlong | Tany32 | Tany64) :: l -> + | (Tint | Tlong | Tany32 | Tany64 as ty) :: l -> if ir < 8 then next_arg_locations (ir + 1) fr stk l - else next_arg_locations ir fr (stk + 8) l - | (Tfloat | Tsingle) :: l -> + else next_arg_locations ir fr (reserve_stack stk ty) l + | (Tfloat | Tsingle as ty) :: l -> if fr < 8 then next_arg_locations ir (fr + 1) stk l - else next_arg_locations ir fr (stk + 8) l + else next_arg_locations ir fr (reserve_stack stk ty) l (* Allocate memory on the stack and use it to save the registers used for parameter passing. As an optimization, do not save @@ -86,6 +97,8 @@ let save_parameter_registers ir fr = emit (Pstrd(float_param_regs.(i), ADimm(XSP, Z.of_uint pos))) done +let current_function_stacksize = ref 0L + (* Initialize a va_list as per va_start. Register r points to the following struct: @@ -98,11 +111,7 @@ let save_parameter_registers ir fr = } *) -let current_function_stacksize = ref 0L - -let expand_builtin_va_start r = - if not (is_current_function_variadic ()) then - invalid_arg "Fatal error: va_start used in non-vararg function"; +let expand_builtin_va_start_aapcs64 r = let (ir, fr, stk) = next_arg_locations 0 0 0 (get_current_function_args ()) in let stack_ofs = Int64.(add !current_function_stacksize (of_int stk)) @@ -127,6 +136,25 @@ let expand_builtin_va_start r = expand_loadimm32 X16 (coqint_of_camlint (Int32.of_int vr_offs)); emit (Pstrw(X16, ADimm(RR1 r, coqint_of_camlint64 28L))) +(* In macOS, va_list is just a pointer (char * ) and all variadic arguments + are passed on the stack. *) + +let expand_builtin_va_start_apple r = + let (ir, fr, stk) = + next_arg_locations 0 0 0 (get_current_function_args ()) in + let stk = align stk 8 in + let stack_ofs = Int64.(add !current_function_stacksize (of_int stk)) in + (* *va = sp + stack_ofs *) + expand_addimm64 (RR1 X16) XSP (coqint_of_camlint64 stack_ofs); + emit (Pstrx(X16, ADimm(RR1 r, coqint_of_camlint64 0L))) + +let expand_builtin_va_start r = + if not (is_current_function_variadic ()) then + invalid_arg "Fatal error: va_start used in non-vararg function"; + match Archi.abi with + | Archi.AAPCS64 -> expand_builtin_va_start_aapcs64 r + | Archi.Apple -> expand_builtin_va_start_apple r + (* Handling of annotations *) let expand_annot_val kind txt targ args res = @@ -382,7 +410,7 @@ let expand_instruction instr = match instr with | Pallocframe (sz, ofs) -> emit (Pmov (RR1 X29, XSP)); - if is_current_function_variadic() then begin + if is_current_function_variadic() && Archi.abi = Archi.AAPCS64 then begin let (ir, fr, _) = next_arg_locations 0 0 0 (get_current_function_args ()) in save_parameter_registers ir fr; diff --git a/aarch64/CBuiltins.ml b/aarch64/CBuiltins.ml index e2a9c87a..4cfb7edf 100644 --- a/aarch64/CBuiltins.ml +++ b/aarch64/CBuiltins.ml @@ -17,16 +17,28 @@ open C -(* va_list is a struct of size 32 and alignment 8, passed by reference *) +(* AAPCS64: + va_list is a struct of size 32 and alignment 8, passed by reference + Apple: + va_list is a pointer (size 8, alignment 8), passed by reference *) -let va_list_type = TArray(TInt(IULong, []), Some 4L, []) -let size_va_list = 32 -let va_list_scalar = false +let (va_list_type, size_va_list, va_list_scalar) = + match Archi.abi with + | Archi.AAPCS64 -> (TArray(TInt(IULong, []), Some 4L, []), 32, false) + | Archi.Apple -> (TPtr(TVoid [], []), 8, true) + +(* Some macOS headers use the GCC built-in types "__int128_t" and + "__uint128_t" unconditionally. Provide a dummy definition. *) + +let int128_type = TArray(TInt(IULong, []), Some 2L, []) let builtins = { - builtin_typedefs = [ - "__builtin_va_list", va_list_type - ]; + builtin_typedefs = + [ "__builtin_va_list", va_list_type ] @ + (if Configuration.system = "macos" then + [ "__int128_t", int128_type; + "__uint128_t", int128_type ] + else []); builtin_functions = [ (* Synchronization *) "__builtin_fence", diff --git a/aarch64/ConstpropOp.vp b/aarch64/ConstpropOp.vp index c0a2c6bf..f2d17a51 100644 --- a/aarch64/ConstpropOp.vp +++ b/aarch64/ConstpropOp.vp @@ -13,11 +13,11 @@ (** Strength reduction for operators and conditions. This is the machine-dependent part of [Constprop]. *) -Require Archi. Require Import Coqlib Compopts. Require Import AST Integers Floats. Require Import Op Registers. Require Import ValueDomain ValueAOp. +Require SelectOp. (** * Converting known values to constants *) @@ -375,7 +375,7 @@ Nondetfunction op_strength_reduction Nondetfunction addr_strength_reduction (addr: addressing) (args: list reg) (vl: list aval) := match addr, args, vl with - | Aindexed n, r1 :: nil, Ptr(Gl symb n1) :: nil => + | Aindexed n, r1 :: nil, Ptr(Gl symb n1) :: nil ?? negb (SelectOp.symbol_is_relocatable symb) => (Aglobal symb (Ptrofs.add n1 (Ptrofs.of_int64 n)), nil) | Aindexed n, r1 :: nil, Ptr(Stk n1) :: nil => (Ainstack (Ptrofs.add n1 (Ptrofs.of_int64 n)), nil) diff --git a/aarch64/ConstpropOpproof.v b/aarch64/ConstpropOpproof.v index c777062c..24498aa4 100644 --- a/aarch64/ConstpropOpproof.v +++ b/aarch64/ConstpropOpproof.v @@ -414,7 +414,7 @@ Proof. Int.bit_solve. destruct (zlt i0 n0). replace (Int.testbit n i0) with (negb (Int.testbit Int.zero i0)). rewrite Int.bits_zero. simpl. rewrite andb_true_r. auto. - rewrite <- EQ. rewrite Int.bits_zero_ext by omega. rewrite zlt_true by auto. + rewrite <- EQ. rewrite Int.bits_zero_ext by lia. rewrite zlt_true by auto. rewrite Int.bits_not by auto. apply negb_involutive. rewrite H6 by auto. auto. econstructor; split; eauto. auto. diff --git a/aarch64/Conventions1.v b/aarch64/Conventions1.v index efda835d..f401458c 100644 --- a/aarch64/Conventions1.v +++ b/aarch64/Conventions1.v @@ -24,7 +24,12 @@ Require Archi. - Caller-save registers that can be modified during a function call. We follow the Procedure Call Standard for the ARM 64-bit Architecture - (AArch64) document: R19-R28 and F8-F15 are callee-save. *) + (AArch64) document: R19-R28 and F8-F15 are callee-save. + + X16 is reserved as a temporary for asm generation. + X18 is reserved as the platform register. + X29 is reserved as the frame pointer register. + X30 is reserved as the return address register. *) Definition is_callee_save (r: mreg): bool := match r with @@ -154,9 +159,23 @@ Qed. (** - The first 8 integer arguments are passed in registers [R0...R7]. - The first 8 FP arguments are passed in registers [F0...F7]. -- Extra arguments are passed on the stack, in [Outgoing] slots of size - 64 bits (2 words), consecutively assigned, starting at word offset 0. -**) +- Extra arguments are passed on the stack, in [Outgoing] slots, + consecutively assigned, starting at word offset 0. + +In the standard AAPCS64, all stack slots are 8-byte wide (2 words). + +In the Apple variant, a stack slot has the size of the type of the +corresponding argument, and is aligned accordingly. We use 8-byte +slots (2 words) for C types [long] and [double], and 4-byte slots +(1 word) for C types [int] and [float]. For full conformance, we should +use 1-byte slots for [char] types and 2-byte slots for [short] types, +but this cannot be expressed in CompCert's type algebra, so we +incorrectly use 4-byte slots. + +Concerning variable arguments to vararg functions: +- In the AAPCS64 standard, they are passed like regular, fixed arguments. +- In the Apple variant, they are always passed on stack, in 8-byte slots. +*) Definition int_param_regs := R0 :: R1 :: R2 :: R3 :: R4 :: R5 :: R6 :: R7 :: nil. @@ -164,31 +183,70 @@ Definition int_param_regs := Definition float_param_regs := F0 :: F1 :: F2 :: F3 :: F4 :: F5 :: F6 :: F7 :: nil. +Definition stack_arg (ty: typ) (ir fr ofs: Z) + (rec: Z -> Z -> Z -> list (rpair loc)) := + match Archi.abi with + | Archi.AAPCS64 => + let ofs := align ofs 2 in + One (S Outgoing ofs ty) :: rec ir fr (ofs + 2) + | Archi.Apple => + let ofs := align ofs (typesize ty) in + One (S Outgoing ofs ty) :: rec ir fr (ofs + typesize ty) + end. + +Definition int_arg (ty: typ) (ir fr ofs: Z) + (rec: Z -> Z -> Z -> list (rpair loc)) := + match list_nth_z int_param_regs ir with + | None => + stack_arg ty ir fr ofs rec + | Some ireg => + One (R ireg) :: rec (ir + 1) fr ofs + end. + +Definition float_arg (ty: typ) (ir fr ofs: Z) + (rec: Z -> Z -> Z -> list (rpair loc)) := + match list_nth_z float_param_regs fr with + | None => + stack_arg ty ir fr ofs rec + | Some freg => + One (R freg) :: rec ir (fr + 1) ofs + end. + +Fixpoint loc_arguments_stack (tyl: list typ) (ofs: Z) {struct tyl} : list (rpair loc) := + match tyl with + | nil => nil + | ty :: tys => One (S Outgoing ofs Tany64) :: loc_arguments_stack tys (ofs + 2) + end. + Fixpoint loc_arguments_rec - (tyl: list typ) (ir fr ofs: Z) {struct tyl} : list (rpair loc) := + (tyl: list typ) (fixed ir fr ofs: Z) {struct tyl} : list (rpair loc) := match tyl with | nil => nil - | (Tint | Tlong | Tany32 | Tany64) as ty :: tys => - match list_nth_z int_param_regs ir with - | None => - One (S Outgoing ofs ty) :: loc_arguments_rec tys ir fr (ofs + 2) - | Some ireg => - One (R ireg) :: loc_arguments_rec tys (ir + 1) fr ofs - end - | (Tfloat | Tsingle) as ty :: tys => - match list_nth_z float_param_regs fr with - | None => - One (S Outgoing ofs ty) :: loc_arguments_rec tys ir fr (ofs + 2) - | Some freg => - One (R freg) :: loc_arguments_rec tys ir (fr + 1) ofs + | ty :: tys => + if zle fixed 0 then loc_arguments_stack tyl (align ofs 2) else + match ty with + | Tint | Tlong | Tany32 | Tany64 => + int_arg ty ir fr ofs (loc_arguments_rec tys (fixed - 1)) + | Tfloat | Tsingle => + float_arg ty ir fr ofs (loc_arguments_rec tys (fixed - 1)) end end. +(** Number of fixed arguments for a function with signature [s]. + For AAPCS64, all arguments are treated as fixed, even for a vararg + function. *) + +Definition fixed_arguments (s: signature) : Z := + match Archi.abi, s.(sig_cc).(cc_vararg) with + | Archi.Apple, Some n => n + | _, _ => list_length_z s.(sig_args) + end. + (** [loc_arguments s] returns the list of locations where to store arguments when calling a function with signature [s]. *) Definition loc_arguments (s: signature) : list (rpair loc) := - loc_arguments_rec s.(sig_args) 0 0 0. + loc_arguments_rec s.(sig_args) (fixed_arguments s) 0 0 0. (** Argument locations are either caller-save registers or [Outgoing] stack slots at nonnegative offsets. *) @@ -200,49 +258,73 @@ Definition loc_argument_acceptable (l: loc) : Prop := | _ => False end. -Definition loc_argument_charact (ofs: Z) (l: loc) : Prop := - match l with - | R r => In r int_param_regs \/ In r float_param_regs - | S Outgoing ofs' ty => ofs' >= ofs /\ (2 | ofs') - | _ => False - end. - -Remark loc_arguments_rec_charact: - forall tyl ir fr ofs p, - In p (loc_arguments_rec tyl ir fr ofs) -> (2 | ofs) -> forall_rpair (loc_argument_charact ofs) p. +Lemma loc_arguments_rec_charact: + forall tyl fixed ri rf ofs p, + ofs >= 0 -> + In p (loc_arguments_rec tyl fixed ri rf ofs) -> forall_rpair loc_argument_acceptable p. Proof. - assert (X: forall ofs1 ofs2 l, loc_argument_charact ofs2 l -> ofs1 <= ofs2 -> loc_argument_charact ofs1 l). - { destruct l; simpl; intros; auto. destruct sl; auto. intuition omega. } - assert (Y: forall ofs1 ofs2 p, forall_rpair (loc_argument_charact ofs2) p -> ofs1 <= ofs2 -> forall_rpair (loc_argument_charact ofs1) p). - { destruct p; simpl; intuition eauto. } - assert (Z: forall ofs, (2 | ofs) -> (2 | ofs + 2)). - { intros. apply Z.divide_add_r; auto. apply Z.divide_refl. } -Opaque list_nth_z. - induction tyl; simpl loc_arguments_rec; intros. -- contradiction. -- assert (A: forall ty, In p - match list_nth_z int_param_regs ir with - | Some ireg => One (R ireg) :: loc_arguments_rec tyl (ir + 1) fr ofs - | None => One (S Outgoing ofs ty) :: loc_arguments_rec tyl ir fr (ofs + 2) - end -> - forall_rpair (loc_argument_charact ofs) p). - { intros. destruct (list_nth_z int_param_regs ir) as [r|] eqn:E; destruct H1. - subst. left. eapply list_nth_z_in; eauto. - eapply IHtyl; eauto. - subst. split. omega. assumption. - eapply Y; eauto. omega. } - assert (B: forall ty, In p - match list_nth_z float_param_regs fr with - | Some ireg => One (R ireg) :: loc_arguments_rec tyl ir (fr + 1) ofs - | None => One (S Outgoing ofs ty) :: loc_arguments_rec tyl ir fr (ofs + 2) - end -> - forall_rpair (loc_argument_charact ofs) p). - { intros. destruct (list_nth_z float_param_regs fr) as [r|] eqn:E; destruct H1. - subst. right. eapply list_nth_z_in; eauto. - eapply IHtyl; eauto. - subst. split. omega. assumption. - eapply Y; eauto. omega. } - destruct a; eauto. + set (OK := fun (l: list (rpair loc)) => + forall p, In p l -> forall_rpair loc_argument_acceptable p). + set (OKF := fun (f: Z -> Z -> Z -> list (rpair loc)) => + forall ri rf ofs, ofs >= 0 -> OK (f ri rf ofs)). + assert (CSI: forall r, In r int_param_regs -> is_callee_save r = false). + { decide_goal. } + assert (CSF: forall r, In r float_param_regs -> is_callee_save r = false). + { decide_goal. } + assert (ALP: forall ofs ty, ofs >= 0 -> align ofs (typesize ty) >= 0). + { intros. + assert (ofs <= align ofs (typesize ty)) by (apply align_le; apply typesize_pos). + lia. } + assert (ALD: forall ofs ty, ofs >= 0 -> (typealign ty | align ofs (typesize ty))). + { intros. apply Z.divide_trans with (typesize ty). apply typealign_typesize. apply align_divides. apply typesize_pos. } + assert (ALP2: forall ofs, ofs >= 0 -> align ofs 2 >= 0). + { intros. + assert (ofs <= align ofs 2) by (apply align_le; lia). + lia. } + assert (ALD2: forall ofs ty, ofs >= 0 -> (typealign ty | align ofs 2)). + { intros. eapply Z.divide_trans with 2. + exists (2 / typealign ty). destruct ty; reflexivity. + apply align_divides. lia. } + assert (STK: forall tyl ofs, + ofs >= 0 -> OK (loc_arguments_stack tyl ofs)). + { induction tyl as [ | ty tyl]; intros ofs OO; red; simpl; intros. + - contradiction. + - destruct H. + + subst p. split. auto. simpl. apply Z.divide_1_l. + + apply IHtyl with (ofs := ofs + 2). lia. auto. + } + assert (A: forall ty ri rf ofs f, + OKF f -> ofs >= 0 -> OK (stack_arg ty ri rf ofs f)). + { intros until f; intros OF OO; red; unfold stack_arg; intros. + destruct Archi.abi; destruct H. + - subst p; simpl; auto. + - eapply OF; [|eauto]. apply ALP2 in OO. lia. + - subst p; simpl; auto. + - eapply OF; [|eauto]. apply (ALP ofs ty) in OO. generalize (typesize_pos ty). lia. + } + assert (B: forall ty ri rf ofs f, + OKF f -> ofs >= 0 -> OK (int_arg ty ri rf ofs f)). + { intros until f; intros OF OO; red; unfold int_arg; intros. + destruct (list_nth_z int_param_regs ri) as [r|] eqn:NTH; [destruct H|]. + - subst p; simpl. apply CSI. eapply list_nth_z_in; eauto. + - eapply OF; eauto. + - eapply A; eauto. + } + assert (C: forall ty ri rf ofs f, + OKF f -> ofs >= 0 -> OK (float_arg ty ri rf ofs f)). + { intros until f; intros OF OO; red; unfold float_arg; intros. + destruct (list_nth_z float_param_regs rf) as [r|] eqn:NTH; [destruct H|]. + - subst p; simpl. apply CSF. eapply list_nth_z_in; eauto. + - eapply OF; eauto. + - eapply A; eauto. + } + cut (forall tyl fixed ri rf ofs, ofs >= 0 -> OK (loc_arguments_rec tyl fixed ri rf ofs)). + unfold OK. eauto. + induction tyl as [ | ty1 tyl]; intros until ofs; intros OO; simpl. +- red; simpl; tauto. +- destruct (zle fixed 0). + + apply (STK (ty1 :: tyl)); auto. + + unfold OKF in *; destruct ty1; eauto. Qed. Lemma loc_arguments_acceptable: @@ -250,19 +332,10 @@ Lemma loc_arguments_acceptable: In p (loc_arguments s) -> forall_rpair loc_argument_acceptable p. Proof. unfold loc_arguments; intros. - assert (A: forall r, In r int_param_regs -> is_callee_save r = false) by decide_goal. - assert (B: forall r, In r float_param_regs -> is_callee_save r = false) by decide_goal. - assert (X: forall l, loc_argument_charact 0 l -> loc_argument_acceptable l). - { unfold loc_argument_charact, loc_argument_acceptable. - destruct l as [r | [] ofs ty]; auto. intros [C|C]; auto. - intros [C D]. split; auto. apply Z.divide_trans with 2; auto. - exists (2 / typealign ty); destruct ty; reflexivity. - } - exploit loc_arguments_rec_charact; eauto using Z.divide_0_r. - unfold forall_rpair; destruct p; intuition auto. + eapply loc_arguments_rec_charact; eauto. lia. Qed. -Hint Resolve loc_arguments_acceptable: locs. +Global Hint Resolve loc_arguments_acceptable: locs. Lemma loc_arguments_main: loc_arguments signature_main = nil. @@ -270,16 +343,29 @@ Proof. unfold loc_arguments; reflexivity. Qed. -(** ** Normalization of function results *) +(** ** Normalization of function results and parameters *) (** According to the AAPCS64 ABI specification, "padding bits" in the return - value of a function have unpredictable values and must be ignored. - Consequently, we force normalization of return values of small integer - types (8- and 16-bit integers), so that the top bits (the "padding bits") - are proper sign- or zero-extensions of the small integer value. *) + value of a function or in a function parameter have unpredictable + values and must be ignored. Consequently, we force normalization + of return values and of function parameters when they have small + integer types (8- and 16-bit integers), so that the top bits (the + "padding bits") are proper sign- or zero-extensions of the small + integer value. + + The Apple variant of the AAPCS64 requires the callee to return a normalized + value, and the caller to pass normalized parameters, hence no + normalization is needed. + *) Definition return_value_needs_normalization (t: rettype) : bool := - match t with - | Tint8signed | Tint8unsigned | Tint16signed | Tint16unsigned => true - | _ => false + match Archi.abi with + | Archi.Apple => false + | Archi.AAPCS64 => + match t with + | Tint8signed | Tint8unsigned | Tint16signed | Tint16unsigned => true + | _ => false + end end. + +Definition parameter_needs_normalization := return_value_needs_normalization. diff --git a/aarch64/Op.v b/aarch64/Op.v index 40f6ebf0..4c0dfb72 100644 --- a/aarch64/Op.v +++ b/aarch64/Op.v @@ -985,25 +985,25 @@ End SHIFT_AMOUNT. Program Definition mk_amount32 (n: int): amount32 := {| a32_amount := Int.zero_ext 5 n |}. Next Obligation. - apply mk_amount_range. omega. reflexivity. + apply mk_amount_range. lia. reflexivity. Qed. Lemma mk_amount32_eq: forall n, Int.ltu n Int.iwordsize = true -> a32_amount (mk_amount32 n) = n. Proof. - intros. eapply mk_amount_eq; eauto. omega. reflexivity. + intros. eapply mk_amount_eq; eauto. lia. reflexivity. Qed. Program Definition mk_amount64 (n: int): amount64 := {| a64_amount := Int.zero_ext 6 n |}. Next Obligation. - apply mk_amount_range. omega. reflexivity. + apply mk_amount_range. lia. reflexivity. Qed. Lemma mk_amount64_eq: forall n, Int.ltu n Int64.iwordsize' = true -> a64_amount (mk_amount64 n) = n. Proof. - intros. eapply mk_amount_eq; eauto. omega. reflexivity. + intros. eapply mk_amount_eq; eauto. lia. reflexivity. Qed. (** Recognition of move operations. *) diff --git a/aarch64/SelectLongproof.v b/aarch64/SelectLongproof.v index 513ee9bd..0984943c 100644 --- a/aarch64/SelectLongproof.v +++ b/aarch64/SelectLongproof.v @@ -228,8 +228,8 @@ Proof. intros. unfold Int.ltu; apply zlt_true. apply Int.ltu_inv in H. apply Int.ltu_inv in H0. change (Int.unsigned Int64.iwordsize') with Int64.zwordsize in *. - unfold Int.sub; rewrite Int.unsigned_repr. omega. - assert (Int64.zwordsize < Int.max_unsigned) by reflexivity. omega. + unfold Int.sub; rewrite Int.unsigned_repr. lia. + assert (Int64.zwordsize < Int.max_unsigned) by reflexivity. lia. Qed. Theorem eval_shrluimm: @@ -245,13 +245,13 @@ Local Opaque Int64.zwordsize. + destruct (Int.ltu n a) eqn:L2. * assert (L3: Int.ltu (Int.sub a n) Int64.iwordsize' = true). { apply sub_shift_amount; auto using a64_range. - apply Int.ltu_inv in L2. omega. } + apply Int.ltu_inv in L2. lia. } econstructor; split. EvalOp. destruct v1; simpl; auto. rewrite mk_amount64_eq, L3, a64_range by auto. simpl. rewrite L. rewrite Int64.shru'_shl', L2 by auto using a64_range. auto. * assert (L3: Int.ltu (Int.sub n a) Int64.iwordsize' = true). { apply sub_shift_amount; auto using a64_range. - unfold Int.ltu in L2. destruct zlt in L2; discriminate || omega. } + unfold Int.ltu in L2. destruct zlt in L2; discriminate || lia. } econstructor; split. EvalOp. destruct v1; simpl; auto. rewrite mk_amount64_eq, L3, a64_range by auto. simpl. rewrite L. rewrite Int64.shru'_shl', L2 by auto using a64_range. auto. @@ -264,11 +264,11 @@ Local Opaque Int64.zwordsize. * econstructor; split. EvalOp. rewrite mk_amount64_eq by auto. destruct v1; simpl; auto. rewrite ! L; simpl. set (s' := s - Int.unsigned n). - replace s with (s' + Int.unsigned n) by (unfold s'; omega). - rewrite Int64.shru'_zero_ext. auto. unfold s'; omega. + replace s with (s' + Int.unsigned n) by (unfold s'; lia). + rewrite Int64.shru'_zero_ext. auto. unfold s'; lia. * econstructor; split. EvalOp. destruct v1; simpl; auto. rewrite ! L; simpl. - rewrite Int64.shru'_zero_ext_0 by omega. auto. + rewrite Int64.shru'_zero_ext_0 by lia. auto. + econstructor; eauto using eval_shrluimm_base. - intros; TrivialExists. Qed. @@ -293,13 +293,13 @@ Proof. + destruct (Int.ltu n a) eqn:L2. * assert (L3: Int.ltu (Int.sub a n) Int64.iwordsize' = true). { apply sub_shift_amount; auto using a64_range. - apply Int.ltu_inv in L2. omega. } + apply Int.ltu_inv in L2. lia. } econstructor; split. EvalOp. destruct v1; simpl; auto. rewrite mk_amount64_eq, L3, a64_range by auto. simpl. rewrite L. rewrite Int64.shr'_shl', L2 by auto using a64_range. auto. * assert (L3: Int.ltu (Int.sub n a) Int64.iwordsize' = true). { apply sub_shift_amount; auto using a64_range. - unfold Int.ltu in L2. destruct zlt in L2; discriminate || omega. } + unfold Int.ltu in L2. destruct zlt in L2; discriminate || lia. } econstructor; split. EvalOp. destruct v1; simpl; auto. rewrite mk_amount64_eq, L3, a64_range by auto. simpl. rewrite L. rewrite Int64.shr'_shl', L2 by auto using a64_range. auto. @@ -312,8 +312,8 @@ Proof. * InvBooleans. econstructor; split. EvalOp. rewrite mk_amount64_eq by auto. destruct v1; simpl; auto. rewrite ! L; simpl. set (s' := s - Int.unsigned n). - replace s with (s' + Int.unsigned n) by (unfold s'; omega). - rewrite Int64.shr'_sign_ext. auto. unfold s'; omega. unfold s'; omega. + replace s with (s' + Int.unsigned n) by (unfold s'; lia). + rewrite Int64.shr'_sign_ext. auto. unfold s'; lia. unfold s'; lia. * econstructor; split; [|eauto]. apply eval_shrlimm_base; auto. EvalOp. + econstructor; eauto using eval_shrlimm_base. - intros; TrivialExists. @@ -395,7 +395,7 @@ Proof. - TrivialExists. - destruct (zlt (Int.unsigned a0) sz). + econstructor; split. EvalOp. destruct v1; simpl; auto. rewrite a64_range; simpl. - apply Val.lessdef_same. f_equal. rewrite Int64.shl'_zero_ext by omega. f_equal. omega. + apply Val.lessdef_same. f_equal. rewrite Int64.shl'_zero_ext by lia. f_equal. lia. + TrivialExists. - TrivialExists. Qed. diff --git a/aarch64/SelectOp.vp b/aarch64/SelectOp.vp index 67575fdb..7f73d592 100644 --- a/aarch64/SelectOp.vp +++ b/aarch64/SelectOp.vp @@ -540,10 +540,18 @@ Definition select (ty: typ) (cond: condition) (args: exprlist) (e1 e2: expr) := (** ** Recognition of addressing modes for load and store operations *) +(** Some symbols are relocatable (e.g. external symbols in macOS) + and cannot be used with [Aglobal] addressing mode. *) + +Parameter symbol_is_relocatable: ident -> bool. + Nondetfunction addressing (chunk: memory_chunk) (e: expr) := match e with | Eop (Oaddrstack n) Enil => (Ainstack n, Enil) - | Eop (Oaddrsymbol id ofs) Enil => (Aglobal id ofs, Enil) + | Eop (Oaddrsymbol id ofs) Enil => + if symbol_is_relocatable id + then (Aindexed (Ptrofs.to_int64 ofs), Eop (Oaddrsymbol id Ptrofs.zero) Enil ::: Enil) + else (Aglobal id ofs, Enil) | Eop (Oaddlimm n) (e1:::Enil) => (Aindexed n, e1:::Enil) | Eop (Oaddlshift Slsl a) (e1:::e2:::Enil) => (Aindexed2shift a, e1:::e2:::Enil) | Eop (Oaddlext x a) (e1:::e2:::Enil) => (Aindexed2ext x a, e1:::e2:::Enil) diff --git a/aarch64/SelectOpproof.v b/aarch64/SelectOpproof.v index 9ce7a8bf..dfa4c598 100644 --- a/aarch64/SelectOpproof.v +++ b/aarch64/SelectOpproof.v @@ -248,8 +248,8 @@ Remark sub_shift_amount: Proof. intros. unfold Int.ltu; apply zlt_true. rewrite Int.unsigned_repr_wordsize. apply Int.ltu_iwordsize_inv in H. apply Int.ltu_iwordsize_inv in H0. - unfold Int.sub; rewrite Int.unsigned_repr. omega. - generalize Int.wordsize_max_unsigned; omega. + unfold Int.sub; rewrite Int.unsigned_repr. lia. + generalize Int.wordsize_max_unsigned; lia. Qed. Theorem eval_shruimm: @@ -265,13 +265,13 @@ Local Opaque Int.zwordsize. + destruct (Int.ltu n a) eqn:L2. * assert (L3: Int.ltu (Int.sub a n) Int.iwordsize = true). { apply sub_shift_amount; auto using a32_range. - apply Int.ltu_inv in L2. omega. } + apply Int.ltu_inv in L2. lia. } econstructor; split. EvalOp. destruct v1; simpl; auto. rewrite mk_amount32_eq, L3, a32_range by auto. simpl. rewrite L. rewrite Int.shru_shl, L2 by auto using a32_range. auto. * assert (L3: Int.ltu (Int.sub n a) Int.iwordsize = true). { apply sub_shift_amount; auto using a32_range. - unfold Int.ltu in L2. destruct zlt in L2; discriminate || omega. } + unfold Int.ltu in L2. destruct zlt in L2; discriminate || lia. } econstructor; split. EvalOp. destruct v1; simpl; auto. rewrite mk_amount32_eq, L3, a32_range by auto. simpl. rewrite L. rewrite Int.shru_shl, L2 by auto using a32_range. auto. @@ -284,11 +284,11 @@ Local Opaque Int.zwordsize. * econstructor; split. EvalOp. rewrite mk_amount32_eq by auto. destruct v1; simpl; auto. rewrite ! L; simpl. set (s' := s - Int.unsigned n). - replace s with (s' + Int.unsigned n) by (unfold s'; omega). - rewrite Int.shru_zero_ext. auto. unfold s'; omega. + replace s with (s' + Int.unsigned n) by (unfold s'; lia). + rewrite Int.shru_zero_ext. auto. unfold s'; lia. * econstructor; split. EvalOp. destruct v1; simpl; auto. rewrite ! L; simpl. - rewrite Int.shru_zero_ext_0 by omega. auto. + rewrite Int.shru_zero_ext_0 by lia. auto. + econstructor; eauto using eval_shruimm_base. - intros; TrivialExists. Qed. @@ -313,13 +313,13 @@ Proof. + destruct (Int.ltu n a) eqn:L2. * assert (L3: Int.ltu (Int.sub a n) Int.iwordsize = true). { apply sub_shift_amount; auto using a32_range. - apply Int.ltu_inv in L2. omega. } + apply Int.ltu_inv in L2. lia. } econstructor; split. EvalOp. destruct v1; simpl; auto. rewrite mk_amount32_eq, L3, a32_range by auto. simpl. rewrite L. rewrite Int.shr_shl, L2 by auto using a32_range. auto. * assert (L3: Int.ltu (Int.sub n a) Int.iwordsize = true). { apply sub_shift_amount; auto using a32_range. - unfold Int.ltu in L2. destruct zlt in L2; discriminate || omega. } + unfold Int.ltu in L2. destruct zlt in L2; discriminate || lia. } econstructor; split. EvalOp. destruct v1; simpl; auto. rewrite mk_amount32_eq, L3, a32_range by auto. simpl. rewrite L. rewrite Int.shr_shl, L2 by auto using a32_range. auto. @@ -332,8 +332,8 @@ Proof. * InvBooleans. econstructor; split. EvalOp. rewrite mk_amount32_eq by auto. destruct v1; simpl; auto. rewrite ! L; simpl. set (s' := s - Int.unsigned n). - replace s with (s' + Int.unsigned n) by (unfold s'; omega). - rewrite Int.shr_sign_ext. auto. unfold s'; omega. unfold s'; omega. + replace s with (s' + Int.unsigned n) by (unfold s'; lia). + rewrite Int.shr_sign_ext. auto. unfold s'; lia. unfold s'; lia. * econstructor; split; [|eauto]. apply eval_shrimm_base; auto. EvalOp. + econstructor; eauto using eval_shrimm_base. - intros; TrivialExists. @@ -404,20 +404,20 @@ Proof. change (Int.ltu (Int.repr 32) Int64.iwordsize') with true; simpl. apply Val.lessdef_same. f_equal. transitivity (Int.repr (Z.shiftr (Int.signed i * Int.signed i0) 32)). - unfold Int.mulhs; f_equal. rewrite Zshiftr_div_two_p by omega. reflexivity. + unfold Int.mulhs; f_equal. rewrite Zshiftr_div_two_p by lia. reflexivity. apply Int.same_bits_eq; intros n N. change Int.zwordsize with 32 in *. - assert (N1: 0 <= n < 64) by omega. + assert (N1: 0 <= n < 64) by lia. rewrite Int64.bits_loword by auto. rewrite Int64.bits_shr' by auto. change (Int.unsigned (Int.repr 32)) with 32. change Int64.zwordsize with 64. - rewrite zlt_true by omega. + rewrite zlt_true by lia. rewrite Int.testbit_repr by auto. - unfold Int64.mul. rewrite Int64.testbit_repr by (change Int64.zwordsize with 64; omega). + unfold Int64.mul. rewrite Int64.testbit_repr by (change Int64.zwordsize with 64; lia). transitivity (Z.testbit (Int.signed i * Int.signed i0) (n + 32)). - rewrite Z.shiftr_spec by omega. auto. + rewrite Z.shiftr_spec by lia. auto. apply Int64.same_bits_eqm. apply Int64.eqm_mult; apply Int64.eqm_unsigned_repr. - change Int64.zwordsize with 64; omega. + change Int64.zwordsize with 64; lia. Qed. Theorem eval_mulhu: binary_constructor_sound mulhu Val.mulhu. @@ -430,20 +430,20 @@ Proof. change (Int.ltu (Int.repr 32) Int64.iwordsize') with true; simpl. apply Val.lessdef_same. f_equal. transitivity (Int.repr (Z.shiftr (Int.unsigned i * Int.unsigned i0) 32)). - unfold Int.mulhu; f_equal. rewrite Zshiftr_div_two_p by omega. reflexivity. + unfold Int.mulhu; f_equal. rewrite Zshiftr_div_two_p by lia. reflexivity. apply Int.same_bits_eq; intros n N. change Int.zwordsize with 32 in *. - assert (N1: 0 <= n < 64) by omega. + assert (N1: 0 <= n < 64) by lia. rewrite Int64.bits_loword by auto. rewrite Int64.bits_shru' by auto. change (Int.unsigned (Int.repr 32)) with 32. change Int64.zwordsize with 64. - rewrite zlt_true by omega. + rewrite zlt_true by lia. rewrite Int.testbit_repr by auto. - unfold Int64.mul. rewrite Int64.testbit_repr by (change Int64.zwordsize with 64; omega). + unfold Int64.mul. rewrite Int64.testbit_repr by (change Int64.zwordsize with 64; lia). transitivity (Z.testbit (Int.unsigned i * Int.unsigned i0) (n + 32)). - rewrite Z.shiftr_spec by omega. auto. + rewrite Z.shiftr_spec by lia. auto. apply Int64.same_bits_eqm. apply Int64.eqm_mult; apply Int64.eqm_unsigned_repr. - change Int64.zwordsize with 64; omega. + change Int64.zwordsize with 64; lia. Qed. (** Integer conversions *) @@ -456,7 +456,7 @@ Proof. - TrivialExists. - destruct (zlt (Int.unsigned a0) sz). + econstructor; split. EvalOp. destruct v1; simpl; auto. rewrite a32_range; simpl. - apply Val.lessdef_same. f_equal. rewrite Int.shl_zero_ext by omega. f_equal. omega. + apply Val.lessdef_same. f_equal. rewrite Int.shl_zero_ext by lia. f_equal. lia. + TrivialExists. - TrivialExists. Qed. @@ -469,29 +469,29 @@ Proof. - TrivialExists. - destruct (zlt (Int.unsigned a0) sz). + econstructor; split. EvalOp. destruct v1; simpl; auto. rewrite a32_range; simpl. - apply Val.lessdef_same. f_equal. rewrite Int.shl_sign_ext by omega. f_equal. omega. + apply Val.lessdef_same. f_equal. rewrite Int.shl_sign_ext by lia. f_equal. lia. + TrivialExists. - TrivialExists. Qed. Theorem eval_cast8signed: unary_constructor_sound cast8signed (Val.sign_ext 8). Proof. - apply eval_sign_ext; omega. + apply eval_sign_ext; lia. Qed. Theorem eval_cast8unsigned: unary_constructor_sound cast8unsigned (Val.zero_ext 8). Proof. - apply eval_zero_ext; omega. + apply eval_zero_ext; lia. Qed. Theorem eval_cast16signed: unary_constructor_sound cast16signed (Val.sign_ext 16). Proof. - apply eval_sign_ext; omega. + apply eval_sign_ext; lia. Qed. Theorem eval_cast16unsigned: unary_constructor_sound cast16unsigned (Val.zero_ext 16). Proof. - apply eval_zero_ext; omega. + apply eval_zero_ext; lia. Qed. (** Bitwise not, and, or, xor *) @@ -1038,7 +1038,13 @@ Theorem eval_addressing: Proof. intros until v. unfold addressing; case (addressing_match a); intros; InvEval. - econstructor; split. EvalOp. simpl; auto. -- econstructor; split. EvalOp. simpl; auto. +- destruct (symbol_is_relocatable id). + + exists (Genv.symbol_address ge id Ptrofs.zero :: nil); split. + constructor. EvalOp. constructor. + simpl. rewrite <- Genv.shift_symbol_address_64 by auto. + rewrite Ptrofs.of_int64_to_int64, Ptrofs.add_zero_l by auto. + auto. + + econstructor; split. EvalOp. simpl; auto. - econstructor; split. EvalOp. simpl. destruct v1; try discriminate. rewrite <- H; auto. - econstructor; split. EvalOp. simpl. congruence. diff --git a/aarch64/Stacklayout.v b/aarch64/Stacklayout.v index 86ba9f45..cdbc64d5 100644 --- a/aarch64/Stacklayout.v +++ b/aarch64/Stacklayout.v @@ -67,13 +67,13 @@ Local Opaque Z.add Z.mul sepconj range. set (ostkdata := align (ol + 4 * b.(bound_local)) 8). change (size_chunk Mptr) with 8. generalize b.(bound_local_pos) b.(bound_outgoing_pos) b.(bound_stack_data_pos); intros. - assert (0 <= 4 * b.(bound_outgoing)) by omega. - assert (4 * b.(bound_outgoing) <= olink) by (apply align_le; omega). - assert (olink + 8 <= oretaddr) by (unfold oretaddr; omega). - assert (oretaddr + 8 <= ocs) by (unfold ocs; omega). + assert (0 <= 4 * b.(bound_outgoing)) by lia. + assert (4 * b.(bound_outgoing) <= olink) by (apply align_le; lia). + assert (olink + 8 <= oretaddr) by (unfold oretaddr; lia). + assert (oretaddr + 8 <= ocs) by (unfold ocs; lia). assert (ocs <= size_callee_save_area b ocs) by (apply size_callee_save_area_incr). - assert (size_callee_save_area b ocs <= ol) by (apply align_le; omega). - assert (ol + 4 * b.(bound_local) <= ostkdata) by (apply align_le; omega). + assert (size_callee_save_area b ocs <= ol) by (apply align_le; lia). + assert (ol + 4 * b.(bound_local) <= ostkdata) by (apply align_le; lia). (* Reorder as: outgoing back link @@ -86,11 +86,11 @@ Local Opaque Z.add Z.mul sepconj range. rewrite sep_swap45. (* Apply range_split and range_split2 repeatedly *) unfold fe_ofs_arg. - apply range_split_2. fold olink; omega. omega. - apply range_split. omega. - apply range_split. omega. - apply range_split_2. fold ol. omega. omega. - apply range_drop_right with ostkdata. omega. + apply range_split_2. fold olink; lia. lia. + apply range_split. lia. + apply range_split. lia. + apply range_split_2. fold ol. lia. lia. + apply range_drop_right with ostkdata. lia. eapply sep_drop2. eexact H. Qed. @@ -106,14 +106,14 @@ Proof. set (ol := align (size_callee_save_area b ocs) 8). set (ostkdata := align (ol + 4 * b.(bound_local)) 8). generalize b.(bound_local_pos) b.(bound_outgoing_pos) b.(bound_stack_data_pos); intros. - assert (0 <= 4 * b.(bound_outgoing)) by omega. - assert (4 * b.(bound_outgoing) <= olink) by (apply align_le; omega). - assert (olink + 8 <= oretaddr) by (unfold oretaddr; omega). - assert (oretaddr + 8 <= ocs) by (unfold ocs; omega). + assert (0 <= 4 * b.(bound_outgoing)) by lia. + assert (4 * b.(bound_outgoing) <= olink) by (apply align_le; lia). + assert (olink + 8 <= oretaddr) by (unfold oretaddr; lia). + assert (oretaddr + 8 <= ocs) by (unfold ocs; lia). assert (ocs <= size_callee_save_area b ocs) by (apply size_callee_save_area_incr). - assert (size_callee_save_area b ocs <= ol) by (apply align_le; omega). - assert (ol + 4 * b.(bound_local) <= ostkdata) by (apply align_le; omega). - split. omega. apply align_le. omega. + assert (size_callee_save_area b ocs <= ol) by (apply align_le; lia). + assert (ol + 4 * b.(bound_local) <= ostkdata) by (apply align_le; lia). + split. lia. apply align_le. lia. Qed. Lemma frame_env_aligned: @@ -133,8 +133,8 @@ Proof. set (ostkdata := align (ol + 4 * b.(bound_local)) 8). change (align_chunk Mptr) with 8. split. apply Z.divide_0_r. - split. apply align_divides; omega. - split. apply align_divides; omega. - split. apply align_divides; omega. - apply Z.divide_add_r. apply align_divides; omega. apply Z.divide_refl. + split. apply align_divides; lia. + split. apply align_divides; lia. + split. apply align_divides; lia. + apply Z.divide_add_r. apply align_divides; lia. apply Z.divide_refl. Qed. diff --git a/aarch64/Archi.v b/aarch64/TO_MERGE/Archi.v index 7f39d1fa..eb022db9 100644 --- a/aarch64/Archi.v +++ b/aarch64/TO_MERGE/Archi.v @@ -85,8 +85,16 @@ Global Opaque ptr64 big_endian splitlong fma_order fma_invalid_mul_is_nan float_of_single_preserves_sNaN. -(** Whether to generate position-independent code or not *) +(** Which ABI to implement *) +<<<<<<< HEAD Parameter pic_code: unit -> bool. Definition has_notrap_loads := false. +======= +Inductive abi_kind: Type := + | AAPCS64 (**r ARM's standard as used in Linux and other ELF platforms *) + | Apple. (**r the variant used in macOS and iOS *) + +Parameter abi: abi_kind. +>>>>>>> master diff --git a/aarch64/Asmgen.v b/aarch64/TO_MERGE/Asmgen.v index 45205158..c8e48b40 100644 --- a/aarch64/Asmgen.v +++ b/aarch64/TO_MERGE/Asmgen.v @@ -17,8 +17,120 @@ Require Import Recdef Coqlib Zwf Zbits. Require Import Errors AST Integers Floats Op. +<<<<<<< HEAD Require Import Locations Compopts. Require Import Mach Asm Asmblock Asmblockgen Machblockgen PostpassScheduling. +======= +Require Import Locations Mach Asm. +Require SelectOp. + +Local Open Scope string_scope. +Local Open Scope list_scope. +Local Open Scope error_monad_scope. + +(** Alignment check for symbols *) + +Parameter symbol_is_aligned : ident -> Z -> bool. +(** [symbol_is_aligned id sz] checks whether the symbol [id] is [sz] aligned *) + +(** Extracting integer or float registers. *) + +Definition ireg_of (r: mreg) : res ireg := + match preg_of r with IR mr => OK mr | _ => Error(msg "Asmgen.ireg_of") end. + +Definition freg_of (r: mreg) : res freg := + match preg_of r with FR mr => OK mr | _ => Error(msg "Asmgen.freg_of") end. + +(** Recognition of immediate arguments for logical integer operations.*) + +(** Valid immediate arguments are repetitions of a bit pattern [B] + of length [e] = 2, 4, 8, 16, 32 or 64. + The bit pattern [B] must be of the form [0*1*0*] or [1*0*1*] + but must not be all zeros or all ones. *) + +(** The following automaton recognizes [0*1*0*|1*0*1*]. +<< + 0 1 0 + / \ / \ / \ + \ / \ / \ / + -0--> [B] --1--> [D] --0--> [F] + / + [A] + \ + -1--> [C] --0--> [E] --1--> [G] + / \ / \ / \ + \ / \ / \ / + 1 0 1 +>> +*) + +Module Automaton. + +Inductive state : Type := SA | SB | SC | SD | SE | SF | SG | Sbad. + +Definition start := SA. + +Definition next (s: state) (b: bool) := + match s, b with + | SA,false => SB | SA,true => SC + | SB,false => SB | SB,true => SD + | SC,false => SE | SC,true => SC + | SD,false => SF | SD,true => SD + | SE,false => SE | SE,true => SG + | SF,false => SF | SF,true => Sbad + | SG,false => Sbad | SG,true => SG + | Sbad,_ => Sbad + end. + +Definition accepting (s: state) := + match s with + | SA | SB | SC | SD | SE | SF | SG => true + | Sbad => false + end. + +Fixpoint run (len: nat) (s: state) (x: Z) : bool := + match len with + | Datatypes.O => accepting s + | Datatypes.S len => run len (next s (Z.odd x)) (Z.div2 x) + end. + +End Automaton. + +(** The following function determines the candidate length [e], + ensuring that [x] is a repetition [BB...B] + of a bit pattern [B] of length [e]. *) + +Definition logical_imm_length (x: Z) (sixtyfour: bool) : nat := + (** [test n] checks that the low [2n] bits of [x] are of the + form [BB], that is, two occurrences of the same [n] bits *) + let test (n: Z) : bool := + Z.eqb (Zzero_ext n x) (Zzero_ext n (Z.shiftr x n)) in + (** If [test n] fails, we know that the candidate length [e] is + at least [2n]. Hence we test with decreasing values of [n]: + 32, 16, 8, 4, 2. *) + if sixtyfour && negb (test 32) then 64%nat + else if negb (test 16) then 32%nat + else if negb (test 8) then 16%nat + else if negb (test 4) then 8%nat + else if negb (test 2) then 4%nat + else 2%nat. + +(** A valid logical immediate is +- neither [0] nor [-1]; +- composed of a repetition [BBBBB] of a bit-pattern [B] of length [e] +- the low [e] bits of the number, that is, [B], match [0*1*0*] or [1*0*1*]. +*) + +Definition is_logical_imm32 (x: int) : bool := + negb (Int.eq x Int.zero) && negb (Int.eq x Int.mone) && + Automaton.run (logical_imm_length (Int.unsigned x) false) + Automaton.start (Int.unsigned x). + +Definition is_logical_imm64 (x: int64) : bool := + negb (Int64.eq x Int64.zero) && negb (Int64.eq x Int64.mone) && + Automaton.run (logical_imm_length (Int64.unsigned x) true) + Automaton.start (Int64.unsigned x). +>>>>>>> master Local Open Scope error_monad_scope. @@ -82,7 +194,86 @@ Definition addimm64 (rd r1: iregsp) (n: int64) (k: code) : code := else if Int64.eq m (Int64.zero_ext 24 m) then addimm_aux (Asm.Psubimm X) rd r1 (Int64.unsigned m) k else if Int64.lt n Int64.zero then +<<<<<<< HEAD loadimm64 X16 m (Asm.Psubext rd r1 X16 (EOuxtx Int.zero) :: k) +======= + loadimm64 X16 m (Psubext rd r1 X16 (EOuxtx Int.zero) :: k) + else + loadimm64 X16 n (Paddext rd r1 X16 (EOuxtx Int.zero) :: k). + +(** Logical immediate *) + +Definition logicalimm32 + (insn1: ireg -> ireg0 -> Z -> instruction) + (insn2: ireg -> ireg0 -> ireg -> shift_op -> instruction) + (rd r1: ireg) (n: int) (k: code) : code := + if is_logical_imm32 n + then insn1 rd r1 (Int.unsigned n) :: k + else loadimm32 X16 n (insn2 rd r1 X16 SOnone :: k). + +Definition logicalimm64 + (insn1: ireg -> ireg0 -> Z -> instruction) + (insn2: ireg -> ireg0 -> ireg -> shift_op -> instruction) + (rd r1: ireg) (n: int64) (k: code) : code := + if is_logical_imm64 n + then insn1 rd r1 (Int64.unsigned n) :: k + else loadimm64 X16 n (insn2 rd r1 X16 SOnone :: k). + +(** Sign- or zero-extended arithmetic *) + +Definition transl_extension (ex: extension) (a: int) : extend_op := + match ex with Xsgn32 => EOsxtw a | Xuns32 => EOuxtw a end. + +Definition move_extended_base + (rd: ireg) (r1: ireg) (ex: extension) (k: code) : code := + match ex with + | Xsgn32 => Pcvtsw2x rd r1 :: k + | Xuns32 => Pcvtuw2x rd r1 :: k + end. + +Definition move_extended + (rd: ireg) (r1: ireg) (ex: extension) (a: int) (k: code) : code := + if Int.eq a Int.zero then + move_extended_base rd r1 ex k + else + move_extended_base rd r1 ex (Padd X rd XZR rd (SOlsl a) :: k). + +Definition arith_extended + (insnX: iregsp -> iregsp -> ireg -> extend_op -> instruction) + (insnS: ireg -> ireg0 -> ireg -> shift_op -> instruction) + (rd r1 r2: ireg) (ex: extension) (a: int) (k: code) : code := + if Int.ltu a (Int.repr 5) then + insnX rd r1 r2 (transl_extension ex a) :: k + else + move_extended_base X16 r2 ex (insnS rd r1 X16 (SOlsl a) :: k). + +(** Extended right shift *) + +Definition shrx32 (rd r1: ireg) (n: int) (k: code) : code := + if Int.eq n Int.zero then + Pmov rd r1 :: k + else + Porr W X16 XZR r1 (SOasr (Int.repr 31)) :: + Padd W X16 r1 X16 (SOlsr (Int.sub Int.iwordsize n)) :: + Porr W rd XZR X16 (SOasr n) :: k. + +Definition shrx64 (rd r1: ireg) (n: int) (k: code) : code := + if Int.eq n Int.zero then + Pmov rd r1 :: k + else + Porr X X16 XZR r1 (SOasr (Int.repr 63)) :: + Padd X X16 r1 X16 (SOlsr (Int.sub Int64.iwordsize' n)) :: + Porr X rd XZR X16 (SOasr n) :: k. + +(** Load the address [id + ofs] in [rd] *) + +Definition loadsymbol (rd: ireg) (id: ident) (ofs: ptrofs) (k: code) : code := + if SelectOp.symbol_is_relocatable id then + if Ptrofs.eq ofs Ptrofs.zero then + Ploadsymbol rd id :: k + else + Ploadsymbol rd id :: addimm64 rd rd (Ptrofs.to_int64 ofs) k +>>>>>>> master else loadimm64 X16 n (Asm.Paddext rd r1 X16 (EOuxtx Int.zero) :: k). @@ -374,6 +565,7 @@ Definition basic_to_instruction (b: basic) : res Asm.instruction := | Pnop => OK (Asm.Pnop) end. +<<<<<<< HEAD Definition cf_instruction_to_instruction (cfi: cf_instruction) : Asm.instruction := match cfi with | Pb l => Asm.Pb l @@ -388,6 +580,59 @@ Definition cf_instruction_to_instruction (cfi: cf_instruction) : Asm.instruction | Ptbnz sz r n lbl => Asm.Ptbnz sz r n lbl | Ptbz sz r n lbl => Asm.Ptbz sz r n lbl | Pbtbl r1 tbl => Asm.Pbtbl r1 tbl +======= +(** Translation of addressing modes *) + +Definition offset_representable (sz: Z) (ofs: int64) : bool := + let isz := Int64.repr sz in + (** either unscaled 9-bit signed *) + Int64.eq ofs (Int64.sign_ext 9 ofs) || + (** or scaled 12-bit unsigned *) + (Int64.eq (Int64.modu ofs isz) Int64.zero + && Int64.ltu ofs (Int64.shl isz (Int64.repr 12))). + +Definition transl_addressing (sz: Z) (addr: Op.addressing) (args: list mreg) + (insn: Asm.addressing -> instruction) (k: code) : res code := + match addr, args with + | Aindexed ofs, a1 :: nil => + do r1 <- ireg_of a1; + if offset_representable sz ofs then + OK (insn (ADimm r1 ofs) :: k) + else + OK (loadimm64 X16 ofs (insn (ADreg r1 X16) :: k)) + | Aindexed2, a1 :: a2 :: nil => + do r1 <- ireg_of a1; do r2 <- ireg_of a2; + OK (insn (ADreg r1 r2) :: k) + | Aindexed2shift a, a1 :: a2 :: nil => + do r1 <- ireg_of a1; do r2 <- ireg_of a2; + if Int.eq a Int.zero then + OK (insn (ADreg r1 r2) :: k) + else if Int.eq (Int.shl Int.one a) (Int.repr sz) then + OK (insn (ADlsl r1 r2 a) :: k) + else + OK (Padd X X16 r1 r2 (SOlsl a) :: insn (ADimm X16 Int64.zero) :: k) + | Aindexed2ext x a, a1 :: a2 :: nil => + do r1 <- ireg_of a1; do r2 <- ireg_of a2; + if Int.eq a Int.zero || Int.eq (Int.shl Int.one a) (Int.repr sz) then + OK (insn (match x with Xsgn32 => ADsxt r1 r2 a + | Xuns32 => ADuxt r1 r2 a end) :: k) + else + OK (arith_extended Paddext (Padd X) X16 r1 r2 x a + (insn (ADimm X16 Int64.zero) :: k)) + | Aglobal id ofs, nil => + assertion (negb (SelectOp.symbol_is_relocatable id)); + if Ptrofs.eq (Ptrofs.modu ofs (Ptrofs.repr sz)) Ptrofs.zero && symbol_is_aligned id sz + then OK (Padrp X16 id ofs :: insn (ADadr X16 id ofs) :: k) + else OK (loadsymbol X16 id ofs (insn (ADimm X16 Int64.zero) :: k)) + | Ainstack ofs, nil => + let ofs := Ptrofs.to_int64 ofs in + if offset_representable sz ofs then + OK (insn (ADimm XSP ofs) :: k) + else + OK (loadimm64 X16 ofs (insn (ADreg XSP X16) :: k)) + | _, _ => + Error(msg "Asmgen.transl_addressing") +>>>>>>> master end. Definition control_to_instruction (c: control) := diff --git a/aarch64/Asmgenproof.v b/aarch64/TO_MERGE/Asmgenproof.v index d27b3f8c..8af013fd 100644 --- a/aarch64/Asmgenproof.v +++ b/aarch64/TO_MERGE/Asmgenproof.v @@ -209,6 +209,7 @@ Definition max_pos (f : Asm.function) := list_length_z f.(Asm.fn_code). Lemma functions_bound_max_pos: forall fb f tf, Genv.find_funct_ptr ge fb = Some (Internal f) -> transf_function f = OK tf -> +<<<<<<< HEAD max_pos tf <= Ptrofs.max_unsigned. Proof. intros fb f tf FINDf TRANSf. @@ -222,6 +223,66 @@ Proof. assert (Asm.fn_code tf = c) as H. { inversion TRANSf as (H'); auto. } rewrite H; lia. Qed. +======= + Genv.find_funct_ptr tge fb = Some (Internal tf). +Proof. + intros. exploit functions_translated; eauto. intros [tf' [A B]]. + monadInv B. rewrite H0 in EQ; inv EQ; auto. +Qed. + +(** * Properties of control flow *) + +Lemma transf_function_no_overflow: + forall f tf, + transf_function f = OK tf -> list_length_z tf.(fn_code) <= Ptrofs.max_unsigned. +Proof. + intros. monadInv H. destruct (zlt Ptrofs.max_unsigned (list_length_z x.(fn_code))); inv EQ0. + lia. +Qed. + +Lemma exec_straight_exec: + forall fb f c ep tf tc c' rs m rs' m', + transl_code_at_pc ge (rs PC) fb f c ep tf tc -> + exec_straight tge tf tc rs m c' rs' m' -> + plus step tge (State rs m) E0 (State rs' m'). +Proof. + intros. inv H. + eapply exec_straight_steps_1; eauto. + eapply transf_function_no_overflow; eauto. + eapply functions_transl; eauto. +Qed. + +Lemma exec_straight_at: + forall fb f c ep tf tc c' ep' tc' rs m rs' m', + transl_code_at_pc ge (rs PC) fb f c ep tf tc -> + transl_code f c' ep' = OK tc' -> + exec_straight tge tf tc rs m tc' rs' m' -> + transl_code_at_pc ge (rs' PC) fb f c' ep' tf tc'. +Proof. + intros. inv H. + exploit exec_straight_steps_2; eauto. + eapply transf_function_no_overflow; eauto. + eapply functions_transl; eauto. + intros [ofs' [PC' CT']]. + rewrite PC'. constructor; auto. +Qed. + +(** The following lemmas show that the translation from Mach to Asm + preserves labels, in the sense that the following diagram commutes: +<< + translation + Mach code ------------------------ Asm instr sequence + | | + | Mach.find_label lbl find_label lbl | + | | + v v + Mach code tail ------------------- Asm instr seq tail + translation +>> + The proof demands many boring lemmas showing that Asm constructor + functions do not introduce new labels. +*) +>>>>>>> master Lemma one_le_max_unsigned: 1 <= Ptrofs.max_unsigned. @@ -366,9 +427,16 @@ Lemma unfold_cdr bb bbs tc: unfold (bb :: bbs) = OK tc -> exists tc', unfold bbs = OK tc'. Proof. +<<<<<<< HEAD intros; exploit unfold_car_cdr; eauto. intros (_ & ? & _ & ? & _). eexists; eauto. Qed. +======= + intros; unfold loadsymbol. + destruct (SelectOp.symbol_is_relocatable id); TailNoLabel. destruct Ptrofs.eq; TailNoLabel. +Qed. +Hint Resolve loadsymbol_label: labels. +>>>>>>> master Lemma unfold_car bb bbs tc: unfold (bb :: bbs) = OK tc -> @@ -1114,6 +1182,7 @@ Proof. * eapply ptrofs_nextinstr_agree; eauto. Qed. +<<<<<<< HEAD Lemma store_rs_a_preserved n rs1 m1 rs1' m1' rs2 m2 v chk a: forall (BOUNDED: 0 <= n <= Ptrofs.max_unsigned) (MATCHI: match_internal n (State rs1 m1) (State rs2 m2)) @@ -1132,6 +1201,33 @@ Proof. * eapply ptrofs_nextinstr_agree; subst; eauto. + next_stuck_cong. Qed. +======= +Lemma find_label_goto_label: + forall f tf lbl rs m c' b ofs, + Genv.find_funct_ptr ge b = Some (Internal f) -> + transf_function f = OK tf -> + rs PC = Vptr b ofs -> + Mach.find_label lbl f.(Mach.fn_code) = Some c' -> + exists tc', exists rs', + goto_label tf lbl rs m = Next rs' m + /\ transl_code_at_pc ge (rs' PC) b f c' false tf tc' + /\ forall r, r <> PC -> rs'#r = rs#r. +Proof. + intros. exploit (transl_find_label lbl f tf); eauto. rewrite H2. + intros [tc [A B]]. + exploit label_pos_code_tail; eauto. instantiate (1 := 0). + intros [pos' [P [Q R]]]. + exists tc; exists (rs#PC <- (Vptr b (Ptrofs.repr pos'))). + split. unfold goto_label. rewrite P. rewrite H1. auto. + split. rewrite Pregmap.gss. constructor; auto. + rewrite Ptrofs.unsigned_repr. replace (pos' - 0) with pos' in Q. + auto. lia. + generalize (transf_function_no_overflow _ _ H0). lia. + intros. apply Pregmap.gso; auto. +Qed. + +(** Existence of return addresses *) +>>>>>>> master Lemma store_double_preserved n rs1 m1 rs1' m1' rs2 m2 v1 v2 chk1 chk2 a: forall (BOUNDED: 0 <= n <= Ptrofs.max_unsigned) @@ -2045,6 +2141,7 @@ Fixpoint preg_notin (r: preg) (rl: list mreg) : Prop := | r1 :: rl => r <> preg_of r1 /\ preg_notin r rl end. +<<<<<<< HEAD Remark preg_notin_charact: forall r rl, preg_notin r rl <-> (forall mr, In mr rl -> r <> preg_of mr). @@ -2056,6 +2153,378 @@ Proof. rewrite IHrl. split. intros [A B]. intros. destruct H. congruence. auto. auto. +======= +Remark preg_of_not_X29: forall r, negb (mreg_eq r R29) = true -> IR X29 <> preg_of r. +Proof. + intros. change (IR X29) with (preg_of R29). red; intros. + exploit preg_of_injective; eauto. intros; subst r; discriminate. +Qed. + +Lemma sp_val': forall ms sp rs, agree ms sp rs -> sp = rs XSP. +Proof. + intros. eapply sp_val; eauto. +Qed. + +(** This is the simulation diagram. We prove it by case analysis on the Mach transition. *) + +Theorem step_simulation: + forall S1 t S2, Mach.step return_address_offset ge S1 t S2 -> + forall S1' (MS: match_states S1 S1'), + (exists S2', plus step tge S1' t S2' /\ match_states S2 S2') + \/ (measure S2 < measure S1 /\ t = E0 /\ match_states S2 S1')%nat. +Proof. + induction 1; intros; inv MS. + +- (* Mlabel *) + left; eapply exec_straight_steps; eauto; intros. + monadInv TR. econstructor; split. apply exec_straight_one. simpl; eauto. auto. + split. apply agree_nextinstr; auto. simpl; congruence. + +- (* Mgetstack *) + unfold load_stack in H. + exploit Mem.loadv_extends; eauto. intros [v' [A B]]. + rewrite (sp_val _ _ _ AG) in A. + left; eapply exec_straight_steps; eauto. intros. simpl in TR. + exploit loadind_correct; eauto with asmgen. intros [rs' [P [Q R]]]. + exists rs'; split. eauto. + split. eapply agree_set_mreg; eauto with asmgen. congruence. + simpl; congruence. + +- (* Msetstack *) + unfold store_stack in H. + assert (Val.lessdef (rs src) (rs0 (preg_of src))) by (eapply preg_val; eauto). + exploit Mem.storev_extends; eauto. intros [m2' [A B]]. + left; eapply exec_straight_steps; eauto. + rewrite (sp_val _ _ _ AG) in A. intros. simpl in TR. + exploit storeind_correct; eauto with asmgen. intros [rs' [P Q]]. + exists rs'; split. eauto. + split. eapply agree_undef_regs; eauto with asmgen. + simpl; intros. rewrite Q; auto with asmgen. + +- (* Mgetparam *) + assert (f0 = f) by congruence; subst f0. + unfold load_stack in *. + exploit Mem.loadv_extends. eauto. eexact H0. auto. + intros [parent' [A B]]. rewrite (sp_val' _ _ _ AG) in A. + exploit lessdef_parent_sp; eauto. clear B; intros B; subst parent'. + exploit Mem.loadv_extends. eauto. eexact H1. auto. + intros [v' [C D]]. +Opaque loadind. + left; eapply exec_straight_steps; eauto; intros. monadInv TR. + destruct ep. +(* X30 contains parent *) + exploit loadind_correct. eexact EQ. + instantiate (2 := rs0). simpl; rewrite DXP; eauto. simpl; congruence. + intros [rs1 [P [Q R]]]. + exists rs1; split. eauto. + split. eapply agree_set_mreg. eapply agree_set_mreg; eauto. congruence. auto with asmgen. + simpl; intros. rewrite R; auto with asmgen. + apply preg_of_not_X29; auto. +(* X30 does not contain parent *) + exploit loadptr_correct. eexact A. simpl; congruence. intros [rs1 [P [Q R]]]. + exploit loadind_correct. eexact EQ. instantiate (2 := rs1). simpl; rewrite Q. eauto. simpl; congruence. + intros [rs2 [S [T U]]]. + exists rs2; split. eapply exec_straight_trans; eauto. + split. eapply agree_set_mreg. eapply agree_set_mreg. eauto. eauto. + instantiate (1 := rs1#X29 <- (rs2#X29)). intros. + rewrite Pregmap.gso; auto with asmgen. + congruence. + intros. unfold Pregmap.set. destruct (PregEq.eq r' X29). congruence. auto with asmgen. + simpl; intros. rewrite U; auto with asmgen. + apply preg_of_not_X29; auto. + +- (* Mop *) + assert (eval_operation tge sp op (map rs args) m = Some v). + { rewrite <- H. apply eval_operation_preserved. exact symbols_preserved. } + exploit eval_operation_lessdef. eapply preg_vals; eauto. eauto. eexact H0. + intros [v' [A B]]. rewrite (sp_val _ _ _ AG) in A. + left; eapply exec_straight_steps; eauto; intros. simpl in TR. + exploit transl_op_correct; eauto. intros [rs2 [P [Q R]]]. + exists rs2; split. eauto. split. + apply agree_set_undef_mreg with rs0; auto. + apply Val.lessdef_trans with v'; auto. + simpl; intros. InvBooleans. + rewrite R; auto. apply preg_of_not_X29; auto. +Local Transparent destroyed_by_op. + destruct op; try exact I; simpl; congruence. + +- (* Mload *) + assert (Op.eval_addressing tge sp addr (map rs args) = Some a). + { rewrite <- H. apply eval_addressing_preserved. exact symbols_preserved. } + exploit eval_addressing_lessdef. eapply preg_vals; eauto. eexact H1. + intros [a' [A B]]. rewrite (sp_val _ _ _ AG) in A. + exploit Mem.loadv_extends; eauto. intros [v' [C D]]. + left; eapply exec_straight_steps; eauto; intros. simpl in TR. + exploit transl_load_correct; eauto. intros [rs2 [P [Q R]]]. + exists rs2; split. eauto. + split. eapply agree_set_undef_mreg; eauto. congruence. + simpl; congruence. + +- (* Mstore *) + assert (Op.eval_addressing tge sp addr (map rs args) = Some a). + { rewrite <- H. apply eval_addressing_preserved. exact symbols_preserved. } + exploit eval_addressing_lessdef. eapply preg_vals; eauto. eexact H1. + intros [a' [A B]]. rewrite (sp_val _ _ _ AG) in A. + assert (Val.lessdef (rs src) (rs0 (preg_of src))) by (eapply preg_val; eauto). + exploit Mem.storev_extends; eauto. intros [m2' [C D]]. + left; eapply exec_straight_steps; eauto. + intros. simpl in TR. exploit transl_store_correct; eauto. intros [rs2 [P Q]]. + exists rs2; split. eauto. + split. eapply agree_undef_regs; eauto with asmgen. + simpl; congruence. + +- (* Mcall *) + assert (f0 = f) by congruence. subst f0. + inv AT. + assert (NOOV: list_length_z tf.(fn_code) <= Ptrofs.max_unsigned). + { eapply transf_function_no_overflow; eauto. } + destruct ros as [rf|fid]; simpl in H; monadInv H5. ++ (* Indirect call *) + assert (rs rf = Vptr f' Ptrofs.zero). + { destruct (rs rf); try discriminate. + revert H; predSpec Ptrofs.eq Ptrofs.eq_spec i Ptrofs.zero; intros; congruence. } + assert (rs0 x0 = Vptr f' Ptrofs.zero). + { exploit ireg_val; eauto. rewrite H5; intros LD; inv LD; auto. } + generalize (code_tail_next_int _ _ _ _ NOOV H6). intro CT1. + assert (TCA: transl_code_at_pc ge (Vptr fb (Ptrofs.add ofs Ptrofs.one)) fb f c false tf x). + { econstructor; eauto. } + exploit return_address_offset_correct; eauto. intros; subst ra. + left; econstructor; split. + apply plus_one. eapply exec_step_internal. Simpl. rewrite <- H2; simpl; eauto. + eapply functions_transl; eauto. eapply find_instr_tail; eauto. + simpl. eauto. + econstructor; eauto. + econstructor; eauto. + eapply agree_sp_def; eauto. + simpl. eapply agree_exten; eauto. intros. Simpl. + Simpl. rewrite <- H2. auto. ++ (* Direct call *) + generalize (code_tail_next_int _ _ _ _ NOOV H6). intro CT1. + assert (TCA: transl_code_at_pc ge (Vptr fb (Ptrofs.add ofs Ptrofs.one)) fb f c false tf x). + econstructor; eauto. + exploit return_address_offset_correct; eauto. intros; subst ra. + left; econstructor; split. + apply plus_one. eapply exec_step_internal. eauto. + eapply functions_transl; eauto. eapply find_instr_tail; eauto. + simpl. unfold Genv.symbol_address. rewrite symbols_preserved. rewrite H. eauto. + econstructor; eauto. + econstructor; eauto. + eapply agree_sp_def; eauto. + simpl. eapply agree_exten; eauto. intros. Simpl. + Simpl. rewrite <- H2. auto. + +- (* Mtailcall *) + assert (f0 = f) by congruence. subst f0. + inversion AT; subst. + assert (NOOV: list_length_z tf.(fn_code) <= Ptrofs.max_unsigned). + { eapply transf_function_no_overflow; eauto. } + exploit Mem.loadv_extends. eauto. eexact H1. auto. simpl. intros [parent' [A B]]. + destruct ros as [rf|fid]; simpl in H; monadInv H7. ++ (* Indirect call *) + assert (rs rf = Vptr f' Ptrofs.zero). + { destruct (rs rf); try discriminate. + revert H; predSpec Ptrofs.eq Ptrofs.eq_spec i Ptrofs.zero; intros; congruence. } + assert (rs0 x0 = Vptr f' Ptrofs.zero). + { exploit ireg_val; eauto. rewrite H7; intros LD; inv LD; auto. } + exploit make_epilogue_correct; eauto. intros (rs1 & m1 & U & V & W & X & Y & Z). + exploit exec_straight_steps_2; eauto using functions_transl. + intros (ofs' & P & Q). + left; econstructor; split. + (* execution *) + eapply plus_right'. eapply exec_straight_exec; eauto. + econstructor. eexact P. eapply functions_transl; eauto. eapply find_instr_tail. eexact Q. + simpl. reflexivity. + traceEq. + (* match states *) + econstructor; eauto. + apply agree_set_other; auto with asmgen. + Simpl. rewrite Z by (rewrite <- (ireg_of_eq _ _ EQ1); eauto with asmgen). assumption. ++ (* Direct call *) + exploit make_epilogue_correct; eauto. intros (rs1 & m1 & U & V & W & X & Y & Z). + exploit exec_straight_steps_2; eauto using functions_transl. + intros (ofs' & P & Q). + left; econstructor; split. + (* execution *) + eapply plus_right'. eapply exec_straight_exec; eauto. + econstructor. eexact P. eapply functions_transl; eauto. eapply find_instr_tail. eexact Q. + simpl. reflexivity. + traceEq. + (* match states *) + econstructor; eauto. + apply agree_set_other; auto with asmgen. + Simpl. unfold Genv.symbol_address. rewrite symbols_preserved. rewrite H. auto. + +- (* Mbuiltin *) + inv AT. monadInv H4. + exploit functions_transl; eauto. intro FN. + generalize (transf_function_no_overflow _ _ H3); intro NOOV. + exploit builtin_args_match; eauto. intros [vargs' [P Q]]. + exploit external_call_mem_extends; eauto. + intros [vres' [m2' [A [B [C D]]]]]. + left. econstructor; split. apply plus_one. + eapply exec_step_builtin. eauto. eauto. + eapply find_instr_tail; eauto. + erewrite <- sp_val by eauto. + eapply eval_builtin_args_preserved with (ge1 := ge); eauto. exact symbols_preserved. + eapply external_call_symbols_preserved; eauto. apply senv_preserved. + eauto. + econstructor; eauto. + instantiate (2 := tf); instantiate (1 := x). + unfold nextinstr. rewrite Pregmap.gss. + rewrite set_res_other. rewrite undef_regs_other. + rewrite <- H1. simpl. econstructor; eauto. + eapply code_tail_next_int; eauto. + simpl; intros. destruct H4. congruence. destruct H4. congruence. + exploit list_in_map_inv; eauto. intros (mr & U & V). subst. + auto with asmgen. + auto with asmgen. + apply agree_nextinstr. eapply agree_set_res; auto. + eapply agree_undef_regs; eauto. intros. + simpl. rewrite undef_regs_other_2; auto. Simpl. + congruence. + +- (* Mgoto *) + assert (f0 = f) by congruence. subst f0. + inv AT. monadInv H4. + exploit find_label_goto_label; eauto. intros [tc' [rs' [GOTO [AT2 INV]]]]. + left; exists (State rs' m'); split. + apply plus_one. econstructor; eauto. + eapply functions_transl; eauto. + eapply find_instr_tail; eauto. + simpl; eauto. + econstructor; eauto. + eapply agree_exten; eauto with asmgen. + congruence. + +- (* Mcond true *) + assert (f0 = f) by congruence. subst f0. + exploit eval_condition_lessdef. eapply preg_vals; eauto. eauto. eauto. intros EC. + left; eapply exec_straight_opt_steps_goto; eauto. + intros. simpl in TR. + exploit transl_cond_branch_correct; eauto. intros (rs' & jmp & A & B & C). + exists jmp; exists k; exists rs'. + split. eexact A. + split. apply agree_exten with rs0; auto with asmgen. + exact B. + +- (* Mcond false *) + exploit eval_condition_lessdef. eapply preg_vals; eauto. eauto. eauto. intros EC. + left; eapply exec_straight_steps; eauto. intros. simpl in TR. + exploit transl_cond_branch_correct; eauto. intros (rs' & jmp & A & B & C). + econstructor; split. + eapply exec_straight_opt_right. eexact A. apply exec_straight_one. eexact B. auto. + split. apply agree_exten with rs0; auto. intros. Simpl. + simpl; congruence. + +- (* Mjumptable *) + assert (f0 = f) by congruence. subst f0. + inv AT. monadInv H6. + exploit functions_transl; eauto. intro FN. + generalize (transf_function_no_overflow _ _ H5); intro NOOV. + exploit find_label_goto_label. eauto. eauto. + instantiate (2 := rs0#X16 <- Vundef). + Simpl. eauto. + eauto. + intros [tc' [rs' [A [B C]]]]. + exploit ireg_val; eauto. rewrite H. intros LD; inv LD. + left; econstructor; split. + apply plus_one. econstructor; eauto. + eapply find_instr_tail; eauto. + simpl. Simpl. rewrite <- H9. unfold Mach.label in H0; unfold label; rewrite H0. eexact A. + econstructor; eauto. + eapply agree_undef_regs; eauto. + simpl. intros. rewrite C; auto with asmgen. Simpl. + congruence. + +- (* Mreturn *) + assert (f0 = f) by congruence. subst f0. + inversion AT; subst. simpl in H6; monadInv H6. + assert (NOOV: list_length_z tf.(fn_code) <= Ptrofs.max_unsigned). + eapply transf_function_no_overflow; eauto. + exploit make_epilogue_correct; eauto. intros (rs1 & m1 & U & V & W & X & Y & Z). + exploit exec_straight_steps_2; eauto using functions_transl. + intros (ofs' & P & Q). + left; econstructor; split. + (* execution *) + eapply plus_right'. eapply exec_straight_exec; eauto. + econstructor. eexact P. eapply functions_transl; eauto. eapply find_instr_tail. eexact Q. + simpl. reflexivity. + traceEq. + (* match states *) + econstructor; eauto. + apply agree_set_other; auto with asmgen. + +- (* internal function *) + + exploit functions_translated; eauto. intros [tf [A B]]. monadInv B. + generalize EQ; intros EQ'. monadInv EQ'. + destruct (zlt Ptrofs.max_unsigned (list_length_z x0.(fn_code))); inversion EQ1. clear EQ1. subst x0. + unfold store_stack in *. + exploit Mem.alloc_extends. eauto. eauto. apply Z.le_refl. apply Z.le_refl. + intros [m1' [C D]]. + exploit Mem.storev_extends. eexact D. eexact H1. eauto. eauto. + intros [m2' [F G]]. + simpl chunk_of_type in F. + exploit Mem.storev_extends. eexact G. eexact H2. eauto. eauto. + intros [m3' [P Q]]. + change (chunk_of_type Tptr) with Mint64 in *. + (* Execution of function prologue *) + monadInv EQ0. rewrite transl_code'_transl_code in EQ1. + set (tfbody := Pallocframe (fn_stacksize f) (fn_link_ofs f) :: + storeptr RA XSP (fn_retaddr_ofs f) x0) in *. + set (tf := {| fn_sig := Mach.fn_sig f; fn_code := tfbody |}) in *. + set (rs2 := nextinstr (rs0#X29 <- (parent_sp s) #SP <- sp #X16 <- Vundef)). + exploit (storeptr_correct tge tf XSP (fn_retaddr_ofs f) RA x0 m2' m3' rs2). + simpl preg_of_iregsp. change (rs2 X30) with (rs0 X30). rewrite ATLR. + change (rs2 X2) with sp. eexact P. + simpl; congruence. congruence. + intros (rs3 & U & V). + assert (EXEC_PROLOGUE: + exec_straight tge tf + tf.(fn_code) rs0 m' + x0 rs3 m3'). + { change (fn_code tf) with tfbody; unfold tfbody. + apply exec_straight_step with rs2 m2'. + unfold exec_instr. rewrite C. fold sp. + rewrite <- (sp_val _ _ _ AG). rewrite F. reflexivity. + reflexivity. + eexact U. } + exploit exec_straight_steps_2; eauto using functions_transl. lia. constructor. + intros (ofs' & X & Y). + left; exists (State rs3 m3'); split. + eapply exec_straight_steps_1; eauto. lia. constructor. + econstructor; eauto. + rewrite X; econstructor; eauto. + apply agree_exten with rs2; eauto with asmgen. + unfold rs2. + apply agree_nextinstr. apply agree_set_other; auto with asmgen. + apply agree_change_sp with (parent_sp s). + apply agree_undef_regs with rs0. auto. +Local Transparent destroyed_at_function_entry. simpl. + simpl; intros; Simpl. + unfold sp; congruence. + intros. rewrite V by auto with asmgen. reflexivity. + +- (* external function *) + exploit functions_translated; eauto. + intros [tf [A B]]. simpl in B. inv B. + exploit extcall_arguments_match; eauto. + intros [args' [C D]]. + exploit external_call_mem_extends; eauto. + intros [res' [m2' [P [Q [R S]]]]]. + left; econstructor; split. + apply plus_one. eapply exec_step_external; eauto. + eapply external_call_symbols_preserved; eauto. apply senv_preserved. + econstructor; eauto. + unfold loc_external_result. apply agree_set_other; auto. apply agree_set_pair; auto. + apply agree_undef_caller_save_regs; auto. + +- (* return *) + inv STACKS. simpl in *. + right. split. lia. split. auto. + rewrite <- ATPC in H5. + econstructor; eauto. congruence. +>>>>>>> master Qed. Lemma undef_regs_other_2: diff --git a/aarch64/TO_MERGE/Asmgenproof1.v b/aarch64/TO_MERGE/Asmgenproof1.v new file mode 100644 index 00000000..93c1f1ed --- /dev/null +++ b/aarch64/TO_MERGE/Asmgenproof1.v @@ -0,0 +1,1836 @@ +(* *********************************************************************) +(* *) +(* The Compcert verified compiler *) +(* *) +(* Xavier Leroy, Collège de France and INRIA Paris *) +(* *) +(* Copyright Institut National de Recherche en Informatique et en *) +(* Automatique. All rights reserved. This file is distributed *) +(* under the terms of the INRIA Non-Commercial License Agreement. *) +(* *) +(* *********************************************************************) + +(** Correctness proof for AArch64 code generation: auxiliary results. *) + +Require Import Recdef Coqlib Zwf Zbits. +Require Import Maps Errors AST Integers Floats Values Memory Globalenvs. +Require Import Op Locations Mach Asm Conventions. +Require Import Asmgen. +Require Import Asmgenproof0. + +Local Transparent Archi.ptr64. + +(** Properties of registers *) + +Lemma preg_of_iregsp_not_PC: forall r, preg_of_iregsp r <> PC. +Proof. + destruct r; simpl; congruence. +Qed. +Global Hint Resolve preg_of_iregsp_not_PC: asmgen. + +Lemma preg_of_not_X16: forall r, preg_of r <> X16. +Proof. + destruct r; simpl; congruence. +Qed. + +Lemma ireg_of_not_X16: forall r x, ireg_of r = OK x -> x <> X16. +Proof. + unfold ireg_of; intros. destruct (preg_of r) eqn:E; inv H. + red; intros; subst x. elim (preg_of_not_X16 r); auto. +Qed. + +Lemma ireg_of_not_X16': forall r x, ireg_of r = OK x -> IR x <> IR X16. +Proof. + intros. apply ireg_of_not_X16 in H. congruence. +Qed. + +Global Hint Resolve preg_of_not_X16 ireg_of_not_X16 ireg_of_not_X16': asmgen. + +(** Useful simplification tactic *) + + +Ltac Simplif := + ((rewrite nextinstr_inv by eauto with asmgen) + || (rewrite nextinstr_inv1 by eauto with asmgen) + || (rewrite Pregmap.gss) + || (rewrite nextinstr_pc) + || (rewrite Pregmap.gso by eauto with asmgen)); auto with asmgen. + +Ltac Simpl := repeat Simplif. + +(** * Correctness of ARM constructor functions *) + +Section CONSTRUCTORS. + +Variable ge: genv. +Variable fn: function. + +(** Decomposition of integer literals *) + +Inductive wf_decomposition: list (Z * Z) -> Prop := + | wf_decomp_nil: + wf_decomposition nil + | wf_decomp_cons: forall m n p l, + n = Zzero_ext 16 m -> 0 <= p -> wf_decomposition l -> + wf_decomposition ((n, p) :: l). + +Lemma decompose_int_wf: + forall N n p, 0 <= p -> wf_decomposition (decompose_int N n p). +Proof. +Local Opaque Zzero_ext. + induction N as [ | N]; simpl; intros. +- constructor. +- set (frag := Zzero_ext 16 (Z.shiftr n p)) in *. destruct (Z.eqb frag 0). ++ apply IHN. lia. ++ econstructor. reflexivity. lia. apply IHN; lia. +Qed. + +Fixpoint recompose_int (accu: Z) (l: list (Z * Z)) : Z := + match l with + | nil => accu + | (n, p) :: l => recompose_int (Zinsert accu n p 16) l + end. + +Lemma decompose_int_correct: + forall N n p accu, + 0 <= p -> + (forall i, p <= i -> Z.testbit accu i = false) -> + (forall i, 0 <= i < p + Z.of_nat N * 16 -> + Z.testbit (recompose_int accu (decompose_int N n p)) i = + if zlt i p then Z.testbit accu i else Z.testbit n i). +Proof. + induction N as [ | N]; intros until accu; intros PPOS ABOVE i RANGE. +- simpl. rewrite zlt_true; auto. extlia. +- rewrite inj_S in RANGE. simpl. + set (frag := Zzero_ext 16 (Z.shiftr n p)). + assert (FRAG: forall i, p <= i < p + 16 -> Z.testbit n i = Z.testbit frag (i - p)). + { unfold frag; intros. rewrite Zzero_ext_spec by lia. rewrite zlt_true by lia. + rewrite Z.shiftr_spec by lia. f_equal; lia. } + destruct (Z.eqb_spec frag 0). ++ rewrite IHN. +* destruct (zlt i p). rewrite zlt_true by lia. auto. + destruct (zlt i (p + 16)); auto. + rewrite ABOVE by lia. rewrite FRAG by lia. rewrite e, Z.testbit_0_l. auto. +* lia. +* intros; apply ABOVE; lia. +* extlia. ++ simpl. rewrite IHN. +* destruct (zlt i (p + 16)). +** rewrite Zinsert_spec by lia. unfold proj_sumbool. + rewrite zlt_true by lia. + destruct (zlt i p). + rewrite zle_false by lia. auto. + rewrite zle_true by lia. simpl. symmetry; apply FRAG; lia. +** rewrite Z.ldiff_spec, Z.shiftl_spec by lia. + change 65535 with (two_p 16 - 1). rewrite Ztestbit_two_p_m1 by lia. + rewrite zlt_false by lia. rewrite zlt_false by lia. apply andb_true_r. +* lia. +* intros. rewrite Zinsert_spec by lia. unfold proj_sumbool. + rewrite zle_true by lia. rewrite zlt_false by lia. simpl. + apply ABOVE. lia. +* extlia. +Qed. + +Corollary decompose_int_eqmod: forall N n, + eqmod (two_power_nat (N * 16)%nat) (recompose_int 0 (decompose_int N n 0)) n. +Proof. + intros; apply eqmod_same_bits; intros. + rewrite decompose_int_correct. apply zlt_false; lia. + lia. intros; apply Z.testbit_0_l. extlia. +Qed. + +Corollary decompose_notint_eqmod: forall N n, + eqmod (two_power_nat (N * 16)%nat) + (Z.lnot (recompose_int 0 (decompose_int N (Z.lnot n) 0))) n. +Proof. + intros; apply eqmod_same_bits; intros. + rewrite Z.lnot_spec, decompose_int_correct. + rewrite zlt_false by lia. rewrite Z.lnot_spec by lia. apply negb_involutive. + lia. intros; apply Z.testbit_0_l. extlia. lia. +Qed. + +Lemma negate_decomposition_wf: + forall l, wf_decomposition l -> wf_decomposition (negate_decomposition l). +Proof. + induction 1; simpl; econstructor; auto. + instantiate (1 := (Z.lnot m)). + apply equal_same_bits; intros. + rewrite H. change 65535 with (two_p 16 - 1). + rewrite Z.lxor_spec, !Zzero_ext_spec, Z.lnot_spec, Ztestbit_two_p_m1 by lia. + destruct (zlt i 16). + apply xorb_true_r. + auto. +Qed. + +Lemma Zinsert_eqmod: + forall n x1 x2 y p l, 0 <= p -> 0 <= l -> + eqmod (two_power_nat n) x1 x2 -> + eqmod (two_power_nat n) (Zinsert x1 y p l) (Zinsert x2 y p l). +Proof. + intros. apply eqmod_same_bits; intros. rewrite ! Zinsert_spec by lia. + destruct (zle p i && zlt i (p + l)); auto. + apply same_bits_eqmod with n; auto. +Qed. + +Lemma Zinsert_0_l: + forall y p l, + 0 <= p -> 0 <= l -> + Z.shiftl (Zzero_ext l y) p = Zinsert 0 (Zzero_ext l y) p l. +Proof. + intros. apply equal_same_bits; intros. + rewrite Zinsert_spec by lia. unfold proj_sumbool. + destruct (zlt i p); [rewrite zle_false by lia|rewrite zle_true by lia]; simpl. +- rewrite Z.testbit_0_l, Z.shiftl_spec_low by auto. auto. +- rewrite Z.shiftl_spec by lia. + destruct (zlt i (p + l)); auto. + rewrite Zzero_ext_spec, zlt_false, Z.testbit_0_l by lia. auto. +Qed. + +Lemma recompose_int_negated: + forall l, wf_decomposition l -> + forall accu, recompose_int (Z.lnot accu) (negate_decomposition l) = Z.lnot (recompose_int accu l). +Proof. + induction 1; intros accu; simpl. +- auto. +- rewrite <- IHwf_decomposition. f_equal. apply equal_same_bits; intros. + rewrite Z.lnot_spec, ! Zinsert_spec, Z.lxor_spec, Z.lnot_spec by lia. + unfold proj_sumbool. + destruct (zle p i); simpl; auto. + destruct (zlt i (p + 16)); simpl; auto. + change 65535 with (two_p 16 - 1). + rewrite Ztestbit_two_p_m1 by lia. rewrite zlt_true by lia. + apply xorb_true_r. +Qed. + +Lemma exec_loadimm_k_w: + forall (rd: ireg) k m l, + wf_decomposition l -> + forall (rs: regset) accu, + rs#rd = Vint (Int.repr accu) -> + exists rs', + exec_straight_opt ge fn (loadimm_k W rd l k) rs m k rs' m + /\ rs'#rd = Vint (Int.repr (recompose_int accu l)) + /\ forall r, r <> PC -> r <> rd -> rs'#r = rs#r. +Proof. + induction 1; intros rs accu ACCU; simpl. +- exists rs; split. apply exec_straight_opt_refl. auto. +- destruct (IHwf_decomposition + (nextinstr (rs#rd <- (insert_in_int rs#rd n p 16))) + (Zinsert accu n p 16)) + as (rs' & P & Q & R). + Simpl. rewrite ACCU. simpl. f_equal. apply Int.eqm_samerepr. + apply Zinsert_eqmod. auto. lia. apply Int.eqm_sym; apply Int.eqm_unsigned_repr. + exists rs'; split. + eapply exec_straight_opt_step_opt. simpl; eauto. auto. exact P. + split. exact Q. intros; Simpl. rewrite R by auto. Simpl. +Qed. + +Lemma exec_loadimm_z_w: + forall rd l k rs m, + wf_decomposition l -> + exists rs', + exec_straight ge fn (loadimm_z W rd l k) rs m k rs' m + /\ rs'#rd = Vint (Int.repr (recompose_int 0 l)) + /\ forall r, r <> PC -> r <> rd -> rs'#r = rs#r. +Proof. + unfold loadimm_z; destruct 1. +- econstructor; split. + apply exec_straight_one. simpl; eauto. auto. + split. Simpl. + intros; Simpl. +- set (accu0 := Zinsert 0 n p 16). + set (rs1 := nextinstr (rs#rd <- (Vint (Int.repr accu0)))). + destruct (exec_loadimm_k_w rd k m l H1 rs1 accu0) as (rs2 & P & Q & R); auto. + unfold rs1; Simpl. + exists rs2; split. + eapply exec_straight_opt_step; eauto. + simpl. unfold rs1. do 5 f_equal. unfold accu0. rewrite H. apply Zinsert_0_l; lia. + reflexivity. + split. exact Q. + intros. rewrite R by auto. unfold rs1; Simpl. +Qed. + +Lemma exec_loadimm_n_w: + forall rd l k rs m, + wf_decomposition l -> + exists rs', + exec_straight ge fn (loadimm_n W rd l k) rs m k rs' m + /\ rs'#rd = Vint (Int.repr (Z.lnot (recompose_int 0 l))) + /\ forall r, r <> PC -> r <> rd -> rs'#r = rs#r. +Proof. + unfold loadimm_n; destruct 1. +- econstructor; split. + apply exec_straight_one. simpl; eauto. auto. + split. Simpl. + intros; Simpl. +- set (accu0 := Z.lnot (Zinsert 0 n p 16)). + set (rs1 := nextinstr (rs#rd <- (Vint (Int.repr accu0)))). + destruct (exec_loadimm_k_w rd k m (negate_decomposition l) + (negate_decomposition_wf l H1) + rs1 accu0) as (rs2 & P & Q & R). + unfold rs1; Simpl. + exists rs2; split. + eapply exec_straight_opt_step; eauto. + simpl. unfold rs1. do 5 f_equal. + unfold accu0. f_equal. rewrite H. apply Zinsert_0_l; lia. + reflexivity. + split. unfold accu0 in Q; rewrite recompose_int_negated in Q by auto. exact Q. + intros. rewrite R by auto. unfold rs1; Simpl. +Qed. + +Lemma exec_loadimm32: + forall rd n k rs m, + exists rs', + exec_straight ge fn (loadimm32 rd n k) rs m k rs' m + /\ rs'#rd = Vint n + /\ forall r, r <> PC -> r <> rd -> rs'#r = rs#r. +Proof. + unfold loadimm32, loadimm; intros. + destruct (is_logical_imm32 n). +- econstructor; split. + apply exec_straight_one. simpl; eauto. auto. + split. Simpl. rewrite Int.repr_unsigned, Int.or_zero_l; auto. + intros; Simpl. +- set (dz := decompose_int 2%nat (Int.unsigned n) 0). + set (dn := decompose_int 2%nat (Z.lnot (Int.unsigned n)) 0). + assert (A: Int.repr (recompose_int 0 dz) = n). + { transitivity (Int.repr (Int.unsigned n)). + apply Int.eqm_samerepr. apply decompose_int_eqmod. + apply Int.repr_unsigned. } + assert (B: Int.repr (Z.lnot (recompose_int 0 dn)) = n). + { transitivity (Int.repr (Int.unsigned n)). + apply Int.eqm_samerepr. apply decompose_notint_eqmod. + apply Int.repr_unsigned. } + destruct Nat.leb. ++ rewrite <- A. apply exec_loadimm_z_w. apply decompose_int_wf; lia. ++ rewrite <- B. apply exec_loadimm_n_w. apply decompose_int_wf; lia. +Qed. + +Lemma exec_loadimm_k_x: + forall (rd: ireg) k m l, + wf_decomposition l -> + forall (rs: regset) accu, + rs#rd = Vlong (Int64.repr accu) -> + exists rs', + exec_straight_opt ge fn (loadimm_k X rd l k) rs m k rs' m + /\ rs'#rd = Vlong (Int64.repr (recompose_int accu l)) + /\ forall r, r <> PC -> r <> rd -> rs'#r = rs#r. +Proof. + induction 1; intros rs accu ACCU; simpl. +- exists rs; split. apply exec_straight_opt_refl. auto. +- destruct (IHwf_decomposition + (nextinstr (rs#rd <- (insert_in_long rs#rd n p 16))) + (Zinsert accu n p 16)) + as (rs' & P & Q & R). + Simpl. rewrite ACCU. simpl. f_equal. apply Int64.eqm_samerepr. + apply Zinsert_eqmod. auto. lia. apply Int64.eqm_sym; apply Int64.eqm_unsigned_repr. + exists rs'; split. + eapply exec_straight_opt_step_opt. simpl; eauto. auto. exact P. + split. exact Q. intros; Simpl. rewrite R by auto. Simpl. +Qed. + +Lemma exec_loadimm_z_x: + forall rd l k rs m, + wf_decomposition l -> + exists rs', + exec_straight ge fn (loadimm_z X rd l k) rs m k rs' m + /\ rs'#rd = Vlong (Int64.repr (recompose_int 0 l)) + /\ forall r, r <> PC -> r <> rd -> rs'#r = rs#r. +Proof. + unfold loadimm_z; destruct 1. +- econstructor; split. + apply exec_straight_one. simpl; eauto. auto. + split. Simpl. + intros; Simpl. +- set (accu0 := Zinsert 0 n p 16). + set (rs1 := nextinstr (rs#rd <- (Vlong (Int64.repr accu0)))). + destruct (exec_loadimm_k_x rd k m l H1 rs1 accu0) as (rs2 & P & Q & R); auto. + unfold rs1; Simpl. + exists rs2; split. + eapply exec_straight_opt_step; eauto. + simpl. unfold rs1. do 5 f_equal. unfold accu0. rewrite H. apply Zinsert_0_l; lia. + reflexivity. + split. exact Q. + intros. rewrite R by auto. unfold rs1; Simpl. +Qed. + +Lemma exec_loadimm_n_x: + forall rd l k rs m, + wf_decomposition l -> + exists rs', + exec_straight ge fn (loadimm_n X rd l k) rs m k rs' m + /\ rs'#rd = Vlong (Int64.repr (Z.lnot (recompose_int 0 l))) + /\ forall r, r <> PC -> r <> rd -> rs'#r = rs#r. +Proof. + unfold loadimm_n; destruct 1. +- econstructor; split. + apply exec_straight_one. simpl; eauto. auto. + split. Simpl. + intros; Simpl. +- set (accu0 := Z.lnot (Zinsert 0 n p 16)). + set (rs1 := nextinstr (rs#rd <- (Vlong (Int64.repr accu0)))). + destruct (exec_loadimm_k_x rd k m (negate_decomposition l) + (negate_decomposition_wf l H1) + rs1 accu0) as (rs2 & P & Q & R). + unfold rs1; Simpl. + exists rs2; split. + eapply exec_straight_opt_step; eauto. + simpl. unfold rs1. do 5 f_equal. + unfold accu0. f_equal. rewrite H. apply Zinsert_0_l; lia. + reflexivity. + split. unfold accu0 in Q; rewrite recompose_int_negated in Q by auto. exact Q. + intros. rewrite R by auto. unfold rs1; Simpl. +Qed. + +Lemma exec_loadimm64: + forall rd n k rs m, + exists rs', + exec_straight ge fn (loadimm64 rd n k) rs m k rs' m + /\ rs'#rd = Vlong n + /\ forall r, r <> PC -> r <> rd -> rs'#r = rs#r. +Proof. + unfold loadimm64, loadimm; intros. + destruct (is_logical_imm64 n). +- econstructor; split. + apply exec_straight_one. simpl; eauto. auto. + split. Simpl. rewrite Int64.repr_unsigned, Int64.or_zero_l; auto. + intros; Simpl. +- set (dz := decompose_int 4%nat (Int64.unsigned n) 0). + set (dn := decompose_int 4%nat (Z.lnot (Int64.unsigned n)) 0). + assert (A: Int64.repr (recompose_int 0 dz) = n). + { transitivity (Int64.repr (Int64.unsigned n)). + apply Int64.eqm_samerepr. apply decompose_int_eqmod. + apply Int64.repr_unsigned. } + assert (B: Int64.repr (Z.lnot (recompose_int 0 dn)) = n). + { transitivity (Int64.repr (Int64.unsigned n)). + apply Int64.eqm_samerepr. apply decompose_notint_eqmod. + apply Int64.repr_unsigned. } + destruct Nat.leb. ++ rewrite <- A. apply exec_loadimm_z_x. apply decompose_int_wf; lia. ++ rewrite <- B. apply exec_loadimm_n_x. apply decompose_int_wf; lia. +Qed. + +(** Add immediate *) + +Lemma exec_addimm_aux_32: + forall (insn: iregsp -> iregsp -> Z -> instruction) (sem: val -> val -> val), + (forall rd r1 n rs m, + exec_instr ge fn (insn rd r1 n) rs m = + Next (nextinstr (rs#rd <- (sem rs#r1 (Vint (Int.repr n))))) m) -> + (forall v n1 n2, sem (sem v (Vint n1)) (Vint n2) = sem v (Vint (Int.add n1 n2))) -> + forall rd r1 n k rs m, + exists rs', + exec_straight ge fn (addimm_aux insn rd r1 (Int.unsigned n) k) rs m k rs' m + /\ rs'#rd = sem rs#r1 (Vint n) + /\ forall r, data_preg r = true -> r <> rd -> rs'#r = rs#r. +Proof. + intros insn sem SEM ASSOC; intros. unfold addimm_aux. + set (nlo := Zzero_ext 12 (Int.unsigned n)). set (nhi := Int.unsigned n - nlo). + assert (E: Int.unsigned n = nhi + nlo) by (unfold nhi; lia). + rewrite <- (Int.repr_unsigned n). + destruct (Z.eqb_spec nhi 0); [|destruct (Z.eqb_spec nlo 0)]. +- econstructor; split. apply exec_straight_one. apply SEM. Simpl. + split. Simpl. do 3 f_equal; lia. + intros; Simpl. +- econstructor; split. apply exec_straight_one. apply SEM. Simpl. + split. Simpl. do 3 f_equal; lia. + intros; Simpl. +- econstructor; split. eapply exec_straight_two. + apply SEM. apply SEM. Simpl. Simpl. + split. Simpl. rewrite ASSOC. do 2 f_equal. apply Int.eqm_samerepr. + rewrite E. auto with ints. + intros; Simpl. +Qed. + +Lemma exec_addimm32: + forall rd r1 n k rs m, + r1 <> X16 -> + exists rs', + exec_straight ge fn (addimm32 rd r1 n k) rs m k rs' m + /\ rs'#rd = Val.add rs#r1 (Vint n) + /\ forall r, data_preg r = true -> r <> rd -> rs'#r = rs#r. +Proof. + intros. unfold addimm32. set (nn := Int.neg n). + destruct (Int.eq n (Int.zero_ext 24 n)); [| destruct (Int.eq nn (Int.zero_ext 24 nn))]. +- apply exec_addimm_aux_32 with (sem := Val.add). auto. intros; apply Val.add_assoc. +- rewrite <- Val.sub_opp_add. + apply exec_addimm_aux_32 with (sem := Val.sub). auto. + intros. rewrite ! Val.sub_add_opp, Val.add_assoc. rewrite Int.neg_add_distr. auto. +- destruct (Int.lt n Int.zero). ++ rewrite <- Val.sub_opp_add; fold nn. + edestruct (exec_loadimm32 X16 nn) as (rs1 & A & B & C). + econstructor; split. + eapply exec_straight_trans. eexact A. eapply exec_straight_one. simpl; eauto. auto. + split. Simpl. rewrite B, C; eauto with asmgen. + intros; Simpl. ++ edestruct (exec_loadimm32 X16 n) as (rs1 & A & B & C). + econstructor; split. + eapply exec_straight_trans. eexact A. eapply exec_straight_one. simpl; eauto. auto. + split. Simpl. rewrite B, C; eauto with asmgen. + intros; Simpl. +Qed. + +Lemma exec_addimm_aux_64: + forall (insn: iregsp -> iregsp -> Z -> instruction) (sem: val -> val -> val), + (forall rd r1 n rs m, + exec_instr ge fn (insn rd r1 n) rs m = + Next (nextinstr (rs#rd <- (sem rs#r1 (Vlong (Int64.repr n))))) m) -> + (forall v n1 n2, sem (sem v (Vlong n1)) (Vlong n2) = sem v (Vlong (Int64.add n1 n2))) -> + forall rd r1 n k rs m, + exists rs', + exec_straight ge fn (addimm_aux insn rd r1 (Int64.unsigned n) k) rs m k rs' m + /\ rs'#rd = sem rs#r1 (Vlong n) + /\ forall r, data_preg r = true -> r <> rd -> rs'#r = rs#r. +Proof. + intros insn sem SEM ASSOC; intros. unfold addimm_aux. + set (nlo := Zzero_ext 12 (Int64.unsigned n)). set (nhi := Int64.unsigned n - nlo). + assert (E: Int64.unsigned n = nhi + nlo) by (unfold nhi; lia). + rewrite <- (Int64.repr_unsigned n). + destruct (Z.eqb_spec nhi 0); [|destruct (Z.eqb_spec nlo 0)]. +- econstructor; split. apply exec_straight_one. apply SEM. Simpl. + split. Simpl. do 3 f_equal; lia. + intros; Simpl. +- econstructor; split. apply exec_straight_one. apply SEM. Simpl. + split. Simpl. do 3 f_equal; lia. + intros; Simpl. +- econstructor; split. eapply exec_straight_two. + apply SEM. apply SEM. Simpl. Simpl. + split. Simpl. rewrite ASSOC. do 2 f_equal. apply Int64.eqm_samerepr. + rewrite E. auto with ints. + intros; Simpl. +Qed. + +Lemma exec_addimm64: + forall rd r1 n k rs m, + preg_of_iregsp r1 <> X16 -> + exists rs', + exec_straight ge fn (addimm64 rd r1 n k) rs m k rs' m + /\ rs'#rd = Val.addl rs#r1 (Vlong n) + /\ forall r, data_preg r = true -> r <> rd -> rs'#r = rs#r. +Proof. + intros. + unfold addimm64. set (nn := Int64.neg n). + destruct (Int64.eq n (Int64.zero_ext 24 n)); [| destruct (Int64.eq nn (Int64.zero_ext 24 nn))]. +- apply exec_addimm_aux_64 with (sem := Val.addl). auto. intros; apply Val.addl_assoc. +- rewrite <- Val.subl_opp_addl. + apply exec_addimm_aux_64 with (sem := Val.subl). auto. + intros. rewrite ! Val.subl_addl_opp, Val.addl_assoc. rewrite Int64.neg_add_distr. auto. +- destruct (Int64.lt n Int64.zero). ++ rewrite <- Val.subl_opp_addl; fold nn. + edestruct (exec_loadimm64 X16 nn) as (rs1 & A & B & C). + econstructor; split. + eapply exec_straight_trans. eexact A. eapply exec_straight_one. simpl; eauto. Simpl. + split. Simpl. rewrite B, C; eauto with asmgen. simpl. rewrite Int64.shl'_zero. auto. + intros; Simpl. ++ edestruct (exec_loadimm64 X16 n) as (rs1 & A & B & C). + econstructor; split. + eapply exec_straight_trans. eexact A. eapply exec_straight_one. simpl; eauto. Simpl. + split. Simpl. rewrite B, C; eauto with asmgen. simpl. rewrite Int64.shl'_zero. auto. + intros; Simpl. +Qed. + +(** Logical immediate *) + +Lemma exec_logicalimm32: + forall (insn1: ireg -> ireg0 -> Z -> instruction) + (insn2: ireg -> ireg0 -> ireg -> shift_op -> instruction) + (sem: val -> val -> val), + (forall rd r1 n rs m, + exec_instr ge fn (insn1 rd r1 n) rs m = + Next (nextinstr (rs#rd <- (sem rs##r1 (Vint (Int.repr n))))) m) -> + (forall rd r1 r2 s rs m, + exec_instr ge fn (insn2 rd r1 r2 s) rs m = + Next (nextinstr (rs#rd <- (sem rs##r1 (eval_shift_op_int rs#r2 s)))) m) -> + forall rd r1 n k rs m, + r1 <> X16 -> + exists rs', + exec_straight ge fn (logicalimm32 insn1 insn2 rd r1 n k) rs m k rs' m + /\ rs'#rd = sem rs#r1 (Vint n) + /\ forall r, data_preg r = true -> r <> rd -> rs'#r = rs#r. +Proof. + intros until sem; intros SEM1 SEM2; intros. unfold logicalimm32. + destruct (is_logical_imm32 n). +- econstructor; split. + apply exec_straight_one. apply SEM1. reflexivity. + split. Simpl. rewrite Int.repr_unsigned; auto. intros; Simpl. +- edestruct (exec_loadimm32 X16 n) as (rs1 & A & B & C). + econstructor; split. + eapply exec_straight_trans. eexact A. + apply exec_straight_one. apply SEM2. reflexivity. + split. Simpl. f_equal; auto. apply C; auto with asmgen. + intros; Simpl. +Qed. + +Lemma exec_logicalimm64: + forall (insn1: ireg -> ireg0 -> Z -> instruction) + (insn2: ireg -> ireg0 -> ireg -> shift_op -> instruction) + (sem: val -> val -> val), + (forall rd r1 n rs m, + exec_instr ge fn (insn1 rd r1 n) rs m = + Next (nextinstr (rs#rd <- (sem rs###r1 (Vlong (Int64.repr n))))) m) -> + (forall rd r1 r2 s rs m, + exec_instr ge fn (insn2 rd r1 r2 s) rs m = + Next (nextinstr (rs#rd <- (sem rs###r1 (eval_shift_op_long rs#r2 s)))) m) -> + forall rd r1 n k rs m, + r1 <> X16 -> + exists rs', + exec_straight ge fn (logicalimm64 insn1 insn2 rd r1 n k) rs m k rs' m + /\ rs'#rd = sem rs#r1 (Vlong n) + /\ forall r, data_preg r = true -> r <> rd -> rs'#r = rs#r. +Proof. + intros until sem; intros SEM1 SEM2; intros. unfold logicalimm64. + destruct (is_logical_imm64 n). +- econstructor; split. + apply exec_straight_one. apply SEM1. reflexivity. + split. Simpl. rewrite Int64.repr_unsigned. auto. intros; Simpl. +- edestruct (exec_loadimm64 X16 n) as (rs1 & A & B & C). + econstructor; split. + eapply exec_straight_trans. eexact A. + apply exec_straight_one. apply SEM2. reflexivity. + split. Simpl. f_equal; auto. apply C; auto with asmgen. + intros; Simpl. +Qed. + +(** Load address of symbol *) + +Lemma exec_loadsymbol: forall rd s ofs k rs m, + rd <> X16 \/ SelectOp.symbol_is_relocatable s = false -> + exists rs', + exec_straight ge fn (loadsymbol rd s ofs k) rs m k rs' m + /\ rs'#rd = Genv.symbol_address ge s ofs + /\ forall r, data_preg r = true -> r <> rd -> rs'#r = rs#r. +Proof. + unfold loadsymbol; intros. destruct (SelectOp.symbol_is_relocatable s). +- predSpec Ptrofs.eq Ptrofs.eq_spec ofs Ptrofs.zero. ++ subst ofs. econstructor; split. + apply exec_straight_one; [simpl; eauto | reflexivity]. + split. Simpl. intros; Simpl. ++ exploit exec_addimm64. instantiate (1 := rd). simpl. destruct H; congruence. + intros (rs1 & A & B & C). + econstructor; split. + econstructor. simpl; eauto. auto. eexact A. + split. simpl in B; rewrite B. Simpl. + rewrite <- Genv.shift_symbol_address_64 by auto. + rewrite Ptrofs.add_zero_l, Ptrofs.of_int64_to_int64 by auto. auto. + intros. rewrite C by auto. Simpl. +- econstructor; split. + eapply exec_straight_two. simpl; eauto. simpl; eauto. auto. auto. + split. Simpl. rewrite symbol_high_low; auto. + intros; Simpl. +Qed. + +(** Shifted operands *) + +Remark transl_shift_not_none: + forall s a, transl_shift s a <> SOnone. +Proof. + destruct s; intros; simpl; congruence. +Qed. + +Remark or_zero_eval_shift_op_int: + forall v s, s <> SOnone -> Val.or (Vint Int.zero) (eval_shift_op_int v s) = eval_shift_op_int v s. +Proof. + intros; destruct s; try congruence; destruct v; auto; simpl; + destruct (Int.ltu n Int.iwordsize); auto; rewrite Int.or_zero_l; auto. +Qed. + +Remark or_zero_eval_shift_op_long: + forall v s, s <> SOnone -> Val.orl (Vlong Int64.zero) (eval_shift_op_long v s) = eval_shift_op_long v s. +Proof. + intros; destruct s; try congruence; destruct v; auto; simpl; + destruct (Int.ltu n Int64.iwordsize'); auto; rewrite Int64.or_zero_l; auto. +Qed. + +Remark add_zero_eval_shift_op_long: + forall v s, s <> SOnone -> Val.addl (Vlong Int64.zero) (eval_shift_op_long v s) = eval_shift_op_long v s. +Proof. + intros; destruct s; try congruence; destruct v; auto; simpl; + destruct (Int.ltu n Int64.iwordsize'); auto; rewrite Int64.add_zero_l; auto. +Qed. + +Lemma transl_eval_shift: forall s v (a: amount32), + eval_shift_op_int v (transl_shift s a) = eval_shift s v a. +Proof. + intros. destruct s; simpl; auto. +Qed. + +Lemma transl_eval_shift': forall s v (a: amount32), + Val.or (Vint Int.zero) (eval_shift_op_int v (transl_shift s a)) = eval_shift s v a. +Proof. + intros. rewrite or_zero_eval_shift_op_int by (apply transl_shift_not_none). + apply transl_eval_shift. +Qed. + +Lemma transl_eval_shiftl: forall s v (a: amount64), + eval_shift_op_long v (transl_shift s a) = eval_shiftl s v a. +Proof. + intros. destruct s; simpl; auto. +Qed. + +Lemma transl_eval_shiftl': forall s v (a: amount64), + Val.orl (Vlong Int64.zero) (eval_shift_op_long v (transl_shift s a)) = eval_shiftl s v a. +Proof. + intros. rewrite or_zero_eval_shift_op_long by (apply transl_shift_not_none). + apply transl_eval_shiftl. +Qed. + +Lemma transl_eval_shiftl'': forall s v (a: amount64), + Val.addl (Vlong Int64.zero) (eval_shift_op_long v (transl_shift s a)) = eval_shiftl s v a. +Proof. + intros. rewrite add_zero_eval_shift_op_long by (apply transl_shift_not_none). + apply transl_eval_shiftl. +Qed. + +(** Zero- and Sign- extensions *) + +Lemma exec_move_extended_base: forall rd r1 ex k rs m, + exists rs', + exec_straight ge fn (move_extended_base rd r1 ex k) rs m k rs' m + /\ rs' rd = match ex with Xsgn32 => Val.longofint rs#r1 | Xuns32 => Val.longofintu rs#r1 end + /\ forall r, r <> PC -> r <> rd -> rs'#r = rs#r. +Proof. + unfold move_extended_base; destruct ex; econstructor; + (split; [apply exec_straight_one; [simpl;eauto|auto] | split; [Simpl|intros;Simpl]]). +Qed. + +Lemma exec_move_extended: forall rd r1 ex (a: amount64) k rs m, + exists rs', + exec_straight ge fn (move_extended rd r1 ex a k) rs m k rs' m + /\ rs' rd = Op.eval_extend ex rs#r1 a + /\ forall r, r <> PC -> r <> rd -> rs'#r = rs#r. +Proof. + unfold move_extended; intros. predSpec Int.eq Int.eq_spec a Int.zero. +- exploit (exec_move_extended_base rd r1 ex). intros (rs' & A & B & C). + exists rs'; split. eexact A. split. unfold Op.eval_extend. rewrite H. rewrite B. + destruct ex, (rs r1); simpl; auto; rewrite Int64.shl'_zero; auto. + auto. +- Local Opaque Val.addl. + exploit (exec_move_extended_base rd r1 ex). intros (rs' & A & B & C). + econstructor; split. + eapply exec_straight_trans. eexact A. apply exec_straight_one. + unfold exec_instr. change (SOlsl a) with (transl_shift Slsl a). rewrite transl_eval_shiftl''. eauto. auto. + split. Simpl. rewrite B. auto. + intros; Simpl. +Qed. + +Lemma exec_arith_extended: + forall (sem: val -> val -> val) + (insnX: iregsp -> iregsp -> ireg -> extend_op -> instruction) + (insnS: ireg -> ireg0 -> ireg -> shift_op -> instruction), + (forall rd r1 r2 x rs m, + exec_instr ge fn (insnX rd r1 r2 x) rs m = + Next (nextinstr (rs#rd <- (sem rs#r1 (eval_extend rs#r2 x)))) m) -> + (forall rd r1 r2 s rs m, + exec_instr ge fn (insnS rd r1 r2 s) rs m = + Next (nextinstr (rs#rd <- (sem rs###r1 (eval_shift_op_long rs#r2 s)))) m) -> + forall (rd r1 r2: ireg) (ex: extension) (a: amount64) (k: code) rs m, + r1 <> X16 -> + exists rs', + exec_straight ge fn (arith_extended insnX insnS rd r1 r2 ex a k) rs m k rs' m + /\ rs'#rd = sem rs#r1 (Op.eval_extend ex rs#r2 a) + /\ forall r, data_preg r = true -> r <> rd -> rs'#r = rs#r. +Proof. + intros sem insnX insnS EX ES; intros. unfold arith_extended. destruct (Int.ltu a (Int.repr 5)). +- econstructor; split. + apply exec_straight_one. rewrite EX; eauto. auto. + split. Simpl. f_equal. destruct ex; auto. + intros; Simpl. +- exploit (exec_move_extended_base X16 r2 ex). intros (rs' & A & B & C). + econstructor; split. + eapply exec_straight_trans. eexact A. apply exec_straight_one. + rewrite ES. eauto. auto. + split. Simpl. unfold ir0x. rewrite C by eauto with asmgen. f_equal. + rewrite B. destruct ex; auto. + intros; Simpl. +Qed. + +(** Extended right shift *) + +Lemma exec_shrx32: forall (rd r1: ireg) (n: int) k v (rs: regset) m, + Val.shrx rs#r1 (Vint n) = Some v -> + r1 <> X16 -> + exists rs', + exec_straight ge fn (shrx32 rd r1 n k) rs m k rs' m + /\ rs'#rd = v + /\ forall r, data_preg r = true -> r <> rd -> rs'#r = rs#r. +Proof. + unfold shrx32; intros. apply Val.shrx_shr_2 in H. + destruct (Int.eq n Int.zero) eqn:E. +- econstructor; split. apply exec_straight_one; [simpl;eauto|auto]. + split. Simpl. subst v; auto. intros; Simpl. +- econstructor; split. eapply exec_straight_three. + unfold exec_instr. rewrite or_zero_eval_shift_op_int by congruence. eauto. + simpl; eauto. + unfold exec_instr. rewrite or_zero_eval_shift_op_int by congruence. eauto. + auto. auto. auto. + split. subst v; Simpl. intros; Simpl. +Qed. + +Lemma exec_shrx64: forall (rd r1: ireg) (n: int) k v (rs: regset) m, + Val.shrxl rs#r1 (Vint n) = Some v -> + r1 <> X16 -> + exists rs', + exec_straight ge fn (shrx64 rd r1 n k) rs m k rs' m + /\ rs'#rd = v + /\ forall r, data_preg r = true -> r <> rd -> rs'#r = rs#r. +Proof. + unfold shrx64; intros. apply Val.shrxl_shrl_2 in H. + destruct (Int.eq n Int.zero) eqn:E. +- econstructor; split. apply exec_straight_one; [simpl;eauto|auto]. + split. Simpl. subst v; auto. intros; Simpl. +- econstructor; split. eapply exec_straight_three. + unfold exec_instr. rewrite or_zero_eval_shift_op_long by congruence. eauto. + simpl; eauto. + unfold exec_instr. rewrite or_zero_eval_shift_op_long by congruence. eauto. + auto. auto. auto. + split. subst v; Simpl. intros; Simpl. +Qed. + +(** Condition bits *) + +Lemma compare_int_spec: forall rs v1 v2 m, + let rs' := compare_int rs v1 v2 m in + rs'#CN = (Val.negative (Val.sub v1 v2)) + /\ rs'#CZ = (Val.cmpu (Mem.valid_pointer m) Ceq v1 v2) + /\ rs'#CC = (Val.cmpu (Mem.valid_pointer m) Cge v1 v2) + /\ rs'#CV = (Val.sub_overflow v1 v2). +Proof. + intros; unfold rs'; auto. +Qed. + +Lemma eval_testcond_compare_sint: forall c v1 v2 b rs m, + Val.cmp_bool c v1 v2 = Some b -> + eval_testcond (cond_for_signed_cmp c) (compare_int rs v1 v2 m) = Some b. +Proof. + intros. generalize (compare_int_spec rs v1 v2 m). + set (rs' := compare_int rs v1 v2 m). intros (B & C & D & E). + unfold eval_testcond; rewrite B, C, D, E. + destruct v1; try discriminate; destruct v2; try discriminate. + simpl in H; inv H. + unfold Val.cmpu; simpl. destruct c; simpl. +- destruct (Int.eq i i0); auto. +- destruct (Int.eq i i0); auto. +- rewrite Int.lt_sub_overflow. destruct (Int.lt i i0); auto. +- rewrite Int.lt_sub_overflow, Int.not_lt. + destruct (Int.eq i i0), (Int.lt i i0); auto. +- rewrite Int.lt_sub_overflow, (Int.lt_not i). + destruct (Int.eq i i0), (Int.lt i i0); auto. +- rewrite Int.lt_sub_overflow. destruct (Int.lt i i0); auto. +Qed. + +Lemma eval_testcond_compare_uint: forall c v1 v2 b rs m, + Val.cmpu_bool (Mem.valid_pointer m) c v1 v2 = Some b -> + eval_testcond (cond_for_unsigned_cmp c) (compare_int rs v1 v2 m) = Some b. +Proof. + intros. generalize (compare_int_spec rs v1 v2 m). + set (rs' := compare_int rs v1 v2 m). intros (B & C & D & E). + unfold eval_testcond; rewrite B, C, D, E. + destruct v1; try discriminate; destruct v2; try discriminate. + simpl in H; inv H. + unfold Val.cmpu; simpl. destruct c; simpl. +- destruct (Int.eq i i0); auto. +- destruct (Int.eq i i0); auto. +- destruct (Int.ltu i i0); auto. +- rewrite (Int.not_ltu i). destruct (Int.eq i i0), (Int.ltu i i0); auto. +- rewrite (Int.ltu_not i). destruct (Int.eq i i0), (Int.ltu i i0); auto. +- destruct (Int.ltu i i0); auto. +Qed. + +Lemma compare_long_spec: forall rs v1 v2 m, + let rs' := compare_long rs v1 v2 m in + rs'#CN = (Val.negativel (Val.subl v1 v2)) + /\ rs'#CZ = (Val.maketotal (Val.cmplu (Mem.valid_pointer m) Ceq v1 v2)) + /\ rs'#CC = (Val.maketotal (Val.cmplu (Mem.valid_pointer m) Cge v1 v2)) + /\ rs'#CV = (Val.subl_overflow v1 v2). +Proof. + intros; unfold rs'; auto. +Qed. + +Remark int64_sub_overflow: + forall x y, + Int.xor (Int.repr (Int64.unsigned (Int64.sub_overflow x y Int64.zero))) + (Int.repr (Int64.unsigned (Int64.negative (Int64.sub x y)))) = + (if Int64.lt x y then Int.one else Int.zero). +Proof. + intros. + transitivity (Int.repr (Int64.unsigned (if Int64.lt x y then Int64.one else Int64.zero))). + rewrite <- (Int64.lt_sub_overflow x y). + unfold Int64.sub_overflow, Int64.negative. + set (s := Int64.signed x - Int64.signed y - Int64.signed Int64.zero). + destruct (zle Int64.min_signed s && zle s Int64.max_signed); + destruct (Int64.lt (Int64.sub x y) Int64.zero); + auto. + destruct (Int64.lt x y); auto. +Qed. + +Lemma eval_testcond_compare_slong: forall c v1 v2 b rs m, + Val.cmpl_bool c v1 v2 = Some b -> + eval_testcond (cond_for_signed_cmp c) (compare_long rs v1 v2 m) = Some b. +Proof. + intros. generalize (compare_long_spec rs v1 v2 m). + set (rs' := compare_long rs v1 v2 m). intros (B & C & D & E). + unfold eval_testcond; rewrite B, C, D, E. + destruct v1; try discriminate; destruct v2; try discriminate. + simpl in H; inv H. + unfold Val.cmplu; simpl. destruct c; simpl. +- destruct (Int64.eq i i0); auto. +- destruct (Int64.eq i i0); auto. +- rewrite int64_sub_overflow. destruct (Int64.lt i i0); auto. +- rewrite int64_sub_overflow, Int64.not_lt. + destruct (Int64.eq i i0), (Int64.lt i i0); auto. +- rewrite int64_sub_overflow, (Int64.lt_not i). + destruct (Int64.eq i i0), (Int64.lt i i0); auto. +- rewrite int64_sub_overflow. destruct (Int64.lt i i0); auto. +Qed. + +Lemma eval_testcond_compare_ulong: forall c v1 v2 b rs m, + Val.cmplu_bool (Mem.valid_pointer m) c v1 v2 = Some b -> + eval_testcond (cond_for_unsigned_cmp c) (compare_long rs v1 v2 m) = Some b. +Proof. + intros. generalize (compare_long_spec rs v1 v2 m). + set (rs' := compare_long rs v1 v2 m). intros (B & C & D & E). + unfold eval_testcond; rewrite B, C, D, E; unfold Val.cmplu. + destruct v1; try discriminate; destruct v2; try discriminate; simpl in H. +- (* int-int *) + inv H. destruct c; simpl. ++ destruct (Int64.eq i i0); auto. ++ destruct (Int64.eq i i0); auto. ++ destruct (Int64.ltu i i0); auto. ++ rewrite (Int64.not_ltu i). destruct (Int64.eq i i0), (Int64.ltu i i0); auto. ++ rewrite (Int64.ltu_not i). destruct (Int64.eq i i0), (Int64.ltu i i0); auto. ++ destruct (Int64.ltu i i0); auto. +- (* int-ptr *) + simpl. + destruct (Int64.eq i Int64.zero && + (Mem.valid_pointer m b0 (Ptrofs.unsigned i0) + || Mem.valid_pointer m b0 (Ptrofs.unsigned i0 - 1))); try discriminate. + destruct c; simpl in H; inv H; reflexivity. +- (* ptr-int *) + simpl. + destruct (Int64.eq i0 Int64.zero && + (Mem.valid_pointer m b0 (Ptrofs.unsigned i) + || Mem.valid_pointer m b0 (Ptrofs.unsigned i - 1))); try discriminate. + destruct c; simpl in H; inv H; reflexivity. +- (* ptr-ptr *) + simpl. + destruct (eq_block b0 b1). ++ destruct ((Mem.valid_pointer m b0 (Ptrofs.unsigned i) + || Mem.valid_pointer m b0 (Ptrofs.unsigned i - 1)) && + (Mem.valid_pointer m b1 (Ptrofs.unsigned i0) + || Mem.valid_pointer m b1 (Ptrofs.unsigned i0 - 1))); + inv H. + destruct c; simpl. +* destruct (Ptrofs.eq i i0); auto. +* destruct (Ptrofs.eq i i0); auto. +* destruct (Ptrofs.ltu i i0); auto. +* rewrite (Ptrofs.not_ltu i). destruct (Ptrofs.eq i i0), (Ptrofs.ltu i i0); auto. +* rewrite (Ptrofs.ltu_not i). destruct (Ptrofs.eq i i0), (Ptrofs.ltu i i0); auto. +* destruct (Ptrofs.ltu i i0); auto. ++ destruct (Mem.valid_pointer m b0 (Ptrofs.unsigned i) && + Mem.valid_pointer m b1 (Ptrofs.unsigned i0)); try discriminate. + destruct c; simpl in H; inv H; reflexivity. +Qed. + +Lemma compare_float_spec: forall rs f1 f2, + let rs' := compare_float rs (Vfloat f1) (Vfloat f2) in + rs'#CN = (Val.of_bool (Float.cmp Clt f1 f2)) + /\ rs'#CZ = (Val.of_bool (Float.cmp Ceq f1 f2)) + /\ rs'#CC = (Val.of_bool (negb (Float.cmp Clt f1 f2))) + /\ rs'#CV = (Val.of_bool (negb (Float.ordered f1 f2))). +Proof. + intros; auto. +Qed. + +Lemma eval_testcond_compare_float: forall c v1 v2 b rs, + Val.cmpf_bool c v1 v2 = Some b -> + eval_testcond (cond_for_float_cmp c) (compare_float rs v1 v2) = Some b. +Proof. + intros. destruct v1; try discriminate; destruct v2; simpl in H; inv H. + generalize (compare_float_spec rs f f0). + set (rs' := compare_float rs (Vfloat f) (Vfloat f0)). + intros (B & C & D & E). + unfold eval_testcond; rewrite B, C, D, E. +Local Transparent Float.cmp Float.ordered. + unfold Float.cmp, Float.ordered; + destruct c; destruct (Float.compare f f0) as [[]|]; reflexivity. +Qed. + +Lemma eval_testcond_compare_not_float: forall c v1 v2 b rs, + option_map negb (Val.cmpf_bool c v1 v2) = Some b -> + eval_testcond (cond_for_float_not_cmp c) (compare_float rs v1 v2) = Some b. +Proof. + intros. destruct v1; try discriminate; destruct v2; simpl in H; inv H. + generalize (compare_float_spec rs f f0). + set (rs' := compare_float rs (Vfloat f) (Vfloat f0)). + intros (B & C & D & E). + unfold eval_testcond; rewrite B, C, D, E. +Local Transparent Float.cmp Float.ordered. + unfold Float.cmp, Float.ordered; + destruct c; destruct (Float.compare f f0) as [[]|]; reflexivity. +Qed. + +Lemma compare_single_spec: forall rs f1 f2, + let rs' := compare_single rs (Vsingle f1) (Vsingle f2) in + rs'#CN = (Val.of_bool (Float32.cmp Clt f1 f2)) + /\ rs'#CZ = (Val.of_bool (Float32.cmp Ceq f1 f2)) + /\ rs'#CC = (Val.of_bool (negb (Float32.cmp Clt f1 f2))) + /\ rs'#CV = (Val.of_bool (negb (Float32.ordered f1 f2))). +Proof. + intros; auto. +Qed. + +Lemma eval_testcond_compare_single: forall c v1 v2 b rs, + Val.cmpfs_bool c v1 v2 = Some b -> + eval_testcond (cond_for_float_cmp c) (compare_single rs v1 v2) = Some b. +Proof. + intros. destruct v1; try discriminate; destruct v2; simpl in H; inv H. + generalize (compare_single_spec rs f f0). + set (rs' := compare_single rs (Vsingle f) (Vsingle f0)). + intros (B & C & D & E). + unfold eval_testcond; rewrite B, C, D, E. +Local Transparent Float32.cmp Float32.ordered. + unfold Float32.cmp, Float32.ordered; + destruct c; destruct (Float32.compare f f0) as [[]|]; reflexivity. +Qed. + +Lemma eval_testcond_compare_not_single: forall c v1 v2 b rs, + option_map negb (Val.cmpfs_bool c v1 v2) = Some b -> + eval_testcond (cond_for_float_not_cmp c) (compare_single rs v1 v2) = Some b. +Proof. + intros. destruct v1; try discriminate; destruct v2; simpl in H; inv H. + generalize (compare_single_spec rs f f0). + set (rs' := compare_single rs (Vsingle f) (Vsingle f0)). + intros (B & C & D & E). + unfold eval_testcond; rewrite B, C, D, E. +Local Transparent Float32.cmp Float32.ordered. + unfold Float32.cmp, Float32.ordered; + destruct c; destruct (Float32.compare f f0) as [[]|]; reflexivity. +Qed. + +Remark compare_float_inv: forall rs v1 v2 r, + match r with CR _ => False | _ => True end -> + (nextinstr (compare_float rs v1 v2))#r = (nextinstr rs)#r. +Proof. + intros; unfold compare_float. + destruct r; try contradiction; destruct v1; auto; destruct v2; auto. +Qed. + +Remark compare_single_inv: forall rs v1 v2 r, + match r with CR _ => False | _ => True end -> + (nextinstr (compare_single rs v1 v2))#r = (nextinstr rs)#r. +Proof. + intros; unfold compare_single. + destruct r; try contradiction; destruct v1; auto; destruct v2; auto. +Qed. + +(** Translation of conditionals *) + +Ltac ArgsInv := + repeat (match goal with + | [ H: Error _ = OK _ |- _ ] => discriminate + | [ H: match ?args with nil => _ | _ :: _ => _ end = OK _ |- _ ] => destruct args + | [ H: bind _ _ = OK _ |- _ ] => monadInv H + | [ H: match _ with left _ => _ | right _ => assertion_failed end = OK _ |- _ ] => monadInv H; ArgsInv + | [ H: match _ with true => _ | false => assertion_failed end = OK _ |- _ ] => monadInv H; ArgsInv + end); + subst; + repeat (match goal with + | [ H: ireg_of _ = OK _ |- _ ] => simpl in *; rewrite (ireg_of_eq _ _ H) in * + | [ H: freg_of _ = OK _ |- _ ] => simpl in *; rewrite (freg_of_eq _ _ H) in * + end). + +Lemma transl_cond_correct: + forall cond args k c rs m, + transl_cond cond args k = OK c -> + exists rs', + exec_straight ge fn c rs m k rs' m + /\ (forall b, + eval_condition cond (map rs (map preg_of args)) m = Some b -> + eval_testcond (cond_for_cond cond) rs' = Some b) + /\ forall r, data_preg r = true -> rs'#r = rs#r. +Proof. + intros until m; intros TR. destruct cond; simpl in TR; ArgsInv. +- (* Ccomp *) + econstructor; split. apply exec_straight_one. simpl; eauto. auto. + split; intros. apply eval_testcond_compare_sint; auto. + destruct r; reflexivity || discriminate. +- (* Ccompu *) + econstructor; split. apply exec_straight_one. simpl; eauto. auto. + split; intros. apply eval_testcond_compare_uint; auto. + destruct r; reflexivity || discriminate. +- (* Ccompimm *) + destruct (is_arith_imm32 n); [|destruct (is_arith_imm32 (Int.neg n))]. ++ econstructor; split. apply exec_straight_one. simpl; eauto. auto. + split; intros. rewrite Int.repr_unsigned. apply eval_testcond_compare_sint; auto. + destruct r; reflexivity || discriminate. ++ econstructor; split. + apply exec_straight_one. simpl. rewrite Int.repr_unsigned, Int.neg_involutive. eauto. auto. + split; intros. apply eval_testcond_compare_sint; auto. + destruct r; reflexivity || discriminate. ++ exploit (exec_loadimm32 X16 n). intros (rs' & A & B & C). + econstructor; split. + eapply exec_straight_trans. eexact A. apply exec_straight_one. + simpl. rewrite B, C by eauto with asmgen. eauto. auto. + split; intros. apply eval_testcond_compare_sint; auto. + transitivity (rs' r). destruct r; reflexivity || discriminate. auto with asmgen. +- (* Ccompuimm *) + destruct (is_arith_imm32 n); [|destruct (is_arith_imm32 (Int.neg n))]. ++ econstructor; split. apply exec_straight_one. simpl; eauto. auto. + split; intros. rewrite Int.repr_unsigned. apply eval_testcond_compare_uint; auto. + destruct r; reflexivity || discriminate. ++ econstructor; split. + apply exec_straight_one. simpl. rewrite Int.repr_unsigned, Int.neg_involutive. eauto. auto. + split; intros. apply eval_testcond_compare_uint; auto. + destruct r; reflexivity || discriminate. ++ exploit (exec_loadimm32 X16 n). intros (rs' & A & B & C). + econstructor; split. + eapply exec_straight_trans. eexact A. apply exec_straight_one. + simpl. rewrite B, C by eauto with asmgen. eauto. auto. + split; intros. apply eval_testcond_compare_uint; auto. + transitivity (rs' r). destruct r; reflexivity || discriminate. auto with asmgen. +- (* Ccompshift *) + econstructor; split. apply exec_straight_one. simpl; eauto. auto. + split; intros. rewrite transl_eval_shift. apply eval_testcond_compare_sint; auto. + destruct r; reflexivity || discriminate. +- (* Ccompushift *) + econstructor; split. apply exec_straight_one. simpl; eauto. auto. + split; intros. rewrite transl_eval_shift. apply eval_testcond_compare_uint; auto. + destruct r; reflexivity || discriminate. +- (* Cmaskzero *) + destruct (is_logical_imm32 n). ++ econstructor; split. apply exec_straight_one. simpl; eauto. auto. + split; intros. rewrite Int.repr_unsigned. apply (eval_testcond_compare_sint Ceq); auto. + destruct r; reflexivity || discriminate. ++ exploit (exec_loadimm32 X16 n). intros (rs' & A & B & C). + econstructor; split. + eapply exec_straight_trans. eexact A. + apply exec_straight_one. simpl. rewrite B, C by eauto with asmgen. eauto. auto. + split; intros. apply (eval_testcond_compare_sint Ceq); auto. + transitivity (rs' r). destruct r; reflexivity || discriminate. auto with asmgen. +- (* Cmasknotzero *) + destruct (is_logical_imm32 n). ++ econstructor; split. apply exec_straight_one. simpl; eauto. auto. + split; intros. rewrite Int.repr_unsigned. apply (eval_testcond_compare_sint Cne); auto. + destruct r; reflexivity || discriminate. ++ exploit (exec_loadimm32 X16 n). intros (rs' & A & B & C). + econstructor; split. + eapply exec_straight_trans. eexact A. + apply exec_straight_one. simpl. rewrite B, C by eauto with asmgen. eauto. auto. + split; intros. apply (eval_testcond_compare_sint Cne); auto. + transitivity (rs' r). destruct r; reflexivity || discriminate. auto with asmgen. +- (* Ccompl *) + econstructor; split. apply exec_straight_one. simpl; eauto. auto. + split; intros. apply eval_testcond_compare_slong; auto. + destruct r; reflexivity || discriminate. +- (* Ccomplu *) + econstructor; split. apply exec_straight_one. simpl; eauto. auto. + split; intros. apply eval_testcond_compare_ulong; auto. + destruct r; reflexivity || discriminate. +- (* Ccomplimm *) + destruct (is_arith_imm64 n); [|destruct (is_arith_imm64 (Int64.neg n))]. ++ econstructor; split. apply exec_straight_one. simpl; eauto. auto. + split; intros. rewrite Int64.repr_unsigned. apply eval_testcond_compare_slong; auto. + destruct r; reflexivity || discriminate. ++ econstructor; split. + apply exec_straight_one. simpl. rewrite Int64.repr_unsigned, Int64.neg_involutive. eauto. auto. + split; intros. apply eval_testcond_compare_slong; auto. + destruct r; reflexivity || discriminate. ++ exploit (exec_loadimm64 X16 n). intros (rs' & A & B & C). + econstructor; split. + eapply exec_straight_trans. eexact A. apply exec_straight_one. + simpl. rewrite B, C by eauto with asmgen. eauto. auto. + split; intros. apply eval_testcond_compare_slong; auto. + transitivity (rs' r). destruct r; reflexivity || discriminate. auto with asmgen. +- (* Ccompluimm *) + destruct (is_arith_imm64 n); [|destruct (is_arith_imm64 (Int64.neg n))]. ++ econstructor; split. apply exec_straight_one. simpl; eauto. auto. + split; intros. rewrite Int64.repr_unsigned. apply eval_testcond_compare_ulong; auto. + destruct r; reflexivity || discriminate. ++ econstructor; split. + apply exec_straight_one. simpl. rewrite Int64.repr_unsigned, Int64.neg_involutive. eauto. auto. + split; intros. apply eval_testcond_compare_ulong; auto. + destruct r; reflexivity || discriminate. ++ exploit (exec_loadimm64 X16 n). intros (rs' & A & B & C). + econstructor; split. + eapply exec_straight_trans. eexact A. apply exec_straight_one. + simpl. rewrite B, C by eauto with asmgen. eauto. auto. + split; intros. apply eval_testcond_compare_ulong; auto. + transitivity (rs' r). destruct r; reflexivity || discriminate. auto with asmgen. +- (* Ccomplshift *) + econstructor; split. apply exec_straight_one. simpl; eauto. auto. + split; intros. rewrite transl_eval_shiftl. apply eval_testcond_compare_slong; auto. + destruct r; reflexivity || discriminate. +- (* Ccomplushift *) + econstructor; split. apply exec_straight_one. simpl; eauto. auto. + split; intros. rewrite transl_eval_shiftl. apply eval_testcond_compare_ulong; auto. + destruct r; reflexivity || discriminate. +- (* Cmasklzero *) + destruct (is_logical_imm64 n). ++ econstructor; split. apply exec_straight_one. simpl; eauto. auto. + split; intros. rewrite Int64.repr_unsigned. apply (eval_testcond_compare_slong Ceq); auto. + destruct r; reflexivity || discriminate. ++ exploit (exec_loadimm64 X16 n). intros (rs' & A & B & C). + econstructor; split. + eapply exec_straight_trans. eexact A. + apply exec_straight_one. simpl. rewrite B, C by eauto with asmgen. eauto. auto. + split; intros. apply (eval_testcond_compare_slong Ceq); auto. + transitivity (rs' r). destruct r; reflexivity || discriminate. auto with asmgen. +- (* Cmasknotzero *) + destruct (is_logical_imm64 n). ++ econstructor; split. apply exec_straight_one. simpl; eauto. auto. + split; intros. rewrite Int64.repr_unsigned. apply (eval_testcond_compare_slong Cne); auto. + destruct r; reflexivity || discriminate. ++ exploit (exec_loadimm64 X16 n). intros (rs' & A & B & C). + econstructor; split. + eapply exec_straight_trans. eexact A. + apply exec_straight_one. simpl. rewrite B, C by eauto with asmgen. eauto. auto. + split; intros. apply (eval_testcond_compare_slong Cne); auto. + transitivity (rs' r). destruct r; reflexivity || discriminate. auto with asmgen. +- (* Ccompf *) + econstructor; split. apply exec_straight_one. simpl; eauto. + rewrite compare_float_inv; auto. + split; intros. apply eval_testcond_compare_float; auto. + destruct r; discriminate || rewrite compare_float_inv; auto. +- (* Cnotcompf *) + econstructor; split. apply exec_straight_one. simpl; eauto. + rewrite compare_float_inv; auto. + split; intros. apply eval_testcond_compare_not_float; auto. + destruct r; discriminate || rewrite compare_float_inv; auto. +- (* Ccompfzero *) + econstructor; split. apply exec_straight_one. simpl; eauto. + rewrite compare_float_inv; auto. + split; intros. apply eval_testcond_compare_float; auto. + destruct r; discriminate || rewrite compare_float_inv; auto. +- (* Cnotcompfzero *) + econstructor; split. apply exec_straight_one. simpl; eauto. + rewrite compare_float_inv; auto. + split; intros. apply eval_testcond_compare_not_float; auto. + destruct r; discriminate || rewrite compare_float_inv; auto. +- (* Ccompfs *) + econstructor; split. apply exec_straight_one. simpl; eauto. + rewrite compare_single_inv; auto. + split; intros. apply eval_testcond_compare_single; auto. + destruct r; discriminate || rewrite compare_single_inv; auto. +- (* Cnotcompfs *) + econstructor; split. apply exec_straight_one. simpl; eauto. + rewrite compare_single_inv; auto. + split; intros. apply eval_testcond_compare_not_single; auto. + destruct r; discriminate || rewrite compare_single_inv; auto. +- (* Ccompfszero *) + econstructor; split. apply exec_straight_one. simpl; eauto. + rewrite compare_single_inv; auto. + split; intros. apply eval_testcond_compare_single; auto. + destruct r; discriminate || rewrite compare_single_inv; auto. +- (* Cnotcompfszero *) + econstructor; split. apply exec_straight_one. simpl; eauto. + rewrite compare_single_inv; auto. + split; intros. apply eval_testcond_compare_not_single; auto. + destruct r; discriminate || rewrite compare_single_inv; auto. +Qed. + +(** Translation of conditional branches *) + +Lemma transl_cond_branch_correct: + forall cond args lbl k c rs m b, + transl_cond_branch cond args lbl k = OK c -> + eval_condition cond (map rs (map preg_of args)) m = Some b -> + exists rs' insn, + exec_straight_opt ge fn c rs m (insn :: k) rs' m + /\ exec_instr ge fn insn rs' m = + (if b then goto_label fn lbl rs' m else Next (nextinstr rs') m) + /\ forall r, data_preg r = true -> rs'#r = rs#r. +Proof. + intros until b; intros TR EV. + assert (DFL: + transl_cond_branch_default cond args lbl k = OK c -> + exists rs' insn, + exec_straight_opt ge fn c rs m (insn :: k) rs' m + /\ exec_instr ge fn insn rs' m = + (if b then goto_label fn lbl rs' m else Next (nextinstr rs') m) + /\ forall r, data_preg r = true -> rs'#r = rs#r). + { + unfold transl_cond_branch_default; intros. + exploit transl_cond_correct; eauto. intros (rs' & A & B & C). + exists rs', (Pbc (cond_for_cond cond) lbl); split. + apply exec_straight_opt_intro. eexact A. + split; auto. simpl. rewrite (B b) by auto. auto. + } +Local Opaque transl_cond transl_cond_branch_default. + destruct args as [ | a1 args]; simpl in TR; auto. + destruct args as [ | a2 args]; simpl in TR; auto. + destruct cond; simpl in TR; auto. +- (* Ccompimm *) + destruct c0; auto; destruct (Int.eq n Int.zero) eqn:N0; auto; + apply Int.same_if_eq in N0; subst n; ArgsInv. ++ (* Ccompimm Cne 0 *) + do 2 econstructor; split. + apply exec_straight_opt_refl. + split; auto. simpl. destruct (rs x); simpl in EV; inv EV. simpl. auto. ++ (* Ccompimm Ceq 0 *) + do 2 econstructor; split. + apply exec_straight_opt_refl. + split; auto. simpl. destruct (rs x); simpl in EV; inv EV. simpl. destruct (Int.eq i Int.zero); auto. +- (* Ccompuimm *) + destruct c0; auto; destruct (Int.eq n Int.zero) eqn:N0; auto; + apply Int.same_if_eq in N0; subst n; ArgsInv. ++ (* Ccompuimm Cne 0 *) + do 2 econstructor; split. + apply exec_straight_opt_refl. + split; auto. simpl. rewrite EV. auto. ++ (* Ccompuimm Ceq 0 *) + do 2 econstructor; split. + apply exec_straight_opt_refl. + split; auto. simpl. rewrite (Val.negate_cmpu_bool (Mem.valid_pointer m) Cne), EV. destruct b; auto. +- (* Cmaskzero *) + destruct (Int.is_power2 n) as [bit|] eqn:P2; auto. ArgsInv. + do 2 econstructor; split. + apply exec_straight_opt_refl. + split; auto. simpl. + erewrite <- Int.mul_pow2, Int.mul_commut, Int.mul_one by eauto. + rewrite (Val.negate_cmp_bool Ceq), EV. destruct b; auto. +- (* Cmasknotzero *) + destruct (Int.is_power2 n) as [bit|] eqn:P2; auto. ArgsInv. + do 2 econstructor; split. + apply exec_straight_opt_refl. + split; auto. simpl. + erewrite <- Int.mul_pow2, Int.mul_commut, Int.mul_one by eauto. + rewrite EV. auto. +- (* Ccomplimm *) + destruct c0; auto; destruct (Int64.eq n Int64.zero) eqn:N0; auto; + apply Int64.same_if_eq in N0; subst n; ArgsInv. ++ (* Ccomplimm Cne 0 *) + do 2 econstructor; split. + apply exec_straight_opt_refl. + split; auto. simpl. destruct (rs x); simpl in EV; inv EV. simpl. auto. ++ (* Ccomplimm Ceq 0 *) + do 2 econstructor; split. + apply exec_straight_opt_refl. + split; auto. simpl. destruct (rs x); simpl in EV; inv EV. simpl. destruct (Int64.eq i Int64.zero); auto. +- (* Ccompluimm *) + destruct c0; auto; destruct (Int64.eq n Int64.zero) eqn:N0; auto; + apply Int64.same_if_eq in N0; subst n; ArgsInv. ++ (* Ccompluimm Cne 0 *) + do 2 econstructor; split. + apply exec_straight_opt_refl. + split; auto. simpl. rewrite EV. auto. ++ (* Ccompluimm Ceq 0 *) + do 2 econstructor; split. + apply exec_straight_opt_refl. + split; auto. simpl. rewrite (Val.negate_cmplu_bool (Mem.valid_pointer m) Cne), EV. destruct b; auto. +- (* Cmasklzero *) + destruct (Int64.is_power2' n) as [bit|] eqn:P2; auto. ArgsInv. + do 2 econstructor; split. + apply exec_straight_opt_refl. + split; auto. simpl. + erewrite <- Int64.mul_pow2', Int64.mul_commut, Int64.mul_one by eauto. + rewrite (Val.negate_cmpl_bool Ceq), EV. destruct b; auto. +- (* Cmasklnotzero *) + destruct (Int64.is_power2' n) as [bit|] eqn:P2; auto. ArgsInv. + do 2 econstructor; split. + apply exec_straight_opt_refl. + split; auto. simpl. + erewrite <- Int64.mul_pow2', Int64.mul_commut, Int64.mul_one by eauto. + rewrite EV. auto. +Qed. + +(** Translation of arithmetic operations *) + +Ltac SimplEval H := + match type of H with + | Some _ = None _ => discriminate + | Some _ = Some _ => inv H + | ?a = Some ?b => let A := fresh in assert (A: Val.maketotal a = b) by (rewrite H; reflexivity) +end. + +Ltac TranslOpSimpl := + econstructor; split; + [ apply exec_straight_one; [simpl; eauto | reflexivity] + | split; [ rewrite ? transl_eval_shift, ? transl_eval_shiftl; + apply Val.lessdef_same; Simpl; fail + | intros; Simpl; fail ] ]. + +Ltac TranslOpBase := + econstructor; split; + [ apply exec_straight_one; [simpl; eauto | reflexivity] + | split; [ rewrite ? transl_eval_shift, ? transl_eval_shiftl; Simpl + | intros; Simpl; fail ] ]. + +Lemma transl_op_correct: + forall op args res k (rs: regset) m v c, + transl_op op args res k = OK c -> + eval_operation ge (rs#SP) op (map rs (map preg_of args)) m = Some v -> + exists rs', + exec_straight ge fn c rs m k rs' m + /\ Val.lessdef v rs'#(preg_of res) + /\ forall r, data_preg r = true -> r <> preg_of res -> preg_notin r (destroyed_by_op op) -> rs' r = rs r. +Proof. +Local Opaque Int.eq Int64.eq Val.add Val.addl Int.zwordsize Int64.zwordsize. + intros until c; intros TR EV. + unfold transl_op in TR; destruct op; ArgsInv; simpl in EV; SimplEval EV; try TranslOpSimpl. +- (* move *) + destruct (preg_of res) eqn:RR; try discriminate; destruct (preg_of m0) eqn:R1; inv TR. ++ TranslOpSimpl. ++ TranslOpSimpl. +- (* intconst *) + exploit exec_loadimm32. intros (rs' & A & B & C). + exists rs'; split. eexact A. split. rewrite B; auto. intros; auto with asmgen. +- (* longconst *) + exploit exec_loadimm64. intros (rs' & A & B & C). + exists rs'; split. eexact A. split. rewrite B; auto. intros; auto with asmgen. +- (* floatconst *) + destruct (Float.eq_dec n Float.zero). ++ subst n. TranslOpSimpl. ++ TranslOpSimpl. +- (* singleconst *) + destruct (Float32.eq_dec n Float32.zero). ++ subst n. TranslOpSimpl. ++ TranslOpSimpl. +- (* loadsymbol *) + exploit (exec_loadsymbol x id ofs). eauto with asmgen. intros (rs' & A & B & C). + exists rs'; split. eexact A. split. rewrite B; auto. auto. +- (* addrstack *) + exploit (exec_addimm64 x XSP (Ptrofs.to_int64 ofs)). simpl; eauto with asmgen. + intros (rs' & A & B & C). + exists rs'; split. eexact A. split. simpl in B; rewrite B. +Local Transparent Val.addl. + destruct (rs SP); simpl; auto. rewrite Ptrofs.of_int64_to_int64 by auto. auto. + auto. +- (* shift *) + rewrite <- transl_eval_shift'. TranslOpSimpl. +- (* addimm *) + exploit (exec_addimm32 x x0 n). eauto with asmgen. intros (rs' & A & B & C). + exists rs'; split. eexact A. split. rewrite B; auto. auto. +- (* mul *) + TranslOpBase. +Local Transparent Val.add. + destruct (rs x0); auto; destruct (rs x1); auto. simpl. rewrite Int.add_zero_l; auto. +- (* andimm *) + exploit (exec_logicalimm32 (Pandimm W) (Pand W)). + intros; reflexivity. intros; reflexivity. instantiate (1 := x0). eauto with asmgen. + intros (rs' & A & B & C). + exists rs'; split. eexact A. split. rewrite B; auto. auto. +- (* orimm *) + exploit (exec_logicalimm32 (Porrimm W) (Porr W)). + intros; reflexivity. intros; reflexivity. instantiate (1 := x0). eauto with asmgen. + intros (rs' & A & B & C). + exists rs'; split. eexact A. split. rewrite B; auto. auto. +- (* xorimm *) + exploit (exec_logicalimm32 (Peorimm W) (Peor W)). + intros; reflexivity. intros; reflexivity. instantiate (1 := x0). eauto with asmgen. + intros (rs' & A & B & C). + exists rs'; split. eexact A. split. rewrite B; auto. auto. +- (* not *) + TranslOpBase. + destruct (rs x0); auto. simpl. rewrite Int.or_zero_l; auto. +- (* notshift *) + TranslOpBase. + destruct (eval_shift s (rs x0) a); auto. simpl. rewrite Int.or_zero_l; auto. +- (* shrx *) + exploit (exec_shrx32 x x0 n); eauto with asmgen. intros (rs' & A & B & C). + econstructor; split. eexact A. split. rewrite B; auto. auto. +- (* zero-ext *) + TranslOpBase. + destruct (rs x0); auto; simpl. rewrite Int.shl_zero. auto. +- (* sign-ext *) + TranslOpBase. + destruct (rs x0); auto; simpl. rewrite Int.shl_zero. auto. +- (* shlzext *) + TranslOpBase. + destruct (rs x0); simpl; auto. rewrite <- Int.shl_zero_ext_min; auto using a32_range. +- (* shlsext *) + TranslOpBase. + destruct (rs x0); simpl; auto. rewrite <- Int.shl_sign_ext_min; auto using a32_range. +- (* zextshr *) + TranslOpBase. + destruct (rs x0); simpl; auto. rewrite ! a32_range; simpl. rewrite <- Int.zero_ext_shru_min; auto using a32_range. +- (* sextshr *) + TranslOpBase. + destruct (rs x0); simpl; auto. rewrite ! a32_range; simpl. rewrite <- Int.sign_ext_shr_min; auto using a32_range. +- (* shiftl *) + rewrite <- transl_eval_shiftl'. TranslOpSimpl. +- (* extend *) + exploit (exec_move_extended x0 x1 x a k). intros (rs' & A & B & C). + econstructor; split. eexact A. + split. rewrite B; auto. eauto with asmgen. +- (* addext *) + exploit (exec_arith_extended Val.addl Paddext (Padd X)). + auto. auto. instantiate (1 := x1). eauto with asmgen. intros (rs' & A & B & C). + econstructor; split. eexact A. split. rewrite B; auto. auto. +- (* addlimm *) + exploit (exec_addimm64 x x0 n). simpl. generalize (ireg_of_not_X16 _ _ EQ1). congruence. + intros (rs' & A & B & C). + exists rs'; split. eexact A. split. simpl in B; rewrite B; auto. auto. +- (* subext *) + exploit (exec_arith_extended Val.subl Psubext (Psub X)). + auto. auto. instantiate (1 := x1). eauto with asmgen. intros (rs' & A & B & C). + econstructor; split. eexact A. split. rewrite B; auto. auto. +- (* mull *) + TranslOpBase. + destruct (rs x0); auto; destruct (rs x1); auto. simpl. rewrite Int64.add_zero_l; auto. +- (* andlimm *) + exploit (exec_logicalimm64 (Pandimm X) (Pand X)). + intros; reflexivity. intros; reflexivity. instantiate (1 := x0). eauto with asmgen. + intros (rs' & A & B & C). + exists rs'; split. eexact A. split. rewrite B; auto. auto. +- (* orlimm *) + exploit (exec_logicalimm64 (Porrimm X) (Porr X)). + intros; reflexivity. intros; reflexivity. instantiate (1 := x0). eauto with asmgen. + intros (rs' & A & B & C). + exists rs'; split. eexact A. split. rewrite B; auto. auto. +- (* xorlimm *) + exploit (exec_logicalimm64 (Peorimm X) (Peor X)). + intros; reflexivity. intros; reflexivity. instantiate (1 := x0). eauto with asmgen. + intros (rs' & A & B & C). + exists rs'; split. eexact A. split. rewrite B; auto. auto. +- (* notl *) + TranslOpBase. + destruct (rs x0); auto. simpl. rewrite Int64.or_zero_l; auto. +- (* notlshift *) + TranslOpBase. + destruct (eval_shiftl s (rs x0) a); auto. simpl. rewrite Int64.or_zero_l; auto. +- (* shrx *) + exploit (exec_shrx64 x x0 n); eauto with asmgen. intros (rs' & A & B & C). + econstructor; split. eexact A. split. rewrite B; auto. auto. +- (* zero-ext-l *) + TranslOpBase. + destruct (rs x0); auto; simpl. rewrite Int64.shl'_zero. auto. +- (* sign-ext-l *) + TranslOpBase. + destruct (rs x0); auto; simpl. rewrite Int64.shl'_zero. auto. +- (* shllzext *) + TranslOpBase. + destruct (rs x0); simpl; auto. rewrite <- Int64.shl'_zero_ext_min; auto using a64_range. +- (* shllsext *) + TranslOpBase. + destruct (rs x0); simpl; auto. rewrite <- Int64.shl'_sign_ext_min; auto using a64_range. +- (* zextshrl *) + TranslOpBase. + destruct (rs x0); simpl; auto. rewrite ! a64_range; simpl. rewrite <- Int64.zero_ext_shru'_min; auto using a64_range. +- (* sextshrl *) + TranslOpBase. + destruct (rs x0); simpl; auto. rewrite ! a64_range; simpl. rewrite <- Int64.sign_ext_shr'_min; auto using a64_range. +- (* condition *) + exploit (transl_cond_correct cond args); eauto. intros (rs' & A & B & C). + econstructor; split. + eapply exec_straight_trans. eexact A. apply exec_straight_one. simpl; eauto. auto. + split. Simpl. destruct (eval_condition cond (map rs (map preg_of args)) m) as [b|]; simpl in *. + rewrite (B b) by auto. auto. + auto. + intros; Simpl. +- (* select *) + destruct (preg_of res) eqn:RES; monadInv TR. + + (* integer *) + generalize (ireg_of_eq _ _ EQ) (ireg_of_eq _ _ EQ1); intros E1 E2; rewrite E1, E2. + exploit (transl_cond_correct cond args); eauto. intros (rs' & A & B & C). + econstructor; split. + eapply exec_straight_trans. eexact A. apply exec_straight_one. simpl; eauto. auto. + split. Simpl. destruct (eval_condition cond (map rs (map preg_of args)) m) as [b|]; simpl in *. + rewrite (B b) by auto. rewrite !C. apply Val.lessdef_normalize. + rewrite <- E2; auto with asmgen. rewrite <- E1; auto with asmgen. + auto. + intros; Simpl. + + (* FP *) + generalize (freg_of_eq _ _ EQ) (freg_of_eq _ _ EQ1); intros E1 E2; rewrite E1, E2. + exploit (transl_cond_correct cond args); eauto. intros (rs' & A & B & C). + econstructor; split. + eapply exec_straight_trans. eexact A. apply exec_straight_one. simpl; eauto. auto. + split. Simpl. destruct (eval_condition cond (map rs (map preg_of args)) m) as [b|]; simpl in *. + rewrite (B b) by auto. rewrite !C. apply Val.lessdef_normalize. + rewrite <- E2; auto with asmgen. rewrite <- E1; auto with asmgen. + auto. + intros; Simpl. +Qed. + +(** Translation of addressing modes, loads, stores *) + +Lemma transl_addressing_correct: + forall sz addr args (insn: Asm.addressing -> instruction) k (rs: regset) m c b o, + transl_addressing sz addr args insn k = OK c -> + Op.eval_addressing ge (rs#SP) addr (map rs (map preg_of args)) = Some (Vptr b o) -> + exists ad rs', + exec_straight_opt ge fn c rs m (insn ad :: k) rs' m + /\ Asm.eval_addressing ge ad rs' = Vptr b o + /\ forall r, data_preg r = true -> rs' r = rs r. +Proof. + intros until o; intros TR EV. + unfold transl_addressing in TR; destruct addr; ArgsInv; SimplEval EV. +- (* Aindexed *) + destruct (offset_representable sz ofs); inv EQ0. ++ econstructor; econstructor; split. apply exec_straight_opt_refl. + auto. ++ exploit (exec_loadimm64 X16 ofs). intros (rs' & A & B & C). + econstructor; exists rs'; split. apply exec_straight_opt_intro; eexact A. + split. simpl. rewrite B, C by eauto with asmgen. auto. + eauto with asmgen. +- (* Aindexed2 *) + econstructor; econstructor; split. apply exec_straight_opt_refl. + auto. +- (* Aindexed2shift *) + destruct (Int.eq a Int.zero) eqn:E; [|destruct (Int.eq (Int.shl Int.one a) (Int.repr sz))]; inv EQ2. ++ apply Int.same_if_eq in E. rewrite E. + econstructor; econstructor; split. apply exec_straight_opt_refl. + split; auto. simpl. + rewrite Val.addl_commut in H0. destruct (rs x0); try discriminate. + unfold Val.shll. rewrite Int64.shl'_zero. auto. ++ econstructor; econstructor; split. apply exec_straight_opt_refl. + auto. ++ econstructor; econstructor; split. + apply exec_straight_opt_intro. apply exec_straight_one. simpl; eauto. auto. + split. simpl. Simpl. rewrite H0. simpl. rewrite Ptrofs.add_zero. auto. + intros; Simpl. +- (* Aindexed2ext *) + destruct (Int.eq a Int.zero || Int.eq (Int.shl Int.one a) (Int.repr sz)); inv EQ2. ++ econstructor; econstructor; split. apply exec_straight_opt_refl. + split; auto. destruct x; auto. ++ exploit (exec_arith_extended Val.addl Paddext (Padd X)); auto. + instantiate (1 := x0). eauto with asmgen. + intros (rs' & A & B & C). + econstructor; exists rs'; split. + apply exec_straight_opt_intro. eexact A. + split. simpl. rewrite B. rewrite Val.addl_assoc. f_equal. + unfold Op.eval_extend; destruct x, (rs x1); simpl; auto; rewrite ! a64_range; + simpl; rewrite Int64.add_zero; auto. + intros. apply C; eauto with asmgen. +- (* Aglobal *) + destruct (Ptrofs.eq (Ptrofs.modu ofs (Ptrofs.repr sz)) Ptrofs.zero && symbol_is_aligned id sz); inv TR. ++ econstructor; econstructor; split. + apply exec_straight_opt_intro. apply exec_straight_one. simpl; eauto. auto. + split. simpl. Simpl. rewrite symbol_high_low. simpl in EV. congruence. + intros; Simpl. ++ exploit (exec_loadsymbol X16 id ofs). auto. intros (rs' & A & B & C). + econstructor; exists rs'; split. + apply exec_straight_opt_intro. eexact A. + split. simpl. + rewrite B. rewrite <- Genv.shift_symbol_address_64, Ptrofs.add_zero by auto. + simpl in EV. congruence. + auto with asmgen. +- (* Ainstrack *) + assert (E: Val.addl (rs SP) (Vlong (Ptrofs.to_int64 ofs)) = Vptr b o). + { simpl in EV. inv EV. destruct (rs SP); simpl in H1; inv H1. simpl. + rewrite Ptrofs.of_int64_to_int64 by auto. auto. } + destruct (offset_representable sz (Ptrofs.to_int64 ofs)); inv TR. ++ econstructor; econstructor; split. apply exec_straight_opt_refl. + auto. ++ exploit (exec_loadimm64 X16 (Ptrofs.to_int64 ofs)). intros (rs' & A & B & C). + econstructor; exists rs'; split. + apply exec_straight_opt_intro. eexact A. + split. simpl. rewrite B, C by eauto with asmgen. auto. + auto with asmgen. +Qed. + +Lemma transl_load_correct: + forall chunk addr args dst k c (rs: regset) m vaddr v, + transl_load chunk addr args dst k = OK c -> + Op.eval_addressing ge (rs#SP) addr (map rs (map preg_of args)) = Some vaddr -> + Mem.loadv chunk m vaddr = Some v -> + exists rs', + exec_straight ge fn c rs m k rs' m + /\ rs'#(preg_of dst) = v + /\ forall r, data_preg r = true -> r <> preg_of dst -> rs' r = rs r. +Proof. + intros. destruct vaddr; try discriminate. + assert (A: exists sz insn, + transl_addressing sz addr args insn k = OK c + /\ (forall ad rs', exec_instr ge fn (insn ad) rs' m = + exec_load ge chunk (fun v => v) ad (preg_of dst) rs' m)). + { + destruct chunk; monadInv H; + try rewrite (ireg_of_eq _ _ EQ); try rewrite (freg_of_eq _ _ EQ); + do 2 econstructor; (split; [eassumption|auto]). + } + destruct A as (sz & insn & B & C). + exploit transl_addressing_correct. eexact B. eexact H0. intros (ad & rs' & P & Q & R). + assert (X: exec_load ge chunk (fun v => v) ad (preg_of dst) rs' m = + Next (nextinstr (rs'#(preg_of dst) <- v)) m). + { unfold exec_load. rewrite Q, H1. auto. } + econstructor; split. + eapply exec_straight_opt_right. eexact P. + apply exec_straight_one. rewrite C, X; eauto. Simpl. + split. Simpl. intros; Simpl. +Qed. + +Lemma transl_store_correct: + forall chunk addr args src k c (rs: regset) m vaddr m', + transl_store chunk addr args src k = OK c -> + Op.eval_addressing ge (rs#SP) addr (map rs (map preg_of args)) = Some vaddr -> + Mem.storev chunk m vaddr rs#(preg_of src) = Some m' -> + exists rs', + exec_straight ge fn c rs m k rs' m' + /\ forall r, data_preg r = true -> rs' r = rs r. +Proof. + intros. destruct vaddr; try discriminate. + set (chunk' := match chunk with Mint8signed => Mint8unsigned + | Mint16signed => Mint16unsigned + | _ => chunk end). + assert (A: exists sz insn, + transl_addressing sz addr args insn k = OK c + /\ (forall ad rs', exec_instr ge fn (insn ad) rs' m = + exec_store ge chunk' ad rs'#(preg_of src) rs' m)). + { + unfold chunk'; destruct chunk; monadInv H; + try rewrite (ireg_of_eq _ _ EQ); try rewrite (freg_of_eq _ _ EQ); + do 2 econstructor; (split; [eassumption|auto]). + } + destruct A as (sz & insn & B & C). + exploit transl_addressing_correct. eexact B. eexact H0. intros (ad & rs' & P & Q & R). + assert (X: Mem.storev chunk' m (Vptr b i) rs#(preg_of src) = Some m'). + { rewrite <- H1. unfold chunk'. destruct chunk; auto; simpl; symmetry. + apply Mem.store_signed_unsigned_8. + apply Mem.store_signed_unsigned_16. } + assert (Y: exec_store ge chunk' ad rs'#(preg_of src) rs' m = + Next (nextinstr rs') m'). + { unfold exec_store. rewrite Q, R, X by auto with asmgen. auto. } + econstructor; split. + eapply exec_straight_opt_right. eexact P. + apply exec_straight_one. rewrite C, Y; eauto. Simpl. + intros; Simpl. +Qed. + +(** Translation of indexed memory accesses *) + +Lemma indexed_memory_access_correct: forall insn sz (base: iregsp) ofs k (rs: regset) m b i, + preg_of_iregsp base <> IR X16 -> + Val.offset_ptr rs#base ofs = Vptr b i -> + exists ad rs', + exec_straight_opt ge fn (indexed_memory_access insn sz base ofs k) rs m (insn ad :: k) rs' m + /\ Asm.eval_addressing ge ad rs' = Vptr b i + /\ forall r, r <> PC -> r <> X16 -> rs' r = rs r. +Proof. + unfold indexed_memory_access; intros. + assert (Val.addl rs#base (Vlong (Ptrofs.to_int64 ofs)) = Vptr b i). + { destruct (rs base); try discriminate. simpl in *. rewrite Ptrofs.of_int64_to_int64 by auto. auto. } + destruct offset_representable. +- econstructor; econstructor; split. apply exec_straight_opt_refl. auto. +- exploit (exec_loadimm64 X16); eauto. intros (rs' & A & B & C). + econstructor; econstructor; split. apply exec_straight_opt_intro; eexact A. + split. simpl. rewrite B, C by eauto with asmgen. auto. auto. +Qed. + +Lemma loadptr_correct: forall (base: iregsp) ofs dst k m v (rs: regset), + Mem.loadv Mint64 m (Val.offset_ptr rs#base ofs) = Some v -> + preg_of_iregsp base <> IR X16 -> + exists rs', + exec_straight ge fn (loadptr base ofs dst k) rs m k rs' m + /\ rs'#dst = v + /\ forall r, r <> PC -> r <> X16 -> r <> dst -> rs' r = rs r. +Proof. + intros. + destruct (Val.offset_ptr rs#base ofs) eqn:V; try discriminate. + exploit indexed_memory_access_correct; eauto. intros (ad & rs' & A & B & C). + econstructor; split. + eapply exec_straight_opt_right. eexact A. + apply exec_straight_one. simpl. unfold exec_load. rewrite B, H. eauto. auto. + split. Simpl. intros; Simpl. +Qed. + +Lemma storeptr_correct: forall (base: iregsp) ofs (src: ireg) k m m' (rs: regset), + Mem.storev Mint64 m (Val.offset_ptr rs#base ofs) rs#src = Some m' -> + preg_of_iregsp base <> IR X16 -> + src <> X16 -> + exists rs', + exec_straight ge fn (storeptr src base ofs k) rs m k rs' m' + /\ forall r, r <> PC -> r <> X16 -> rs' r = rs r. +Proof. + intros. + destruct (Val.offset_ptr rs#base ofs) eqn:V; try discriminate. + exploit indexed_memory_access_correct; eauto. intros (ad & rs' & A & B & C). + econstructor; split. + eapply exec_straight_opt_right. eexact A. + apply exec_straight_one. simpl. unfold exec_store. rewrite B, C, H by eauto with asmgen. eauto. auto. + intros; Simpl. +Qed. + +Lemma loadind_correct: forall (base: iregsp) ofs ty dst k c (rs: regset) m v, + loadind base ofs ty dst k = OK c -> + Mem.loadv (chunk_of_type ty) m (Val.offset_ptr rs#base ofs) = Some v -> + preg_of_iregsp base <> IR X16 -> + exists rs', + exec_straight ge fn c rs m k rs' m + /\ rs'#(preg_of dst) = v + /\ forall r, data_preg r = true -> r <> preg_of dst -> rs' r = rs r. +Proof. + intros. + destruct (Val.offset_ptr rs#base ofs) eqn:V; try discriminate. + assert (X: exists sz insn, + c = indexed_memory_access insn sz base ofs k + /\ (forall ad rs', exec_instr ge fn (insn ad) rs' m = + exec_load ge (chunk_of_type ty) (fun v => v) ad (preg_of dst) rs' m)). + { + unfold loadind in H; destruct ty; destruct (preg_of dst); inv H; do 2 econstructor; eauto. + } + destruct X as (sz & insn & EQ & SEM). subst c. + exploit indexed_memory_access_correct; eauto. intros (ad & rs' & A & B & C). + econstructor; split. + eapply exec_straight_opt_right. eexact A. + apply exec_straight_one. rewrite SEM. unfold exec_load. rewrite B, H0. eauto. Simpl. + split. Simpl. intros; Simpl. +Qed. + +Lemma storeind_correct: forall (base: iregsp) ofs ty src k c (rs: regset) m m', + storeind src base ofs ty k = OK c -> + Mem.storev (chunk_of_type ty) m (Val.offset_ptr rs#base ofs) rs#(preg_of src) = Some m' -> + preg_of_iregsp base <> IR X16 -> + exists rs', + exec_straight ge fn c rs m k rs' m' + /\ forall r, data_preg r = true -> rs' r = rs r. +Proof. + intros. + destruct (Val.offset_ptr rs#base ofs) eqn:V; try discriminate. + assert (X: exists sz insn, + c = indexed_memory_access insn sz base ofs k + /\ (forall ad rs', exec_instr ge fn (insn ad) rs' m = + exec_store ge (chunk_of_type ty) ad rs'#(preg_of src) rs' m)). + { + unfold storeind in H; destruct ty; destruct (preg_of src); inv H; do 2 econstructor; eauto. + } + destruct X as (sz & insn & EQ & SEM). subst c. + exploit indexed_memory_access_correct; eauto. intros (ad & rs' & A & B & C). + econstructor; split. + eapply exec_straight_opt_right. eexact A. + apply exec_straight_one. rewrite SEM. + unfold exec_store. rewrite B, C, H0 by eauto with asmgen. eauto. + Simpl. + intros; Simpl. +Qed. + +Lemma make_epilogue_correct: + forall ge0 f m stk soff cs m' ms rs k tm, + load_stack m (Vptr stk soff) Tptr f.(fn_link_ofs) = Some (parent_sp cs) -> + load_stack m (Vptr stk soff) Tptr f.(fn_retaddr_ofs) = Some (parent_ra cs) -> + Mem.free m stk 0 f.(fn_stacksize) = Some m' -> + agree ms (Vptr stk soff) rs -> + Mem.extends m tm -> + match_stack ge0 cs -> + exists rs', exists tm', + exec_straight ge fn (make_epilogue f k) rs tm k rs' tm' + /\ agree ms (parent_sp cs) rs' + /\ Mem.extends m' tm' + /\ rs'#RA = parent_ra cs + /\ rs'#SP = parent_sp cs + /\ (forall r, r <> PC -> r <> SP -> r <> X30 -> r <> X16 -> rs'#r = rs#r). +Proof. + intros until tm; intros LP LRA FREE AG MEXT MCS. + exploit Mem.loadv_extends. eauto. eexact LP. auto. simpl. intros (parent' & LP' & LDP'). + exploit Mem.loadv_extends. eauto. eexact LRA. auto. simpl. intros (ra' & LRA' & LDRA'). + exploit lessdef_parent_sp; eauto. intros EQ; subst parent'; clear LDP'. + exploit lessdef_parent_ra; eauto. intros EQ; subst ra'; clear LDRA'. + exploit Mem.free_parallel_extends; eauto. intros (tm' & FREE' & MEXT'). + unfold make_epilogue. + exploit (loadptr_correct XSP (fn_retaddr_ofs f)). + instantiate (2 := rs). simpl. rewrite <- (sp_val _ _ _ AG). simpl. eexact LRA'. simpl; congruence. + intros (rs1 & A1 & B1 & C1). + econstructor; econstructor; split. + eapply exec_straight_trans. eexact A1. apply exec_straight_one. simpl. + simpl; rewrite (C1 SP) by auto with asmgen. rewrite <- (sp_val _ _ _ AG). simpl; rewrite LP'. + rewrite FREE'. eauto. auto. + split. apply agree_nextinstr. apply agree_set_other; auto. + apply agree_change_sp with (Vptr stk soff). + apply agree_exten with rs; auto. intros; apply C1; auto with asmgen. + eapply parent_sp_def; eauto. + split. auto. + split. Simpl. + split. Simpl. + intros. Simpl. +Qed. + +End CONSTRUCTORS. diff --git a/aarch64/TargetPrinter.ml b/aarch64/TO_MERGE/TargetPrinter.ml index 9ec1d563..bc4279a0 100644 --- a/aarch64/TargetPrinter.ml +++ b/aarch64/TO_MERGE/TargetPrinter.ml @@ -21,19 +21,147 @@ open AisAnnot open PrintAsmaux open Fileinfo +<<<<<<< HEAD (* Module containing the printing functions *) module Target (*: TARGET*) = - struct - -(* Basic printing functions *) +======= +(* Recognition of FP numbers that are supported by the fmov #imm instructions: + "a normalized binary floating point encoding with 1 sign bit, + 4 bits of fraction and a 3-bit exponent" +*) + +let is_immediate_float64 bits = + let exp = (Int64.(to_int (shift_right_logical bits 52)) land 0x7FF) - 1023 in + let mant = Int64.logand bits 0xF_FFFF_FFFF_FFFFL in + exp >= -3 && exp <= 4 && Int64.logand mant 0xF_0000_0000_0000L = mant + +let is_immediate_float32 bits = + let exp = (Int32.(to_int (shift_right_logical bits 23)) land 0xFF) - 127 in + let mant = Int32.logand bits 0x7F_FFFFl in + exp >= -3 && exp <= 4 && Int32.logand mant 0x78_0000l = mant + +(* Naming and printing registers *) + +let intsz oc (sz, n) = + match sz with X -> coqint64 oc n | W -> coqint oc n + +let xreg_name = function + | X0 -> "x0" | X1 -> "x1" | X2 -> "x2" | X3 -> "x3" + | X4 -> "x4" | X5 -> "x5" | X6 -> "x6" | X7 -> "x7" + | X8 -> "x8" | X9 -> "x9" | X10 -> "x10" | X11 -> "x11" + | X12 -> "x12" | X13 -> "x13" | X14 -> "x14" | X15 -> "x15" + | X16 -> "x16" | X17 -> "x17" | X18 -> "x18" | X19 -> "x19" + | X20 -> "x20" | X21 -> "x21" | X22 -> "x22" | X23 -> "x23" + | X24 -> "x24" | X25 -> "x25" | X26 -> "x26" | X27 -> "x27" + | X28 -> "x28" | X29 -> "x29" | X30 -> "x30" + +let wreg_name = function + | X0 -> "w0" | X1 -> "w1" | X2 -> "w2" | X3 -> "w3" + | X4 -> "w4" | X5 -> "w5" | X6 -> "w6" | X7 -> "w7" + | X8 -> "w8" | X9 -> "w9" | X10 -> "w10" | X11 -> "w11" + | X12 -> "w12" | X13 -> "w13" | X14 -> "w14" | X15 -> "w15" + | X16 -> "w16" | X17 -> "w17" | X18 -> "w18" | X19 -> "w19" + | X20 -> "w20" | X21 -> "w21" | X22 -> "w22" | X23 -> "w23" + | X24 -> "w24" | X25 -> "w25" | X26 -> "w26" | X27 -> "w27" + | X28 -> "w28" | X29 -> "w29" | X30 -> "w30" + +let xreg0_name = function RR0 r -> xreg_name r | XZR -> "xzr" +let wreg0_name = function RR0 r -> wreg_name r | XZR -> "wzr" + +let xregsp_name = function RR1 r -> xreg_name r | XSP -> "sp" +let wregsp_name = function RR1 r -> wreg_name r | XSP -> "wsp" + +let dreg_name = function +| D0 -> "d0" | D1 -> "d1" | D2 -> "d2" | D3 -> "d3" +| D4 -> "d4" | D5 -> "d5" | D6 -> "d6" | D7 -> "d7" +| D8 -> "d8" | D9 -> "d9" | D10 -> "d10" | D11 -> "d11" +| D12 -> "d12" | D13 -> "d13" | D14 -> "d14" | D15 -> "d15" +| D16 -> "d16" | D17 -> "d17" | D18 -> "d18" | D19 -> "d19" +| D20 -> "d20" | D21 -> "d21" | D22 -> "d22" | D23 -> "d23" +| D24 -> "d24" | D25 -> "d25" | D26 -> "d26" | D27 -> "d27" +| D28 -> "d28" | D29 -> "d29" | D30 -> "d30" | D31 -> "d31" + +let sreg_name = function +| D0 -> "s0" | D1 -> "s1" | D2 -> "s2" | D3 -> "s3" +| D4 -> "s4" | D5 -> "s5" | D6 -> "s6" | D7 -> "s7" +| D8 -> "s8" | D9 -> "s9" | D10 -> "s10" | D11 -> "s11" +| D12 -> "s12" | D13 -> "s13" | D14 -> "s14" | D15 -> "s15" +| D16 -> "s16" | D17 -> "s17" | D18 -> "s18" | D19 -> "s19" +| D20 -> "s20" | D21 -> "s21" | D22 -> "s22" | D23 -> "s23" +| D24 -> "s24" | D25 -> "s25" | D26 -> "s26" | D27 -> "s27" +| D28 -> "s28" | D29 -> "s29" | D30 -> "s30" | D31 -> "s31" + +let xreg oc r = output_string oc (xreg_name r) +let wreg oc r = output_string oc (wreg_name r) +let ireg oc (sz, r) = + output_string oc (match sz with X -> xreg_name r | W -> wreg_name r) + +let xreg0 oc r = output_string oc (xreg0_name r) +let wreg0 oc r = output_string oc (wreg0_name r) +let ireg0 oc (sz, r) = + output_string oc (match sz with X -> xreg0_name r | W -> wreg0_name r) + +let xregsp oc r = output_string oc (xregsp_name r) +let iregsp oc (sz, r) = + output_string oc (match sz with X -> xregsp_name r | W -> wregsp_name r) + +let dreg oc r = output_string oc (dreg_name r) +let sreg oc r = output_string oc (sreg_name r) +let freg oc (sz, r) = + output_string oc (match sz with D -> dreg_name r | S -> sreg_name r) + +let preg_asm oc ty = function + | IR r -> if ty = Tint then wreg oc r else xreg oc r + | FR r -> if ty = Tsingle then sreg oc r else dreg oc r + | _ -> assert false + +let preg_annot = function + | IR r -> xreg_name r + | FR r -> dreg_name r + | _ -> assert false + +(* Base-2 log of a Caml integer *) +let rec log2 n = + assert (n > 0); + if n = 1 then 0 else 1 + log2 (n lsr 1) + +(* System dependent printer functions *) + +module type SYSTEM = + sig + val comment: string + val raw_symbol: out_channel -> string -> unit + val symbol: out_channel -> P.t -> unit + val symbol_offset_high: out_channel -> P.t * Z.t -> unit + val symbol_offset_low: out_channel -> P.t * Z.t -> unit + val label: out_channel -> int -> unit + val label_high: out_channel -> int -> unit + val label_low: out_channel -> int -> unit + val load_symbol_address: out_channel -> ireg -> P.t -> unit + val name_of_section: section_name -> string + val print_fun_info: out_channel -> P.t -> unit + val print_var_info: out_channel -> P.t -> unit + val print_comm_decl: out_channel -> P.t -> Z.t -> int -> unit + val print_lcomm_decl: out_channel -> P.t -> Z.t -> int -> unit + end +module ELF_System : SYSTEM = +>>>>>>> master + struct let comment = "//" - - let symbol = elf_symbol - let symbol_offset = elf_symbol_offset - let label = elf_label - + let raw_symbol = output_string + let symbol = elf_symbol + let symbol_offset_high = elf_symbol_offset + let symbol_offset_low oc id_ofs = + fprintf oc "#:lo12:%a" elf_symbol_offset id_ofs + + let label = elf_label + let label_high = elf_label + let label_low oc lbl = + fprintf oc "#:lo12:%a" elf_label lbl + +<<<<<<< HEAD let print_label oc lbl = label oc (transl_label lbl) let intsz oc (sz, n) = @@ -122,8 +250,18 @@ module Target (*: TARGET*) = failwith "_Thread_local unsupported on this platform" | Section_data(i, false) | Section_small_data i -> if i then ".data" else common_section () +======= + let load_symbol_address oc rd id = + fprintf oc " adrp %a, :got:%a\n" xreg rd symbol id; + fprintf oc " ldr %a, [%a, #:got_lo12:%a]\n" xreg rd xreg rd symbol id + + let name_of_section = function + | Section_text -> ".text" + | Section_data i | Section_small_data i -> + variable_section ~sec:".data" ~bss:".bss" i +>>>>>>> master | Section_const i | Section_small_const i -> - if i || (not !Clflags.option_fcommon) then ".section .rodata" else "COMM" + variable_section ~sec:".section .rodata" i | Section_string -> ".section .rodata" | Section_literal -> ".section .rodata" | Section_jumptable -> ".section .rodata" @@ -138,6 +276,94 @@ module Target (*: TARGET*) = s (if wr then "w" else "") (if ex then "x" else "") | Section_ais_annotation -> sprintf ".section \"__compcert_ais_annotations\",\"\",@note" + let print_fun_info = elf_print_fun_info + let print_var_info = elf_print_var_info + + let print_comm_decl oc name sz al = + fprintf oc " .comm %a, %s, %d\n" symbol name (Z.to_string sz) al + + let print_lcomm_decl oc name sz al = + fprintf oc " .local %a\n" symbol name; + print_comm_decl oc name sz al + + end + +module MacOS_System : SYSTEM = + struct + let comment = ";" + + let raw_symbol oc s = + fprintf oc "_%s" s + + let symbol oc symb = + raw_symbol oc (extern_atom symb) + + let symbol_offset_gen kind oc (id, ofs) = + fprintf oc "%a@%s" symbol id kind; + let ofs = camlint64_of_ptrofs ofs in + if ofs <> 0L then fprintf oc " + %Ld" ofs + + let symbol_offset_high = symbol_offset_gen "PAGE" + let symbol_offset_low = symbol_offset_gen "PAGEOFF" + + let label oc lbl = + fprintf oc "L%d" lbl + + let label_high oc lbl = + fprintf oc "%a@PAGE" label lbl + let label_low oc lbl = + fprintf oc "%a@PAGEOFF" label lbl + + let load_symbol_address oc rd id = + fprintf oc " adrp %a, %a@GOTPAGE\n" xreg rd symbol id; + fprintf oc " ldr %a, [%a, %a@GOTPAGEOFF]\n" xreg rd xreg rd symbol id + + let name_of_section = function + | Section_text -> ".text" + | Section_data i | Section_small_data i -> + variable_section ~sec:".data" i + | Section_const i | Section_small_const i -> + variable_section ~sec:".const" ~reloc:".const_data" i + | Section_string -> ".const" + | Section_literal -> ".const" + | Section_jumptable -> ".text" + | Section_user(s, wr, ex) -> + sprintf ".section \"%s\", %s, %s" + (if wr then "__DATA" else "__TEXT") s + (if ex then "regular, pure_instructions" else "regular") + | Section_debug_info _ -> ".section __DWARF,__debug_info,regular,debug" + | Section_debug_loc -> ".section __DWARF,__debug_loc,regular,debug" + | Section_debug_line _ -> ".section __DWARF,__debug_line,regular,debug" + | Section_debug_str -> ".section __DWARF,__debug_str,regular,debug" + | Section_debug_ranges -> ".section __DWARF,__debug_ranges,regular,debug" + | Section_debug_abbrev -> ".section __DWARF,__debug_abbrev,regular,debug" + | Section_ais_annotation -> assert false (* Not supported under MacOS *) + + let print_fun_info _ _ = () + let print_var_info _ _ = () + + let print_comm_decl oc name sz al = + fprintf oc " .comm %a, %s, %d\n" + symbol name (Z.to_string sz) (log2 al) + + let print_lcomm_decl oc name sz al = + fprintf oc " .lcomm %a, %s, %d\n" + symbol name (Z.to_string sz) (log2 al) + + end + +(* Module containing the printing functions *) + +module Target(System: SYSTEM): TARGET = + struct + include System + +(* Basic printing functions *) + + let print_label oc lbl = label oc (transl_label lbl) + +(* Names of sections *) + let section oc sec = fprintf oc " %s\n" (name_of_section sec) @@ -193,7 +419,7 @@ module Target (*: TARGET*) = | ADlsl(base, r, n) -> fprintf oc "[%a, %a, lsl #%a]" xregsp base xreg r coqint n | ADsxt(base, r, n) -> fprintf oc "[%a, %a, sxtw #%a]" xregsp base wreg r coqint n | ADuxt(base, r, n) -> fprintf oc "[%a, %a, uxtw #%a]" xregsp base wreg r coqint n - | ADadr(base, id, ofs) -> fprintf oc "[%a, #:lo12:%a]" xregsp base symbol_offset (id, ofs) + | ADadr(base, id, ofs) -> fprintf oc "[%a, %a]" xregsp base symbol_offset_low (id, ofs) | ADpostincr(base, n) -> fprintf oc "[%a], #%a" xregsp base coqint64 n (* Print a shifted operand *) @@ -204,15 +430,15 @@ module Target (*: TARGET*) = | SOasr n -> fprintf oc ", asr #%a" coqint n | SOror n -> fprintf oc ", ror #%a" coqint n -(* Print a sign- or zero-extended operand *) - let extendop oc = function - | EOsxtb n -> fprintf oc ", sxtb #%a" coqint n - | EOsxth n -> fprintf oc ", sxth #%a" coqint n - | EOsxtw n -> fprintf oc ", sxtw #%a" coqint n - | EOuxtb n -> fprintf oc ", uxtb #%a" coqint n - | EOuxth n -> fprintf oc ", uxth #%a" coqint n - | EOuxtw n -> fprintf oc ", uxtw #%a" coqint n - | EOuxtx n -> fprintf oc ", uxtx #%a" coqint n +(* Print a sign- or zero-extended register operand *) + let regextend oc = function + | (r, EOsxtb n) -> fprintf oc "%a, sxtb #%a" wreg r coqint n + | (r, EOsxth n) -> fprintf oc "%a, sxth #%a" wreg r coqint n + | (r, EOsxtw n) -> fprintf oc "%a, sxtw #%a" wreg r coqint n + | (r, EOuxtb n) -> fprintf oc "%a, uxtb #%a" wreg r coqint n + | (r, EOuxth n) -> fprintf oc "%a, uxth #%a" wreg r coqint n + | (r, EOuxtw n) -> fprintf oc "%a, uxtw #%a" wreg r coqint n + | (r, EOuxtx n) -> fprintf oc "%a, uxtx #%a" xreg r coqint n let next_profiling_label = let atomic_incr_counter = ref 0 in @@ -325,9 +551,9 @@ module Target (*: TARGET*) = fprintf oc " movk %a, #%d, lsl #%d\n" ireg (sz, rd) (Z.to_int n) (Z.to_int pos) (* PC-relative addressing *) | Padrp(rd, id, ofs) -> - fprintf oc " adrp %a, %a\n" xreg rd symbol_offset (id, ofs) + fprintf oc " adrp %a, %a\n" xreg rd symbol_offset_high (id, ofs) | Paddadr(rd, r1, id, ofs) -> - fprintf oc " add %a, %a, #:lo12:%a\n" xreg rd xreg r1 symbol_offset (id, ofs) + fprintf oc " add %a, %a, %a\n" xreg rd xreg r1 symbol_offset_low (id, ofs) (* Bit-field operations *) | Psbfiz(sz, rd, r1, r, s) -> fprintf oc " sbfiz %a, %a, %a, %d\n" ireg (sz, rd) ireg (sz, r1) coqint r (Z.to_int s) @@ -348,13 +574,13 @@ module Target (*: TARGET*) = fprintf oc " cmn %a, %a%a\n" ireg0 (sz, r1) ireg (sz, r2) shiftop s (* Integer arithmetic, extending register *) | Paddext(rd, r1, r2, x) -> - fprintf oc " add %a, %a, %a%a\n" xregsp rd xregsp r1 wreg r2 extendop x + fprintf oc " add %a, %a, %a\n" xregsp rd xregsp r1 regextend (r2, x) | Psubext(rd, r1, r2, x) -> - fprintf oc " sub %a, %a, %a%a\n" xregsp rd xregsp r1 wreg r2 extendop x + fprintf oc " sub %a, %a, %a\n" xregsp rd xregsp r1 regextend (r2, x) | Pcmpext(r1, r2, x) -> - fprintf oc " cmp %a, %a%a\n" xreg r1 wreg r2 extendop x + fprintf oc " cmp %a, %a\n" xreg r1 regextend (r2, x) | Pcmnext(r1, r2, x) -> - fprintf oc " cmn %a, %a%a\n" xreg r1 wreg r2 extendop x + fprintf oc " cmn %a, %a\n" xreg r1 regextend (r2, x) (* Logical, shifted register *) | Pand(sz, rd, r1, r2, s) -> fprintf oc " and %a, %a, %a%a\n" ireg (sz, rd) ireg0 (sz, r1) ireg (sz, r2) shiftop s @@ -434,8 +660,8 @@ module Target (*: TARGET*) = fprintf oc " fmov %a, #%.7f\n" dreg rd (Int64.float_of_bits d) else begin let lbl = label_literal64 d in - fprintf oc " adrp x16, %a\n" label lbl; - fprintf oc " ldr %a, [x16, #:lo12:%a] %s %.18g\n" dreg rd label lbl comment (Int64.float_of_bits d) + fprintf oc " adrp x16, %a\n" label_high lbl; + fprintf oc " ldr %a, [x16, %a] %s %.18g\n" dreg rd label_low lbl comment (Int64.float_of_bits d) end | Pfmovimms(rd, f) -> let d = camlint_of_coqint (Floats.Float32.to_bits f) in @@ -443,8 +669,8 @@ module Target (*: TARGET*) = fprintf oc " fmov %a, #%.7f\n" sreg rd (Int32.float_of_bits d) else begin let lbl = label_literal32 d in - fprintf oc " adrp x16, %a\n" label lbl; - fprintf oc " ldr %a, [x16, #:lo12:%a] %s %.18g\n" sreg rd label lbl comment (Int32.float_of_bits d) + fprintf oc " adrp x16, %a\n" label_high lbl; + fprintf oc " ldr %a, [x16, %a] %s %.18g\n" sreg rd label_low lbl comment (Int32.float_of_bits d) end | Pfmovi(D, rd, r1) -> fprintf oc " fmov %a, %a\n" dreg rd xreg0 r1 @@ -511,8 +737,7 @@ module Target (*: TARGET*) = | Plabel lbl -> fprintf oc "%a:\n" print_label lbl | Ploadsymbol(rd, id) -> - fprintf oc " adrp %a, :got:%a\n" xreg rd symbol id; - fprintf oc " ldr %a, [%a, #:got_lo12:%a]\n" xreg rd xreg rd symbol id + load_symbol_address oc rd id | Pcvtsw2x(rd, r1) -> fprintf oc " sxtw %a, %a\n" xreg rd wreg r1 | Pcvtuw2x(rd, r1) -> @@ -577,19 +802,12 @@ module Target (*: TARGET*) = jumptables := [] end - let print_fun_info = elf_print_fun_info - let print_optional_fun_info _ = () - let print_var_info = elf_print_var_info - let print_comm_symb oc sz name align = - if C2C.atom_is_static name then - fprintf oc " .local %a\n" symbol name; - fprintf oc " .comm %a, %s, %d\n" - symbol name - (Z.to_string sz) - align + if C2C.atom_is_static name + then print_lcomm_decl oc name sz align + else print_comm_decl oc name sz align let print_instructions oc fn = current_function_sig := fn.fn_sig; @@ -627,7 +845,7 @@ module Target (*: TARGET*) = section oc Section_text; end - let default_falignment = 2 + let default_falignment = 4 let cfi_startproc oc = () let cfi_endproc oc = () @@ -635,4 +853,10 @@ module Target (*: TARGET*) = end let sel_target () = - (module Target:TARGET) + let module S = + (val (match Configuration.system with + | "linux" -> (module ELF_System : SYSTEM) + | "macos" -> (module MacOS_System : SYSTEM) + | _ -> invalid_arg ("System " ^ Configuration.system ^ " not supported")) + : SYSTEM) in + (module Target(S) : TARGET) diff --git a/aarch64/extractionMachdep.v b/aarch64/TO_MERGE/extractionMachdep.v index 69edeb55..947fa38b 100644 --- a/aarch64/extractionMachdep.v +++ b/aarch64/TO_MERGE/extractionMachdep.v @@ -15,13 +15,31 @@ (* Additional extraction directives specific to the AArch64 port *) -Require Archi Asm. +Require Archi Asm Asmgen SelectOp. (* Archi *) -Extract Constant Archi.pic_code => "fun () -> false". (* for the time being *) +Extract Constant Archi.abi => + "match Configuration.abi with + | ""apple"" -> Apple + | _ -> AAPCS64". + +(* SelectOp *) + +Extract Constant SelectOp.symbol_is_relocatable => + "match Configuration.system with + | ""macos"" -> C2C.atom_is_extern + | _ -> (fun _ -> false)". (* Asm *) + Extract Constant Asm.symbol_low => "fun _ _ _ -> assert false". Extract Constant Asm.symbol_high => "fun _ _ _ -> assert false". +<<<<<<< HEAD Extract Constant Asmblockgen.symbol_is_aligned => "C2C.atom_is_aligned". +======= + +(* Asmgen *) + +Extract Constant Asmgen.symbol_is_aligned => "C2C.atom_is_aligned". +>>>>>>> master @@ -1004,7 +1004,7 @@ Ltac Equalities := split. auto. intros. destruct B; auto. subst. auto. (* trace length *) red; intros; inv H; simpl. - omega. + lia. inv H3; eapply external_call_trace_length; eauto. eapply external_call_trace_length; eauto. (* initial states *) diff --git a/arm/Asmexpand.ml b/arm/Asmexpand.ml index 104bfc94..83bce915 100644 --- a/arm/Asmexpand.ml +++ b/arm/Asmexpand.ml @@ -545,7 +545,7 @@ module FixupHF = struct end let fixup_arguments dir sg = - if sg.sig_cc.cc_vararg then + if sg.sig_cc.cc_vararg <> None then FixupEABI.fixup_arguments dir sg else begin let act = fixup_actions (Array.make 16 false) 0 sg.sig_args in @@ -555,7 +555,7 @@ module FixupHF = struct end let fixup_result dir sg = - if sg.sig_cc.cc_vararg then + if sg.sig_cc.cc_vararg <> None then FixupEABI.fixup_result dir sg end diff --git a/arm/Asmgenproof.v b/arm/Asmgenproof.v index fd70c9ad..67cfe0ae 100644 --- a/arm/Asmgenproof.v +++ b/arm/Asmgenproof.v @@ -68,7 +68,7 @@ Lemma transf_function_no_overflow: forall f tf, transf_function f = OK tf -> list_length_z (fn_code tf) <= Ptrofs.max_unsigned. Proof. - intros. monadInv H. destruct (zlt Ptrofs.max_unsigned (list_length_z (fn_code x))); inv EQ0. omega. + intros. monadInv H. destruct (zlt Ptrofs.max_unsigned (list_length_z (fn_code x))); inv EQ0. lia. Qed. Lemma exec_straight_exec: @@ -122,13 +122,13 @@ Proof. case (is_label lbl a). intro EQ; injection EQ; intro; subst c'. exists (pos + 1). split. auto. split. - replace (pos + 1 - pos) with (0 + 1) by omega. constructor. constructor. - rewrite list_length_z_cons. generalize (list_length_z_pos c). omega. + replace (pos + 1 - pos) with (0 + 1) by lia. constructor. constructor. + rewrite list_length_z_cons. generalize (list_length_z_pos c). lia. intros. generalize (IHc (pos + 1) c' H). intros [pos' [A [B C]]]. exists pos'. split. auto. split. - replace (pos' - pos) with ((pos' - (pos + 1)) + 1) by omega. + replace (pos' - pos) with ((pos' - (pos + 1)) + 1) by lia. constructor. auto. - rewrite list_length_z_cons. omega. + rewrite list_length_z_cons. lia. Qed. (** The following lemmas show that the translation from Mach to ARM @@ -379,8 +379,8 @@ Proof. split. unfold goto_label. rewrite P. rewrite H1. auto. split. rewrite Pregmap.gss. constructor; auto. rewrite Ptrofs.unsigned_repr. replace (pos' - 0) with pos' in Q. - auto. omega. - generalize (transf_function_no_overflow _ _ H0). omega. + auto. lia. + generalize (transf_function_no_overflow _ _ H0). lia. intros. apply Pregmap.gso; auto. Qed. @@ -910,11 +910,11 @@ Opaque loadind. simpl; reflexivity. reflexivity. } (* After the function prologue is the code for the function body *) - exploit exec_straight_steps_2; eauto using functions_transl. omega. constructor. + exploit exec_straight_steps_2; eauto using functions_transl. lia. constructor. intros (ofsbody & U & V). (* Conclusions *) left; exists (State rs4 m3'); split. - eapply exec_straight_steps_1; eauto. omega. constructor. + eapply exec_straight_steps_1; eauto. lia. constructor. econstructor; eauto. rewrite U. econstructor; eauto. apply agree_nextinstr. apply agree_undef_regs2 with rs2. @@ -941,7 +941,7 @@ Opaque loadind. - (* return *) inv STACKS. simpl in *. - right. split. omega. split. auto. + right. split. lia. split. auto. rewrite <- ATPC in H5. econstructor; eauto. congruence. Qed. diff --git a/arm/Asmgenproof1.v b/arm/Asmgenproof1.v index cdac697e..7a707f32 100644 --- a/arm/Asmgenproof1.v +++ b/arm/Asmgenproof1.v @@ -40,14 +40,14 @@ Lemma ireg_of_not_R14: Proof. intros. erewrite <- ireg_of_eq; eauto with asmgen. Qed. -Hint Resolve ireg_of_not_R14: asmgen. +Global Hint Resolve ireg_of_not_R14: asmgen. Lemma ireg_of_not_R14': forall m r, ireg_of m = OK r -> r <> IR14. Proof. intros. generalize (ireg_of_not_R14 _ _ H). congruence. Qed. -Hint Resolve ireg_of_not_R14': asmgen. +Global Hint Resolve ireg_of_not_R14': asmgen. (** [undef_flags] and [nextinstr_nf] *) @@ -75,7 +75,7 @@ Proof. intros; red; intros; subst; discriminate. Qed. -Hint Resolve data_if_preg if_preg_not_PC: asmgen. +Global Hint Resolve data_if_preg if_preg_not_PC: asmgen. Lemma nextinstr_nf_inv: forall r rs, if_preg r = true -> (nextinstr_nf rs)#r = rs#r. @@ -352,15 +352,15 @@ Proof. apply exec_straight_one. simpl; eauto. auto. split; intros; Simpl. econstructor; split. eapply exec_straight_two. simpl; reflexivity. simpl; reflexivity. auto. auto. - split; intros; Simpl. simpl. f_equal. rewrite Int.zero_ext_and by omega. + split; intros; Simpl. simpl. f_equal. rewrite Int.zero_ext_and by lia. rewrite Int.and_assoc. change 65535 with (two_p 16 - 1). rewrite Int.and_idem. apply Int.same_bits_eq; intros. rewrite Int.bits_or, Int.bits_and, Int.bits_shl, Int.testbit_repr by auto. - rewrite Ztestbit_two_p_m1 by omega. change (Int.unsigned (Int.repr 16)) with 16. + rewrite Ztestbit_two_p_m1 by lia. change (Int.unsigned (Int.repr 16)) with 16. destruct (zlt i 16). rewrite andb_true_r, orb_false_r; auto. - rewrite andb_false_r; simpl. rewrite Int.bits_shru by omega. - change (Int.unsigned (Int.repr 16)) with 16. rewrite zlt_true by omega. f_equal; omega. + rewrite andb_false_r; simpl. rewrite Int.bits_shru by lia. + change (Int.unsigned (Int.repr 16)) with 16. rewrite zlt_true by lia. f_equal; lia. } destruct (Nat.leb l1 l2). { (* mov - orr* *) @@ -696,10 +696,10 @@ Lemma int_not_lt: Proof. intros. unfold Int.lt. rewrite int_signed_eq. unfold proj_sumbool. destruct (zlt (Int.signed y) (Int.signed x)). - rewrite zlt_false. rewrite zeq_false. auto. omega. omega. + rewrite zlt_false. rewrite zeq_false. auto. lia. lia. destruct (zeq (Int.signed x) (Int.signed y)). - rewrite zlt_false. auto. omega. - rewrite zlt_true. auto. omega. + rewrite zlt_false. auto. lia. + rewrite zlt_true. auto. lia. Qed. Lemma int_lt_not: @@ -713,10 +713,10 @@ Lemma int_not_ltu: Proof. intros. unfold Int.ltu, Int.eq. destruct (zlt (Int.unsigned y) (Int.unsigned x)). - rewrite zlt_false. rewrite zeq_false. auto. omega. omega. + rewrite zlt_false. rewrite zeq_false. auto. lia. lia. destruct (zeq (Int.unsigned x) (Int.unsigned y)). - rewrite zlt_false. auto. omega. - rewrite zlt_true. auto. omega. + rewrite zlt_false. auto. lia. + rewrite zlt_true. auto. lia. Qed. Lemma int_ltu_not: @@ -1296,16 +1296,16 @@ Local Transparent destroyed_by_op. rewrite Int.unsigned_repr. apply zlt_true. assert (Int.unsigned i <> 0). { red; intros; elim H. rewrite <- (Int.repr_unsigned i). rewrite H1; reflexivity. } - omega. + lia. change (Int.unsigned (Int.repr 31)) with (Int.zwordsize - 1) in H0. - generalize Int.wordsize_max_unsigned; omega. + generalize Int.wordsize_max_unsigned; lia. } assert (LTU'': Int.ltu i Int.iwordsize = true). { generalize (Int.ltu_inv _ _ LTU). intros. unfold Int.ltu. rewrite Int.unsigned_repr_wordsize. apply zlt_true. change (Int.unsigned (Int.repr 31)) with (Int.zwordsize - 1) in H0. - omega. + lia. } set (j := Int.sub Int.iwordsize i) in *. set (rs1 := nextinstr_nf (rs#IR14 <- (Val.shr (Vint i0) (Vint (Int.repr 31))))). diff --git a/arm/ConstpropOpproof.v b/arm/ConstpropOpproof.v index a4f5c29c..cd0afb7a 100644 --- a/arm/ConstpropOpproof.v +++ b/arm/ConstpropOpproof.v @@ -451,7 +451,7 @@ Proof. Int.bit_solve. destruct (zlt i0 n0). replace (Int.testbit n i0) with (negb (Int.testbit Int.zero i0)). rewrite Int.bits_zero. simpl. rewrite andb_true_r. auto. - rewrite <- EQ. rewrite Int.bits_zero_ext by omega. rewrite zlt_true by auto. + rewrite <- EQ. rewrite Int.bits_zero_ext by lia. rewrite zlt_true by auto. rewrite Int.bits_not by auto. apply negb_involutive. rewrite H6 by auto. auto. econstructor; split; eauto. auto. diff --git a/arm/Conventions1.v b/arm/Conventions1.v index fe49a781..0ddd882f 100644 --- a/arm/Conventions1.v +++ b/arm/Conventions1.v @@ -309,7 +309,7 @@ Remark loc_arguments_hf_charact: In p (loc_arguments_hf tyl ir fr ofs) -> forall_rpair (loc_argument_charact ofs) p. Proof. assert (X: forall ofs1 ofs2 l, loc_argument_charact ofs2 l -> ofs1 <= ofs2 -> loc_argument_charact ofs1 l). - { destruct l; simpl; intros; auto. destruct sl; auto. intuition omega. } + { destruct l; simpl; intros; auto. destruct sl; auto. intuition lia. } assert (Y: forall ofs1 ofs2 p, forall_rpair (loc_argument_charact ofs2) p -> ofs1 <= ofs2 -> forall_rpair (loc_argument_charact ofs1) p). { destruct p; simpl; intuition eauto. } induction tyl; simpl loc_arguments_hf; intros. @@ -319,40 +319,40 @@ Proof. destruct (zlt ir 4); destruct H. subst. apply ireg_param_caller_save. eapply IHtyl; eauto. - subst. split; [omega | auto]. - eapply Y; eauto. omega. + subst. split; [lia | auto]. + eapply Y; eauto. lia. - (* float *) destruct (zlt fr 8); destruct H. subst. apply freg_param_caller_save. eapply IHtyl; eauto. - subst. split. apply Z.le_ge. apply align_le. omega. auto. - eapply Y; eauto. apply Z.le_trans with (align ofs 2). apply align_le; omega. omega. + subst. split. apply Z.le_ge. apply align_le. lia. auto. + eapply Y; eauto. apply Z.le_trans with (align ofs 2). apply align_le; lia. lia. - (* long *) set (ir' := align ir 2) in *. - assert (ofs <= align ofs 2) by (apply align_le; omega). + assert (ofs <= align ofs 2) by (apply align_le; lia). destruct (zlt ir' 4). destruct H. subst p. split; apply ireg_param_caller_save. eapply IHtyl; eauto. - destruct H. subst p. split; destruct Archi.big_endian; (split; [ omega | auto ]). - eapply Y. eapply IHtyl; eauto. omega. + destruct H. subst p. split; destruct Archi.big_endian; (split; [ lia | auto ]). + eapply Y. eapply IHtyl; eauto. lia. - (* single *) destruct (zlt fr 8); destruct H. subst. apply freg_param_caller_save. eapply IHtyl; eauto. - subst. split; [omega|auto]. - eapply Y; eauto. omega. + subst. split; [lia|auto]. + eapply Y; eauto. lia. - (* any32 *) destruct (zlt ir 4); destruct H. subst. apply ireg_param_caller_save. eapply IHtyl; eauto. - subst. split; [omega | auto]. - eapply Y; eauto. omega. + subst. split; [lia | auto]. + eapply Y; eauto. lia. - (* any64 *) destruct (zlt fr 8); destruct H. subst. apply freg_param_caller_save. eapply IHtyl; eauto. - subst. split. apply Z.le_ge. apply align_le. omega. auto. - eapply Y; eauto. apply Z.le_trans with (align ofs 2). apply align_le; omega. omega. + subst. split. apply Z.le_ge. apply align_le. lia. auto. + eapply Y; eauto. apply Z.le_trans with (align ofs 2). apply align_le; lia. lia. Qed. Remark loc_arguments_sf_charact: @@ -360,7 +360,7 @@ Remark loc_arguments_sf_charact: In p (loc_arguments_sf tyl ofs) -> forall_rpair (loc_argument_charact (Z.max 0 ofs)) p. Proof. assert (X: forall ofs1 ofs2 l, loc_argument_charact (Z.max 0 ofs2) l -> ofs1 <= ofs2 -> loc_argument_charact (Z.max 0 ofs1) l). - { destruct l; simpl; intros; auto. destruct sl; auto. intuition xomega. } + { destruct l; simpl; intros; auto. destruct sl; auto. intuition extlia. } assert (Y: forall ofs1 ofs2 p, forall_rpair (loc_argument_charact (Z.max 0 ofs2)) p -> ofs1 <= ofs2 -> forall_rpair (loc_argument_charact (Z.max 0 ofs1)) p). { destruct p; simpl; intuition eauto. } induction tyl; simpl loc_arguments_sf; intros. @@ -370,44 +370,44 @@ Proof. destruct H. destruct (zlt ofs 0); subst p. apply ireg_param_caller_save. - split; [xomega|auto]. - eapply Y; eauto. omega. + split; [extlia|auto]. + eapply Y; eauto. lia. - (* float *) set (ofs' := align ofs 2) in *. - assert (ofs <= ofs') by (apply align_le; omega). + assert (ofs <= ofs') by (apply align_le; lia). destruct H. destruct (zlt ofs' 0); subst p. apply freg_param_caller_save. - split; [xomega|auto]. - eapply Y. eapply IHtyl; eauto. omega. + split; [extlia|auto]. + eapply Y. eapply IHtyl; eauto. lia. - (* long *) set (ofs' := align ofs 2) in *. - assert (ofs <= ofs') by (apply align_le; omega). + assert (ofs <= ofs') by (apply align_le; lia). destruct H. destruct (zlt ofs' 0); subst p. split; apply ireg_param_caller_save. - split; destruct Archi.big_endian; (split; [xomega|auto]). - eapply Y. eapply IHtyl; eauto. omega. + split; destruct Archi.big_endian; (split; [extlia|auto]). + eapply Y. eapply IHtyl; eauto. lia. - (* single *) destruct H. destruct (zlt ofs 0); subst p. apply freg_param_caller_save. - split; [xomega|auto]. - eapply Y; eauto. omega. + split; [extlia|auto]. + eapply Y; eauto. lia. - (* any32 *) destruct H. destruct (zlt ofs 0); subst p. apply ireg_param_caller_save. - split; [xomega|auto]. - eapply Y; eauto. omega. + split; [extlia|auto]. + eapply Y; eauto. lia. - (* any64 *) set (ofs' := align ofs 2) in *. - assert (ofs <= ofs') by (apply align_le; omega). + assert (ofs <= ofs') by (apply align_le; lia). destruct H. destruct (zlt ofs' 0); subst p. apply freg_param_caller_save. - split; [xomega|auto]. - eapply Y. eapply IHtyl; eauto. omega. + split; [extlia|auto]. + eapply Y. eapply IHtyl; eauto. lia. Qed. Lemma loc_arguments_acceptable: @@ -427,7 +427,7 @@ Proof. destruct Archi.abi; [ | destruct (cc_vararg (sig_cc s)) ]; auto. Qed. -Hint Resolve loc_arguments_acceptable: locs. +Global Hint Resolve loc_arguments_acceptable: locs. Lemma loc_arguments_main: loc_arguments signature_main = nil. @@ -436,8 +436,9 @@ Proof. destruct Archi.abi; reflexivity. Qed. -(** ** Normalization of function results *) +(** ** Normalization of function results and parameters *) (** No normalization needed. *) Definition return_value_needs_normalization (t: rettype) := false. +Definition parameter_needs_normalization (t: rettype) := false. diff --git a/arm/NeedOp.v b/arm/NeedOp.v index c70c7e40..23e8f047 100644 --- a/arm/NeedOp.v +++ b/arm/NeedOp.v @@ -198,8 +198,8 @@ Lemma operation_is_redundant_sound: vagree v arg1' nv. Proof. intros. destruct op; simpl in *; try discriminate; inv H1; FuncInv; subst. -- apply sign_ext_redundant_sound; auto. omega. -- apply sign_ext_redundant_sound; auto. omega. +- apply sign_ext_redundant_sound; auto. lia. +- apply sign_ext_redundant_sound; auto. lia. - apply andimm_redundant_sound; auto. - apply orimm_redundant_sound; auto. Qed. @@ -558,10 +558,10 @@ End SOUNDNESS. Program Definition mk_shift_amount (n: int) : shift_amount := {| s_amount := Int.modu n Int.iwordsize; s_range := _ |}. Next Obligation. - assert (0 <= Z.modulo (Int.unsigned n) 32 < 32). apply Z_mod_lt. omega. + assert (0 <= Z.modulo (Int.unsigned n) 32 < 32). apply Z_mod_lt. lia. unfold Int.ltu, Int.modu. change (Int.unsigned Int.iwordsize) with 32. - rewrite Int.unsigned_repr. apply zlt_true. omega. - assert (32 < Int.max_unsigned). compute; auto. omega. + rewrite Int.unsigned_repr. apply zlt_true. lia. + assert (32 < Int.max_unsigned). compute; auto. lia. Qed. Lemma mk_shift_amount_eq: diff --git a/arm/SelectOpproof.v b/arm/SelectOpproof.v index 56534c04..e4e606bc 100644 --- a/arm/SelectOpproof.v +++ b/arm/SelectOpproof.v @@ -757,7 +757,7 @@ Qed. Theorem eval_cast8unsigned: unary_constructor_sound cast8unsigned (Val.zero_ext 8). Proof. red; intros until x. unfold cast8unsigned. - rewrite Val.zero_ext_and. apply eval_andimm. omega. + rewrite Val.zero_ext_and. apply eval_andimm. lia. Qed. Theorem eval_cast16signed: unary_constructor_sound cast16signed (Val.sign_ext 16). @@ -770,7 +770,7 @@ Qed. Theorem eval_cast16unsigned: unary_constructor_sound cast16unsigned (Val.zero_ext 16). Proof. red; intros until x. unfold cast8unsigned. - rewrite Val.zero_ext_and. apply eval_andimm. omega. + rewrite Val.zero_ext_and. apply eval_andimm. lia. Qed. Theorem eval_singleoffloat: unary_constructor_sound singleoffloat Val.singleoffloat. diff --git a/arm/Stacklayout.v b/arm/Stacklayout.v index 462d83ad..f6e01e0c 100644 --- a/arm/Stacklayout.v +++ b/arm/Stacklayout.v @@ -72,12 +72,12 @@ Local Opaque Z.add Z.mul sepconj range. set (ocs := ol + 4 * b.(bound_local)); set (ostkdata := align (size_callee_save_area b ocs) 8). generalize b.(bound_local_pos) b.(bound_outgoing_pos) b.(bound_stack_data_pos); intros. - assert (0 <= olink) by (unfold olink; omega). - assert (olink <= ora) by (unfold ora; omega). - assert (ora + 4 <= ol) by (apply align_le; omega). - assert (ol + 4 * b.(bound_local) <= ocs) by (unfold ocs; omega). + assert (0 <= olink) by (unfold olink; lia). + assert (olink <= ora) by (unfold ora; lia). + assert (ora + 4 <= ol) by (apply align_le; lia). + assert (ol + 4 * b.(bound_local) <= ocs) by (unfold ocs; lia). assert (ocs <= size_callee_save_area b ocs) by apply size_callee_save_area_incr. - assert (size_callee_save_area b ocs <= ostkdata) by (apply align_le; omega). + assert (size_callee_save_area b ocs <= ostkdata) by (apply align_le; lia). (* Reorder as: outgoing back link @@ -89,11 +89,11 @@ Local Opaque Z.add Z.mul sepconj range. rewrite sep_swap34. (* Apply range_split and range_split2 repeatedly *) unfold fe_ofs_arg. - apply range_split. omega. - apply range_split. omega. - apply range_split_2. fold ol; omega. omega. - apply range_split. omega. - apply range_drop_right with ostkdata. omega. + apply range_split. lia. + apply range_split. lia. + apply range_split_2. fold ol; lia. lia. + apply range_split. lia. + apply range_drop_right with ostkdata. lia. eapply sep_drop2. eexact H. Qed. @@ -109,13 +109,13 @@ Proof. set (ocs := ol + 4 * b.(bound_local)); set (ostkdata := align (size_callee_save_area b ocs) 8). generalize b.(bound_local_pos) b.(bound_outgoing_pos) b.(bound_stack_data_pos); intros. - assert (0 <= olink) by (unfold olink; omega). - assert (olink <= ora) by (unfold ora; omega). - assert (ora + 4 <= ol) by (apply align_le; omega). - assert (ol + 4 * b.(bound_local) <= ocs) by (unfold ocs; omega). + assert (0 <= olink) by (unfold olink; lia). + assert (olink <= ora) by (unfold ora; lia). + assert (ora + 4 <= ol) by (apply align_le; lia). + assert (ol + 4 * b.(bound_local) <= ocs) by (unfold ocs; lia). assert (ocs <= size_callee_save_area b ocs) by apply size_callee_save_area_incr. - assert (size_callee_save_area b ocs <= ostkdata) by (apply align_le; omega). - split. omega. apply align_le; omega. + assert (size_callee_save_area b ocs <= ostkdata) by (apply align_le; lia). + split. lia. apply align_le; lia. Qed. Lemma frame_env_aligned: @@ -134,7 +134,7 @@ Proof. set (ocs := ol + 4 * b.(bound_local)); set (ostkdata := align (size_callee_save_area b ocs) 8). split. apply Z.divide_0_r. - split. apply align_divides; omega. - split. apply align_divides; omega. + split. apply align_divides; lia. + split. apply align_divides; lia. unfold ora, olink; auto using Z.divide_mul_l, Z.divide_add_r, Z.divide_refl. Qed. diff --git a/arm/TargetPrinter.ml b/arm/TargetPrinter.ml index 839530c6..9269dd29 100644 --- a/arm/TargetPrinter.ml +++ b/arm/TargetPrinter.ml @@ -150,9 +150,9 @@ struct | Section_data(i, true) -> failwith "_Thread_local unsupported on this platform" | Section_data(i, false) | Section_small_data(i) -> - if i then ".data" else common_section () + variable_section ~sec:".data" ~bss:".bss" i | Section_const i | Section_small_const i -> - if i || (not !Clflags.option_fcommon) then ".section .rodata" else "COMM" + variable_section ~sec:".section .rodata" i | Section_string -> ".section .rodata" | Section_literal -> ".text" | Section_jumptable -> ".text" diff --git a/backend/Allocationproof.v b/backend/Allocationproof.v index 3c7df58a..15cbdcdc 100644 --- a/backend/Allocationproof.v +++ b/backend/Allocationproof.v @@ -548,7 +548,7 @@ Proof. unfold select_reg_l; intros. destruct H. red in H. congruence. rewrite Pos.leb_le in *. red in H. destruct H as [A | [A B]]. - red in A. zify; omega. + red in A. zify; lia. rewrite <- A; auto. Qed. @@ -560,7 +560,7 @@ Proof. unfold select_reg_h; intros. destruct H. red in H. congruence. rewrite Pos.leb_le in *. red in H. destruct H as [A | [A B]]. - red in A. zify; omega. + red in A. zify; lia. rewrite A; auto. Qed. @@ -568,7 +568,7 @@ Remark select_reg_charact: forall r q, select_reg_l r q = true /\ select_reg_h r q = true <-> ereg q = r. Proof. unfold select_reg_l, select_reg_h; intros; split. - rewrite ! Pos.leb_le. unfold reg; zify; omega. + rewrite ! Pos.leb_le. unfold reg; zify; lia. intros. rewrite H. rewrite ! Pos.leb_refl; auto. Qed. diff --git a/backend/Asmexpandaux.ml b/backend/Asmexpandaux.ml index cc171cae..1017ce26 100644 --- a/backend/Asmexpandaux.ml +++ b/backend/Asmexpandaux.ml @@ -58,7 +58,7 @@ let get_current_function_args () = (!current_function).fn_sig.sig_args let is_current_function_variadic () = - (!current_function).fn_sig.sig_cc.cc_vararg + (!current_function).fn_sig.sig_cc.cc_vararg <> None let get_current_function_sig () = (!current_function).fn_sig diff --git a/backend/Asmgenproof0.v b/backend/Asmgenproof0.v index 3638c465..85cee14f 100644 --- a/backend/Asmgenproof0.v +++ b/backend/Asmgenproof0.v @@ -31,7 +31,7 @@ Require Import Conventions. (** * Processor registers and register states *) -Hint Extern 2 (_ <> _) => congruence: asmgen. +Global Hint Extern 2 (_ <> _) => congruence: asmgen. Lemma ireg_of_eq: forall r r', ireg_of r = OK r' -> preg_of r = IR r'. @@ -56,7 +56,7 @@ Lemma preg_of_data: Proof. intros. destruct r; reflexivity. Qed. -Hint Resolve preg_of_data: asmgen. +Global Hint Resolve preg_of_data: asmgen. Lemma data_diff: forall r r', @@ -64,7 +64,7 @@ Lemma data_diff: Proof. congruence. Qed. -Hint Resolve data_diff: asmgen. +Global Hint Resolve data_diff: asmgen. Lemma preg_of_not_SP: forall r, preg_of r <> SP. @@ -78,7 +78,7 @@ Proof. intros. apply data_diff; auto with asmgen. Qed. -Hint Resolve preg_of_not_SP preg_of_not_PC: asmgen. +Global Hint Resolve preg_of_not_SP preg_of_not_PC: asmgen. Lemma nextinstr_pc: forall rs, (nextinstr rs)#PC = Val.offset_ptr rs#PC Ptrofs.one. @@ -473,7 +473,7 @@ Inductive code_tail: Z -> code -> code -> Prop := Lemma code_tail_pos: forall pos c1 c2, code_tail pos c1 c2 -> pos >= 0. Proof. - induction 1. omega. omega. + induction 1. lia. lia. Qed. Lemma find_instr_tail: @@ -484,8 +484,8 @@ Proof. induction c1; simpl; intros. inv H. destruct (zeq pos 0). subst pos. - inv H. auto. generalize (code_tail_pos _ _ _ H4). intro. omegaContradiction. - inv H. congruence. replace (pos0 + 1 - 1) with pos0 by omega. + inv H. auto. generalize (code_tail_pos _ _ _ H4). intro. extlia. + inv H. congruence. replace (pos0 + 1 - 1) with pos0 by lia. eauto. Qed. @@ -494,8 +494,8 @@ Remark code_tail_bounds_1: code_tail ofs fn c -> 0 <= ofs <= list_length_z fn. Proof. induction 1; intros; simpl. - generalize (list_length_z_pos c). omega. - rewrite list_length_z_cons. omega. + generalize (list_length_z_pos c). lia. + rewrite list_length_z_cons. lia. Qed. Remark code_tail_bounds_2: @@ -505,8 +505,8 @@ Proof. assert (forall ofs fn c, code_tail ofs fn c -> forall i c', c = i :: c' -> 0 <= ofs < list_length_z fn). induction 1; intros; simpl. - rewrite H. rewrite list_length_z_cons. generalize (list_length_z_pos c'). omega. - rewrite list_length_z_cons. generalize (IHcode_tail _ _ H0). omega. + rewrite H. rewrite list_length_z_cons. generalize (list_length_z_pos c'). lia. + rewrite list_length_z_cons. generalize (IHcode_tail _ _ H0). lia. eauto. Qed. @@ -531,7 +531,7 @@ Lemma code_tail_next_int: Proof. intros. rewrite Ptrofs.add_unsigned, Ptrofs.unsigned_one. rewrite Ptrofs.unsigned_repr. apply code_tail_next with i; auto. - generalize (code_tail_bounds_2 _ _ _ _ H0). omega. + generalize (code_tail_bounds_2 _ _ _ _ H0). lia. Qed. (** [transl_code_at_pc pc fb f c ep tf tc] holds if the code pointer [pc] points @@ -654,7 +654,7 @@ Opaque transl_instr. exists (Ptrofs.repr ofs). red; intros. rewrite Ptrofs.unsigned_repr. congruence. exploit code_tail_bounds_1; eauto. - apply transf_function_len in TF. omega. + apply transf_function_len in TF. lia. + exists Ptrofs.zero; red; intros. congruence. Qed. @@ -663,7 +663,7 @@ End RETADDR_EXISTS. Remark code_tail_no_bigger: forall pos c1 c2, code_tail pos c1 c2 -> (length c2 <= length c1)%nat. Proof. - induction 1; simpl; omega. + induction 1; simpl; lia. Qed. Remark code_tail_unique: @@ -671,8 +671,8 @@ Remark code_tail_unique: code_tail pos fn c -> code_tail pos' fn c -> pos = pos'. Proof. induction fn; intros until pos'; intros ITA CT; inv ITA; inv CT; auto. - generalize (code_tail_no_bigger _ _ _ H3); simpl; intro; omega. - generalize (code_tail_no_bigger _ _ _ H3); simpl; intro; omega. + generalize (code_tail_no_bigger _ _ _ H3); simpl; intro; lia. + generalize (code_tail_no_bigger _ _ _ H3); simpl; intro; lia. f_equal. eauto. Qed. @@ -713,13 +713,13 @@ Proof. case (is_label lbl a). intro EQ; injection EQ; intro; subst c'. exists (pos + 1). split. auto. split. - replace (pos + 1 - pos) with (0 + 1) by omega. constructor. constructor. - rewrite list_length_z_cons. generalize (list_length_z_pos c). omega. + replace (pos + 1 - pos) with (0 + 1) by lia. constructor. constructor. + rewrite list_length_z_cons. generalize (list_length_z_pos c). lia. intros. generalize (IHc (pos + 1) c' H). intros [pos' [A [B C]]]. exists pos'. split. auto. split. - replace (pos' - pos) with ((pos' - (pos + 1)) + 1) by omega. + replace (pos' - pos) with ((pos' - (pos + 1)) + 1) by lia. constructor. auto. - rewrite list_length_z_cons. omega. + rewrite list_length_z_cons. lia. Qed. (** Helper lemmas to reason about @@ -746,7 +746,7 @@ Qed. Definition nolabel (i: instruction) := match i with Plabel _ => False | _ => True end. -Hint Extern 1 (nolabel _) => exact I : labels. +Global Hint Extern 1 (nolabel _) => exact I : labels. Lemma tail_nolabel_cons: forall i c k, @@ -757,7 +757,7 @@ Proof. intros. simpl. rewrite <- H1. destruct i; reflexivity || contradiction. Qed. -Hint Resolve tail_nolabel_refl: labels. +Global Hint Resolve tail_nolabel_refl: labels. Ltac TailNoLabel := eauto with labels; diff --git a/backend/Bounds.v b/backend/Bounds.v index b8c12166..d6b67a02 100644 --- a/backend/Bounds.v +++ b/backend/Bounds.v @@ -163,7 +163,7 @@ Proof. intros until valu. unfold max_over_list. assert (forall l z, fold_left (fun x y => Z.max x (valu y)) l z >= z). induction l; simpl; intros. - omega. apply Zge_trans with (Z.max z (valu a)). + lia. apply Zge_trans with (Z.max z (valu a)). auto. apply Z.le_ge. apply Z.le_max_l. auto. Qed. @@ -307,7 +307,7 @@ Proof. let f := fold_left (fun x y => Z.max x (valu y)) c z in z <= f /\ (In x c -> valu x <= f)). induction c; simpl; intros. - split. omega. tauto. + split. lia. tauto. elim (IHc (Z.max z (valu a))); intros. split. apply Z.le_trans with (Z.max z (valu a)). apply Z.le_max_l. auto. intro H1; elim H1; intro. @@ -446,12 +446,12 @@ Lemma size_callee_save_area_rec_incr: Proof. Local Opaque mreg_type. induction l as [ | r l]; intros; simpl. -- omega. +- lia. - eapply Z.le_trans. 2: apply IHl. generalize (AST.typesize_pos (mreg_type r)); intros. apply Z.le_trans with (align ofs (AST.typesize (mreg_type r))). apply align_le; auto. - omega. + lia. Qed. Lemma size_callee_save_area_incr: diff --git a/backend/CSEdomain.v b/backend/CSEdomain.v index 34ec0118..f78e1d25 100644 --- a/backend/CSEdomain.v +++ b/backend/CSEdomain.v @@ -92,7 +92,7 @@ Record wf_numbering (n: numbering) : Prop := { In r (PMap.get v n.(num_val)) -> PTree.get r n.(num_reg) = Some v }. -Hint Resolve wf_num_eqs wf_num_reg wf_num_val: cse. +Global Hint Resolve wf_num_eqs wf_num_reg wf_num_val: cse. (** Satisfiability of numberings. A numbering holds in a concrete execution state if there exists a valuation assigning values to @@ -139,7 +139,7 @@ Record numbering_holds (valu: valuation) (ge: genv) (sp: val) n.(num_reg)!r = Some v -> rs#r = valu v }. -Hint Resolve num_holds_wf num_holds_eq num_holds_reg: cse. +Global Hint Resolve num_holds_wf num_holds_eq num_holds_reg: cse. Lemma empty_numbering_holds: forall valu ge sp rs m, diff --git a/backend/CSEproof.v b/backend/CSEproof.v index a7465cee..0716dad7 100644 --- a/backend/CSEproof.v +++ b/backend/CSEproof.v @@ -132,9 +132,9 @@ Proof. exists valu2; splitall. + constructor; simpl; intros. * constructor; simpl; intros. - apply wf_equation_incr with (num_next n). eauto with cse. xomega. + apply wf_equation_incr with (num_next n). eauto with cse. extlia. rewrite PTree.gsspec in H0. destruct (peq r0 r). - inv H0; xomega. + inv H0; extlia. apply Plt_trans_succ; eauto with cse. rewrite PMap.gsspec in H0. destruct (peq v (num_next n)). replace r0 with r by (simpl in H0; intuition). rewrite PTree.gss. subst; auto. @@ -146,8 +146,8 @@ Proof. rewrite peq_false. eauto with cse. apply Plt_ne; eauto with cse. + unfold valu2. rewrite peq_true; auto. + auto. -+ xomega. -+ xomega. ++ extlia. ++ extlia. Qed. Lemma valnum_regs_holds: @@ -162,7 +162,7 @@ Lemma valnum_regs_holds: /\ Ple n.(num_next) n'.(num_next). Proof. induction rl; simpl; intros. -- inv H0. exists valu1; splitall; auto. red; auto. simpl; tauto. xomega. +- inv H0. exists valu1; splitall; auto. red; auto. simpl; tauto. extlia. - destruct (valnum_reg n a) as [n1 v1] eqn:V1. destruct (valnum_regs n1 rl) as [n2 vs] eqn:V2. inv H0. @@ -173,9 +173,9 @@ Proof. exists valu3; splitall. + auto. + simpl; f_equal; auto. rewrite R; auto. - + red; intros. transitivity (valu2 v); auto. apply R. xomega. - + simpl; intros. destruct H0; auto. subst v1; xomega. - + xomega. + + red; intros. transitivity (valu2 v); auto. apply R. extlia. + + simpl; intros. destruct H0; auto. subst v1; extlia. + + extlia. Qed. Lemma find_valnum_rhs_charact: @@ -331,11 +331,11 @@ Proof. { red; intros. unfold valu2. apply peq_false. apply Plt_ne; auto. } exists valu2; constructor; simpl; intros. + constructor; simpl; intros. - * destruct H3. inv H3. simpl; split. xomega. + * destruct H3. inv H3. simpl; split. extlia. red; intros. apply Plt_trans_succ; eauto. - apply wf_equation_incr with (num_next n). eauto with cse. xomega. + apply wf_equation_incr with (num_next n). eauto with cse. extlia. * rewrite PTree.gsspec in H3. destruct (peq r rd). - inv H3. xomega. + inv H3. extlia. apply Plt_trans_succ; eauto with cse. * apply update_reg_charact; eauto with cse. + destruct H3. inv H3. @@ -546,10 +546,10 @@ Lemma store_normalized_range_sound: Proof. intros. unfold Val.load_result; remember Archi.ptr64 as ptr64. destruct chunk; simpl in *; destruct v; auto. -- inv H. rewrite is_sgn_sign_ext in H4 by omega. rewrite H4; auto. -- inv H. rewrite is_uns_zero_ext in H4 by omega. rewrite H4; auto. -- inv H. rewrite is_sgn_sign_ext in H4 by omega. rewrite H4; auto. -- inv H. rewrite is_uns_zero_ext in H4 by omega. rewrite H4; auto. +- inv H. rewrite is_sgn_sign_ext in H4 by lia. rewrite H4; auto. +- inv H. rewrite is_uns_zero_ext in H4 by lia. rewrite H4; auto. +- inv H. rewrite is_sgn_sign_ext in H4 by lia. rewrite H4; auto. +- inv H. rewrite is_uns_zero_ext in H4 by lia. rewrite H4; auto. - destruct ptr64; auto. - destruct ptr64; auto. - destruct ptr64; auto. @@ -608,7 +608,7 @@ Proof. simpl. rewrite negb_false_iff in H8. eapply Mem.load_storebytes_other. eauto. - rewrite H6. rewrite Z2Nat.id by omega. + rewrite H6. rewrite Z2Nat.id by lia. eapply pdisjoint_sound. eauto. unfold aaddressing. apply match_aptr_of_aval. eapply eval_static_addressing_sound; eauto. erewrite <- regs_valnums_sound by eauto. eauto with va. @@ -642,39 +642,39 @@ Proof. set (n1 := i - ofs1). set (n2 := size_chunk chunk). set (n3 := sz - (n1 + n2)). - replace sz with (n1 + (n2 + n3)) in H by (unfold n3, n2, n1; omega). + replace sz with (n1 + (n2 + n3)) in H by (unfold n3, n2, n1; lia). exploit Mem.loadbytes_split; eauto. - unfold n1; omega. - unfold n3, n2, n1; omega. + unfold n1; lia. + unfold n3, n2, n1; lia. intros (bytes1 & bytes23 & LB1 & LB23 & EQ). clear H. exploit Mem.loadbytes_split; eauto. - unfold n2; omega. - unfold n3, n2, n1; omega. + unfold n2; lia. + unfold n3, n2, n1; lia. intros (bytes2 & bytes3 & LB2 & LB3 & EQ'). subst bytes23; subst bytes. exploit Mem.load_loadbytes; eauto. intros (bytes2' & A & B). assert (bytes2' = bytes2). - { replace (ofs1 + n1) with i in LB2 by (unfold n1; omega). unfold n2 in LB2. congruence. } + { replace (ofs1 + n1) with i in LB2 by (unfold n1; lia). unfold n2 in LB2. congruence. } subst bytes2'. exploit Mem.storebytes_split; eauto. intros (m1 & SB1 & SB23). clear H0. exploit Mem.storebytes_split; eauto. intros (m2 & SB2 & SB3). clear SB23. assert (L1: Z.of_nat (length bytes1) = n1). - { erewrite Mem.loadbytes_length by eauto. apply Z2Nat.id. unfold n1; omega. } + { erewrite Mem.loadbytes_length by eauto. apply Z2Nat.id. unfold n1; lia. } assert (L2: Z.of_nat (length bytes2) = n2). - { erewrite Mem.loadbytes_length by eauto. apply Z2Nat.id. unfold n2; omega. } + { erewrite Mem.loadbytes_length by eauto. apply Z2Nat.id. unfold n2; lia. } rewrite L1 in *. rewrite L2 in *. assert (LB': Mem.loadbytes m2 b2 (ofs2 + n1) n2 = Some bytes2). { rewrite <- L2. eapply Mem.loadbytes_storebytes_same; eauto. } assert (LB'': Mem.loadbytes m' b2 (ofs2 + n1) n2 = Some bytes2). { rewrite <- LB'. eapply Mem.loadbytes_storebytes_other; eauto. - unfold n2; omega. - right; left; omega. } + unfold n2; lia. + right; left; lia. } exploit Mem.load_valid_access; eauto. intros [P Q]. rewrite B. apply Mem.loadbytes_load. - replace (i + (ofs2 - ofs1)) with (ofs2 + n1) by (unfold n1; omega). + replace (i + (ofs2 - ofs1)) with (ofs2 + n1) by (unfold n1; lia). exact LB''. apply Z.divide_add_r; auto. Qed. @@ -719,9 +719,9 @@ Proof with (try discriminate). Mem.loadv chunk m (Vptr sp ofs) = Some v -> Mem.loadv chunk m' (Vptr sp (Ptrofs.repr j)) = Some v). { - simpl; intros. rewrite Ptrofs.unsigned_repr by omega. + simpl; intros. rewrite Ptrofs.unsigned_repr by lia. unfold j, delta. eapply load_memcpy; eauto. - apply Zmod_divide; auto. generalize (align_chunk_pos chunk); omega. + apply Zmod_divide; auto. generalize (align_chunk_pos chunk); lia. } inv H2. + inv H3. exploit eval_addressing_Ainstack_inv; eauto. intros [E1 E2]. diff --git a/backend/CleanupLabelsproof.v b/backend/CleanupLabelsproof.v index 84ca403e..39c3919f 100644 --- a/backend/CleanupLabelsproof.v +++ b/backend/CleanupLabelsproof.v @@ -298,7 +298,7 @@ Proof. constructor. econstructor; eauto with coqlib. (* eliminated *) - right. split. simpl. omega. split. auto. econstructor; eauto with coqlib. + right. split. simpl. lia. split. auto. econstructor; eauto with coqlib. (* Lgoto *) left; econstructor; split. econstructor. eapply find_label_translated; eauto. red; auto. diff --git a/backend/Cminor.v b/backend/Cminor.v index dcebbb86..e585dc13 100644 --- a/backend/Cminor.v +++ b/backend/Cminor.v @@ -590,7 +590,7 @@ Proof. exploit external_call_receptive; eauto. intros [vres2 [m2 EC2]]. exists (Returnstate vres2 k m2). econstructor; eauto. (* trace length *) - red; intros; inv H; simpl; try omega; eapply external_call_trace_length; eauto. + red; intros; inv H; simpl; try lia; eapply external_call_trace_length; eauto. Qed. (** This semantics is determinate. *) @@ -647,7 +647,7 @@ Proof. intros (A & B). split; intros; auto. apply B in H; destruct H; congruence. - (* single event *) - red; simpl. destruct 1; simpl; try omega; + red; simpl. destruct 1; simpl; try lia; eapply external_call_trace_length; eauto. - (* initial states *) inv H; inv H0. unfold ge0, ge1 in *. congruence. diff --git a/backend/CminorSel.v b/backend/CminorSel.v index 26f47e23..cedd2bed 100644 --- a/backend/CminorSel.v +++ b/backend/CminorSel.v @@ -464,7 +464,7 @@ Inductive final_state: state -> int -> Prop := Definition semantics (p: program) := Semantics step (initial_state p) final_state (Genv.globalenv p). -Hint Constructors eval_expr eval_exprlist eval_condexpr: evalexpr. +Global Hint Constructors eval_expr eval_exprlist eval_condexpr: evalexpr. (** * Lifting of let-bound variables *) @@ -522,9 +522,9 @@ Lemma insert_lenv_lookup1: nth_error le' n = Some v. Proof. induction 1; intros. - omegaContradiction. + extlia. destruct n; simpl; simpl in H0. auto. - apply IHinsert_lenv. auto. omega. + apply IHinsert_lenv. auto. lia. Qed. Lemma insert_lenv_lookup2: @@ -536,8 +536,8 @@ Lemma insert_lenv_lookup2: Proof. induction 1; intros. simpl. assumption. - simpl. destruct n. omegaContradiction. - apply IHinsert_lenv. exact H0. omega. + simpl. destruct n. extlia. + apply IHinsert_lenv. exact H0. lia. Qed. Lemma eval_lift_expr: @@ -580,4 +580,4 @@ Proof. eexact H. apply insert_lenv_0. Qed. -Hint Resolve eval_lift: evalexpr. +Global Hint Resolve eval_lift: evalexpr. diff --git a/backend/Cminortyping.v b/backend/Cminortyping.v index 8945cecf..d9e99122 100644 --- a/backend/Cminortyping.v +++ b/backend/Cminortyping.v @@ -291,7 +291,7 @@ Lemma expect_incr: forall te e t1 t2 e', Proof. unfold expect; intros. destruct (typ_eq t1 t2); inv H; auto. Qed. -Hint Resolve expect_incr: ty. +Global Hint Resolve expect_incr: ty. Lemma expect_sound: forall e t1 t2 e', expect e t1 t2 = OK e' -> t1 = t2. @@ -306,7 +306,7 @@ Proof. - destruct (type_unop u) as [targ1 tres]; monadInv T; eauto with ty. - destruct (type_binop b) as [[targ1 targ2] tres]; monadInv T; eauto with ty. Qed. -Hint Resolve type_expr_incr: ty. +Global Hint Resolve type_expr_incr: ty. Lemma type_expr_sound: forall te a t e e', type_expr e a t = OK e' -> S.satisf te e' -> wt_expr te a t. @@ -326,7 +326,7 @@ Lemma type_exprlist_incr: forall te al tl e e', Proof. induction al; destruct tl; simpl; intros until e'; intros T SAT; monadInv T; eauto with ty. Qed. -Hint Resolve type_exprlist_incr: ty. +Global Hint Resolve type_exprlist_incr: ty. Lemma type_exprlist_sound: forall te al tl e e', type_exprlist e al tl = OK e' -> S.satisf te e' -> list_forall2 (wt_expr te) al tl. @@ -343,7 +343,7 @@ Proof. - destruct (type_unop u) as [targ1 tres]; monadInv T; eauto with ty. - destruct (type_binop b) as [[targ1 targ2] tres]; monadInv T; eauto with ty. Qed. -Hint Resolve type_assign_incr: ty. +Global Hint Resolve type_assign_incr: ty. Lemma type_assign_sound: forall te id a e e', type_assign e id a = OK e' -> S.satisf te e' -> wt_expr te a (te id). @@ -363,7 +363,7 @@ Lemma opt_set_incr: forall te optid optty e e', Proof. unfold opt_set; intros. destruct optid, optty; try (monadInv H); eauto with ty. Qed. -Hint Resolve opt_set_incr: ty. +Global Hint Resolve opt_set_incr: ty. Lemma opt_set_sound: forall te optid sg e e', opt_set e optid (proj_sig_res sg) = OK e' -> S.satisf te e' -> @@ -380,7 +380,7 @@ Proof. induction s; simpl; intros e1 e2 T SAT; try (monadInv T); eauto with ty. - destruct tret, o; try (monadInv T); eauto with ty. Qed. -Hint Resolve type_stmt_incr: ty. +Global Hint Resolve type_stmt_incr: ty. Lemma type_stmt_sound: forall te tret s e e', type_stmt tret e s = OK e' -> S.satisf te e' -> wt_stmt te tret s. diff --git a/backend/Constpropproof.v b/backend/Constpropproof.v index 60663503..b59ee8b4 100644 --- a/backend/Constpropproof.v +++ b/backend/Constpropproof.v @@ -364,7 +364,7 @@ Proof. - (* Inop, skipped over *) assert (s0 = pc') by congruence. subst s0. - right; exists n; split. omega. split. auto. + right; exists n; split. lia. split. auto. apply match_states_intro; auto. - (* Iop *) @@ -583,7 +583,7 @@ Opaque builtin_strength_reduction. - (* Icond, skipped over *) rewrite H1 in H; inv H. - right; exists n; split. omega. split. auto. + right; exists n; split. lia. split. auto. econstructor; eauto. - (* Ijumptable *) diff --git a/backend/Conventions.v b/backend/Conventions.v index 14ffb587..8910ee49 100644 --- a/backend/Conventions.v +++ b/backend/Conventions.v @@ -60,9 +60,9 @@ Remark fold_max_outgoing_above: forall l n, fold_left max_outgoing_2 l n >= n. Proof. assert (A: forall n l, max_outgoing_1 n l >= n). - { intros; unfold max_outgoing_1. destruct l as [_ | []]; xomega. } + { intros; unfold max_outgoing_1. destruct l as [_ | []]; extlia. } induction l; simpl; intros. - - omega. + - lia. - eapply Zge_trans. eauto. destruct a; simpl. apply A. eapply Zge_trans; eauto. Qed. @@ -80,14 +80,14 @@ Lemma loc_arguments_bounded: Proof. intros until ty. assert (A: forall n l, n <= max_outgoing_1 n l). - { intros; unfold max_outgoing_1. destruct l as [_ | []]; xomega. } + { intros; unfold max_outgoing_1. destruct l as [_ | []]; extlia. } assert (B: forall p n, In (S Outgoing ofs ty) (regs_of_rpair p) -> ofs + typesize ty <= max_outgoing_2 n p). { intros. destruct p; simpl in H; intuition; subst; simpl. - - xomega. - - eapply Z.le_trans. 2: apply A. xomega. - - xomega. } + - extlia. + - eapply Z.le_trans. 2: apply A. extlia. + - extlia. } assert (C: forall l n, In (S Outgoing ofs ty) (regs_of_rpairs l) -> ofs + typesize ty <= fold_left max_outgoing_2 l n). @@ -168,7 +168,7 @@ Proof. unfold loc_argument_acceptable. destruct l; intros. auto. destruct sl; try contradiction. destruct H1. generalize (loc_arguments_bounded _ _ _ H0). - generalize (typesize_pos ty). omega. + generalize (typesize_pos ty). lia. Qed. diff --git a/backend/Deadcodeproof.v b/backend/Deadcodeproof.v index 6919fe78..b51d6cce 100644 --- a/backend/Deadcodeproof.v +++ b/backend/Deadcodeproof.v @@ -67,7 +67,7 @@ Lemma mextends_agree: forall m1 m2 P, Mem.extends m1 m2 -> magree m1 m2 P. Proof. intros. destruct H. destruct mext_inj. constructor; intros. -- replace ofs with (ofs + 0) by omega. eapply mi_perm; eauto. auto. +- replace ofs with (ofs + 0) by lia. eapply mi_perm; eauto. auto. - eauto. - exploit mi_memval; eauto. unfold inject_id; eauto. rewrite Z.add_0_r. auto. @@ -99,15 +99,15 @@ Proof. induction n; intros; simpl. constructor. rewrite Nat2Z.inj_succ in H. constructor. - apply H. omega. - apply IHn. intros; apply H; omega. + apply H. lia. + apply IHn. intros; apply H; lia. } Local Transparent Mem.loadbytes. unfold Mem.loadbytes; intros. destruct H. destruct (Mem.range_perm_dec m1 b ofs (ofs + n) Cur Readable); inv H0. rewrite pred_dec_true. econstructor; split; eauto. apply GETN. intros. rewrite Z_to_nat_max in H. - assert (ofs <= i < ofs + n) by xomega. + assert (ofs <= i < ofs + n) by extlia. apply ma_memval0; auto. red; intros; eauto. Qed. @@ -146,11 +146,11 @@ Proof. (ZMap.get q (Mem.setN bytes2 p c2))). { induction 1; intros; simpl. - - apply H; auto. simpl. omega. + - apply H; auto. simpl. lia. - simpl length in H1; rewrite Nat2Z.inj_succ in H1. apply IHlist_forall2; auto. intros. rewrite ! ZMap.gsspec. destruct (ZIndexed.eq i p). auto. - apply H1; auto. unfold ZIndexed.t in *; omega. + apply H1; auto. unfold ZIndexed.t in *; lia. } intros. destruct (Mem.range_perm_storebytes m2 b ofs bytes2) as [m2' ST2]. @@ -211,8 +211,8 @@ Proof. - rewrite (Mem.storebytes_mem_contents _ _ _ _ _ H0). rewrite PMap.gsspec. destruct (peq b0 b). + subst b0. rewrite Mem.setN_outside. eapply ma_memval; eauto. eapply Mem.perm_storebytes_2; eauto. - destruct (zlt ofs0 ofs); auto. destruct (zle (ofs + Z.of_nat (length bytes1)) ofs0); try omega. - elim (H1 ofs0). omega. auto. + destruct (zlt ofs0 ofs); auto. destruct (zle (ofs + Z.of_nat (length bytes1)) ofs0); try lia. + elim (H1 ofs0). lia. auto. + eapply ma_memval; eauto. eapply Mem.perm_storebytes_2; eauto. - rewrite (Mem.nextblock_storebytes _ _ _ _ _ H0). eapply ma_nextblock; eauto. @@ -358,7 +358,7 @@ Proof. intros. destruct ros; simpl in *. eapply add_need_all_eagree; eauto. auto. Qed. -Hint Resolve add_need_all_eagree add_need_all_lessdef +Global Hint Resolve add_need_all_eagree add_need_all_lessdef add_need_eagree add_need_vagree add_needs_all_eagree add_needs_all_lessdef add_needs_eagree add_needs_vagree @@ -1043,7 +1043,7 @@ Ltac UseTransfer := intros. eapply nlive_remove; eauto. unfold adst, vanalyze; rewrite AN; eapply aaddr_arg_sound_1; eauto. erewrite Mem.loadbytes_length in H1 by eauto. - rewrite Z2Nat.id in H1 by omega. auto. + rewrite Z2Nat.id in H1 by lia. auto. eauto. intros (tm' & A & B). econstructor; split. @@ -1070,7 +1070,7 @@ Ltac UseTransfer := intros (bc & A & B & C). intros. eapply nlive_contains; eauto. erewrite Mem.loadbytes_length in H0 by eauto. - rewrite Z2Nat.id in H0 by omega. auto. + rewrite Z2Nat.id in H0 by lia. auto. + (* annot *) destruct (transfer_builtin_args (kill_builtin_res res ne, nm) _x2) as (ne1, nm1) eqn:TR. InvSoundState. diff --git a/backend/Inlining.v b/backend/Inlining.v index 8c7e1898..0e18d38e 100644 --- a/backend/Inlining.v +++ b/backend/Inlining.v @@ -71,12 +71,12 @@ Inductive sincr (s1 s2: state) : Prop := Remark sincr_refl: forall s, sincr s s. Proof. - intros; constructor; xomega. + intros; constructor; extlia. Qed. Lemma sincr_trans: forall s1 s2 s3, sincr s1 s2 -> sincr s2 s3 -> sincr s1 s3. Proof. - intros. inv H; inv H0. constructor; xomega. + intros. inv H; inv H0. constructor; extlia. Qed. (** Dependently-typed state monad, ensuring that the final state is @@ -111,7 +111,7 @@ Program Definition set_instr (pc: node) (i: instruction): mon unit := (mkstate s.(st_nextreg) s.(st_nextnode) (PTree.set pc i s.(st_code)) s.(st_stksize)) _. Next Obligation. - intros; constructor; simpl; xomega. + intros; constructor; simpl; extlia. Qed. Program Definition add_instr (i: instruction): mon node := @@ -121,7 +121,7 @@ Program Definition add_instr (i: instruction): mon node := (mkstate s.(st_nextreg) (Pos.succ pc) (PTree.set pc i s.(st_code)) s.(st_stksize)) _. Next Obligation. - intros; constructor; simpl; xomega. + intros; constructor; simpl; extlia. Qed. Program Definition reserve_nodes (numnodes: positive): mon positive := @@ -130,7 +130,7 @@ Program Definition reserve_nodes (numnodes: positive): mon positive := (mkstate s.(st_nextreg) (Pos.add s.(st_nextnode) numnodes) s.(st_code) s.(st_stksize)) _. Next Obligation. - intros; constructor; simpl; xomega. + intros; constructor; simpl; extlia. Qed. Program Definition reserve_regs (numregs: positive): mon positive := @@ -139,7 +139,7 @@ Program Definition reserve_regs (numregs: positive): mon positive := (mkstate (Pos.add s.(st_nextreg) numregs) s.(st_nextnode) s.(st_code) s.(st_stksize)) _. Next Obligation. - intros; constructor; simpl; xomega. + intros; constructor; simpl; extlia. Qed. Program Definition request_stack (sz: Z): mon unit := @@ -148,7 +148,7 @@ Program Definition request_stack (sz: Z): mon unit := (mkstate s.(st_nextreg) s.(st_nextnode) s.(st_code) (Z.max s.(st_stksize) sz)) _. Next Obligation. - intros; constructor; simpl; xomega. + intros; constructor; simpl; extlia. Qed. Program Definition ptree_mfold {A: Type} (f: positive -> A -> mon unit) (t: PTree.t A): mon unit := diff --git a/backend/Inliningproof.v b/backend/Inliningproof.v index c4efaf18..eb30732b 100644 --- a/backend/Inliningproof.v +++ b/backend/Inliningproof.v @@ -67,21 +67,21 @@ Qed. Remark sreg_below_diff: forall ctx r r', Plt r' ctx.(dreg) -> sreg ctx r <> r'. Proof. - intros. zify. unfold sreg; rewrite shiftpos_eq. xomega. + intros. zify. unfold sreg; rewrite shiftpos_eq. extlia. Qed. Remark context_below_diff: forall ctx1 ctx2 r1 r2, context_below ctx1 ctx2 -> Ple r1 ctx1.(mreg) -> sreg ctx1 r1 <> sreg ctx2 r2. Proof. - intros. red in H. zify. unfold sreg; rewrite ! shiftpos_eq. xomega. + intros. red in H. zify. unfold sreg; rewrite ! shiftpos_eq. extlia. Qed. Remark context_below_lt: forall ctx1 ctx2 r, context_below ctx1 ctx2 -> Ple r ctx1.(mreg) -> Plt (sreg ctx1 r) ctx2.(dreg). Proof. intros. red in H. unfold Plt; zify. unfold sreg; rewrite shiftpos_eq. - xomega. + extlia. Qed. (* @@ -89,7 +89,7 @@ Remark context_below_le: forall ctx1 ctx2 r, context_below ctx1 ctx2 -> Ple r ctx1.(mreg) -> Ple (sreg ctx1 r) ctx2.(dreg). Proof. intros. red in H. unfold Ple; zify. unfold sreg; rewrite shiftpos_eq. - xomega. + extlia. Qed. *) @@ -105,7 +105,7 @@ Definition val_reg_charact (F: meminj) (ctx: context) (rs': regset) (v: val) (r: Remark Plt_Ple_dec: forall p q, {Plt p q} + {Ple q p}. Proof. - intros. destruct (plt p q). left; auto. right; xomega. + intros. destruct (plt p q). left; auto. right; extlia. Qed. Lemma agree_val_reg_gen: @@ -149,7 +149,7 @@ Proof. repeat rewrite Regmap.gsspec. destruct (peq r0 r). subst r0. rewrite peq_true. auto. rewrite peq_false. auto. apply shiftpos_diff; auto. - rewrite Regmap.gso. auto. xomega. + rewrite Regmap.gso. auto. extlia. Qed. Lemma agree_set_reg_undef: @@ -184,7 +184,7 @@ Proof. unfold agree_regs; intros. destruct H. split; intros. rewrite H0. auto. apply shiftpos_above. - eapply Pos.lt_le_trans. apply shiftpos_below. xomega. + eapply Pos.lt_le_trans. apply shiftpos_below. extlia. apply H1; auto. Qed. @@ -272,7 +272,7 @@ Lemma range_private_invariant: range_private F1 m1 m1' sp lo hi. Proof. intros; red; intros. exploit H; eauto. intros [A B]. split; auto. - intros; red; intros. exploit H0; eauto. omega. intros [P Q]. + intros; red; intros. exploit H0; eauto. lia. intros [P Q]. eelim B; eauto. Qed. @@ -293,12 +293,12 @@ Lemma range_private_alloc_left: range_private F1 m1 m' sp' (base + Z.max sz 0) hi. Proof. intros; red; intros. - exploit (H ofs). generalize (Z.le_max_r sz 0). omega. intros [A B]. + exploit (H ofs). generalize (Z.le_max_r sz 0). lia. intros [A B]. split; auto. intros; red; intros. exploit Mem.perm_alloc_inv; eauto. destruct (eq_block b sp); intros. subst b. rewrite H1 in H4; inv H4. - rewrite Zmax_spec in H3. destruct (zlt 0 sz); omega. + rewrite Zmax_spec in H3. destruct (zlt 0 sz); lia. rewrite H2 in H4; auto. eelim B; eauto. Qed. @@ -313,21 +313,21 @@ Proof. intros; red; intros. destruct (zlt ofs (base + Z.max sz 0)) as [z|z]. red; split. - replace ofs with ((ofs - base) + base) by omega. + replace ofs with ((ofs - base) + base) by lia. eapply Mem.perm_inject; eauto. eapply Mem.free_range_perm; eauto. - rewrite Zmax_spec in z. destruct (zlt 0 sz); omega. + rewrite Zmax_spec in z. destruct (zlt 0 sz); lia. intros; red; intros. destruct (eq_block b b0). subst b0. rewrite H1 in H4; inv H4. - eelim Mem.perm_free_2; eauto. rewrite Zmax_spec in z. destruct (zlt 0 sz); omega. + eelim Mem.perm_free_2; eauto. rewrite Zmax_spec in z. destruct (zlt 0 sz); lia. exploit Mem.mi_no_overlap; eauto. apply Mem.perm_cur_max. apply Mem.perm_implies with Freeable; auto with mem. eapply Mem.free_range_perm. eauto. - instantiate (1 := ofs - base). rewrite Zmax_spec in z. destruct (zlt 0 sz); omega. + instantiate (1 := ofs - base). rewrite Zmax_spec in z. destruct (zlt 0 sz); lia. eapply Mem.perm_free_3; eauto. - intros [A | A]. congruence. omega. + intros [A | A]. congruence. lia. - exploit (H ofs). omega. intros [A B]. split. auto. + exploit (H ofs). lia. intros [A B]. split. auto. intros; red; intros. eelim B; eauto. eapply Mem.perm_free_3; eauto. Qed. @@ -607,39 +607,39 @@ Proof. (* cons *) apply match_stacks_cons with (fenv := fenv) (ctx := ctx); auto. eapply match_stacks_inside_invariant; eauto. - intros; eapply INJ; eauto; xomega. - intros; eapply PERM1; eauto; xomega. - intros; eapply PERM2; eauto; xomega. - intros; eapply PERM3; eauto; xomega. + intros; eapply INJ; eauto; extlia. + intros; eapply PERM1; eauto; extlia. + intros; eapply PERM2; eauto; extlia. + intros; eapply PERM3; eauto; extlia. eapply agree_regs_incr; eauto. eapply range_private_invariant; eauto. (* untailcall *) apply match_stacks_untailcall with (ctx := ctx); auto. eapply match_stacks_inside_invariant; eauto. - intros; eapply INJ; eauto; xomega. - intros; eapply PERM1; eauto; xomega. - intros; eapply PERM2; eauto; xomega. - intros; eapply PERM3; eauto; xomega. + intros; eapply INJ; eauto; extlia. + intros; eapply PERM1; eauto; extlia. + intros; eapply PERM2; eauto; extlia. + intros; eapply PERM3; eauto; extlia. eapply range_private_invariant; eauto. induction 1; intros. (* base *) eapply match_stacks_inside_base; eauto. eapply match_stacks_invariant; eauto. - intros; eapply INJ; eauto; xomega. - intros; eapply PERM1; eauto; xomega. - intros; eapply PERM2; eauto; xomega. - intros; eapply PERM3; eauto; xomega. + intros; eapply INJ; eauto; extlia. + intros; eapply PERM1; eauto; extlia. + intros; eapply PERM2; eauto; extlia. + intros; eapply PERM3; eauto; extlia. (* inlined *) apply match_stacks_inside_inlined with (fenv := fenv) (ctx' := ctx'); auto. apply IHmatch_stacks_inside; auto. - intros. apply RS. red in BELOW. xomega. + intros. apply RS. red in BELOW. extlia. apply agree_regs_incr with F; auto. apply agree_regs_invariant with rs'; auto. - intros. apply RS. red in BELOW. xomega. + intros. apply RS. red in BELOW. extlia. eapply range_private_invariant; eauto. - intros. split. eapply INJ; eauto. xomega. eapply PERM1; eauto. xomega. - intros. eapply PERM2; eauto. xomega. + intros. split. eapply INJ; eauto. extlia. eapply PERM1; eauto. extlia. + intros. eapply PERM2; eauto. extlia. Qed. Lemma match_stacks_empty: @@ -668,7 +668,7 @@ Lemma match_stacks_inside_set_reg: match_stacks_inside F m m' stk stk' f' ctx sp' (rs'#(sreg ctx r) <- v). Proof. intros. eapply match_stacks_inside_invariant; eauto. - intros. apply Regmap.gso. zify. unfold sreg; rewrite shiftpos_eq. xomega. + intros. apply Regmap.gso. zify. unfold sreg; rewrite shiftpos_eq. extlia. Qed. Lemma match_stacks_inside_set_res: @@ -717,11 +717,11 @@ Proof. subst b1. rewrite H1 in H4. inv H4. eelim Plt_strict; eauto. (* inlined *) eapply match_stacks_inside_inlined; eauto. - eapply IHmatch_stacks_inside; eauto. destruct SBELOW. omega. + eapply IHmatch_stacks_inside; eauto. destruct SBELOW. lia. eapply agree_regs_incr; eauto. eapply range_private_invariant; eauto. intros. exploit Mem.perm_alloc_inv; eauto. destruct (eq_block b0 b); intros. - subst b0. rewrite H2 in H5; inv H5. elimtype False; xomega. + subst b0. rewrite H2 in H5; inv H5. elimtype False; extlia. rewrite H3 in H5; auto. Qed. @@ -753,25 +753,25 @@ Lemma min_alignment_sound: Proof. intros; red; intros. unfold min_alignment in H. assert (2 <= sz -> (2 | n)). intros. - destruct (zle sz 1). omegaContradiction. + destruct (zle sz 1). extlia. destruct (zle sz 2). auto. destruct (zle sz 4). apply Z.divide_trans with 4; auto. exists 2; auto. apply Z.divide_trans with 8; auto. exists 4; auto. assert (4 <= sz -> (4 | n)). intros. - destruct (zle sz 1). omegaContradiction. - destruct (zle sz 2). omegaContradiction. + destruct (zle sz 1). extlia. + destruct (zle sz 2). extlia. destruct (zle sz 4). auto. apply Z.divide_trans with 8; auto. exists 2; auto. assert (8 <= sz -> (8 | n)). intros. - destruct (zle sz 1). omegaContradiction. - destruct (zle sz 2). omegaContradiction. - destruct (zle sz 4). omegaContradiction. + destruct (zle sz 1). extlia. + destruct (zle sz 2). extlia. + destruct (zle sz 4). extlia. auto. destruct chunk; simpl in *; auto. apply Z.divide_1_l. apply Z.divide_1_l. - apply H2; omega. - apply H2; omega. + apply H2; lia. + apply H2; lia. Qed. (** Preservation by external calls *) @@ -803,19 +803,19 @@ Proof. inv MG. constructor; intros; eauto. destruct (F1 b1) as [[b2' delta']|] eqn:?. exploit INCR; eauto. intros EQ; rewrite H0 in EQ; inv EQ. eapply IMAGE; eauto. - exploit SEP; eauto. intros [A B]. elim B. red. xomega. + exploit SEP; eauto. intros [A B]. elim B. red. extlia. eapply match_stacks_cons; eauto. - eapply match_stacks_inside_extcall; eauto. xomega. + eapply match_stacks_inside_extcall; eauto. extlia. eapply agree_regs_incr; eauto. - eapply range_private_extcall; eauto. red; xomega. - intros. apply SSZ2; auto. apply MAXPERM'; auto. red; xomega. + eapply range_private_extcall; eauto. red; extlia. + intros. apply SSZ2; auto. apply MAXPERM'; auto. red; extlia. eapply match_stacks_untailcall; eauto. - eapply match_stacks_inside_extcall; eauto. xomega. - eapply range_private_extcall; eauto. red; xomega. - intros. apply SSZ2; auto. apply MAXPERM'; auto. red; xomega. + eapply match_stacks_inside_extcall; eauto. extlia. + eapply range_private_extcall; eauto. red; extlia. + intros. apply SSZ2; auto. apply MAXPERM'; auto. red; extlia. induction 1; intros. eapply match_stacks_inside_base; eauto. - eapply match_stacks_extcall; eauto. xomega. + eapply match_stacks_extcall; eauto. extlia. eapply match_stacks_inside_inlined; eauto. eapply agree_regs_incr; eauto. eapply range_private_extcall; eauto. @@ -829,7 +829,7 @@ Lemma align_unchanged: forall n amount, amount > 0 -> (amount | n) -> align n amount = n. Proof. intros. destruct H0 as [p EQ]. subst n. unfold align. decEq. - apply Zdiv_unique with (b := amount - 1). omega. omega. + apply Zdiv_unique with (b := amount - 1). lia. lia. Qed. Lemma match_stacks_inside_inlined_tailcall: @@ -849,10 +849,10 @@ Proof. (* inlined *) assert (dstk ctx <= dstk ctx'). rewrite H1. apply align_le. apply min_alignment_pos. eapply match_stacks_inside_inlined; eauto. - red; intros. destruct (zlt ofs (dstk ctx)). apply PAD; omega. apply H3. inv H4. xomega. + red; intros. destruct (zlt ofs (dstk ctx)). apply PAD; lia. apply H3. inv H4. extlia. congruence. - unfold context_below in *. xomega. - unfold context_stack_call in *. omega. + unfold context_below in *. extlia. + unfold context_stack_call in *. lia. Qed. (** ** Relating states *) @@ -1068,12 +1068,12 @@ Proof. + (* inlined *) assert (EQ: fd = Internal f0) by (eapply find_inlined_function; eauto). subst fd. - right; split. simpl; omega. split. auto. + right; split. simpl; lia. split. auto. econstructor; eauto. eapply match_stacks_inside_inlined; eauto. - red; intros. apply PRIV. inv H13. destruct H16. xomega. + red; intros. apply PRIV. inv H13. destruct H16. extlia. apply agree_val_regs_gen; auto. - red; intros; apply PRIV. destruct H16. omega. + red; intros; apply PRIV. destruct H16. lia. - (* tailcall *) exploit match_stacks_inside_globalenvs; eauto. intros [bound G]. @@ -1086,9 +1086,9 @@ Proof. assert (X: { m1' | Mem.free m'0 sp' 0 (fn_stacksize f') = Some m1'}). apply Mem.range_perm_free. red; intros. destruct (zlt ofs f.(fn_stacksize)). - replace ofs with (ofs + dstk ctx) by omega. eapply Mem.perm_inject; eauto. - eapply Mem.free_range_perm; eauto. omega. - inv FB. eapply range_private_perms; eauto. xomega. + replace ofs with (ofs + dstk ctx) by lia. eapply Mem.perm_inject; eauto. + eapply Mem.free_range_perm; eauto. lia. + inv FB. eapply range_private_perms; eauto. extlia. destruct X as [m1' FREE]. left; econstructor; split. eapply plus_one. eapply exec_Itailcall; eauto. @@ -1099,12 +1099,12 @@ Proof. intros. eapply Mem.perm_free_3; eauto. intros. eapply Mem.perm_free_1; eauto with ordered_type. intros. eapply Mem.perm_free_3; eauto. - erewrite Mem.nextblock_free; eauto. red in VB; xomega. + erewrite Mem.nextblock_free; eauto. red in VB; extlia. eapply agree_val_regs; eauto. eapply Mem.free_right_inject; eauto. eapply Mem.free_left_inject; eauto. (* show that no valid location points into the stack block being freed *) - intros. rewrite DSTK in PRIV'. exploit (PRIV' (ofs + delta)). omega. intros [P Q]. - eelim Q; eauto. replace (ofs + delta - delta) with ofs by omega. + intros. rewrite DSTK in PRIV'. exploit (PRIV' (ofs + delta)). lia. intros [P Q]. + eelim Q; eauto. replace (ofs + delta - delta) with ofs by lia. apply Mem.perm_max with k. apply Mem.perm_implies with p; auto with mem. + (* turned into a call *) left; econstructor; split. @@ -1119,7 +1119,7 @@ Proof. + (* inlined *) assert (EQ: fd = Internal f0) by (eapply find_inlined_function; eauto). subst fd. - right; split. simpl; omega. split. auto. + right; split. simpl; lia. split. auto. econstructor; eauto. eapply match_stacks_inside_inlined_tailcall; eauto. eapply match_stacks_inside_invariant; eauto. @@ -1128,7 +1128,7 @@ Proof. eapply Mem.free_left_inject; eauto. red; intros; apply PRIV'. assert (dstk ctx <= dstk ctx'). red in H14; rewrite H14. apply align_le. apply min_alignment_pos. - omega. + lia. - (* builtin *) exploit tr_funbody_inv; eauto. intros TR; inv TR. @@ -1178,10 +1178,10 @@ Proof. assert (X: { m1' | Mem.free m'0 sp' 0 (fn_stacksize f') = Some m1'}). apply Mem.range_perm_free. red; intros. destruct (zlt ofs f.(fn_stacksize)). - replace ofs with (ofs + dstk ctx) by omega. eapply Mem.perm_inject; eauto. - eapply Mem.free_range_perm; eauto. omega. + replace ofs with (ofs + dstk ctx) by lia. eapply Mem.perm_inject; eauto. + eapply Mem.free_range_perm; eauto. lia. inv FB. eapply range_private_perms; eauto. - generalize (Zmax_spec (fn_stacksize f) 0). destruct (zlt 0 (fn_stacksize f)); omega. + generalize (Zmax_spec (fn_stacksize f) 0). destruct (zlt 0 (fn_stacksize f)); lia. destruct X as [m1' FREE]. left; econstructor; split. eapply plus_one. eapply exec_Ireturn; eauto. @@ -1191,19 +1191,19 @@ Proof. intros. eapply Mem.perm_free_3; eauto. intros. eapply Mem.perm_free_1; eauto with ordered_type. intros. eapply Mem.perm_free_3; eauto. - erewrite Mem.nextblock_free; eauto. red in VB; xomega. + erewrite Mem.nextblock_free; eauto. red in VB; extlia. destruct or; simpl. apply agree_val_reg; auto. auto. eapply Mem.free_right_inject; eauto. eapply Mem.free_left_inject; eauto. (* show that no valid location points into the stack block being freed *) intros. inversion FB; subst. assert (PRIV': range_private F m' m'0 sp' (dstk ctx) f'.(fn_stacksize)). rewrite H8 in PRIV. eapply range_private_free_left; eauto. - rewrite DSTK in PRIV'. exploit (PRIV' (ofs + delta)). omega. intros [A B]. - eelim B; eauto. replace (ofs + delta - delta) with ofs by omega. + rewrite DSTK in PRIV'. exploit (PRIV' (ofs + delta)). lia. intros [A B]. + eelim B; eauto. replace (ofs + delta - delta) with ofs by lia. apply Mem.perm_max with k. apply Mem.perm_implies with p; auto with mem. + (* inlined *) - right. split. simpl. omega. split. auto. + right. split. simpl. lia. split. auto. econstructor; eauto. eapply match_stacks_inside_invariant; eauto. intros. eapply Mem.perm_free_3; eauto. @@ -1219,7 +1219,7 @@ Proof. { eapply tr_function_linkorder; eauto. } inversion TR; subst. exploit Mem.alloc_parallel_inject. eauto. eauto. apply Z.le_refl. - instantiate (1 := fn_stacksize f'). inv H1. xomega. + instantiate (1 := fn_stacksize f'). inv H1. extlia. intros [F' [m1' [sp' [A [B [C [D E]]]]]]]. left; econstructor; split. eapply plus_one. eapply exec_function_internal; eauto. @@ -1241,13 +1241,13 @@ Proof. rewrite H5. apply agree_regs_init_regs. eauto. auto. inv H1; auto. congruence. auto. eapply Mem.valid_new_block; eauto. red; intros. split. - eapply Mem.perm_alloc_2; eauto. inv H1; xomega. + eapply Mem.perm_alloc_2; eauto. inv H1; extlia. intros; red; intros. exploit Mem.perm_alloc_inv. eexact H. eauto. destruct (eq_block b stk); intros. - subst. rewrite D in H9; inv H9. inv H1; xomega. + subst. rewrite D in H9; inv H9. inv H1; extlia. rewrite E in H9; auto. eelim Mem.fresh_block_alloc. eexact A. eapply Mem.mi_mappedblocks; eauto. auto. - intros. exploit Mem.perm_alloc_inv; eauto. rewrite dec_eq_true. omega. + intros. exploit Mem.perm_alloc_inv; eauto. rewrite dec_eq_true. lia. - (* internal function, inlined *) inversion FB; subst. @@ -1257,19 +1257,19 @@ Proof. (* sp' is valid *) instantiate (1 := sp'). auto. (* offset is representable *) - instantiate (1 := dstk ctx). generalize (Z.le_max_r (fn_stacksize f) 0). omega. + instantiate (1 := dstk ctx). generalize (Z.le_max_r (fn_stacksize f) 0). lia. (* size of target block is representable *) - intros. right. exploit SSZ2; eauto with mem. inv FB; omega. + intros. right. exploit SSZ2; eauto with mem. inv FB; lia. (* we have full permissions on sp' at and above dstk ctx *) intros. apply Mem.perm_cur. apply Mem.perm_implies with Freeable; auto with mem. - eapply range_private_perms; eauto. xomega. + eapply range_private_perms; eauto. extlia. (* offset is aligned *) - replace (fn_stacksize f - 0) with (fn_stacksize f) by omega. + replace (fn_stacksize f - 0) with (fn_stacksize f) by lia. inv FB. apply min_alignment_sound; auto. (* nobody maps to (sp, dstk ctx...) *) - intros. exploit (PRIV (ofs + delta')); eauto. xomega. + intros. exploit (PRIV (ofs + delta')); eauto. extlia. intros [A B]. eelim B; eauto. - replace (ofs + delta' - delta') with ofs by omega. + replace (ofs + delta' - delta') with ofs by lia. apply Mem.perm_max with k. apply Mem.perm_implies with p; auto with mem. intros [F' [A [B [C D]]]]. exploit tr_moves_init_regs; eauto. intros [rs'' [P [Q R]]]. @@ -1278,7 +1278,7 @@ Proof. econstructor. eapply match_stacks_inside_alloc_left; eauto. eapply match_stacks_inside_invariant; eauto. - omega. + lia. eauto. auto. apply agree_regs_incr with F; auto. auto. auto. auto. @@ -1299,7 +1299,7 @@ Proof. eapply match_stacks_extcall with (F1 := F) (F2 := F1) (m1 := m) (m1' := m'0); eauto. intros; eapply external_call_max_perm; eauto. intros; eapply external_call_max_perm; eauto. - xomega. + extlia. eapply external_call_nextblock; eauto. auto. auto. @@ -1321,14 +1321,14 @@ Proof. eauto. auto. apply agree_set_reg; auto. auto. auto. auto. - red; intros. destruct (zlt ofs (dstk ctx)). apply PAD; omega. apply PRIV; omega. + red; intros. destruct (zlt ofs (dstk ctx)). apply PAD; lia. apply PRIV; lia. auto. auto. - (* return from inlined function *) inv MS0; try congruence. rewrite RET0 in RET; inv RET. unfold inline_return in AT. assert (PRIV': range_private F m m' sp' (dstk ctx' + mstk ctx') f'.(fn_stacksize)). - red; intros. destruct (zlt ofs (dstk ctx)). apply PAD. omega. apply PRIV. omega. + red; intros. destruct (zlt ofs (dstk ctx)). apply PAD. lia. apply PRIV. lia. destruct or. + (* with a result *) left; econstructor; split. diff --git a/backend/Inliningspec.v b/backend/Inliningspec.v index eba026ec..e846e0fd 100644 --- a/backend/Inliningspec.v +++ b/backend/Inliningspec.v @@ -73,7 +73,7 @@ Qed. Lemma shiftpos_eq: forall x y, Zpos (shiftpos x y) = (Zpos x + Zpos y) - 1. Proof. intros. unfold shiftpos. zify. try rewrite Pos2Z.inj_sub. auto. - zify. omega. + zify. lia. Qed. Lemma shiftpos_inj: @@ -82,7 +82,7 @@ Proof. intros. assert (Zpos (shiftpos x n) = Zpos (shiftpos y n)) by congruence. rewrite ! shiftpos_eq in H0. - assert (Z.pos x = Z.pos y) by omega. + assert (Z.pos x = Z.pos y) by lia. congruence. Qed. @@ -95,25 +95,25 @@ Qed. Lemma shiftpos_above: forall x n, Ple n (shiftpos x n). Proof. - intros. unfold Ple; zify. rewrite shiftpos_eq. xomega. + intros. unfold Ple; zify. rewrite shiftpos_eq. extlia. Qed. Lemma shiftpos_not_below: forall x n, Plt (shiftpos x n) n -> False. Proof. - intros. generalize (shiftpos_above x n). xomega. + intros. generalize (shiftpos_above x n). extlia. Qed. Lemma shiftpos_below: forall x n, Plt (shiftpos x n) (Pos.add x n). Proof. - intros. unfold Plt; zify. rewrite shiftpos_eq. omega. + intros. unfold Plt; zify. rewrite shiftpos_eq. lia. Qed. Lemma shiftpos_le: forall x y n, Ple x y -> Ple (shiftpos x n) (shiftpos y n). Proof. - intros. unfold Ple in *; zify. rewrite ! shiftpos_eq. omega. + intros. unfold Ple in *; zify. rewrite ! shiftpos_eq. lia. Qed. @@ -219,9 +219,9 @@ Proof. induction srcs; simpl; intros. monadInv H. auto. destruct dsts; monadInv H. auto. - transitivity (st_code s0)!pc. eapply IHsrcs; eauto. monadInv EQ; simpl. xomega. + transitivity (st_code s0)!pc. eapply IHsrcs; eauto. monadInv EQ; simpl. extlia. monadInv EQ; simpl. apply PTree.gso. - inversion INCR0; simpl in *. xomega. + inversion INCR0; simpl in *. extlia. Qed. Lemma add_moves_spec: @@ -234,13 +234,13 @@ Proof. monadInv H. apply tr_moves_nil; auto. destruct dsts; monadInv H. apply tr_moves_nil; auto. apply tr_moves_cons with x. eapply IHsrcs; eauto. - intros. inversion INCR. apply H0; xomega. + intros. inversion INCR. apply H0; extlia. monadInv EQ. rewrite H0. erewrite add_moves_unchanged; eauto. simpl. apply PTree.gss. - simpl. xomega. - xomega. - inversion INCR; inversion INCR0; simpl in *; xomega. + simpl. extlia. + extlia. + inversion INCR; inversion INCR0; simpl in *; extlia. Qed. (** ** Relational specification of CFG expansion *) @@ -386,9 +386,9 @@ Proof. monadInv H. unfold inline_function in EQ. monadInv EQ. transitivity (s2.(st_code)!pc'). eauto. transitivity (s5.(st_code)!pc'). eapply add_moves_unchanged; eauto. - left. inversion INCR5. inversion INCR3. monadInv EQ1; simpl in *. xomega. + left. inversion INCR5. inversion INCR3. monadInv EQ1; simpl in *. extlia. transitivity (s4.(st_code)!pc'). eapply rec_unchanged; eauto. - simpl. monadInv EQ; simpl. monadInv EQ1; simpl. xomega. + simpl. monadInv EQ; simpl. monadInv EQ1; simpl. extlia. simpl. monadInv EQ1; simpl. auto. monadInv EQ; simpl. monadInv EQ1; simpl. auto. (* tailcall *) @@ -397,9 +397,9 @@ Proof. monadInv H. unfold inline_tail_function in EQ. monadInv EQ. transitivity (s2.(st_code)!pc'). eauto. transitivity (s5.(st_code)!pc'). eapply add_moves_unchanged; eauto. - left. inversion INCR5. inversion INCR3. monadInv EQ1; simpl in *. xomega. + left. inversion INCR5. inversion INCR3. monadInv EQ1; simpl in *. extlia. transitivity (s4.(st_code)!pc'). eapply rec_unchanged; eauto. - simpl. monadInv EQ; simpl. monadInv EQ1; simpl. xomega. + simpl. monadInv EQ; simpl. monadInv EQ1; simpl. extlia. simpl. monadInv EQ1; simpl. auto. monadInv EQ; simpl. monadInv EQ1; simpl. auto. (* return *) @@ -422,7 +422,7 @@ Proof. destruct a as [pc1 instr1]; simpl in *. monadInv H. inv H3. transitivity ((st_code s0)!pc). - eapply IHl; eauto. destruct INCR; xomega. destruct INCR; xomega. + eapply IHl; eauto. destruct INCR; extlia. destruct INCR; extlia. eapply expand_instr_unchanged; eauto. Qed. @@ -438,7 +438,7 @@ Proof. exploit ptree_mfold_spec; eauto. intros [INCR' ITER]. eapply iter_expand_instr_unchanged; eauto. subst s0; auto. - subst s0; simpl. xomega. + subst s0; simpl. extlia. red; intros. exploit list_in_map_inv; eauto. intros [pc1 [A B]]. subst pc. unfold spc in H1. eapply shiftpos_not_below; eauto. apply PTree.elements_keys_norepet. @@ -464,7 +464,7 @@ Remark min_alignment_pos: forall sz, min_alignment sz > 0. Proof. intros; unfold min_alignment. - destruct (zle sz 1). omega. destruct (zle sz 2). omega. destruct (zle sz 4); omega. + destruct (zle sz 1). lia. destruct (zle sz 2). lia. destruct (zle sz 4); lia. Qed. Ltac inv_incr := @@ -501,20 +501,20 @@ Proof. apply tr_call_inlined with (pc1 := x0) (ctx' := ctx') (f := f); auto. eapply BASE; eauto. eapply add_moves_spec; eauto. - intros. rewrite S1. eapply set_instr_other; eauto. unfold node; xomega. - xomega. xomega. + intros. rewrite S1. eapply set_instr_other; eauto. unfold node; extlia. + extlia. extlia. eapply rec_spec; eauto. red; intros. rewrite PTree.grspec in H. destruct (PTree.elt_eq id0 id); try discriminate. auto. - simpl. subst s2; simpl in *; xomega. - simpl. subst s3; simpl in *; xomega. - simpl. xomega. + simpl. subst s2; simpl in *; extlia. + simpl. subst s3; simpl in *; extlia. + simpl. extlia. simpl. apply align_divides. apply min_alignment_pos. - assert (dstk ctx + mstk ctx <= dstk ctx'). simpl. apply align_le. apply min_alignment_pos. omega. - omega. + assert (dstk ctx + mstk ctx <= dstk ctx'). simpl. apply align_le. apply min_alignment_pos. lia. + lia. intros. simpl in H. rewrite S1. - transitivity (s1.(st_code)!pc0). eapply set_instr_other; eauto. unfold node in *; xomega. - eapply add_moves_unchanged; eauto. unfold node in *; xomega. xomega. - red; simpl. subst s2; simpl in *. xomega. + transitivity (s1.(st_code)!pc0). eapply set_instr_other; eauto. unfold node in *; extlia. + eapply add_moves_unchanged; eauto. unfold node in *; extlia. extlia. + red; simpl. subst s2; simpl in *. extlia. red; simpl. split. auto. apply align_le. apply min_alignment_pos. (* tailcall *) destruct (can_inline fe s1) as [|id f P Q]. @@ -532,20 +532,20 @@ Proof. apply tr_tailcall_inlined with (pc1 := x0) (ctx' := ctx') (f := f); auto. eapply BASE; eauto. eapply add_moves_spec; eauto. - intros. rewrite S1. eapply set_instr_other; eauto. unfold node; xomega. xomega. xomega. + intros. rewrite S1. eapply set_instr_other; eauto. unfold node; extlia. extlia. extlia. eapply rec_spec; eauto. red; intros. rewrite PTree.grspec in H. destruct (PTree.elt_eq id0 id); try discriminate. auto. - simpl. subst s3; simpl in *. subst s2; simpl in *. xomega. - simpl. subst s3; simpl in *; xomega. - simpl. xomega. + simpl. subst s3; simpl in *. subst s2; simpl in *. extlia. + simpl. subst s3; simpl in *; extlia. + simpl. extlia. simpl. apply align_divides. apply min_alignment_pos. - assert (dstk ctx <= dstk ctx'). simpl. apply align_le. apply min_alignment_pos. omega. - omega. + assert (dstk ctx <= dstk ctx'). simpl. apply align_le. apply min_alignment_pos. lia. + lia. intros. simpl in H. rewrite S1. - transitivity (s1.(st_code))!pc0. eapply set_instr_other; eauto. unfold node in *; xomega. - eapply add_moves_unchanged; eauto. unfold node in *; xomega. xomega. + transitivity (s1.(st_code))!pc0. eapply set_instr_other; eauto. unfold node in *; extlia. + eapply add_moves_unchanged; eauto. unfold node in *; extlia. extlia. red; simpl. -subst s2; simpl in *; xomega. +subst s2; simpl in *; extlia. red; auto. (* builtin *) eapply tr_builtin; eauto. destruct b; eauto. @@ -577,31 +577,31 @@ Proof. destruct a as [pc1 instr1]; simpl in *. inv H0. monadInv H. inv_incr. assert (A: Ple ctx.(dpc) s0.(st_nextnode)). assert (B: Plt (spc ctx pc) (st_nextnode s)) by eauto. - unfold spc in B. generalize (shiftpos_above pc (dpc ctx)). xomega. + unfold spc in B. generalize (shiftpos_above pc (dpc ctx)). extlia. destruct H9. inv H. (* same pc *) eapply expand_instr_spec; eauto. - omega. + lia. intros. transitivity ((st_code s')!pc'). - apply H7. auto. xomega. + apply H7. auto. extlia. eapply iter_expand_instr_unchanged; eauto. red; intros. rewrite list_map_compose in H9. exploit list_in_map_inv; eauto. intros [[pc0 instr0] [P Q]]. simpl in P. - assert (Plt (spc ctx pc0) (st_nextnode s)) by eauto. xomega. + assert (Plt (spc ctx pc0) (st_nextnode s)) by eauto. extlia. transitivity ((st_code s')!(spc ctx pc)). eapply H8; eauto. eapply iter_expand_instr_unchanged; eauto. - assert (Plt (spc ctx pc) (st_nextnode s)) by eauto. xomega. + assert (Plt (spc ctx pc) (st_nextnode s)) by eauto. extlia. red; intros. rewrite list_map_compose in H. exploit list_in_map_inv; eauto. intros [[pc0 instr0] [P Q]]. simpl in P. assert (pc = pc0) by (eapply shiftpos_inj; eauto). subst pc0. elim H12. change pc with (fst (pc, instr0)). apply List.in_map; auto. (* older pc *) inv_incr. eapply IHl; eauto. - intros. eapply Pos.lt_le_trans. eapply H2. right; eauto. xomega. + intros. eapply Pos.lt_le_trans. eapply H2. right; eauto. extlia. intros; eapply Ple_trans; eauto. - intros. apply H7; auto. xomega. + intros. apply H7; auto. extlia. Qed. Lemma expand_cfg_rec_spec: @@ -629,16 +629,16 @@ Proof. intros. assert (Ple pc0 (max_pc_function f)). eapply max_pc_function_sound. eapply PTree.elements_complete; eauto. - eapply Pos.lt_le_trans. apply shiftpos_below. subst s0; simpl; xomega. + eapply Pos.lt_le_trans. apply shiftpos_below. subst s0; simpl; extlia. subst s0; simpl; auto. - intros. apply H8; auto. subst s0; simpl in H11; xomega. + intros. apply H8; auto. subst s0; simpl in H11; extlia. intros. apply H8. apply shiftpos_above. assert (Ple pc0 (max_pc_function f)). eapply max_pc_function_sound. eapply PTree.elements_complete; eauto. - eapply Pos.lt_le_trans. apply shiftpos_below. inversion i; xomega. + eapply Pos.lt_le_trans. apply shiftpos_below. inversion i; extlia. apply PTree.elements_correct; auto. auto. auto. auto. - inversion INCR0. subst s0; simpl in STKSIZE; xomega. + inversion INCR0. subst s0; simpl in STKSIZE; extlia. Qed. End EXPAND_INSTR. @@ -721,12 +721,12 @@ Opaque initstate. apply funenv_program_compat. eapply expand_cfg_spec with (fe := fenv); eauto. red; auto. - unfold ctx; rewrite <- H1; rewrite <- H2; rewrite <- H3; simpl. xomega. - unfold ctx; rewrite <- H0; rewrite <- H1; simpl. xomega. - simpl. xomega. + unfold ctx; rewrite <- H1; rewrite <- H2; rewrite <- H3; simpl. extlia. + unfold ctx; rewrite <- H0; rewrite <- H1; simpl. extlia. + simpl. extlia. simpl. apply Z.divide_0_r. - simpl. omega. - simpl. omega. + simpl. lia. + simpl. lia. simpl. split; auto. destruct INCR2. destruct INCR1. destruct INCR0. destruct INCR. - simpl. change 0 with (st_stksize initstate). omega. + simpl. change 0 with (st_stksize initstate). lia. Qed. diff --git a/backend/JsonAST.ml b/backend/JsonAST.ml index c73bf30d..a55bfa0c 100644 --- a/backend/JsonAST.ml +++ b/backend/JsonAST.ml @@ -21,14 +21,22 @@ open Sections let pp_storage pp static = pp_jstring pp (if static then "Static" else "Extern") +let pp_init pp init = + pp_jstring pp + (match init with + | Uninit -> "Uninit" + | Init -> "Init" + | Init_reloc -> "Init_reloc") + let pp_section pp sec = let pp_simple name = pp_jsingle_object pp "Section Name" pp_jstring name and pp_complex name init = pp_jobject_start pp; pp_jmember ~first:true pp "Section Name" pp_jstring name; - pp_jmember pp "Init" pp_jbool init; + pp_jmember pp "Init" pp_init init; pp_jobject_end pp in + match sec with | Section_text -> pp_simple "Text" | Section_data(init, thread_local) -> pp_complex "Data" init (* FIXME *) diff --git a/backend/Linearizeproof.v b/backend/Linearizeproof.v index 18dc52a5..c12eab6e 100644 --- a/backend/Linearizeproof.v +++ b/backend/Linearizeproof.v @@ -658,7 +658,7 @@ Proof. - (* Lbranch *) assert ((reachable f)!!pc = true). apply REACH; simpl; auto. - right; split. simpl; omega. split. auto. simpl. econstructor; eauto. + right; split. simpl; lia. split. auto. simpl. econstructor; eauto. - (* Lcond *) assert (REACH1: (reachable f)!!pc1 = true) by (apply REACH; simpl; auto). @@ -675,12 +675,12 @@ Proof. rewrite eval_negate_condition. rewrite H. auto. eauto. rewrite DC. econstructor; eauto. (* cond is false: branch is taken *) - right; split. simpl; omega. split. auto. rewrite <- DC. econstructor; eauto. + right; split. simpl; lia. split. auto. rewrite <- DC. econstructor; eauto. rewrite eval_negate_condition. rewrite H. auto. (* branch if cond is true *) destruct b. (* cond is true: branch is taken *) - right; split. simpl; omega. split. auto. econstructor; eauto. + right; split. simpl; lia. split. auto. econstructor; eauto. (* cond is false: no branch *) left; econstructor; split. apply plus_one. eapply exec_Lcond_false. eauto. eauto. @@ -689,7 +689,7 @@ Proof. - (* Ljumptable *) assert (REACH': (reachable f)!!pc = true). apply REACH. simpl. eapply list_nth_z_in; eauto. - right; split. simpl; omega. split. auto. econstructor; eauto. + right; split. simpl; lia. split. auto. econstructor; eauto. - (* Lreturn *) left; econstructor; split. diff --git a/backend/Locations.v b/backend/Locations.v index c437df5d..2a3ae1d7 100644 --- a/backend/Locations.v +++ b/backend/Locations.v @@ -157,7 +157,7 @@ Module Loc. forall l, ~(diff l l). Proof. destruct l; unfold diff; auto. - red; intros. destruct H; auto. generalize (typesize_pos ty); omega. + red; intros. destruct H; auto. generalize (typesize_pos ty); lia. Qed. Lemma diff_not_eq: @@ -184,7 +184,7 @@ Module Loc. left; auto. destruct (zle (pos0 + typesize ty0) pos). left; auto. - right; red; intros [P | [P | P]]. congruence. omega. omega. + right; red; intros [P | [P | P]]. congruence. lia. lia. left; auto. Defined. @@ -497,7 +497,7 @@ Module OrderedLoc <: OrderedType. destruct x. eelim Plt_strict; eauto. destruct H. eelim OrderedSlot.lt_not_eq; eauto. red; auto. - destruct H. destruct H0. omega. + destruct H. destruct H0. lia. destruct H0. eelim OrderedTyp.lt_not_eq; eauto. red; auto. Qed. Definition compare : forall x y : t, Compare lt eq x y. @@ -545,18 +545,18 @@ Module OrderedLoc <: OrderedType. { destruct H. apply not_eq_sym. apply Plt_ne; auto. apply Plt_ne; auto. } congruence. - assert (RANGE: forall ty, 1 <= typesize ty <= 2). - { intros; unfold typesize. destruct ty0; omega. } + { intros; unfold typesize. destruct ty0; lia. } destruct H. + destruct H. left. apply not_eq_sym. apply OrderedSlot.lt_not_eq; auto. destruct H. right. - destruct H0. right. generalize (RANGE ty'); omega. + destruct H0. right. generalize (RANGE ty'); lia. destruct H0. assert (ty' = Tint \/ ty' = Tsingle \/ ty' = Tany32). { unfold OrderedTyp.lt in H1. destruct ty'; auto; compute in H1; congruence. } - right. destruct H2 as [E|[E|E]]; subst ty'; simpl typesize; omega. + right. destruct H2 as [E|[E|E]]; subst ty'; simpl typesize; lia. + destruct H. left. apply OrderedSlot.lt_not_eq; auto. destruct H. right. - destruct H0. left; omega. + destruct H0. left; lia. destruct H0. exfalso. destruct ty'; compute in H1; congruence. Qed. @@ -572,14 +572,14 @@ Module OrderedLoc <: OrderedType. - destruct (OrderedSlot.compare sl sl'); auto. destruct H. contradiction. destruct H. - right; right; split; auto. left; omega. + right; right; split; auto. left; lia. left; right; split; auto. assert (EITHER: typesize ty' = 1 /\ OrderedTyp.lt ty' Tany64 \/ typesize ty' = 2). { destruct ty'; compute; auto. } destruct (zlt ofs' (ofs - 1)). left; auto. destruct EITHER as [[P Q] | P]. - right; split; auto. omega. - left; omega. + right; split; auto. lia. + left; lia. Qed. End OrderedLoc. diff --git a/backend/NeedDomain.v b/backend/NeedDomain.v index d9e9e025..fc1ae16d 100644 --- a/backend/NeedDomain.v +++ b/backend/NeedDomain.v @@ -74,7 +74,7 @@ Proof. intros. simpl in H. auto. Qed. -Hint Resolve vagree_same vagree_lessdef lessdef_vagree: na. +Global Hint Resolve vagree_same vagree_lessdef lessdef_vagree: na. Inductive vagree_list: list val -> list val -> list nval -> Prop := | vagree_list_nil: forall nvl, @@ -100,7 +100,7 @@ Proof. destruct nvl; constructor; auto with na. Qed. -Hint Resolve lessdef_vagree_list vagree_lessdef_list: na. +Global Hint Resolve lessdef_vagree_list vagree_lessdef_list: na. (** ** Ordering and least upper bound between value needs *) @@ -116,8 +116,8 @@ Proof. destruct x; constructor; auto. Qed. -Hint Constructors nge: na. -Hint Resolve nge_refl: na. +Global Hint Constructors nge: na. +Global Hint Resolve nge_refl: na. Lemma nge_trans: forall x y, nge x y -> forall z, nge y z -> nge x z. Proof. @@ -240,9 +240,9 @@ Proof. destruct (zlt i (Int.unsigned n)). - auto. - generalize (Int.unsigned_range n); intros. - apply H. omega. rewrite Int.bits_shru by omega. - replace (i - Int.unsigned n + Int.unsigned n) with i by omega. - rewrite zlt_true by omega. auto. + apply H. lia. rewrite Int.bits_shru by lia. + replace (i - Int.unsigned n + Int.unsigned n) with i by lia. + rewrite zlt_true by lia. auto. Qed. Lemma iagree_shru: @@ -252,9 +252,9 @@ Proof. intros; red; intros. autorewrite with ints; auto. destruct (zlt (i + Int.unsigned n) Int.zwordsize). - generalize (Int.unsigned_range n); intros. - apply H. omega. rewrite Int.bits_shl by omega. - replace (i + Int.unsigned n - Int.unsigned n) with i by omega. - rewrite zlt_false by omega. auto. + apply H. lia. rewrite Int.bits_shl by lia. + replace (i + Int.unsigned n - Int.unsigned n) with i by lia. + rewrite zlt_false by lia. auto. - auto. Qed. @@ -266,7 +266,7 @@ Proof. intros; red; intros. rewrite <- H in H2. rewrite Int.bits_shru in H2 by auto. rewrite ! Int.bits_shr by auto. destruct (zlt (i + Int.unsigned n) Int.zwordsize). -- apply H0; auto. generalize (Int.unsigned_range n); omega. +- apply H0; auto. generalize (Int.unsigned_range n); lia. - discriminate. Qed. @@ -281,11 +281,11 @@ Proof. then i + Int.unsigned n else Int.zwordsize - 1). assert (0 <= j < Int.zwordsize). - { unfold j; destruct (zlt (i + Int.unsigned n) Int.zwordsize); omega. } + { unfold j; destruct (zlt (i + Int.unsigned n) Int.zwordsize); lia. } apply H; auto. autorewrite with ints; auto. apply orb_true_intro. unfold j; destruct (zlt (i + Int.unsigned n) Int.zwordsize). -- left. rewrite zlt_false by omega. - replace (i + Int.unsigned n - Int.unsigned n) with i by omega. +- left. rewrite zlt_false by lia. + replace (i + Int.unsigned n - Int.unsigned n) with i by lia. auto. - right. reflexivity. Qed. @@ -303,7 +303,7 @@ Proof. mod Int.zwordsize) with i. auto. apply eqmod_small_eq with Int.zwordsize; auto. apply eqmod_trans with ((i - Int.unsigned amount) + Int.unsigned amount). - apply eqmod_refl2; omega. + apply eqmod_refl2; lia. eapply eqmod_trans. 2: apply eqmod_mod; auto. apply eqmod_add. apply eqmod_mod; auto. @@ -330,12 +330,12 @@ Lemma eqmod_iagree: Proof. intros. set (p := Z.to_nat (Int.size m)). generalize (Int.size_range m); intros RANGE. - assert (EQ: Int.size m = Z.of_nat p). { symmetry; apply Z2Nat.id. omega. } + assert (EQ: Int.size m = Z.of_nat p). { symmetry; apply Z2Nat.id. lia. } rewrite EQ in H; rewrite <- two_power_nat_two_p in H. red; intros. rewrite ! Int.testbit_repr by auto. destruct (zlt i (Int.size m)). - eapply same_bits_eqmod; eauto. omega. - assert (Int.testbit m i = false) by (eapply Int.bits_size_2; omega). + eapply same_bits_eqmod; eauto. lia. + assert (Int.testbit m i = false) by (eapply Int.bits_size_2; lia). congruence. Qed. @@ -348,11 +348,11 @@ Lemma iagree_eqmod: Proof. intros. set (p := Z.to_nat (Int.size m)). generalize (Int.size_range m); intros RANGE. - assert (EQ: Int.size m = Z.of_nat p). { symmetry; apply Z2Nat.id. omega. } + assert (EQ: Int.size m = Z.of_nat p). { symmetry; apply Z2Nat.id. lia. } rewrite EQ; rewrite <- two_power_nat_two_p. - apply eqmod_same_bits. intros. apply H. omega. - unfold complete_mask. rewrite Int.bits_zero_ext by omega. - rewrite zlt_true by omega. rewrite Int.bits_mone by omega. auto. + apply eqmod_same_bits. intros. apply H. lia. + unfold complete_mask. rewrite Int.bits_zero_ext by lia. + rewrite zlt_true by lia. rewrite Int.bits_mone by lia. auto. Qed. Lemma complete_mask_idem: @@ -363,12 +363,12 @@ Proof. + assert (Int.unsigned m <> 0). { red; intros; elim n. rewrite <- (Int.repr_unsigned m). rewrite H; auto. } assert (0 < Int.size m). - { apply Zsize_pos'. generalize (Int.unsigned_range m); omega. } + { apply Zsize_pos'. generalize (Int.unsigned_range m); lia. } generalize (Int.size_range m); intros. f_equal. apply Int.bits_size_4. tauto. - rewrite Int.bits_zero_ext by omega. rewrite zlt_true by omega. - apply Int.bits_mone; omega. - intros. rewrite Int.bits_zero_ext by omega. apply zlt_false; omega. + rewrite Int.bits_zero_ext by lia. rewrite zlt_true by lia. + apply Int.bits_mone; lia. + intros. rewrite Int.bits_zero_ext by lia. apply zlt_false; lia. Qed. (** ** Abstract operations over value needs. *) @@ -676,12 +676,12 @@ Proof. destruct x; simpl in *. - auto. - unfold Val.zero_ext; InvAgree. - red; intros. autorewrite with ints; try omega. + red; intros. autorewrite with ints; try lia. destruct (zlt i1 n); auto. apply H; auto. - autorewrite with ints; try omega. rewrite zlt_true; auto. + autorewrite with ints; try lia. rewrite zlt_true; auto. - unfold Val.zero_ext; InvAgree; auto. apply Val.lessdef_same. f_equal. - Int.bit_solve; try omega. destruct (zlt i1 n); auto. apply H; auto. - autorewrite with ints; try omega. apply zlt_true; auto. + Int.bit_solve; try lia. destruct (zlt i1 n); auto. apply H; auto. + autorewrite with ints; try lia. apply zlt_true; auto. Qed. Definition sign_ext (n: Z) (x: nval) := @@ -700,25 +700,25 @@ Proof. unfold sign_ext; intros. destruct x; simpl in *. - auto. - unfold Val.sign_ext; InvAgree. - red; intros. autorewrite with ints; try omega. + red; intros. autorewrite with ints; try lia. set (j := if zlt i1 n then i1 else n - 1). assert (0 <= j < Int.zwordsize). - { unfold j; destruct (zlt i1 n); omega. } + { unfold j; destruct (zlt i1 n); lia. } apply H; auto. - autorewrite with ints; try omega. apply orb_true_intro. + autorewrite with ints; try lia. apply orb_true_intro. unfold j; destruct (zlt i1 n). left. rewrite zlt_true; auto. - right. rewrite Int.unsigned_repr. rewrite zlt_false by omega. - replace (n - 1 - (n - 1)) with 0 by omega. reflexivity. - generalize Int.wordsize_max_unsigned; omega. + right. rewrite Int.unsigned_repr. rewrite zlt_false by lia. + replace (n - 1 - (n - 1)) with 0 by lia. reflexivity. + generalize Int.wordsize_max_unsigned; lia. - unfold Val.sign_ext; InvAgree; auto. apply Val.lessdef_same. f_equal. - Int.bit_solve; try omega. + Int.bit_solve; try lia. set (j := if zlt i1 n then i1 else n - 1). assert (0 <= j < Int.zwordsize). - { unfold j; destruct (zlt i1 n); omega. } - apply H; auto. rewrite Int.bits_zero_ext; try omega. + { unfold j; destruct (zlt i1 n); lia. } + apply H; auto. rewrite Int.bits_zero_ext; try lia. rewrite zlt_true. apply Int.bits_mone; auto. - unfold j. destruct (zlt i1 n); omega. + unfold j. destruct (zlt i1 n); lia. Qed. (** The needs of a memory store concerning the value being stored. *) @@ -778,11 +778,11 @@ Proof. - apply sign_ext_sound with (v := Vint i) (w := Vint i0) (x := All) (n := 8). auto. compute; auto. - apply zero_ext_sound with (v := Vint i) (w := Vint i0) (x := All) (n := 8). - auto. omega. + auto. lia. - apply sign_ext_sound with (v := Vint i) (w := Vint i0) (x := All) (n := 16). auto. compute; auto. - apply zero_ext_sound with (v := Vint i) (w := Vint i0) (x := All) (n := 16). - auto. omega. + auto. lia. Qed. (** The needs of a comparison *) @@ -1014,9 +1014,9 @@ Proof. unfold zero_ext_redundant; intros. destruct x; try discriminate. - auto. - simpl in *; InvAgree. simpl. InvBooleans. rewrite <- H. - red; intros; autorewrite with ints; try omega. + red; intros; autorewrite with ints; try lia. destruct (zlt i1 n). apply H0; auto. - rewrite Int.bits_zero_ext in H3 by omega. rewrite zlt_false in H3 by auto. discriminate. + rewrite Int.bits_zero_ext in H3 by lia. rewrite zlt_false in H3 by auto. discriminate. Qed. Definition sign_ext_redundant (n: Z) (x: nval) := @@ -1036,10 +1036,10 @@ Proof. unfold sign_ext_redundant; intros. destruct x; try discriminate. - auto. - simpl in *; InvAgree. simpl. InvBooleans. rewrite <- H. - red; intros; autorewrite with ints; try omega. + red; intros; autorewrite with ints; try lia. destruct (zlt i1 n). apply H0; auto. rewrite Int.bits_or; auto. rewrite H3; auto. - rewrite Int.bits_zero_ext in H3 by omega. rewrite zlt_false in H3 by auto. discriminate. + rewrite Int.bits_zero_ext in H3 by lia. rewrite zlt_false in H3 by auto. discriminate. Qed. (** * Neededness for register environments *) @@ -1084,7 +1084,7 @@ Proof. intros. apply H. Qed. -Hint Resolve nreg_agree: na. +Global Hint Resolve nreg_agree: na. Lemma eagree_ge: forall e1 e2 ne ne', @@ -1300,13 +1300,13 @@ Proof. split; simpl; auto; intros. rewrite PTree.gsspec in H6. destruct (peq id0 id). + inv H6. destruct H3. congruence. destruct gl!id as [iv0|] eqn:NG. - unfold iv'; rewrite ISet.In_add. intros [P|P]. omega. eelim GL; eauto. - unfold iv'; rewrite ISet.In_interval. omega. + unfold iv'; rewrite ISet.In_add. intros [P|P]. lia. eelim GL; eauto. + unfold iv'; rewrite ISet.In_interval. lia. + eauto. - (* Stk ofs *) split; simpl; auto; intros. destruct H3. elim H3. subst b'. eapply bc_stack; eauto. - rewrite ISet.In_add. intros [P|P]. omega. eapply STK; eauto. + rewrite ISet.In_add. intros [P|P]. lia. eapply STK; eauto. Qed. (** Test (conservatively) whether some locations in the range delimited diff --git a/backend/PrintAsm.ml b/backend/PrintAsm.ml index 0635e32d..7cc386ed 100644 --- a/backend/PrintAsm.ml +++ b/backend/PrintAsm.ml @@ -121,7 +121,7 @@ module Printer(Target:TARGET) = let sec = match C2C.atom_sections name with | [s] -> s - | _ -> Section_data (true, false) + | _ -> Section_data (Init, false) (* FIX Sylvain: not sure of this fix *) and align = match C2C.atom_alignof name with | Some a -> a diff --git a/backend/PrintAsmaux.ml b/backend/PrintAsmaux.ml index 5cb693af..f1978ad2 100644 --- a/backend/PrintAsmaux.ml +++ b/backend/PrintAsmaux.ml @@ -307,15 +307,32 @@ let print_version_and_options oc comment = fprintf oc " %s" Commandline.argv.(i) done; fprintf oc "\n" - -(** Get the name of the common section if it is used otherwise the given section - name, with bss as default *) -let common_section ?(sec = ".bss") () = - if !Clflags.option_fcommon then - "COMM" - else - sec;; +(** Determine the name of the section to use for a variable. + - [i] is the initialization status of the variable. + - [sec] is the name of the section to use if initialized (with no + relocations) or if no other cases apply. + - [reloc] is the name of the section to use if initialized and + containing relocations. If not provided, [sec] is used. + - [bss] is the name of the section to use if uninitialized and + common declarations are not used. If not provided, [sec] is used. + - [common] says whether common declarations can be used for uninitialized + variables. It defaults to the status of the [-fcommon] / [-fno-common] + command-line option. Passing [~common:false] is needed when + common declarations cannot be used at all, for example in the context of + small data areas. +*) + +let variable_section ~sec ?bss ?reloc ?(common = !Clflags.option_fcommon) i = + match i with + | Uninit -> + if common + then "COMM" + else begin match bss with Some s -> s | None -> sec end + | Init -> sec + | Init_reloc -> + begin match reloc with Some s -> s | None -> sec end + (* Profiling *) let profiling_table : (Digest.t, int) Hashtbl.t = Hashtbl.create 1000;; diff --git a/backend/RTL.v b/backend/RTL.v index dec59ca2..31b5cf99 100644 --- a/backend/RTL.v +++ b/backend/RTL.v @@ -367,7 +367,7 @@ Proof. exploit external_call_receptive; eauto. intros [vres2 [m2 EC2]]. exists (Returnstate s0 vres2 m2). econstructor; eauto. (* trace length *) - red; intros; inv H; simpl; try omega. + red; intros; inv H; simpl; try lia. eapply external_call_trace_length; eauto. eapply external_call_trace_length; eauto. Qed. @@ -465,8 +465,8 @@ Proof. rewrite PTree.gempty. congruence. (* inductive case *) intros. rewrite PTree.gsspec in H2. destruct (peq pc k). - inv H2. xomega. - apply Ple_trans with a. auto. xomega. + inv H2. extlia. + apply Ple_trans with a. auto. extlia. Qed. (** Maximum pseudo-register mentioned in a function. All results or arguments @@ -504,9 +504,9 @@ Proof. assert (X: forall l n, Ple m n -> Ple m (fold_left Pos.max l n)). { induction l; simpl; intros. auto. - apply IHl. xomega. } - destruct i; simpl; try (destruct s0); repeat (apply X); try xomega. - destruct o; xomega. + apply IHl. extlia. } + destruct i; simpl; try (destruct s0); repeat (apply X); try extlia. + destruct o; extlia. Qed. Remark max_reg_instr_def: @@ -514,12 +514,12 @@ Remark max_reg_instr_def: Proof. intros. assert (X: forall l n, Ple r n -> Ple r (fold_left Pos.max l n)). - { induction l; simpl; intros. xomega. apply IHl. xomega. } + { induction l; simpl; intros. extlia. apply IHl. extlia. } destruct i; simpl in *; inv H. -- apply X. xomega. -- apply X. xomega. -- destruct s0; apply X; xomega. -- destruct b; inv H1. apply X. simpl. xomega. +- apply X. extlia. +- apply X. extlia. +- destruct s0; apply X; extlia. +- destruct b; inv H1. apply X. simpl. extlia. Qed. Remark max_reg_instr_uses: @@ -529,14 +529,14 @@ Proof. assert (X: forall l n, In r l \/ Ple r n -> Ple r (fold_left Pos.max l n)). { induction l; simpl; intros. tauto. - apply IHl. destruct H0 as [[A|A]|A]. right; subst; xomega. auto. right; xomega. } + apply IHl. destruct H0 as [[A|A]|A]. right; subst; extlia. auto. right; extlia. } destruct i; simpl in *; try (destruct s0); try (apply X; auto). - contradiction. -- destruct H. right; subst; xomega. auto. -- destruct H. right; subst; xomega. auto. -- destruct H. right; subst; xomega. auto. -- intuition. subst; xomega. -- destruct o; simpl in H; intuition. subst; xomega. +- destruct H. right; subst; extlia. auto. +- destruct H. right; subst; extlia. auto. +- destruct H. right; subst; extlia. auto. +- intuition. subst; extlia. +- destruct o; simpl in H; intuition. subst; extlia. Qed. Lemma max_reg_function_def: @@ -554,7 +554,7 @@ Proof. + inv H3. eapply max_reg_instr_def; eauto. + apply Ple_trans with a. auto. apply max_reg_instr_ge. } - unfold max_reg_function. xomega. + unfold max_reg_function. extlia. Qed. Lemma max_reg_function_use: @@ -572,7 +572,7 @@ Proof. + inv H3. eapply max_reg_instr_uses; eauto. + apply Ple_trans with a. auto. apply max_reg_instr_ge. } - unfold max_reg_function. xomega. + unfold max_reg_function. extlia. Qed. Lemma max_reg_function_params: @@ -582,8 +582,8 @@ Proof. assert (X: forall l n, In r l \/ Ple r n -> Ple r (fold_left Pos.max l n)). { induction l; simpl; intros. tauto. - apply IHl. destruct H0 as [[A|A]|A]. right; subst; xomega. auto. right; xomega. } + apply IHl. destruct H0 as [[A|A]|A]. right; subst; extlia. auto. right; extlia. } assert (Y: Ple r (fold_left Pos.max f.(fn_params) 1%positive)). { apply X; auto. } - unfold max_reg_function. xomega. + unfold max_reg_function. extlia. Qed. diff --git a/backend/RTLgenproof.v b/backend/RTLgenproof.v index e62aff22..d07dc968 100644 --- a/backend/RTLgenproof.v +++ b/backend/RTLgenproof.v @@ -165,7 +165,7 @@ Proof. subst r0; contradiction. apply Regmap.gso; auto. Qed. -Hint Resolve match_env_update_temp: rtlg. +Global Hint Resolve match_env_update_temp: rtlg. (** Matching between environments is preserved by simultaneous assignment to a Cminor local variable (in the Cminor environments) @@ -205,7 +205,7 @@ Proof. eapply match_env_update_temp; eauto. eapply match_env_update_var; eauto. Qed. -Hint Resolve match_env_update_dest: rtlg. +Global Hint Resolve match_env_update_dest: rtlg. (** A variant of [match_env_update_var] corresponding to the assignment of the result of a builtin. *) @@ -1145,7 +1145,7 @@ Proof. Qed. Ltac Lt_state := - apply lt_state_intro; simpl; try omega. + apply lt_state_intro; simpl; try lia. Lemma lt_state_wf: well_founded lt_state. diff --git a/backend/RTLgenspec.v b/backend/RTLgenspec.v index 36b8409d..0210aa5b 100644 --- a/backend/RTLgenspec.v +++ b/backend/RTLgenspec.v @@ -128,7 +128,7 @@ Ltac monadInv H := (** * Monotonicity properties of the state *) -Hint Resolve state_incr_refl: rtlg. +Global Hint Resolve state_incr_refl: rtlg. Lemma instr_at_incr: forall s1 s2 n i, @@ -137,7 +137,7 @@ Proof. intros. inv H. destruct (H3 n); congruence. Qed. -Hint Resolve instr_at_incr: rtlg. +Global Hint Resolve instr_at_incr: rtlg. (** The following tactic saturates the hypotheses with [state_incr] properties that follow by transitivity from @@ -174,14 +174,14 @@ Lemma valid_fresh_absurd: Proof. intros r s. unfold reg_valid, reg_fresh; case r; tauto. Qed. -Hint Resolve valid_fresh_absurd: rtlg. +Global Hint Resolve valid_fresh_absurd: rtlg. Lemma valid_fresh_different: forall r1 r2 s, reg_valid r1 s -> reg_fresh r2 s -> r1 <> r2. Proof. unfold not; intros. subst r2. eauto with rtlg. Qed. -Hint Resolve valid_fresh_different: rtlg. +Global Hint Resolve valid_fresh_different: rtlg. Lemma reg_valid_incr: forall r s1 s2, state_incr s1 s2 -> reg_valid r s1 -> reg_valid r s2. @@ -190,7 +190,7 @@ Proof. inversion INCR. unfold reg_valid. intros; apply Plt_Ple_trans with (st_nextreg s1); auto. Qed. -Hint Resolve reg_valid_incr: rtlg. +Global Hint Resolve reg_valid_incr: rtlg. Lemma reg_fresh_decr: forall r s1 s2, state_incr s1 s2 -> reg_fresh r s2 -> reg_fresh r s1. @@ -199,7 +199,7 @@ Proof. unfold reg_fresh; unfold not; intros. apply H4. apply Plt_Ple_trans with (st_nextreg s1); auto. Qed. -Hint Resolve reg_fresh_decr: rtlg. +Global Hint Resolve reg_fresh_decr: rtlg. (** Validity of a list of registers. *) @@ -211,7 +211,7 @@ Lemma regs_valid_nil: Proof. intros; red; intros. elim H. Qed. -Hint Resolve regs_valid_nil: rtlg. +Global Hint Resolve regs_valid_nil: rtlg. Lemma regs_valid_cons: forall r1 rl s, @@ -232,7 +232,7 @@ Lemma regs_valid_incr: Proof. unfold regs_valid; intros; eauto with rtlg. Qed. -Hint Resolve regs_valid_incr: rtlg. +Global Hint Resolve regs_valid_incr: rtlg. (** A register is ``in'' a mapping if it is associated with a Cminor local or let-bound variable. *) @@ -253,7 +253,7 @@ Lemma map_valid_incr: Proof. unfold map_valid; intros; eauto with rtlg. Qed. -Hint Resolve map_valid_incr: rtlg. +Global Hint Resolve map_valid_incr: rtlg. (** * Properties of basic operations over the state *) @@ -265,7 +265,7 @@ Lemma add_instr_at: Proof. intros. monadInv H. simpl. apply PTree.gss. Qed. -Hint Resolve add_instr_at: rtlg. +Global Hint Resolve add_instr_at: rtlg. (** Properties of [update_instr]. *) @@ -278,7 +278,7 @@ Proof. destruct (check_empty_node s1 n); try discriminate. inv H. simpl. apply PTree.gss. Qed. -Hint Resolve update_instr_at: rtlg. +Global Hint Resolve update_instr_at: rtlg. (** Properties of [new_reg]. *) @@ -289,7 +289,7 @@ Proof. intros. monadInv H. unfold reg_valid; simpl. apply Plt_succ. Qed. -Hint Resolve new_reg_valid: rtlg. +Global Hint Resolve new_reg_valid: rtlg. Lemma new_reg_fresh: forall s1 s2 r i, @@ -299,7 +299,7 @@ Proof. unfold reg_fresh; simpl. exact (Plt_strict _). Qed. -Hint Resolve new_reg_fresh: rtlg. +Global Hint Resolve new_reg_fresh: rtlg. Lemma new_reg_not_in_map: forall s1 s2 m r i, @@ -307,7 +307,7 @@ Lemma new_reg_not_in_map: Proof. unfold not; intros; eauto with rtlg. Qed. -Hint Resolve new_reg_not_in_map: rtlg. +Global Hint Resolve new_reg_not_in_map: rtlg. (** * Properties of operations over compilation environments *) @@ -330,7 +330,7 @@ Proof. intros. inv H0. left; exists name; auto. intros. inv H0. Qed. -Hint Resolve find_var_in_map: rtlg. +Global Hint Resolve find_var_in_map: rtlg. Lemma find_var_valid: forall s1 s2 map name r i, @@ -338,7 +338,7 @@ Lemma find_var_valid: Proof. eauto with rtlg. Qed. -Hint Resolve find_var_valid: rtlg. +Global Hint Resolve find_var_valid: rtlg. (** Properties of [find_letvar]. *) @@ -350,7 +350,7 @@ Proof. caseEq (nth_error (map_letvars map) idx); intros; monadInv H0. right; apply nth_error_in with idx; auto. Qed. -Hint Resolve find_letvar_in_map: rtlg. +Global Hint Resolve find_letvar_in_map: rtlg. Lemma find_letvar_valid: forall s1 s2 map idx r i, @@ -358,7 +358,7 @@ Lemma find_letvar_valid: Proof. eauto with rtlg. Qed. -Hint Resolve find_letvar_valid: rtlg. +Global Hint Resolve find_letvar_valid: rtlg. (** Properties of [add_var]. *) @@ -445,7 +445,7 @@ Proof. intros until r. unfold alloc_reg. case a; eauto with rtlg. Qed. -Hint Resolve alloc_reg_valid: rtlg. +Global Hint Resolve alloc_reg_valid: rtlg. Lemma alloc_reg_fresh_or_in_map: forall map a s r s' i, @@ -469,7 +469,7 @@ Proof. apply regs_valid_nil. apply regs_valid_cons. eauto with rtlg. eauto with rtlg. Qed. -Hint Resolve alloc_regs_valid: rtlg. +Global Hint Resolve alloc_regs_valid: rtlg. Lemma alloc_regs_fresh_or_in_map: forall map al s rl s' i, @@ -494,7 +494,7 @@ Proof. intros until r. unfold alloc_reg. case dest; eauto with rtlg. Qed. -Hint Resolve alloc_optreg_valid: rtlg. +Global Hint Resolve alloc_optreg_valid: rtlg. Lemma alloc_optreg_fresh_or_in_map: forall map dest s r s' i, @@ -609,7 +609,7 @@ Proof. apply regs_valid_cons; eauto with rtlg. Qed. -Hint Resolve new_reg_target_ok alloc_reg_target_ok +Global Hint Resolve new_reg_target_ok alloc_reg_target_ok alloc_regs_target_ok: rtlg. (** The following predicate is a variant of [target_reg_ok] used @@ -631,7 +631,7 @@ Lemma return_reg_ok_incr: Proof. induction 1; intros; econstructor; eauto with rtlg. Qed. -Hint Resolve return_reg_ok_incr: rtlg. +Global Hint Resolve return_reg_ok_incr: rtlg. Lemma new_reg_return_ok: forall s1 r s2 map sig i, @@ -676,7 +676,7 @@ Inductive reg_map_ok: mapping -> reg -> option ident -> Prop := map.(map_vars)!id = Some rd -> reg_map_ok map rd (Some id). -Hint Resolve reg_map_ok_novar: rtlg. +Global Hint Resolve reg_map_ok_novar: rtlg. (** [tr_expr c map pr expr ns nd rd optid] holds if the graph [c], between nodes [ns] and [nd], contains instructions that compute the diff --git a/backend/SelectDivproof.v b/backend/SelectDivproof.v index 1873da4d..3f91b1ba 100644 --- a/backend/SelectDivproof.v +++ b/backend/SelectDivproof.v @@ -45,55 +45,55 @@ Proof. set (r := n mod d). intro EUCL. assert (0 <= r <= d - 1). - unfold r. generalize (Z_mod_lt n d d_pos). omega. + unfold r. generalize (Z_mod_lt n d d_pos). lia. assert (0 <= m). apply Zmult_le_0_reg_r with d. auto. - exploit (two_p_gt_ZERO (N + l)). omega. omega. + exploit (two_p_gt_ZERO (N + l)). lia. lia. set (k := m * d - two_p (N + l)). assert (0 <= k <= two_p l). - unfold k; omega. + unfold k; lia. assert ((m * n - two_p (N + l) * q) * d = k * n + two_p (N + l) * r). unfold k. rewrite EUCL. ring. assert (0 <= k * n). - apply Z.mul_nonneg_nonneg; omega. + apply Z.mul_nonneg_nonneg; lia. assert (k * n <= two_p (N + l) - two_p l). apply Z.le_trans with (two_p l * n). - apply Z.mul_le_mono_nonneg_r; omega. - replace (N + l) with (l + N) by omega. + apply Z.mul_le_mono_nonneg_r; lia. + replace (N + l) with (l + N) by lia. rewrite two_p_is_exp. replace (two_p l * two_p N - two_p l) with (two_p l * (two_p N - 1)) by ring. - apply Z.mul_le_mono_nonneg_l. omega. exploit (two_p_gt_ZERO l). omega. omega. - omega. omega. + apply Z.mul_le_mono_nonneg_l. lia. exploit (two_p_gt_ZERO l). lia. lia. + lia. lia. assert (0 <= two_p (N + l) * r). apply Z.mul_nonneg_nonneg. - exploit (two_p_gt_ZERO (N + l)). omega. omega. - omega. + exploit (two_p_gt_ZERO (N + l)). lia. lia. + lia. assert (two_p (N + l) * r <= two_p (N + l) * d - two_p (N + l)). replace (two_p (N + l) * d - two_p (N + l)) with (two_p (N + l) * (d - 1)) by ring. apply Z.mul_le_mono_nonneg_l. - omega. - exploit (two_p_gt_ZERO (N + l)). omega. omega. + lia. + exploit (two_p_gt_ZERO (N + l)). lia. lia. assert (0 <= m * n - two_p (N + l) * q). apply Zmult_le_reg_r with d. auto. - replace (0 * d) with 0 by ring. rewrite H2. omega. + replace (0 * d) with 0 by ring. rewrite H2. lia. assert (m * n - two_p (N + l) * q < two_p (N + l)). - apply Zmult_lt_reg_r with d. omega. + apply Zmult_lt_reg_r with d. lia. rewrite H2. apply Z.le_lt_trans with (two_p (N + l) * d - two_p l). - omega. - exploit (two_p_gt_ZERO l). omega. omega. + lia. + exploit (two_p_gt_ZERO l). lia. lia. symmetry. apply Zdiv_unique with (m * n - two_p (N + l) * q). - ring. omega. + ring. lia. Qed. Lemma Zdiv_unique_2: forall x y q, y > 0 -> 0 < y * q - x <= y -> Z.div x y = q - 1. Proof. intros. apply Zdiv_unique with (x - (q - 1) * y). ring. - replace ((q - 1) * y) with (y * q - y) by ring. omega. + replace ((q - 1) * y) with (y * q - y) by ring. lia. Qed. Lemma Zdiv_mul_opp: @@ -111,42 +111,42 @@ Proof. set (r := n mod d). intro EUCL. assert (0 <= r <= d - 1). - unfold r. generalize (Z_mod_lt n d d_pos). omega. + unfold r. generalize (Z_mod_lt n d d_pos). lia. assert (0 <= m). apply Zmult_le_0_reg_r with d. auto. - exploit (two_p_gt_ZERO (N + l)). omega. omega. + exploit (two_p_gt_ZERO (N + l)). lia. lia. cut (Z.div (- (m * n)) (two_p (N + l)) = -q - 1). - omega. + lia. apply Zdiv_unique_2. - apply two_p_gt_ZERO. omega. + apply two_p_gt_ZERO. lia. replace (two_p (N + l) * - q - - (m * n)) with (m * n - two_p (N + l) * q) by ring. set (k := m * d - two_p (N + l)). assert (0 < k <= two_p l). - unfold k; omega. + unfold k; lia. assert ((m * n - two_p (N + l) * q) * d = k * n + two_p (N + l) * r). unfold k. rewrite EUCL. ring. split. - apply Zmult_lt_reg_r with d. omega. - replace (0 * d) with 0 by omega. + apply Zmult_lt_reg_r with d. lia. + replace (0 * d) with 0 by lia. rewrite H2. - assert (0 < k * n). apply Z.mul_pos_pos; omega. + assert (0 < k * n). apply Z.mul_pos_pos; lia. assert (0 <= two_p (N + l) * r). - apply Z.mul_nonneg_nonneg. exploit (two_p_gt_ZERO (N + l)); omega. omega. - omega. - apply Zmult_le_reg_r with d. omega. + apply Z.mul_nonneg_nonneg. exploit (two_p_gt_ZERO (N + l)); lia. lia. + lia. + apply Zmult_le_reg_r with d. lia. rewrite H2. assert (k * n <= two_p (N + l)). - rewrite Z.add_comm. rewrite two_p_is_exp; try omega. - apply Z.le_trans with (two_p l * n). apply Z.mul_le_mono_nonneg_r; omega. - apply Z.mul_le_mono_nonneg_l. omega. exploit (two_p_gt_ZERO l). omega. omega. + rewrite Z.add_comm. rewrite two_p_is_exp; try lia. + apply Z.le_trans with (two_p l * n). apply Z.mul_le_mono_nonneg_r; lia. + apply Z.mul_le_mono_nonneg_l. lia. exploit (two_p_gt_ZERO l). lia. lia. assert (two_p (N + l) * r <= two_p (N + l) * d - two_p (N + l)). replace (two_p (N + l) * d - two_p (N + l)) with (two_p (N + l) * (d - 1)) by ring. - apply Z.mul_le_mono_nonneg_l. exploit (two_p_gt_ZERO (N + l)). omega. omega. omega. - omega. + apply Z.mul_le_mono_nonneg_l. exploit (two_p_gt_ZERO (N + l)). lia. lia. lia. + lia. Qed. (** This is theorem 5.1 from Granlund and Montgomery, PLDI 1994. *) @@ -160,13 +160,13 @@ Lemma Zquot_mul: Z.quot n d = Z.div (m * n) (two_p (N + l)) + (if zlt n 0 then 1 else 0). Proof. intros. destruct (zlt n 0). - exploit (Zdiv_mul_opp m l H H0 (-n)). omega. + exploit (Zdiv_mul_opp m l H H0 (-n)). lia. replace (- - n) with n by ring. replace (Z.quot n d) with (- Z.quot (-n) d). - rewrite Zquot_Zdiv_pos by omega. omega. - rewrite Z.quot_opp_l by omega. ring. - rewrite Z.add_0_r. rewrite Zquot_Zdiv_pos by omega. - apply Zdiv_mul_pos; omega. + rewrite Zquot_Zdiv_pos by lia. lia. + rewrite Z.quot_opp_l by lia. ring. + rewrite Z.add_0_r. rewrite Zquot_Zdiv_pos by lia. + apply Zdiv_mul_pos; lia. Qed. End Z_DIV_MUL. @@ -195,11 +195,11 @@ Proof with (try discriminate). destruct (zlt p1 32)... intros EQ; inv EQ. split. auto. split. auto. intros. - replace (32 + p') with (31 + (p' + 1)) by omega. - apply Zquot_mul; try omega. - replace (31 + (p' + 1)) with (32 + p') by omega. omega. + replace (32 + p') with (31 + (p' + 1)) by lia. + apply Zquot_mul; try lia. + replace (31 + (p' + 1)) with (32 + p') by lia. lia. change (Int.min_signed <= n < Int.half_modulus). - unfold Int.max_signed in H. omega. + unfold Int.max_signed in H. lia. Qed. Lemma divu_mul_params_sound: @@ -224,7 +224,7 @@ Proof with (try discriminate). destruct (zlt p1 32)... intros EQ; inv EQ. split. auto. split. auto. intros. - apply Zdiv_mul_pos; try omega. assumption. + apply Zdiv_mul_pos; try lia. assumption. Qed. Lemma divs_mul_shift_gen: @@ -238,25 +238,25 @@ Proof. exploit divs_mul_params_sound; eauto. intros (A & B & C). split. auto. split. auto. unfold Int.divs. fold n; fold d. rewrite C by (apply Int.signed_range). - rewrite two_p_is_exp by omega. rewrite <- Zdiv_Zdiv. + rewrite two_p_is_exp by lia. rewrite <- Zdiv_Zdiv. rewrite Int.shru_lt_zero. unfold Int.add. apply Int.eqm_samerepr. apply Int.eqm_add. rewrite Int.shr_div_two_p. apply Int.eqm_unsigned_repr_r. apply Int.eqm_refl2. rewrite Int.unsigned_repr. f_equal. rewrite Int.signed_repr. rewrite Int.modulus_power. f_equal. ring. cut (Int.min_signed <= n * m / Int.modulus < Int.half_modulus). - unfold Int.max_signed; omega. - apply Zdiv_interval_1. generalize Int.min_signed_neg; omega. apply Int.half_modulus_pos. + unfold Int.max_signed; lia. + apply Zdiv_interval_1. generalize Int.min_signed_neg; lia. apply Int.half_modulus_pos. apply Int.modulus_pos. split. apply Z.le_trans with (Int.min_signed * m). - apply Z.mul_le_mono_nonpos_l. generalize Int.min_signed_neg; omega. omega. - apply Z.mul_le_mono_nonneg_r. omega. unfold n; generalize (Int.signed_range x); tauto. + apply Z.mul_le_mono_nonpos_l. generalize Int.min_signed_neg; lia. lia. + apply Z.mul_le_mono_nonneg_r. lia. unfold n; generalize (Int.signed_range x); tauto. apply Z.le_lt_trans with (Int.half_modulus * m). - apply Z.mul_le_mono_nonneg_r. tauto. generalize (Int.signed_range x); unfold n, Int.max_signed; omega. - apply Zmult_lt_compat_l. generalize Int.half_modulus_pos; omega. tauto. - assert (32 < Int.max_unsigned) by (compute; auto). omega. + apply Z.mul_le_mono_nonneg_r. tauto. generalize (Int.signed_range x); unfold n, Int.max_signed; lia. + apply Zmult_lt_compat_l. generalize Int.half_modulus_pos; lia. tauto. + assert (32 < Int.max_unsigned) by (compute; auto). lia. unfold Int.lt; fold n. rewrite Int.signed_zero. destruct (zlt n 0); apply Int.eqm_unsigned_repr. - apply two_p_gt_ZERO. omega. - apply two_p_gt_ZERO. omega. + apply two_p_gt_ZERO. lia. + apply two_p_gt_ZERO. lia. Qed. Theorem divs_mul_shift_1: @@ -270,7 +270,7 @@ Proof. intros. exploit divs_mul_shift_gen; eauto. instantiate (1 := x). intros (A & B & C). split. auto. rewrite C. unfold Int.mulhs. rewrite Int.signed_repr. auto. - generalize Int.min_signed_neg; unfold Int.max_signed; omega. + generalize Int.min_signed_neg; unfold Int.max_signed; lia. Qed. Theorem divs_mul_shift_2: @@ -306,18 +306,18 @@ Proof. split. auto. rewrite Int.shru_div_two_p. rewrite Int.unsigned_repr. unfold Int.divu, Int.mulhu. f_equal. rewrite C by apply Int.unsigned_range. - rewrite two_p_is_exp by omega. rewrite <- Zdiv_Zdiv by (apply two_p_gt_ZERO; omega). + rewrite two_p_is_exp by lia. rewrite <- Zdiv_Zdiv by (apply two_p_gt_ZERO; lia). f_equal. rewrite (Int.unsigned_repr m). rewrite Int.unsigned_repr. f_equal. ring. cut (0 <= Int.unsigned x * m / Int.modulus < Int.modulus). - unfold Int.max_unsigned; omega. - apply Zdiv_interval_1. omega. compute; auto. compute; auto. - split. simpl. apply Z.mul_nonneg_nonneg. generalize (Int.unsigned_range x); omega. omega. + unfold Int.max_unsigned; lia. + apply Zdiv_interval_1. lia. compute; auto. compute; auto. + split. simpl. apply Z.mul_nonneg_nonneg. generalize (Int.unsigned_range x); lia. lia. apply Z.le_lt_trans with (Int.modulus * m). - apply Zmult_le_compat_r. generalize (Int.unsigned_range x); omega. omega. - apply Zmult_lt_compat_l. compute; auto. omega. - unfold Int.max_unsigned; omega. - assert (32 < Int.max_unsigned) by (compute; auto). omega. + apply Zmult_le_compat_r. generalize (Int.unsigned_range x); lia. lia. + apply Zmult_lt_compat_l. compute; auto. lia. + unfold Int.max_unsigned; lia. + assert (32 < Int.max_unsigned) by (compute; auto). lia. Qed. (** Same, for 64-bit integers *) @@ -344,11 +344,11 @@ Proof with (try discriminate). destruct (zlt p1 64)... intros EQ; inv EQ. split. auto. split. auto. intros. - replace (64 + p') with (63 + (p' + 1)) by omega. - apply Zquot_mul; try omega. - replace (63 + (p' + 1)) with (64 + p') by omega. omega. + replace (64 + p') with (63 + (p' + 1)) by lia. + apply Zquot_mul; try lia. + replace (63 + (p' + 1)) with (64 + p') by lia. lia. change (Int64.min_signed <= n < Int64.half_modulus). - unfold Int64.max_signed in H. omega. + unfold Int64.max_signed in H. lia. Qed. Lemma divlu_mul_params_sound: @@ -373,13 +373,13 @@ Proof with (try discriminate). destruct (zlt p1 64)... intros EQ; inv EQ. split. auto. split. auto. intros. - apply Zdiv_mul_pos; try omega. assumption. + apply Zdiv_mul_pos; try lia. assumption. Qed. Remark int64_shr'_div_two_p: forall x y, Int64.shr' x y = Int64.repr (Int64.signed x / two_p (Int.unsigned y)). Proof. - intros; unfold Int64.shr'. rewrite Zshiftr_div_two_p; auto. generalize (Int.unsigned_range y); omega. + intros; unfold Int64.shr'. rewrite Zshiftr_div_two_p; auto. generalize (Int.unsigned_range y); lia. Qed. Lemma divls_mul_shift_gen: @@ -393,25 +393,25 @@ Proof. exploit divls_mul_params_sound; eauto. intros (A & B & C). split. auto. split. auto. unfold Int64.divs. fold n; fold d. rewrite C by (apply Int64.signed_range). - rewrite two_p_is_exp by omega. rewrite <- Zdiv_Zdiv. + rewrite two_p_is_exp by lia. rewrite <- Zdiv_Zdiv. rewrite Int64.shru_lt_zero. unfold Int64.add. apply Int64.eqm_samerepr. apply Int64.eqm_add. rewrite int64_shr'_div_two_p. apply Int64.eqm_unsigned_repr_r. apply Int64.eqm_refl2. rewrite Int.unsigned_repr. f_equal. rewrite Int64.signed_repr. rewrite Int64.modulus_power. f_equal. ring. cut (Int64.min_signed <= n * m / Int64.modulus < Int64.half_modulus). - unfold Int64.max_signed; omega. - apply Zdiv_interval_1. generalize Int64.min_signed_neg; omega. apply Int64.half_modulus_pos. + unfold Int64.max_signed; lia. + apply Zdiv_interval_1. generalize Int64.min_signed_neg; lia. apply Int64.half_modulus_pos. apply Int64.modulus_pos. split. apply Z.le_trans with (Int64.min_signed * m). - apply Z.mul_le_mono_nonpos_l. generalize Int64.min_signed_neg; omega. omega. + apply Z.mul_le_mono_nonpos_l. generalize Int64.min_signed_neg; lia. lia. apply Z.mul_le_mono_nonneg_r. tauto. unfold n; generalize (Int64.signed_range x); tauto. apply Z.le_lt_trans with (Int64.half_modulus * m). - apply Zmult_le_compat_r. generalize (Int64.signed_range x); unfold n, Int64.max_signed; omega. tauto. - apply Zmult_lt_compat_l. generalize Int64.half_modulus_pos; omega. tauto. - assert (64 < Int.max_unsigned) by (compute; auto). omega. + apply Zmult_le_compat_r. generalize (Int64.signed_range x); unfold n, Int64.max_signed; lia. tauto. + apply Zmult_lt_compat_l. generalize Int64.half_modulus_pos; lia. tauto. + assert (64 < Int.max_unsigned) by (compute; auto). lia. unfold Int64.lt; fold n. rewrite Int64.signed_zero. destruct (zlt n 0); apply Int64.eqm_unsigned_repr. - apply two_p_gt_ZERO. omega. - apply two_p_gt_ZERO. omega. + apply two_p_gt_ZERO. lia. + apply two_p_gt_ZERO. lia. Qed. Theorem divls_mul_shift_1: @@ -425,7 +425,7 @@ Proof. intros. exploit divls_mul_shift_gen; eauto. instantiate (1 := x). intros (A & B & C). split. auto. rewrite C. unfold Int64.mulhs. rewrite Int64.signed_repr. auto. - generalize Int64.min_signed_neg; unfold Int64.max_signed; omega. + generalize Int64.min_signed_neg; unfold Int64.max_signed; lia. Qed. Theorem divls_mul_shift_2: @@ -454,7 +454,7 @@ Qed. Remark int64_shru'_div_two_p: forall x y, Int64.shru' x y = Int64.repr (Int64.unsigned x / two_p (Int.unsigned y)). Proof. - intros; unfold Int64.shru'. rewrite Zshiftr_div_two_p; auto. generalize (Int.unsigned_range y); omega. + intros; unfold Int64.shru'. rewrite Zshiftr_div_two_p; auto. generalize (Int.unsigned_range y); lia. Qed. Theorem divlu_mul_shift: @@ -467,18 +467,18 @@ Proof. split. auto. rewrite int64_shru'_div_two_p. rewrite Int.unsigned_repr. unfold Int64.divu, Int64.mulhu. f_equal. rewrite C by apply Int64.unsigned_range. - rewrite two_p_is_exp by omega. rewrite <- Zdiv_Zdiv by (apply two_p_gt_ZERO; omega). + rewrite two_p_is_exp by lia. rewrite <- Zdiv_Zdiv by (apply two_p_gt_ZERO; lia). f_equal. rewrite (Int64.unsigned_repr m). rewrite Int64.unsigned_repr. f_equal. ring. cut (0 <= Int64.unsigned x * m / Int64.modulus < Int64.modulus). - unfold Int64.max_unsigned; omega. - apply Zdiv_interval_1. omega. compute; auto. compute; auto. - split. simpl. apply Z.mul_nonneg_nonneg. generalize (Int64.unsigned_range x); omega. omega. + unfold Int64.max_unsigned; lia. + apply Zdiv_interval_1. lia. compute; auto. compute; auto. + split. simpl. apply Z.mul_nonneg_nonneg. generalize (Int64.unsigned_range x); lia. lia. apply Z.le_lt_trans with (Int64.modulus * m). - apply Zmult_le_compat_r. generalize (Int64.unsigned_range x); omega. omega. - apply Zmult_lt_compat_l. compute; auto. omega. - unfold Int64.max_unsigned; omega. - assert (64 < Int.max_unsigned) by (compute; auto). omega. + apply Zmult_le_compat_r. generalize (Int64.unsigned_range x); lia. lia. + apply Zmult_lt_compat_l. compute; auto. lia. + unfold Int64.max_unsigned; lia. + assert (64 < Int.max_unsigned) by (compute; auto). lia. Qed. (** * Correctness of the smart constructors for division and modulus *) @@ -516,7 +516,7 @@ Proof. replace (Int.ltu (Int.repr p) Int.iwordsize) with true in Q. inv Q. rewrite B. auto. unfold Int.ltu. rewrite Int.unsigned_repr. rewrite zlt_true; auto. tauto. - assert (32 < Int.max_unsigned) by (compute; auto). omega. + assert (32 < Int.max_unsigned) by (compute; auto). lia. Qed. Theorem eval_divuimm: @@ -631,7 +631,7 @@ Proof. simpl in LD. inv LD. assert (RANGE: 0 <= p < 32 -> Int.ltu (Int.repr p) Int.iwordsize = true). { intros. unfold Int.ltu. rewrite Int.unsigned_repr. rewrite zlt_true by tauto. auto. - assert (32 < Int.max_unsigned) by (compute; auto). omega. } + assert (32 < Int.max_unsigned) by (compute; auto). lia. } destruct (zlt M Int.half_modulus). - exploit (divs_mul_shift_1 x); eauto. intros [A B]. exploit eval_shrimm. eexact X. instantiate (1 := Int.repr p). intros [v1 [Z LD]]. @@ -769,7 +769,7 @@ Proof. simpl in B1; inv B1. simpl in B2. replace (Int.ltu (Int.repr p) Int64.iwordsize') with true in B2. inv B2. rewrite B. assumption. unfold Int.ltu. rewrite Int.unsigned_repr. rewrite zlt_true; auto. tauto. - assert (64 < Int.max_unsigned) by (compute; auto). omega. + assert (64 < Int.max_unsigned) by (compute; auto). lia. Qed. Theorem eval_divlu: @@ -848,10 +848,10 @@ Proof. exploit eval_addl. auto. eexact A5. eexact A3. intros (v6 & A6 & B6). assert (RANGE: forall x, 0 <= x < 64 -> Int.ltu (Int.repr x) Int64.iwordsize' = true). { intros. unfold Int.ltu. rewrite Int.unsigned_repr. rewrite zlt_true by tauto. auto. - assert (64 < Int.max_unsigned) by (compute; auto). omega. } + assert (64 < Int.max_unsigned) by (compute; auto). lia. } simpl in B1; inv B1. simpl in B2; inv B2. - simpl in B3; rewrite RANGE in B3 by omega; inv B3. + simpl in B3; rewrite RANGE in B3 by lia; inv B3. destruct (zlt M Int64.half_modulus). - exploit (divls_mul_shift_1 x); eauto. intros [A B]. simpl in B5; rewrite RANGE in B5 by auto; inv B5. diff --git a/backend/Selectionproof.v b/backend/Selectionproof.v index 8f3f5f00..e737ba4b 100644 --- a/backend/Selectionproof.v +++ b/backend/Selectionproof.v @@ -533,7 +533,7 @@ Lemma sel_switch_correct: (XElet arg (sel_switch make_cmp_eq make_cmp_ltu make_sub make_to_int O t)) (switch_target i dfl cases). Proof. - intros. exploit validate_switch_correct; eauto. omega. intros [A B]. + intros. exploit validate_switch_correct; eauto. lia. intros [A B]. econstructor. eauto. eapply sel_switch_correct_rec; eauto. Qed. @@ -566,7 +566,7 @@ Proof. inv R. unfold Val.cmp in B. simpl in B. revert B. predSpec Int.eq Int.eq_spec n0 (Int.repr n); intros B; inv B. rewrite Int.unsigned_repr. unfold proj_sumbool; rewrite zeq_true; auto. - unfold Int.max_unsigned; omega. + unfold Int.max_unsigned; lia. unfold proj_sumbool; rewrite zeq_false; auto. red; intros; elim H1. rewrite <- (Int.repr_unsigned n0). congruence. - intros until n; intros EVAL R RANGE. @@ -575,7 +575,7 @@ Proof. inv R. unfold Val.cmpu in B. simpl in B. unfold Int.ltu in B. rewrite Int.unsigned_repr in B. destruct (zlt (Int.unsigned n0) n); inv B; auto. - unfold Int.max_unsigned; omega. + unfold Int.max_unsigned; lia. - intros until n; intros EVAL R RANGE. exploit eval_sub. eexact EVAL. apply (INTCONST (Int.repr n)). intros (vb & A & B). inv R. simpl in B. inv B. econstructor; split; eauto. @@ -583,7 +583,7 @@ Proof. with (Int.unsigned (Int.sub n0 (Int.repr n))). constructor. unfold Int.sub. rewrite Int.unsigned_repr_eq. f_equal. f_equal. - apply Int.unsigned_repr. unfold Int.max_unsigned; omega. + apply Int.unsigned_repr. unfold Int.max_unsigned; lia. - intros until i0; intros EVAL R. exists v; split; auto. inv R. rewrite Z.mod_small by (apply Int.unsigned_range). constructor. - constructor. @@ -601,12 +601,12 @@ Proof. eapply eval_cmpl. eexact EVAL. apply eval_longconst with (n := Int64.repr n). inv R. unfold Val.cmpl. simpl. f_equal; f_equal. unfold Int64.eq. rewrite Int64.unsigned_repr. destruct (zeq (Int64.unsigned n0) n); auto. - unfold Int64.max_unsigned; omega. + unfold Int64.max_unsigned; lia. - intros until n; intros EVAL R RANGE. eapply eval_cmplu; auto. eexact EVAL. apply eval_longconst with (n := Int64.repr n). inv R. unfold Val.cmplu. simpl. f_equal; f_equal. unfold Int64.ltu. rewrite Int64.unsigned_repr. destruct (zlt (Int64.unsigned n0) n); auto. - unfold Int64.max_unsigned; omega. + unfold Int64.max_unsigned; lia. - intros until n; intros EVAL R RANGE. exploit eval_subl; auto; try apply HF'. eexact EVAL. apply eval_longconst with (n := Int64.repr n). intros (vb & A & B). @@ -615,7 +615,7 @@ Proof. with (Int64.unsigned (Int64.sub n0 (Int64.repr n))). constructor. unfold Int64.sub. rewrite Int64.unsigned_repr_eq. f_equal. f_equal. - apply Int64.unsigned_repr. unfold Int64.max_unsigned; omega. + apply Int64.unsigned_repr. unfold Int64.max_unsigned; lia. - intros until i0; intros EVAL R. exploit eval_lowlong. eexact EVAL. intros (vb & A & B). inv R. simpl in B. inv B. econstructor; split; eauto. @@ -1299,7 +1299,7 @@ Proof. eapply match_cont_call with (cunit := cunit) (hf := hf); eauto. + (* turned into Sbuiltin *) intros EQ. subst fd. - right; left; split. simpl; omega. split; auto. econstructor; eauto. + right; left; split. simpl; lia. split; auto. econstructor; eauto. - (* Stailcall *) exploit Mem.free_parallel_extends; eauto. intros [m2' [P Q]]. erewrite <- stackspace_function_translated in P by eauto. @@ -1417,7 +1417,7 @@ Proof. apply plus_one; econstructor. econstructor; eauto. destruct optid; simpl; auto. apply set_var_lessdef; auto. - (* return of an external call turned into a Sbuiltin *) - right; left; split. simpl; omega. split. auto. econstructor; eauto. + right; left; split. simpl; lia. split. auto. econstructor; eauto. Qed. Lemma sel_initial_states: diff --git a/backend/SplitLongproof.v b/backend/SplitLongproof.v index c8e3b94c..e45c3a34 100644 --- a/backend/SplitLongproof.v +++ b/backend/SplitLongproof.v @@ -318,7 +318,7 @@ Proof. fold (Int.testbit i i0). destruct (zlt i0 Int.zwordsize). auto. - rewrite Int.bits_zero. rewrite Int.bits_above by omega. auto. + rewrite Int.bits_zero. rewrite Int.bits_above by lia. auto. Qed. Theorem eval_longofint: unary_constructor_sound longofint Val.longofint. @@ -335,13 +335,13 @@ Proof. apply Int64.same_bits_eq; intros. rewrite Int64.testbit_repr by auto. rewrite Int64.bits_ofwords by auto. - rewrite Int.bits_signed by omega. + rewrite Int.bits_signed by lia. destruct (zlt i0 Int.zwordsize). auto. assert (Int64.zwordsize = 2 * Int.zwordsize) by reflexivity. - rewrite Int.bits_shr by omega. + rewrite Int.bits_shr by lia. change (Int.unsigned (Int.repr 31)) with (Int.zwordsize - 1). - f_equal. destruct (zlt (i0 - Int.zwordsize + (Int.zwordsize - 1)) Int.zwordsize); omega. + f_equal. destruct (zlt (i0 - Int.zwordsize + (Int.zwordsize - 1)) Int.zwordsize); lia. Qed. Theorem eval_negl: unary_constructor_sound negl Val.negl. @@ -528,24 +528,24 @@ Proof. { red; intros. elim H. rewrite <- (Int.repr_unsigned n). rewrite H0. auto. } destruct (Int.ltu n Int.iwordsize) eqn:LT. exploit Int.ltu_iwordsize_inv; eauto. intros RANGE. - assert (0 <= Int.zwordsize - Int.unsigned n < Int.zwordsize) by omega. + assert (0 <= Int.zwordsize - Int.unsigned n < Int.zwordsize) by lia. apply A1. auto. auto. unfold Int.ltu, Int.sub. rewrite Int.unsigned_repr_wordsize. - rewrite Int.unsigned_repr. rewrite zlt_true; auto. omega. - generalize Int.wordsize_max_unsigned; omega. + rewrite Int.unsigned_repr. rewrite zlt_true; auto. lia. + generalize Int.wordsize_max_unsigned; lia. unfold Int.ltu. rewrite zlt_true; auto. change (Int.unsigned Int64.iwordsize') with 64. - change Int.zwordsize with 32 in RANGE. omega. + change Int.zwordsize with 32 in RANGE. lia. destruct (Int.ltu n Int64.iwordsize') eqn:LT'. exploit Int.ltu_inv; eauto. change (Int.unsigned Int64.iwordsize') with (Int.zwordsize * 2). intros RANGE. assert (Int.zwordsize <= Int.unsigned n). unfold Int.ltu in LT. rewrite Int.unsigned_repr_wordsize in LT. - destruct (zlt (Int.unsigned n) Int.zwordsize). discriminate. omega. + destruct (zlt (Int.unsigned n) Int.zwordsize). discriminate. lia. apply A2. tauto. unfold Int.ltu, Int.sub. rewrite Int.unsigned_repr_wordsize. - rewrite Int.unsigned_repr. rewrite zlt_true; auto. omega. - generalize Int.wordsize_max_unsigned; omega. + rewrite Int.unsigned_repr. rewrite zlt_true; auto. lia. + generalize Int.wordsize_max_unsigned; lia. auto. Qed. @@ -901,19 +901,19 @@ Proof. rewrite Int.bits_zero. rewrite Int.bits_or by auto. symmetry. apply orb_false_intro. transitivity (Int64.testbit (Int64.ofwords h l) (i + Int.zwordsize)). - rewrite Int64.bits_ofwords by omega. rewrite zlt_false by omega. f_equal; omega. + rewrite Int64.bits_ofwords by lia. rewrite zlt_false by lia. f_equal; lia. rewrite H0. apply Int64.bits_zero. transitivity (Int64.testbit (Int64.ofwords h l) i). - rewrite Int64.bits_ofwords by omega. rewrite zlt_true by omega. auto. + rewrite Int64.bits_ofwords by lia. rewrite zlt_true by lia. auto. rewrite H0. apply Int64.bits_zero. symmetry. apply Int.eq_false. red; intros; elim H0. apply Int64.same_bits_eq; intros. rewrite Int64.bits_zero. rewrite Int64.bits_ofwords by auto. destruct (zlt i Int.zwordsize). assert (Int.testbit (Int.or h l) i = false) by (rewrite H1; apply Int.bits_zero). - rewrite Int.bits_or in H3 by omega. exploit orb_false_elim; eauto. tauto. + rewrite Int.bits_or in H3 by lia. exploit orb_false_elim; eauto. tauto. assert (Int.testbit (Int.or h l) (i - Int.zwordsize) = false) by (rewrite H1; apply Int.bits_zero). - rewrite Int.bits_or in H3 by omega. exploit orb_false_elim; eauto. tauto. + rewrite Int.bits_or in H3 by lia. exploit orb_false_elim; eauto. tauto. Qed. Lemma eval_cmpl_eq_zero: diff --git a/backend/Stackingproof.v b/backend/Stackingproof.v index d3fcdb91..aa74a1a1 100644 --- a/backend/Stackingproof.v +++ b/backend/Stackingproof.v @@ -58,7 +58,7 @@ Lemma slot_outgoing_argument_valid: Proof. intros. exploit loc_arguments_acceptable_2; eauto. intros [A B]. unfold slot_valid. unfold proj_sumbool. - rewrite zle_true by omega. + rewrite zle_true by lia. rewrite pred_dec_true by auto. auto. Qed. @@ -126,7 +126,7 @@ Proof. destruct (wt_function f); simpl negb. destruct (zlt Ptrofs.max_unsigned (fe_size (make_env (function_bounds f)))). intros; discriminate. - intros. unfold fe. unfold b. omega. + intros. unfold fe. unfold b. lia. intros; discriminate. Qed. @@ -200,7 +200,7 @@ Next Obligation. - exploit H4; eauto. intros (v & A & B). exists v; split; auto. eapply Mem.load_unchanged_on; eauto. simpl; intros. rewrite size_type_chunk, typesize_typesize in H8. - split; auto. omega. + split; auto. lia. Qed. Next Obligation. eauto with mem. @@ -215,7 +215,7 @@ Remark valid_access_location: Proof. intros; split. - red; intros. apply Mem.perm_implies with Freeable; auto with mem. - apply H0. rewrite size_type_chunk, typesize_typesize in H4. omega. + apply H0. rewrite size_type_chunk, typesize_typesize in H4. lia. - rewrite align_type_chunk. apply Z.divide_add_r. apply Z.divide_trans with 8; auto. exists (8 / (4 * typealign ty)); destruct ty; reflexivity. @@ -233,7 +233,7 @@ Proof. intros. destruct H as (D & E & F & G & H). exploit H; eauto. intros (v & U & V). exists v; split; auto. unfold load_stack; simpl. rewrite Ptrofs.add_zero_l, Ptrofs.unsigned_repr; auto. - unfold Ptrofs.max_unsigned. generalize (typesize_pos ty). omega. + unfold Ptrofs.max_unsigned. generalize (typesize_pos ty). lia. Qed. Lemma set_location: @@ -252,19 +252,19 @@ Proof. { red; intros; eauto with mem. } exists m'; split. - unfold store_stack; simpl. rewrite Ptrofs.add_zero_l, Ptrofs.unsigned_repr; eauto. - unfold Ptrofs.max_unsigned. generalize (typesize_pos ty). omega. + unfold Ptrofs.max_unsigned. generalize (typesize_pos ty). lia. - simpl. intuition auto. + unfold Locmap.set. destruct (Loc.eq (S sl ofs ty) (S sl ofs0 ty0)); [|destruct (Loc.diff_dec (S sl ofs ty) (S sl ofs0 ty0))]. * (* same location *) inv e. rename ofs0 into ofs. rename ty0 into ty. exists (Val.load_result (chunk_of_type ty) v'); split. - eapply Mem.load_store_similar_2; eauto. omega. + eapply Mem.load_store_similar_2; eauto. lia. apply Val.load_result_inject; auto. * (* different locations *) exploit H; eauto. intros (v0 & X & Y). exists v0; split; auto. rewrite <- X; eapply Mem.load_store_other; eauto. - destruct d. congruence. right. rewrite ! size_type_chunk, ! typesize_typesize. omega. + destruct d. congruence. right. rewrite ! size_type_chunk, ! typesize_typesize. lia. * (* overlapping locations *) destruct (Mem.valid_access_load m' (chunk_of_type ty0) sp (pos + 4 * ofs0)) as [v'' LOAD]. apply Mem.valid_access_implies with Writable; auto with mem. @@ -273,7 +273,7 @@ Proof. + apply (m_invar P) with m; auto. eapply Mem.store_unchanged_on; eauto. intros i; rewrite size_type_chunk, typesize_typesize. intros; red; intros. - eelim C; eauto. simpl. split; auto. omega. + eelim C; eauto. simpl. split; auto. lia. Qed. Lemma initial_locations: @@ -933,8 +933,8 @@ Local Opaque mreg_type. { unfold pos1. apply Z.divide_trans with sz. unfold sz; rewrite <- size_type_chunk. apply align_size_chunk_divides. apply align_divides; auto. } - apply range_drop_left with (mid := pos1) in SEP; [ | omega ]. - apply range_split with (mid := pos1 + sz) in SEP; [ | omega ]. + apply range_drop_left with (mid := pos1) in SEP; [ | lia ]. + apply range_split with (mid := pos1 + sz) in SEP; [ | lia ]. unfold sz at 1 in SEP. rewrite <- size_type_chunk in SEP. apply range_contains in SEP; auto. exploit (contains_set_stack (fun v' => Val.inject j (ls (R r)) v') (rs r)). @@ -1073,7 +1073,7 @@ Local Opaque b fe. instantiate (1 := fe_stack_data fe). tauto. reflexivity. instantiate (1 := fe_stack_data fe + bound_stack_data b). rewrite Z.max_comm. reflexivity. - generalize (bound_stack_data_pos b) size_no_overflow; omega. + generalize (bound_stack_data_pos b) size_no_overflow; lia. tauto. tauto. clear SEP. intros (j' & SEP & INCR & SAME). @@ -1607,7 +1607,7 @@ Proof. + simpl in SEP. unfold parent_sp. assert (slot_valid f Outgoing pos ty = true). { destruct H0. unfold slot_valid, proj_sumbool. - rewrite zle_true by omega. rewrite pred_dec_true by auto. reflexivity. } + rewrite zle_true by lia. rewrite pred_dec_true by auto. reflexivity. } assert (slot_within_bounds (function_bounds f) Outgoing pos ty) by eauto. exploit frame_get_outgoing; eauto. intros (v & A & B). exists v; split. diff --git a/backend/Tailcallproof.v b/backend/Tailcallproof.v index 79a5c1cf..80a68327 100644 --- a/backend/Tailcallproof.v +++ b/backend/Tailcallproof.v @@ -47,11 +47,11 @@ Proof. intro f. assert (forall n pc, (return_measure_rec n f pc <= n)%nat). induction n; intros; simpl. - omega. - destruct (f!pc); try omega. - destruct i; try omega. - generalize (IHn n0). omega. - generalize (IHn n0). omega. + lia. + destruct (f!pc); try lia. + destruct i; try lia. + generalize (IHn n0). lia. + generalize (IHn n0). lia. intros. unfold return_measure. apply H. Qed. @@ -61,11 +61,11 @@ Remark return_measure_rec_incr: (return_measure_rec n1 f pc <= return_measure_rec n2 f pc)%nat. Proof. induction n1; intros; simpl. - omega. - destruct n2. omegaContradiction. assert (n1 <= n2)%nat by omega. - simpl. destruct f!pc; try omega. destruct i; try omega. - generalize (IHn1 n2 n H0). omega. - generalize (IHn1 n2 n H0). omega. + lia. + destruct n2. extlia. assert (n1 <= n2)%nat by lia. + simpl. destruct f!pc; try lia. destruct i; try lia. + generalize (IHn1 n2 n H0). lia. + generalize (IHn1 n2 n H0). lia. Qed. Lemma is_return_measure_rec: @@ -75,13 +75,13 @@ Lemma is_return_measure_rec: Proof. induction n; simpl; intros. congruence. - destruct n'. omegaContradiction. simpl. + destruct n'. extlia. simpl. destruct (fn_code f)!pc; try congruence. destruct i; try congruence. - decEq. apply IHn with r. auto. omega. + decEq. apply IHn with r. auto. lia. destruct (is_move_operation o l); try congruence. destruct (Reg.eq r r1); try congruence. - decEq. apply IHn with r0. auto. omega. + decEq. apply IHn with r0. auto. lia. Qed. (** ** Relational characterization of the code transformation *) @@ -117,22 +117,22 @@ Proof. generalize H. simpl. caseEq ((fn_code f)!pc); try congruence. intro i. caseEq i; try congruence. - intros s; intros. eapply is_return_nop; eauto. eapply IHn; eauto. omega. + intros s; intros. eapply is_return_nop; eauto. eapply IHn; eauto. lia. unfold return_measure. rewrite <- (is_return_measure_rec f (S n) niter pc rret); auto. rewrite <- (is_return_measure_rec f n niter s rret); auto. - simpl. rewrite H2. omega. omega. + simpl. rewrite H2. lia. lia. intros op args dst s EQ1 EQ2. caseEq (is_move_operation op args); try congruence. intros src IMO. destruct (Reg.eq rret src); try congruence. subst rret. intro. exploit is_move_operation_correct; eauto. intros [A B]. subst. - eapply is_return_move; eauto. eapply IHn; eauto. omega. + eapply is_return_move; eauto. eapply IHn; eauto. lia. unfold return_measure. rewrite <- (is_return_measure_rec f (S n) niter pc src); auto. rewrite <- (is_return_measure_rec f n niter s dst); auto. - simpl. rewrite EQ2. omega. omega. + simpl. rewrite EQ2. lia. lia. intros or EQ1 EQ2. destruct or; intros. assert (r = rret). eapply proj_sumbool_true; eauto. subst r. @@ -407,7 +407,7 @@ Proof. eapply exec_Inop; eauto. constructor; auto. - (* eliminated nop *) assert (s0 = pc') by congruence. subst s0. - right. split. simpl. omega. split. auto. + right. split. simpl. lia. split. auto. econstructor; eauto. - (* op *) @@ -421,7 +421,7 @@ Proof. econstructor; eauto. apply set_reg_lessdef; auto. - (* eliminated move *) rewrite H1 in H. clear H1. inv H. - right. split. simpl. omega. split. auto. + right. split. simpl. lia. split. auto. econstructor; eauto. simpl in H0. rewrite PMap.gss. congruence. - (* load *) @@ -492,13 +492,13 @@ Proof. + (* call turned tailcall *) assert ({ m'' | Mem.free m' sp0 0 (fn_stacksize (transf_function f)) = Some m''}). apply Mem.range_perm_free. rewrite stacksize_preserved. rewrite H7. - red; intros; omegaContradiction. + red; intros; extlia. destruct X as [m'' FREE]. left. exists (Callstate s' (transf_fundef fd) (rs'##args) m''); split. eapply exec_Itailcall; eauto. apply sig_preserved. constructor. eapply match_stackframes_tail; eauto. apply regs_lessdef_regs; auto. eapply Mem.free_right_extends; eauto. - rewrite stacksize_preserved. rewrite H7. intros. omegaContradiction. + rewrite stacksize_preserved. rewrite H7. intros. extlia. + (* call that remains a call *) left. exists (Callstate (Stackframe res (transf_function f) (Vptr sp0 Ptrofs.zero) pc' rs' :: s') (transf_fundef fd) (rs'##args) m'); split. @@ -551,22 +551,22 @@ Proof. - (* eliminated return None *) assert (or = None) by congruence. subst or. - right. split. simpl. omega. split. auto. + right. split. simpl. lia. split. auto. constructor. auto. simpl. constructor. eapply Mem.free_left_extends; eauto. - (* eliminated return Some *) assert (or = Some r) by congruence. subst or. - right. split. simpl. omega. split. auto. + right. split. simpl. lia. split. auto. constructor. auto. simpl. auto. eapply Mem.free_left_extends; eauto. - (* internal call *) exploit Mem.alloc_extends; eauto. - instantiate (1 := 0). omega. - instantiate (1 := fn_stacksize f). omega. + instantiate (1 := 0). lia. + instantiate (1 := fn_stacksize f). lia. intros [m'1 [ALLOC EXT]]. assert (fn_stacksize (transf_function f) = fn_stacksize f /\ fn_entrypoint (transf_function f) = fn_entrypoint f /\ @@ -596,7 +596,7 @@ Proof. right. split. unfold measure. simpl length. change (S (length s) * (niter + 2))%nat with ((niter + 2) + (length s) * (niter + 2))%nat. - generalize (return_measure_bounds (fn_code f) pc). omega. + generalize (return_measure_bounds (fn_code f) pc). lia. split. auto. econstructor; eauto. rewrite Regmap.gss. auto. diff --git a/backend/Tunneling.v b/backend/Tunneling.v index 269ebb6f..c849ea92 100644 --- a/backend/Tunneling.v +++ b/backend/Tunneling.v @@ -34,8 +34,8 @@ Require Import LTL. computations or useless moves), therefore there are more opportunities for tunneling after allocation than before. Symmetrically, prior tunneling helps linearization to produce - better code, e.g. by revealing that some [nop] instructions are - dead code (as the "nop L3" in the example above). + better code, e.g. by revealing that some [branch] instructions are + dead code (as the "branch L3" in the example above). *) (** The implementation consists in two passes: the first pass @@ -51,7 +51,7 @@ Naively, we may define [branch_t f pc] as follows: However, this definition can fail to terminate if the program can contain loops consisting only of branches, as in << - L1: nop L1; + L1: branch L1; >> or << diff --git a/backend/Tunnelingproof.v b/backend/Tunnelingproof.v index 126b7b87..3bc92f75 100644 --- a/backend/Tunnelingproof.v +++ b/backend/Tunnelingproof.v @@ -66,7 +66,7 @@ Local Hint Resolve target_None Z.abs_nonneg: core. Lemma get_nonneg td pc t d: get td pc = (t, d) -> (0 <= d)%Z. Proof. - unfold get. destruct (td!_) as [(t0&d0)|]; intros H; inversion H; subst; simpl; omega || auto. + unfold get. destruct (td!_) as [(t0&d0)|]; intros H; inversion H; subst; simpl; lia || auto. Qed. Local Hint Resolve get_nonneg: core. @@ -469,11 +469,10 @@ Proof. * econstructor; eauto. + (* FT_branch *) simpl; right. - rewrite EQ; repeat (econstructor; omega || eauto). + rewrite EQ; repeat (econstructor; lia || eauto). + (* FT_cond *) simpl; right. - repeat (econstructor; omega || eauto); simpl. - apply Nat.max_case; omega. + repeat (econstructor; lia || eauto); simpl. destruct (peq _ _); try congruence. - (* Lop *) exploit eval_operation_lessdef. apply reglist_lessdef; eauto. eauto. eauto. @@ -568,7 +567,7 @@ Proof. eapply exec_Lbranch; eauto. fold (branch_target f pc). econstructor; eauto. - (* Lbranch (eliminated) *) - right; split. simpl. omega. split. auto. constructor; auto. + right; split. simpl. lia. split. auto. constructor; auto. - (* Lcond (preserved) *) simpl; left; destruct (peq _ _) eqn: EQ. + econstructor; split. @@ -583,8 +582,8 @@ Proof. destruct (peq _ _) eqn: EQ; try inv H1. right; split; simpl. + destruct b. - generalize (Nat.le_max_l (bound (branch_target f) pc1) (bound (branch_target f) pc2)); omega. - generalize (Nat.le_max_r (bound (branch_target f) pc1) (bound (branch_target f) pc2)); omega. + generalize (Nat.le_max_l (bound (branch_target f) pc1) (bound (branch_target f) pc2)); lia. + generalize (Nat.le_max_r (bound (branch_target f) pc1) (bound (branch_target f) pc2)); lia. + destruct b. -- repeat (constructor; auto). -- rewrite e; repeat (constructor; auto). diff --git a/backend/Unusedglobproof.v b/backend/Unusedglobproof.v index 160c0b18..aaacf9d1 100644 --- a/backend/Unusedglobproof.v +++ b/backend/Unusedglobproof.v @@ -1012,7 +1012,7 @@ Proof. intros. exploit G; eauto. intros [U V]. assert (Mem.valid_block m sp0) by (eapply Mem.valid_block_inject_1; eauto). assert (Mem.valid_block tm tsp) by (eapply Mem.valid_block_inject_2; eauto). - unfold Mem.valid_block in *; xomega. + unfold Mem.valid_block in *; extlia. apply set_res_inject; auto. apply regset_inject_incr with j; auto. - (* cond *) @@ -1066,7 +1066,7 @@ Proof. apply match_stacks_bound with (Mem.nextblock m) (Mem.nextblock tm). apply match_stacks_incr with j; auto. intros. exploit G; eauto. intros [P Q]. - unfold Mem.valid_block in *; xomega. + unfold Mem.valid_block in *; extlia. eapply external_call_nextblock; eauto. eapply external_call_nextblock; eauto. @@ -1093,7 +1093,7 @@ Proof. - apply IHl. unfold Genv.add_global, P; simpl. intros LT. apply Plt_succ_inv in LT. destruct LT. + rewrite PTree.gso. apply H; auto. apply Plt_ne; auto. + rewrite H0. rewrite PTree.gss. exists g1; auto. } - apply H. red; simpl; intros. exfalso; xomega. + apply H. red; simpl; intros. exfalso; extlia. Qed. *) @@ -1153,10 +1153,10 @@ Lemma Mem_getN_forall2: P (ZMap.get i c1) (ZMap.get i c2). Proof. induction n; simpl Mem.getN; intros. -- simpl in H1. omegaContradiction. +- simpl in H1. extlia. - inv H. rewrite Nat2Z.inj_succ in H1. destruct (zeq i p0). + congruence. -+ apply IHn with (p0 + 1); auto. omega. omega. ++ apply IHn with (p0 + 1); auto. lia. lia. Qed. Lemma init_mem_inj_1: @@ -1173,7 +1173,7 @@ Proof. + intros (P2 & Q2 & R2 & S2) (P1 & Q1 & R1 & S1). apply Q1 in H0. destruct H0. subst. apply Mem.perm_cur. eapply Mem.perm_implies; eauto. - apply P2. omega. + apply P2. lia. - exploit init_meminj_invert; eauto. intros (A & id & B & C). subst delta. apply Z.divide_0_r. - exploit init_meminj_invert_strong; eauto. intros (A & id & gd & B & C & D & E & F). @@ -1192,8 +1192,8 @@ Local Transparent Mem.loadbytes. rewrite Z.add_0_r. apply Mem_getN_forall2 with (p := 0) (n := Z.to_nat (init_data_list_size (gvar_init v))). rewrite H3, H4. apply bytes_of_init_inject. auto. - omega. - rewrite Z2Nat.id by (apply Z.ge_le; apply init_data_list_size_pos). omega. + lia. + rewrite Z2Nat.id by (apply Z.ge_le; apply init_data_list_size_pos). lia. Qed. Lemma init_mem_inj_2: @@ -1211,18 +1211,18 @@ Proof. exploit init_meminj_invert. eexact H1. intros (A2 & id2 & B2 & C2). destruct (ident_eq id1 id2). congruence. left; eapply Genv.global_addresses_distinct; eauto. - exploit init_meminj_invert; eauto. intros (A & id & B & C). subst delta. - split. omega. generalize (Ptrofs.unsigned_range_2 ofs). omega. + split. lia. generalize (Ptrofs.unsigned_range_2 ofs). lia. - exploit init_meminj_invert_strong; eauto. intros (A & id & gd & B & C & D & E & F). exploit (Genv.init_mem_characterization_gen p); eauto. exploit (Genv.init_mem_characterization_gen tp); eauto. destruct gd as [f|v]. + intros (P2 & Q2) (P1 & Q1). - apply Q2 in H0. destruct H0. subst. replace ofs with 0 by omega. + apply Q2 in H0. destruct H0. subst. replace ofs with 0 by lia. left; apply Mem.perm_cur; auto. + intros (P2 & Q2 & R2 & S2) (P1 & Q1 & R1 & S1). apply Q2 in H0. destruct H0. subst. left. apply Mem.perm_cur. eapply Mem.perm_implies; eauto. - apply P1. omega. + apply P1. lia. Qed. End INIT_MEM. diff --git a/backend/ValueAnalysis.v b/backend/ValueAnalysis.v index 2e79d1a9..561e94c9 100644 --- a/backend/ValueAnalysis.v +++ b/backend/ValueAnalysis.v @@ -347,7 +347,7 @@ Proof. induction rl; simpl; intros. constructor. constructor; auto. apply areg_sound; auto. Qed. -Hint Resolve areg_sound aregs_sound: va. +Global Hint Resolve areg_sound aregs_sound: va. Lemma abuiltin_arg_sound: forall bc ge rs sp m ae rm am, @@ -549,8 +549,8 @@ Proof. eapply SM; auto. eapply mmatch_top; eauto. + (* below *) red; simpl; intros. rewrite NB. destruct (eq_block b sp). - subst b; rewrite SP; xomega. - exploit mmatch_below; eauto. xomega. + subst b; rewrite SP; extlia. + exploit mmatch_below; eauto. extlia. - (* unchanged *) simpl; intros. apply dec_eq_false. apply Plt_ne. auto. - (* values *) @@ -1152,11 +1152,11 @@ Proof. - constructor. - assert (Plt sp bound') by eauto with va. eapply sound_stack_public_call; eauto. apply IHsound_stack; intros. - apply INV. xomega. rewrite SAME; auto with ordered_type. xomega. auto. auto. + apply INV. extlia. rewrite SAME; auto with ordered_type. extlia. auto. auto. - assert (Plt sp bound') by eauto with va. eapply sound_stack_private_call; eauto. apply IHsound_stack; intros. - apply INV. xomega. rewrite SAME; auto with ordered_type. xomega. auto. auto. - apply bmatch_ext with m; auto. intros. apply INV. xomega. auto. auto. auto. + apply INV. extlia. rewrite SAME; auto with ordered_type. extlia. auto. auto. + apply bmatch_ext with m; auto. intros. apply INV. extlia. auto. auto. auto. Qed. Lemma sound_stack_inv: @@ -1215,8 +1215,8 @@ Lemma sound_stack_new_bound: Proof. intros. inv H. - constructor. -- eapply sound_stack_public_call with (bound' := bound'0); eauto. xomega. -- eapply sound_stack_private_call with (bound' := bound'0); eauto. xomega. +- eapply sound_stack_public_call with (bound' := bound'0); eauto. extlia. +- eapply sound_stack_private_call with (bound' := bound'0); eauto. extlia. Qed. Lemma sound_stack_exten: @@ -1229,12 +1229,12 @@ Proof. - constructor. - assert (Plt sp bound') by eauto with va. eapply sound_stack_public_call; eauto. - rewrite H0; auto. xomega. - intros. rewrite H0; auto. xomega. + rewrite H0; auto. extlia. + intros. rewrite H0; auto. extlia. - assert (Plt sp bound') by eauto with va. eapply sound_stack_private_call; eauto. - rewrite H0; auto. xomega. - intros. rewrite H0; auto. xomega. + rewrite H0; auto. extlia. + intros. rewrite H0; auto. extlia. Qed. (** ** Preservation of the semantic invariant by one step of execution *) @@ -1935,7 +1935,7 @@ Proof. - exact NOSTACK. Qed. -Hint Resolve areg_sound aregs_sound: va. +Global Hint Resolve areg_sound aregs_sound: va. (** * Interface with other optimizations *) diff --git a/backend/ValueDomain.v b/backend/ValueDomain.v index f1a46baa..0f895040 100644 --- a/backend/ValueDomain.v +++ b/backend/ValueDomain.v @@ -43,12 +43,12 @@ Proof. elim H. apply H0; auto. Qed. -Hint Extern 2 (_ = _) => congruence : va. -Hint Extern 2 (_ <> _) => congruence : va. -Hint Extern 2 (_ < _) => xomega : va. -Hint Extern 2 (_ <= _) => xomega : va. -Hint Extern 2 (_ > _) => xomega : va. -Hint Extern 2 (_ >= _) => xomega : va. +Global Hint Extern 2 (_ = _) => congruence : va. +Global Hint Extern 2 (_ <> _) => congruence : va. +Global Hint Extern 2 (_ < _) => extlia : va. +Global Hint Extern 2 (_ <= _) => extlia : va. +Global Hint Extern 2 (_ > _) => extlia : va. +Global Hint Extern 2 (_ >= _) => extlia : va. Section MATCH. @@ -595,17 +595,17 @@ Hint Extern 1 (vmatch _ _) => constructor : va. Lemma is_uns_mon: forall n1 n2 i, is_uns n1 i -> n1 <= n2 -> is_uns n2 i. Proof. - intros; red; intros. apply H; omega. + intros; red; intros. apply H; lia. Qed. Lemma is_sgn_mon: forall n1 n2 i, is_sgn n1 i -> n1 <= n2 -> is_sgn n2 i. Proof. - intros; red; intros. apply H; omega. + intros; red; intros. apply H; lia. Qed. Lemma is_uns_sgn: forall n1 n2 i, is_uns n1 i -> n1 < n2 -> is_sgn n2 i. Proof. - intros; red; intros. rewrite ! H by omega. auto. + intros; red; intros. rewrite ! H by lia. auto. Qed. Definition usize := Int.size. @@ -616,7 +616,7 @@ Lemma is_uns_usize: forall i, is_uns (usize i) i. Proof. unfold usize; intros; red; intros. - apply Int.bits_size_2. omega. + apply Int.bits_size_2. lia. Qed. Lemma is_sgn_ssize: @@ -628,10 +628,10 @@ Proof. rewrite <- (negb_involutive (Int.testbit i (Int.zwordsize - 1))). f_equal. generalize (Int.size_range (Int.not i)); intros RANGE. - rewrite <- ! Int.bits_not by omega. - rewrite ! Int.bits_size_2 by omega. + rewrite <- ! Int.bits_not by lia. + rewrite ! Int.bits_size_2 by lia. auto. -- rewrite ! Int.bits_size_2 by omega. +- rewrite ! Int.bits_size_2 by lia. auto. Qed. @@ -639,8 +639,8 @@ Lemma is_uns_zero_ext: forall n i, is_uns n i <-> Int.zero_ext n i = i. Proof. intros; split; intros. - Int.bit_solve. destruct (zlt i0 n); auto. symmetry; apply H; auto. omega. - rewrite <- H. red; intros. rewrite Int.bits_zero_ext by omega. rewrite zlt_false by omega. auto. + Int.bit_solve. destruct (zlt i0 n); auto. symmetry; apply H; auto. lia. + rewrite <- H. red; intros. rewrite Int.bits_zero_ext by lia. rewrite zlt_false by lia. auto. Qed. Lemma is_sgn_sign_ext: @@ -649,18 +649,18 @@ Proof. intros; split; intros. Int.bit_solve. destruct (zlt i0 n); auto. transitivity (Int.testbit i (Int.zwordsize - 1)). - apply H0; omega. symmetry; apply H0; omega. - rewrite <- H0. red; intros. rewrite ! Int.bits_sign_ext by omega. - f_equal. transitivity (n-1). destruct (zlt m n); omega. - destruct (zlt (Int.zwordsize - 1) n); omega. + apply H0; lia. symmetry; apply H0; lia. + rewrite <- H0. red; intros. rewrite ! Int.bits_sign_ext by lia. + f_equal. transitivity (n-1). destruct (zlt m n); lia. + destruct (zlt (Int.zwordsize - 1) n); lia. Qed. Lemma is_zero_ext_uns: forall i n m, is_uns m i \/ n <= m -> is_uns m (Int.zero_ext n i). Proof. - intros. red; intros. rewrite Int.bits_zero_ext by omega. - destruct (zlt m0 n); auto. destruct H. apply H; omega. omegaContradiction. + intros. red; intros. rewrite Int.bits_zero_ext by lia. + destruct (zlt m0 n); auto. destruct H. apply H; lia. extlia. Qed. Lemma is_zero_ext_sgn: @@ -668,9 +668,9 @@ Lemma is_zero_ext_sgn: n < m -> is_sgn m (Int.zero_ext n i). Proof. - intros. red; intros. rewrite ! Int.bits_zero_ext by omega. - transitivity false. apply zlt_false; omega. - symmetry; apply zlt_false; omega. + intros. red; intros. rewrite ! Int.bits_zero_ext by lia. + transitivity false. apply zlt_false; lia. + symmetry; apply zlt_false; lia. Qed. Lemma is_sign_ext_uns: @@ -679,8 +679,8 @@ Lemma is_sign_ext_uns: is_uns m i -> is_uns m (Int.sign_ext n i). Proof. - intros; red; intros. rewrite Int.bits_sign_ext by omega. - apply H0. destruct (zlt m0 n); omega. destruct (zlt m0 n); omega. + intros; red; intros. rewrite Int.bits_sign_ext by lia. + apply H0. destruct (zlt m0 n); lia. destruct (zlt m0 n); lia. Qed. Lemma is_sign_ext_sgn: @@ -690,9 +690,9 @@ Lemma is_sign_ext_sgn: Proof. intros. apply is_sgn_sign_ext; auto. destruct (zlt m n). destruct H1. apply is_sgn_sign_ext in H1; auto. - rewrite <- H1. rewrite (Int.sign_ext_widen i) by omega. apply Int.sign_ext_idem; auto. - omegaContradiction. - apply Int.sign_ext_widen; omega. + rewrite <- H1. rewrite (Int.sign_ext_widen i) by lia. apply Int.sign_ext_idem; auto. + extlia. + apply Int.sign_ext_widen; lia. Qed. Hint Resolve is_uns_mon is_sgn_mon is_uns_sgn is_uns_usize is_sgn_ssize : va. @@ -701,8 +701,8 @@ Lemma is_uns_1: forall n, is_uns 1 n -> n = Int.zero \/ n = Int.one. Proof. intros. destruct (Int.testbit n 0) eqn:B0; [right|left]; apply Int.same_bits_eq; intros. - rewrite Int.bits_one. destruct (zeq i 0). subst i; auto. apply H; omega. - rewrite Int.bits_zero. destruct (zeq i 0). subst i; auto. apply H; omega. + rewrite Int.bits_one. destruct (zeq i 0). subst i; auto. apply H; lia. + rewrite Int.bits_zero. destruct (zeq i 0). subst i; auto. apply H; lia. Qed. (** Tracking leakage of pointers through arithmetic operations. @@ -958,13 +958,13 @@ Hint Resolve vge_uns_uns' vge_uns_i' vge_sgn_sgn' vge_sgn_i' : va. Lemma usize_pos: forall n, 0 <= usize n. Proof. - unfold usize; intros. generalize (Int.size_range n); omega. + unfold usize; intros. generalize (Int.size_range n); lia. Qed. Lemma ssize_pos: forall n, 0 < ssize n. Proof. unfold ssize; intros. - generalize (Int.size_range (if Int.lt n Int.zero then Int.not n else n)); omega. + generalize (Int.size_range (if Int.lt n Int.zero then Int.not n else n)); lia. Qed. Lemma vge_lub_l: @@ -975,12 +975,12 @@ Proof. unfold vlub; destruct x, y; eauto using pge_lub_l with va. - predSpec Int.eq Int.eq_spec n n0. auto with va. destruct (Int.lt n Int.zero || Int.lt n0 Int.zero). - apply vge_sgn_i'. generalize (ssize_pos n); xomega. eauto with va. - apply vge_uns_i'. generalize (usize_pos n); xomega. eauto with va. + apply vge_sgn_i'. generalize (ssize_pos n); extlia. eauto with va. + apply vge_uns_i'. generalize (usize_pos n); extlia. eauto with va. - destruct (Int.lt n Int.zero). - apply vge_sgn_i'. generalize (ssize_pos n); xomega. eauto with va. - apply vge_uns_i'. generalize (usize_pos n); xomega. eauto with va. -- apply vge_sgn_i'. generalize (ssize_pos n); xomega. eauto with va. + apply vge_sgn_i'. generalize (ssize_pos n); extlia. eauto with va. + apply vge_uns_i'. generalize (usize_pos n); extlia. eauto with va. +- apply vge_sgn_i'. generalize (ssize_pos n); extlia. eauto with va. - destruct (Int.lt n0 Int.zero). eapply vge_trans. apply vge_sgn_sgn'. apply vge_trans with (Sgn p (n + 1)); eauto with va. @@ -1269,12 +1269,12 @@ Proof. destruct (Int.ltu n Int.iwordsize) eqn:LTU; auto. exploit Int.ltu_inv; eauto. intros RANGE. inv H; auto with va. -- apply vmatch_uns'. red; intros. rewrite Int.bits_shl by omega. - destruct (zlt m (Int.unsigned n)). auto. apply H1; xomega. +- apply vmatch_uns'. red; intros. rewrite Int.bits_shl by lia. + destruct (zlt m (Int.unsigned n)). auto. apply H1; extlia. - apply vmatch_sgn'. red; intros. zify. - rewrite ! Int.bits_shl by omega. - rewrite ! zlt_false by omega. - rewrite H1 by omega. symmetry. rewrite H1 by omega. auto. + rewrite ! Int.bits_shl by lia. + rewrite ! zlt_false by lia. + rewrite H1 by lia. symmetry. rewrite H1 by lia. auto. - destruct v; constructor. Qed. @@ -1306,13 +1306,13 @@ Proof. assert (DEFAULT2: forall i, vmatch (Vint (Int.shru i n)) (uns (provenance x) (Int.zwordsize - Int.unsigned n))). { intros. apply vmatch_uns. red; intros. - rewrite Int.bits_shru by omega. apply zlt_false. omega. + rewrite Int.bits_shru by lia. apply zlt_false. lia. } inv H; auto with va. - apply vmatch_uns'. red; intros. zify. - rewrite Int.bits_shru by omega. + rewrite Int.bits_shru by lia. destruct (zlt (m + Int.unsigned n) Int.zwordsize); auto. - apply H1; omega. + apply H1; lia. - destruct v; constructor. Qed. @@ -1345,22 +1345,22 @@ Proof. assert (DEFAULT2: forall i, vmatch (Vint (Int.shr i n)) (sgn (provenance x) (Int.zwordsize - Int.unsigned n))). { intros. apply vmatch_sgn. red; intros. - rewrite ! Int.bits_shr by omega. f_equal. + rewrite ! Int.bits_shr by lia. f_equal. destruct (zlt (m + Int.unsigned n) Int.zwordsize); destruct (zlt (Int.zwordsize - 1 + Int.unsigned n) Int.zwordsize); - omega. + lia. } assert (SGN: forall q i p, is_sgn p i -> 0 < p -> vmatch (Vint (Int.shr i n)) (sgn q (p - Int.unsigned n))). { intros. apply vmatch_sgn'. red; intros. zify. - rewrite ! Int.bits_shr by omega. + rewrite ! Int.bits_shr by lia. transitivity (Int.testbit i (Int.zwordsize - 1)). destruct (zlt (m + Int.unsigned n) Int.zwordsize). - apply H0; omega. + apply H0; lia. auto. symmetry. destruct (zlt (Int.zwordsize - 1 + Int.unsigned n) Int.zwordsize). - apply H0; omega. + apply H0; lia. auto. } inv H; eauto with va. @@ -1418,12 +1418,12 @@ Proof. assert (UNS: forall i j n m, is_uns n i -> is_uns m j -> is_uns (Z.max n m) (Int.or i j)). { intros; red; intros. rewrite Int.bits_or by auto. - rewrite H by xomega. rewrite H0 by xomega. auto. + rewrite H by extlia. rewrite H0 by extlia. auto. } assert (SGN: forall i j n m, is_sgn n i -> is_sgn m j -> is_sgn (Z.max n m) (Int.or i j)). { - intros; red; intros. rewrite ! Int.bits_or by xomega. - rewrite H by xomega. rewrite H0 by xomega. auto. + intros; red; intros. rewrite ! Int.bits_or by extlia. + rewrite H by extlia. rewrite H0 by extlia. auto. } intros. unfold or, Val.or; inv H; eauto with va; inv H0; eauto with va. Qed. @@ -1443,12 +1443,12 @@ Proof. assert (UNS: forall i j n m, is_uns n i -> is_uns m j -> is_uns (Z.max n m) (Int.xor i j)). { intros; red; intros. rewrite Int.bits_xor by auto. - rewrite H by xomega. rewrite H0 by xomega. auto. + rewrite H by extlia. rewrite H0 by extlia. auto. } assert (SGN: forall i j n m, is_sgn n i -> is_sgn m j -> is_sgn (Z.max n m) (Int.xor i j)). { - intros; red; intros. rewrite ! Int.bits_xor by xomega. - rewrite H by xomega. rewrite H0 by xomega. auto. + intros; red; intros. rewrite ! Int.bits_xor by extlia. + rewrite H by extlia. rewrite H0 by extlia. auto. } intros. unfold xor, Val.xor; inv H; eauto with va; inv H0; eauto with va. Qed. @@ -1466,7 +1466,7 @@ Lemma notint_sound: Proof. assert (SGN: forall n i, is_sgn n i -> is_sgn n (Int.not i)). { - intros; red; intros. rewrite ! Int.bits_not by omega. + intros; red; intros. rewrite ! Int.bits_not by lia. f_equal. apply H; auto. } intros. unfold Val.notint, notint; inv H; eauto with va. @@ -1492,13 +1492,13 @@ Proof. inv H; auto with va. - apply vmatch_uns. red; intros. rewrite Int.bits_rol by auto. generalize (Int.unsigned_range n); intros. - rewrite Z.mod_small by omega. - apply H1. omega. omega. + rewrite Z.mod_small by lia. + apply H1. lia. lia. - destruct (zlt n0 Int.zwordsize); auto with va. - apply vmatch_sgn. red; intros. rewrite ! Int.bits_rol by omega. + apply vmatch_sgn. red; intros. rewrite ! Int.bits_rol by lia. generalize (Int.unsigned_range n); intros. - rewrite ! Z.mod_small by omega. - rewrite H1 by omega. symmetry. rewrite H1 by omega. auto. + rewrite ! Z.mod_small by lia. + rewrite H1 by lia. symmetry. rewrite H1 by lia. auto. - destruct (zlt n0 Int.zwordsize); auto with va. Qed. @@ -1674,8 +1674,8 @@ Proof. generalize (Int.unsigned_range_2 j); intros RANGE. assert (Int.unsigned j <> 0). { red; intros; elim H. rewrite <- (Int.repr_unsigned j). rewrite H0. auto. } - exploit (Z_mod_lt (Int.unsigned i) (Int.unsigned j)). omega. intros MOD. - unfold Int.modu. rewrite Int.unsigned_repr. omega. omega. + exploit (Z_mod_lt (Int.unsigned i) (Int.unsigned j)). lia. intros MOD. + unfold Int.modu. rewrite Int.unsigned_repr. lia. lia. } intros. destruct v; destruct w; try discriminate; simpl in H1. destruct (Int.eq i0 Int.zero) eqn:Z; inv H1. @@ -2083,12 +2083,12 @@ Lemma zero_ext_sound: Proof. assert (DFL: forall nbits i, is_uns nbits (Int.zero_ext nbits i)). { - intros; red; intros. rewrite Int.bits_zero_ext by omega. apply zlt_false; auto. + intros; red; intros. rewrite Int.bits_zero_ext by lia. apply zlt_false; auto. } intros. inv H; simpl; auto with va. apply vmatch_uns. red; intros. zify. - rewrite Int.bits_zero_ext by omega. - destruct (zlt m nbits); auto. apply H1; omega. + rewrite Int.bits_zero_ext by lia. + destruct (zlt m nbits); auto. apply H1; lia. Qed. Definition sign_ext (nbits: Z) (v: aval) := @@ -2108,7 +2108,7 @@ Proof. intros. apply vmatch_sgn. apply is_sign_ext_sgn; auto with va. } intros. unfold sign_ext. destruct (zle nbits 0). -- destruct v; simpl; auto with va. constructor. omega. +- destruct v; simpl; auto with va. constructor. lia. rewrite Int.sign_ext_below by auto. red; intros; apply Int.bits_zero. - inv H; simpl; auto with va. + destruct (zlt n nbits); eauto with va. @@ -2975,26 +2975,26 @@ Proof. intros c [lo hi] x n; simpl; intros R. destruct c; unfold zcmp, proj_sumbool. - (* eq *) - destruct (zlt n lo). rewrite zeq_false by omega. constructor. - destruct (zlt hi n). rewrite zeq_false by omega. constructor. + destruct (zlt n lo). rewrite zeq_false by lia. constructor. + destruct (zlt hi n). rewrite zeq_false by lia. constructor. constructor. - (* ne *) constructor. - (* lt *) - destruct (zlt hi n). rewrite zlt_true by omega. constructor. - destruct (zle n lo). rewrite zlt_false by omega. constructor. + destruct (zlt hi n). rewrite zlt_true by lia. constructor. + destruct (zle n lo). rewrite zlt_false by lia. constructor. constructor. - (* le *) - destruct (zle hi n). rewrite zle_true by omega. constructor. - destruct (zlt n lo). rewrite zle_false by omega. constructor. + destruct (zle hi n). rewrite zle_true by lia. constructor. + destruct (zlt n lo). rewrite zle_false by lia. constructor. constructor. - (* gt *) - destruct (zlt n lo). rewrite zlt_true by omega. constructor. - destruct (zle hi n). rewrite zlt_false by omega. constructor. + destruct (zlt n lo). rewrite zlt_true by lia. constructor. + destruct (zle hi n). rewrite zlt_false by lia. constructor. constructor. - (* ge *) - destruct (zle n lo). rewrite zle_true by omega. constructor. - destruct (zlt hi n). rewrite zle_false by omega. constructor. + destruct (zle n lo). rewrite zle_true by lia. constructor. + destruct (zlt hi n). rewrite zle_false by lia. constructor. constructor. Qed. @@ -3028,10 +3028,10 @@ Lemma uintv_sound: forall n v, vmatch (Vint n) v -> fst (uintv v) <= Int.unsigned n <= snd (uintv v). Proof. intros. inv H; simpl; try (apply Int.unsigned_range_2). -- omega. +- lia. - destruct (zlt n0 Int.zwordsize); simpl. -+ rewrite is_uns_zero_ext in H2. rewrite <- H2. rewrite Int.zero_ext_mod by omega. - exploit (Z_mod_lt (Int.unsigned n) (two_p n0)). apply two_p_gt_ZERO; auto. omega. ++ rewrite is_uns_zero_ext in H2. rewrite <- H2. rewrite Int.zero_ext_mod by lia. + exploit (Z_mod_lt (Int.unsigned n) (two_p n0)). apply two_p_gt_ZERO; auto. lia. + apply Int.unsigned_range_2. Qed. @@ -3043,8 +3043,8 @@ Proof. intros. simpl. replace (Int.cmpu c n1 n2) with (zcmp c (Int.unsigned n1) (Int.unsigned n2)). apply zcmp_intv_sound; apply uintv_sound; auto. destruct c; simpl; auto. - unfold Int.ltu. destruct (zle (Int.unsigned n1) (Int.unsigned n2)); [rewrite zlt_false|rewrite zlt_true]; auto; omega. - unfold Int.ltu. destruct (zle (Int.unsigned n2) (Int.unsigned n1)); [rewrite zlt_false|rewrite zlt_true]; auto; omega. + unfold Int.ltu. destruct (zle (Int.unsigned n1) (Int.unsigned n2)); [rewrite zlt_false|rewrite zlt_true]; auto; lia. + unfold Int.ltu. destruct (zle (Int.unsigned n2) (Int.unsigned n1)); [rewrite zlt_false|rewrite zlt_true]; auto; lia. Qed. Lemma cmpu_intv_sound_2: @@ -3071,22 +3071,22 @@ Lemma sintv_sound: forall n v, vmatch (Vint n) v -> fst (sintv v) <= Int.signed n <= snd (sintv v). Proof. intros. inv H; simpl; try (apply Int.signed_range). -- omega. +- lia. - destruct (zlt n0 Int.zwordsize); simpl. + rewrite is_uns_zero_ext in H2. rewrite <- H2. - assert (Int.unsigned (Int.zero_ext n0 n) = Int.unsigned n mod two_p n0) by (apply Int.zero_ext_mod; omega). + assert (Int.unsigned (Int.zero_ext n0 n) = Int.unsigned n mod two_p n0) by (apply Int.zero_ext_mod; lia). exploit (Z_mod_lt (Int.unsigned n) (two_p n0)). apply two_p_gt_ZERO; auto. intros. replace (Int.signed (Int.zero_ext n0 n)) with (Int.unsigned (Int.zero_ext n0 n)). - rewrite H. omega. + rewrite H. lia. unfold Int.signed. rewrite zlt_true. auto. assert (two_p n0 <= Int.half_modulus). { change Int.half_modulus with (two_p (Int.zwordsize - 1)). - apply two_p_monotone. omega. } - omega. + apply two_p_monotone. lia. } + lia. + apply Int.signed_range. - destruct (zlt n0 (Int.zwordsize)); simpl. + rewrite is_sgn_sign_ext in H2 by auto. rewrite <- H2. - exploit (Int.sign_ext_range n0 n). omega. omega. + exploit (Int.sign_ext_range n0 n). lia. lia. + apply Int.signed_range. Qed. @@ -3098,8 +3098,8 @@ Proof. intros. simpl. replace (Int.cmp c n1 n2) with (zcmp c (Int.signed n1) (Int.signed n2)). apply zcmp_intv_sound; apply sintv_sound; auto. destruct c; simpl; rewrite ? Int.eq_signed; auto. - unfold Int.lt. destruct (zle (Int.signed n1) (Int.signed n2)); [rewrite zlt_false|rewrite zlt_true]; auto; omega. - unfold Int.lt. destruct (zle (Int.signed n2) (Int.signed n1)); [rewrite zlt_false|rewrite zlt_true]; auto; omega. + unfold Int.lt. destruct (zle (Int.signed n1) (Int.signed n2)); [rewrite zlt_false|rewrite zlt_true]; auto; lia. + unfold Int.lt. destruct (zle (Int.signed n2) (Int.signed n1)); [rewrite zlt_false|rewrite zlt_true]; auto; lia. Qed. Lemma cmp_intv_sound_2: @@ -3284,7 +3284,7 @@ Proof. assert (DEFAULT: vmatch (Val.of_optbool ob) (Uns Pbot 1)). { destruct ob; simpl; auto with va. - destruct b; constructor; try omega. + destruct b; constructor; try lia. change 1 with (usize Int.one). apply is_uns_usize. red; intros. apply Int.bits_zero. } @@ -3403,27 +3403,27 @@ Proof. - destruct (zlt n 8); constructor; auto with va. apply is_sign_ext_uns; auto. apply is_sign_ext_sgn; auto with va. -- constructor. xomega. apply is_zero_ext_uns. apply Z.min_case; auto with va. +- constructor. extlia. apply is_zero_ext_uns. apply Z.min_case; auto with va. - destruct (zlt n 16); constructor; auto with va. apply is_sign_ext_uns; auto. apply is_sign_ext_sgn; auto with va. -- constructor. xomega. apply is_zero_ext_uns. apply Z.min_case; auto with va. +- constructor. extlia. apply is_zero_ext_uns. apply Z.min_case; auto with va. - destruct (zlt n 8); auto with va. - destruct (zlt n 16); auto with va. -- constructor. xomega. apply is_sign_ext_sgn; auto with va. apply Z.min_case; auto with va. -- constructor. omega. apply is_zero_ext_uns; auto with va. -- constructor. xomega. apply is_sign_ext_sgn; auto with va. apply Z.min_case; auto with va. -- constructor. omega. apply is_zero_ext_uns; auto with va. +- constructor. extlia. apply is_sign_ext_sgn; auto with va. apply Z.min_case; auto with va. +- constructor. lia. apply is_zero_ext_uns; auto with va. +- constructor. extlia. apply is_sign_ext_sgn; auto with va. apply Z.min_case; auto with va. +- constructor. lia. apply is_zero_ext_uns; auto with va. - destruct ptr64; auto with va. - destruct ptr64; auto with va. - destruct ptr64; auto with va. - destruct ptr64; auto with va. - destruct ptr64; auto with va. - destruct ptr64; auto with va. -- constructor. omega. apply is_sign_ext_sgn; auto with va. -- constructor. omega. apply is_zero_ext_uns; auto with va. -- constructor. omega. apply is_sign_ext_sgn; auto with va. -- constructor. omega. apply is_zero_ext_uns; auto with va. +- constructor. lia. apply is_sign_ext_sgn; auto with va. +- constructor. lia. apply is_zero_ext_uns; auto with va. +- constructor. lia. apply is_sign_ext_sgn; auto with va. +- constructor. lia. apply is_zero_ext_uns; auto with va. - destruct ptr64; auto with va. - destruct ptr64; auto with va. - destruct ptr64; auto with va. @@ -3438,13 +3438,13 @@ Proof. intros. exploit Mem.load_cast; eauto. exploit Mem.load_type; eauto. destruct chunk; simpl; intros. - (* int8signed *) - rewrite H2. destruct v; simpl; constructor. omega. apply is_sign_ext_sgn; auto with va. + rewrite H2. destruct v; simpl; constructor. lia. apply is_sign_ext_sgn; auto with va. - (* int8unsigned *) - rewrite H2. destruct v; simpl; constructor. omega. apply is_zero_ext_uns; auto with va. + rewrite H2. destruct v; simpl; constructor. lia. apply is_zero_ext_uns; auto with va. - (* int16signed *) - rewrite H2. destruct v; simpl; constructor. omega. apply is_sign_ext_sgn; auto with va. + rewrite H2. destruct v; simpl; constructor. lia. apply is_sign_ext_sgn; auto with va. - (* int16unsigned *) - rewrite H2. destruct v; simpl; constructor. omega. apply is_zero_ext_uns; auto with va. + rewrite H2. destruct v; simpl; constructor. lia. apply is_zero_ext_uns; auto with va. - (* int32 *) auto. - (* int64 *) @@ -3486,9 +3486,9 @@ Proof with (auto using provenance_monotone with va). apply is_sign_ext_sgn... - constructor... apply is_zero_ext_uns... apply Z.min_case... - unfold provenance; destruct (va_strict tt)... -- destruct (zlt n1 8). rewrite zlt_true by omega... +- destruct (zlt n1 8). rewrite zlt_true by lia... destruct (zlt n2 8)... -- destruct (zlt n1 16). rewrite zlt_true by omega... +- destruct (zlt n1 16). rewrite zlt_true by lia... destruct (zlt n2 16)... - constructor... apply is_sign_ext_sgn... apply Z.min_case... - constructor... apply is_zero_ext_uns... @@ -3609,7 +3609,7 @@ Function inval_after (lo: Z) (hi: Z) (c: ZTree.t acontent) { wf (Zwf lo) hi } : then inval_after lo (hi - 1) (ZTree.remove hi c) else c. Proof. - intros; red; omega. + intros; red; lia. apply Zwf_well_founded. Qed. @@ -3624,7 +3624,7 @@ Function inval_before (hi: Z) (lo: Z) (c: ZTree.t acontent) { wf (Zwf_up hi) lo then inval_before hi (lo + 1) (inval_if hi lo c) else c. Proof. - intros; red; omega. + intros; red; lia. apply Zwf_up_well_founded. Qed. @@ -3662,7 +3662,7 @@ Remark loadbytes_load_ext: Proof. intros. exploit Mem.load_loadbytes; eauto. intros [bytes [A B]]. exploit Mem.load_valid_access; eauto. intros [C D]. - subst v. apply Mem.loadbytes_load; auto. apply H; auto. generalize (size_chunk_pos chunk); omega. + subst v. apply Mem.loadbytes_load; auto. apply H; auto. generalize (size_chunk_pos chunk); lia. Qed. Lemma smatch_ext: @@ -3673,7 +3673,7 @@ Lemma smatch_ext: Proof. intros. destruct H. split; intros. eapply H; eauto. eapply loadbytes_load_ext; eauto. - eapply H1; eauto. apply H0; eauto. omega. + eapply H1; eauto. apply H0; eauto. lia. Qed. Lemma smatch_inv: @@ -3708,19 +3708,19 @@ Proof. + rewrite (Mem.loadbytes_empty m b ofs sz) in LOAD by auto. inv LOAD. contradiction. + exploit (Mem.loadbytes_split m b ofs 1 (sz - 1) bytes). - replace (1 + (sz - 1)) with sz by omega. auto. - omega. - omega. + replace (1 + (sz - 1)) with sz by lia. auto. + lia. + lia. intros (bytes1 & bytes2 & LOAD1 & LOAD2 & CONCAT). subst bytes. exploit Mem.loadbytes_length. eexact LOAD1. change (Z.to_nat 1) with 1%nat. intros LENGTH1. rewrite in_app_iff in IN. destruct IN. * destruct bytes1; try discriminate. destruct bytes1; try discriminate. simpl in H. destruct H; try contradiction. subst m0. - exists ofs; split. omega. auto. - * exploit (REC (sz - 1)). red; omega. eexact LOAD2. auto. + exists ofs; split. lia. auto. + * exploit (REC (sz - 1)). red; lia. eexact LOAD2. auto. intros (ofs' & A & B). - exists ofs'; split. omega. auto. + exists ofs'; split. lia. auto. Qed. Lemma smatch_loadbytes: @@ -3746,13 +3746,13 @@ Proof. - apply Zwf_well_founded. - intros sz REC ofs bytes LOAD LOAD1 IN. exploit (Mem.loadbytes_split m b ofs 1 (sz - 1) bytes). - replace (1 + (sz - 1)) with sz by omega. auto. - omega. - omega. + replace (1 + (sz - 1)) with sz by lia. auto. + lia. + lia. intros (bytes1 & bytes2 & LOAD3 & LOAD4 & CONCAT). subst bytes. rewrite in_app_iff. destruct (zeq ofs ofs'). + subst ofs'. rewrite LOAD1 in LOAD3; inv LOAD3. left; simpl; auto. -+ right. eapply (REC (sz - 1)). red; omega. eexact LOAD4. auto. omega. ++ right. eapply (REC (sz - 1)). red; lia. eexact LOAD4. auto. lia. Qed. Lemma storebytes_provenance: @@ -3770,10 +3770,10 @@ Proof. destruct (eq_block b' b); auto. destruct (zle (ofs' + 1) ofs); auto. destruct (zle (ofs + Z.of_nat (length bytes)) ofs'); auto. - right. split. auto. omega. + right. split. auto. lia. } destruct EITHER as [A | (A & B)]. -- right. rewrite <- H0. symmetry. eapply Mem.loadbytes_storebytes_other; eauto. omega. +- right. rewrite <- H0. symmetry. eapply Mem.loadbytes_storebytes_other; eauto. lia. - subst b'. left. eapply loadbytes_provenance; eauto. eapply Mem.loadbytes_storebytes_same; eauto. @@ -3918,7 +3918,7 @@ Remark inval_after_outside: forall i lo hi c, i < lo \/ i > hi -> (inval_after lo hi c)##i = c##i. Proof. intros until c. functional induction (inval_after lo hi c); intros. - rewrite IHt by omega. apply ZTree.gro. unfold ZTree.elt, ZIndexed.t; omega. + rewrite IHt by lia. apply ZTree.gro. unfold ZTree.elt, ZIndexed.t; lia. auto. Qed. @@ -3929,18 +3929,18 @@ Remark inval_after_contents: Proof. intros until c. functional induction (inval_after lo hi c); intros. destruct (zeq i hi). - subst i. rewrite inval_after_outside in H by omega. rewrite ZTree.grs in H. discriminate. - exploit IHt; eauto. intros [A B]. rewrite ZTree.gro in A by auto. split. auto. omega. - split. auto. omega. + subst i. rewrite inval_after_outside in H by lia. rewrite ZTree.grs in H. discriminate. + exploit IHt; eauto. intros [A B]. rewrite ZTree.gro in A by auto. split. auto. lia. + split. auto. lia. Qed. Remark inval_before_outside: forall i hi lo c, i < lo \/ i >= hi -> (inval_before hi lo c)##i = c##i. Proof. intros until c. functional induction (inval_before hi lo c); intros. - rewrite IHt by omega. unfold inval_if. destruct (c##lo) as [[chunk av]|]; auto. + rewrite IHt by lia. unfold inval_if. destruct (c##lo) as [[chunk av]|]; auto. destruct (zle (lo + size_chunk chunk) hi); auto. - apply ZTree.gro. unfold ZTree.elt, ZIndexed.t; omega. + apply ZTree.gro. unfold ZTree.elt, ZIndexed.t; lia. auto. Qed. @@ -3951,16 +3951,21 @@ Remark inval_before_contents_1: Proof. intros until c. functional induction (inval_before hi lo c); intros. - destruct (zeq lo i). -+ subst i. rewrite inval_before_outside in H0 by omega. ++ subst i. rewrite inval_before_outside in H0 by lia. unfold inval_if in H0. destruct (c##lo) as [[chunk0 v0]|] eqn:C; try congruence. destruct (zle (lo + size_chunk chunk0) hi). rewrite C in H0; inv H0. auto. rewrite ZTree.grs in H0. congruence. -+ exploit IHt. omega. auto. intros [A B]; split; auto. ++ exploit IHt. lia. auto. intros [A B]; split; auto. unfold inval_if in A. destruct (c##lo) as [[chunk0 v0]|] eqn:C; auto. destruct (zle (lo + size_chunk chunk0) hi); auto. rewrite ZTree.gro in A; auto. -- omegaContradiction. +- extlia. +Qed. + +Lemma max_size_chunk: forall chunk, size_chunk chunk <= 8. +Proof. + destruct chunk; simpl; lia. Qed. Remark inval_before_contents: @@ -3969,12 +3974,12 @@ Remark inval_before_contents: c##j = Some (ACval chunk' av') /\ (j + size_chunk chunk' <= i \/ i <= j). Proof. intros. destruct (zlt j (i - 7)). - rewrite inval_before_outside in H by omega. - split. auto. left. generalize (max_size_chunk chunk'); omega. + rewrite inval_before_outside in H by lia. + split. auto. left. generalize (max_size_chunk chunk'); lia. destruct (zlt j i). - exploit inval_before_contents_1; eauto. omega. tauto. - rewrite inval_before_outside in H by omega. - split. auto. omega. + exploit inval_before_contents_1; eauto. lia. tauto. + rewrite inval_before_outside in H by lia. + split. auto. lia. Qed. Lemma ablock_store_contents: @@ -3990,7 +3995,7 @@ Proof. right. rewrite ZTree.gso in H by auto. exploit inval_before_contents; eauto. intros [A B]. exploit inval_after_contents; eauto. intros [C D]. - split. auto. omega. + split. auto. lia. Qed. Lemma chunk_compat_true: @@ -4060,7 +4065,7 @@ Proof. unfold ablock_storebytes; simpl; intros. exploit inval_before_contents; eauto. clear H. intros [A B]. exploit inval_after_contents; eauto. clear A. intros [C D]. - split. auto. xomega. + split. auto. extlia. Qed. Lemma ablock_storebytes_sound: @@ -4083,7 +4088,7 @@ Proof. exploit ablock_storebytes_contents; eauto. intros [A B]. assert (Mem.load chunk' m b ofs' = Some v'). { rewrite <- LOAD'; symmetry. eapply Mem.load_storebytes_other; eauto. - rewrite U. rewrite LENGTH. rewrite Z_to_nat_max. right; omega. } + rewrite U. rewrite LENGTH. rewrite Z_to_nat_max. right; lia. } exploit BM2; eauto. unfold ablock_load. rewrite A. rewrite COMPAT. auto. Qed. @@ -4211,7 +4216,7 @@ Proof. apply bmatch_inv with m; auto. + intros. eapply Mem.loadbytes_store_other; eauto. left. red; intros; subst b0. elim (C ofs). apply Mem.perm_cur_max. - apply P. generalize (size_chunk_pos chunk); omega. + apply P. generalize (size_chunk_pos chunk); lia. - intros; red; intros; elim (C ofs0). eauto with mem. Qed. @@ -4640,7 +4645,7 @@ Proof. - apply bmatch_ext with m; eauto with va. - apply smatch_ext with m; auto with va. - apply smatch_ext with m; auto with va. -- red; intros. exploit mmatch_below0; eauto. xomega. +- red; intros. exploit mmatch_below0; eauto. extlia. Qed. Lemma mmatch_free: @@ -4651,7 +4656,7 @@ Lemma mmatch_free: Proof. intros. apply mmatch_ext with m; auto. intros. eapply Mem.loadbytes_free_2; eauto. - erewrite <- Mem.nextblock_free by eauto. xomega. + erewrite <- Mem.nextblock_free by eauto. extlia. Qed. Lemma mmatch_top': @@ -4875,7 +4880,7 @@ Proof. { Local Transparent Mem.loadbytes. unfold Mem.loadbytes. rewrite pred_dec_true. reflexivity. - red; intros. replace ofs0 with ofs by omega. auto. + red; intros. replace ofs0 with ofs by lia. auto. } destruct mv; econstructor. destruct v; econstructor. apply inj_of_bc_valid. @@ -4896,7 +4901,7 @@ Proof. auto. - (* overflow *) intros. exploit inj_of_bc_inv; eauto. intros (A & B & C); subst. - rewrite Z.add_0_r. split. omega. apply Ptrofs.unsigned_range_2. + rewrite Z.add_0_r. split. lia. apply Ptrofs.unsigned_range_2. - (* perm inv *) intros. exploit inj_of_bc_inv; eauto. intros (A & B & C); subst. rewrite Z.add_0_r in H2. auto. @@ -5167,10 +5172,10 @@ Module VA <: SEMILATTICE. End VA. -Hint Constructors cmatch : va. -Hint Constructors pmatch: va. -Hint Constructors vmatch: va. -Hint Resolve cnot_sound symbol_address_sound +Global Hint Constructors cmatch : va. +Global Hint Constructors pmatch: va. +Global Hint Constructors vmatch: va. +Global Hint Resolve cnot_sound symbol_address_sound shl_sound shru_sound shr_sound and_sound or_sound xor_sound notint_sound ror_sound rolm_sound diff --git a/cfrontend/C2C.ml b/cfrontend/C2C.ml index d830ada6..61172dda 100644 --- a/cfrontend/C2C.ml +++ b/cfrontend/C2C.ml @@ -590,10 +590,16 @@ let convertAttr a = let n = Cutil.alignas_attribute a in if n > 0 then Some (N.of_int (log2 n)) else None } -let convertCallconv va unproto attr = +let convertCallconv _tres targs va attr = + let vararg = + match targs with + | None -> None + | Some tl -> if va then Some (Z.of_uint (List.length tl)) else None in let sr = Cutil.find_custom_attributes ["structreturn"; "__structreturn"] attr in - { AST.cc_vararg = va; cc_unproto = unproto; cc_structret = sr <> [] } + { AST.cc_vararg = vararg; + AST.cc_unproto = (targs = None); + AST.cc_structret = (sr <> []) } (** Types *) @@ -661,7 +667,7 @@ let rec convertTyp env t = | Some tl -> convertParams env tl end, convertTyp env tres, - convertCallconv va (targs = None) a) + convertCallconv tres targs va a) | C.TNamed _ -> convertTyp env (Cutil.unroll env t) | C.TStruct(id, a) -> @@ -1035,7 +1041,7 @@ let rec convertExpr env e = and tres = convertTyp env e.etyp in let sg = signature_of_type targs tres - { AST.cc_vararg = true; cc_unproto = false; cc_structret = false} in + { AST.cc_vararg = Some (coqint_of_camlint 1l); cc_unproto = false; cc_structret = false} in Ebuiltin( AST.EF_external(coqstring_of_camlstring "printf", sg), targs, convertExprList env args, tres) @@ -1303,7 +1309,8 @@ let convertFundef loc env fd = a_loc = loc }; (id', AST.Gfun(Ctypes.Internal {fn_return = ret; - fn_callconv = convertCallconv fd.fd_vararg false fd.fd_attrib; + fn_callconv = convertCallconv fd.fd_ret (Some fd.fd_params) + fd.fd_vararg fd.fd_attrib; fn_params = params; fn_vars = vars; fn_body = body'})) @@ -1382,8 +1389,13 @@ let convertGlobvar loc env (sto, id, ty, optinit) = then [] else [AST.Init_space sz] | Some i -> convertInitializer env ty i in + let initialized = + if optinit = None then Sections.Uninit else + if List.exists (function AST.Init_addrof _ -> true | _ -> false) init' + then Sections.Init_reloc + else Sections.Init in let (section, access) = - Sections.for_variable env loc id' ty (optinit <> None) + Sections.for_variable env loc id' ty initialized (match sto with | Storage_thread_local | Storage_thread_local_extern | Storage_thread_local_static -> true diff --git a/cfrontend/Cexec.v b/cfrontend/Cexec.v index fbf9bbeb..24f10b68 100644 --- a/cfrontend/Cexec.v +++ b/cfrontend/Cexec.v @@ -290,7 +290,7 @@ Definition assign_copy_ok (ty: type) (b: block) (ofs: ptrofs) (b': block) (ofs': Remark check_assign_copy: forall (ty: type) (b: block) (ofs: ptrofs) (b': block) (ofs': ptrofs), { assign_copy_ok ty b ofs b' ofs' } + {~ assign_copy_ok ty b ofs b' ofs' }. -Proof with try (right; intuition omega). +Proof with try (right; intuition lia). intros. unfold assign_copy_ok. destruct (Zdivide_dec (alignof_blockcopy ge ty) (Ptrofs.unsigned ofs')); auto... destruct (Zdivide_dec (alignof_blockcopy ge ty) (Ptrofs.unsigned ofs)); auto... @@ -306,8 +306,8 @@ Proof with try (right; intuition omega). destruct (zeq (Ptrofs.unsigned ofs') (Ptrofs.unsigned ofs)); auto. destruct (zle (Ptrofs.unsigned ofs' + sizeof ge ty) (Ptrofs.unsigned ofs)); auto. destruct (zle (Ptrofs.unsigned ofs + sizeof ge ty) (Ptrofs.unsigned ofs')); auto. - right; intuition omega. - destruct Y... left; intuition omega. + right; intuition lia. + destruct Y... left; intuition lia. Defined. Definition do_assign_loc (w: world) (ty: type) (m: mem) (b: block) (ofs: ptrofs) (v: val): option (world * trace * mem) := @@ -584,7 +584,7 @@ Proof with try congruence. replace (Vlong Int64.zero) with Vnullptr. split; constructor. unfold Vnullptr; rewrite H0; auto. + destruct vargs... mydestr. - split. apply SIZE in Heqo0. econstructor; eauto. congruence. omega. + split. apply SIZE in Heqo0. econstructor; eauto. congruence. lia. constructor. - (* EF_memcpy *) unfold do_ef_memcpy. destruct vargs... destruct v... destruct vargs... @@ -643,7 +643,7 @@ Proof. inv H0. erewrite SIZE by eauto. rewrite H1, H2. auto. - (* EF_free *) inv H; unfold do_ef_free. -+ inv H0. rewrite H1. erewrite SIZE by eauto. rewrite zlt_true. rewrite H3. auto. omega. ++ inv H0. rewrite H1. erewrite SIZE by eauto. rewrite zlt_true. rewrite H3. auto. lia. + inv H0. unfold Vnullptr; destruct Archi.ptr64; auto. - (* EF_memcpy *) inv H; unfold do_ef_memcpy. diff --git a/cfrontend/Clight.v b/cfrontend/Clight.v index 8ab29fe9..239ca370 100644 --- a/cfrontend/Clight.v +++ b/cfrontend/Clight.v @@ -739,7 +739,7 @@ Proof. exploit external_call_receptive; eauto. intros [vres2 [m2 EC2]]. exists (Returnstate vres2 k m2). econstructor; eauto. (* trace length *) - red; simpl; intros. inv H; simpl; try omega. + red; simpl; intros. inv H; simpl; try lia. eapply external_call_trace_length; eauto. eapply external_call_trace_length; eauto. Qed. diff --git a/cfrontend/Cminorgen.v b/cfrontend/Cminorgen.v index 45c21f96..1b031866 100644 --- a/cfrontend/Cminorgen.v +++ b/cfrontend/Cminorgen.v @@ -240,7 +240,7 @@ Module VarOrder <: TotalLeBool. Theorem leb_total: forall v1 v2, leb v1 v2 = true \/ leb v2 v1 = true. Proof. unfold leb; intros. - assert (snd v1 <= snd v2 \/ snd v2 <= snd v1) by omega. + assert (snd v1 <= snd v2 \/ snd v2 <= snd v1) by lia. unfold proj_sumbool. destruct H; [left|right]; apply zle_true; auto. Qed. End VarOrder. diff --git a/cfrontend/Cminorgenproof.v b/cfrontend/Cminorgenproof.v index 744df818..4c97011e 100644 --- a/cfrontend/Cminorgenproof.v +++ b/cfrontend/Cminorgenproof.v @@ -287,7 +287,7 @@ Lemma match_env_external_call: Proof. intros. apply match_env_invariant with f1; auto. intros. eapply inject_incr_separated_same'; eauto. - intros. eapply inject_incr_separated_same; eauto. red. destruct H. xomega. + intros. eapply inject_incr_separated_same; eauto. red. destruct H. extlia. Qed. (** [match_env] and allocations *) @@ -317,18 +317,18 @@ Proof. constructor; eauto. constructor. (* low-high *) - rewrite NEXTBLOCK; xomega. + rewrite NEXTBLOCK; extlia. (* bounded *) intros. rewrite PTree.gsspec in H. destruct (peq id0 id). - inv H. rewrite NEXTBLOCK; xomega. - exploit me_bounded0; eauto. rewrite NEXTBLOCK; xomega. + inv H. rewrite NEXTBLOCK; extlia. + exploit me_bounded0; eauto. rewrite NEXTBLOCK; extlia. (* inv *) intros. destruct (eq_block b (Mem.nextblock m1)). subst b. rewrite SAME in H; inv H. exists id; exists sz. apply PTree.gss. rewrite OTHER in H; auto. exploit me_inv0; eauto. intros [id1 [sz1 EQ]]. exists id1; exists sz1. rewrite PTree.gso; auto. congruence. (* incr *) - intros. rewrite OTHER in H. eauto. unfold block in *; xomega. + intros. rewrite OTHER in H. eauto. unfold block in *; extlia. Qed. (** The sizes of blocks appearing in [e] are respected. *) @@ -512,23 +512,23 @@ Proof. (* base case *) econstructor; eauto. inv H. constructor; intros; eauto. - eapply IMAGE; eauto. eapply H6; eauto. xomega. + eapply IMAGE; eauto. eapply H6; eauto. extlia. (* inductive case *) assert (Ple lo hi) by (eapply me_low_high; eauto). econstructor; eauto. eapply match_temps_invariant; eauto. eapply match_env_invariant; eauto. - intros. apply H3. xomega. + intros. apply H3. extlia. eapply match_bounds_invariant; eauto. intros. eapply H1; eauto. - exploit me_bounded; eauto. xomega. + exploit me_bounded; eauto. extlia. eapply padding_freeable_invariant; eauto. - intros. apply H3. xomega. + intros. apply H3. extlia. eapply IHmatch_callstack; eauto. - intros. eapply H1; eauto. xomega. - intros. eapply H2; eauto. xomega. - intros. eapply H3; eauto. xomega. - intros. eapply H4; eauto. xomega. + intros. eapply H1; eauto. extlia. + intros. eapply H2; eauto. extlia. + intros. eapply H3; eauto. extlia. + intros. eapply H4; eauto. extlia. Qed. Lemma match_callstack_incr_bound: @@ -538,8 +538,8 @@ Lemma match_callstack_incr_bound: match_callstack f m tm cs bound' tbound'. Proof. intros. inv H. - econstructor; eauto. xomega. xomega. - constructor; auto. xomega. xomega. + econstructor; eauto. extlia. extlia. + constructor; auto. extlia. extlia. Qed. (** Assigning a temporary variable. *) @@ -596,17 +596,17 @@ Proof. auto. inv A. assert (Mem.range_perm m b 0 sz Cur Freeable). eapply free_list_freeable; eauto. eapply in_blocks_of_env; eauto. - replace ofs with ((ofs - delta) + delta) by omega. - eapply Mem.perm_inject; eauto. apply H3. omega. + replace ofs with ((ofs - delta) + delta) by lia. + eapply Mem.perm_inject; eauto. apply H3. lia. destruct X as [tm' FREE]. exploit nextblock_freelist; eauto. intro NEXT. exploit Mem.nextblock_free; eauto. intro NEXT'. exists tm'. split. auto. split. rewrite NEXT; rewrite NEXT'. - apply match_callstack_incr_bound with lo sp; try omega. + apply match_callstack_incr_bound with lo sp; try lia. apply match_callstack_invariant with f m tm; auto. intros. eapply perm_freelist; eauto. - intros. eapply Mem.perm_free_1; eauto. left; unfold block; xomega. xomega. xomega. + intros. eapply Mem.perm_free_1; eauto. left; unfold block; extlia. extlia. extlia. eapply Mem.free_inject; eauto. intros. exploit me_inv0; eauto. intros [id [sz A]]. exists 0; exists sz; split. @@ -636,21 +636,21 @@ Proof. inv H. constructor; auto. intros. case_eq (f1 b1). intros [b2' delta'] EQ. rewrite (INCR _ _ _ EQ) in H. inv H. eauto. - intro EQ. exploit SEPARATED; eauto. intros [A B]. elim B. red. xomega. + intro EQ. exploit SEPARATED; eauto. intros [A B]. elim B. red. extlia. (* inductive case *) constructor. auto. auto. eapply match_temps_invariant; eauto. eapply match_env_invariant; eauto. red in SEPARATED. intros. destruct (f1 b) as [[b' delta']|] eqn:?. exploit INCR; eauto. congruence. - exploit SEPARATED; eauto. intros [A B]. elim B. red. xomega. + exploit SEPARATED; eauto. intros [A B]. elim B. red. extlia. intros. assert (Ple lo hi) by (eapply me_low_high; eauto). destruct (f1 b) as [[b' delta']|] eqn:?. apply INCR; auto. destruct (f2 b) as [[b' delta']|] eqn:?; auto. - exploit SEPARATED; eauto. intros [A B]. elim A. red. xomega. + exploit SEPARATED; eauto. intros [A B]. elim A. red. extlia. eapply match_bounds_invariant; eauto. - intros. eapply MAXPERMS; eauto. red. exploit me_bounded; eauto. xomega. + intros. eapply MAXPERMS; eauto. red. exploit me_bounded; eauto. extlia. (* padding-freeable *) red; intros. destruct (is_reachable_from_env_dec f1 e sp ofs). @@ -660,10 +660,10 @@ Proof. red; intros; red; intros. elim H3. exploit me_inv; eauto. intros [id [lv B]]. exploit BOUND0; eauto. intros C. - apply is_reachable_intro with id b0 lv delta; auto; omega. + apply is_reachable_intro with id b0 lv delta; auto; lia. eauto with mem. (* induction *) - eapply IHmatch_callstack; eauto. inv MENV; xomega. xomega. + eapply IHmatch_callstack; eauto. inv MENV; extlia. extlia. Qed. (** [match_callstack] and allocations *) @@ -683,12 +683,12 @@ Proof. exploit Mem.nextblock_alloc; eauto. intros NEXTBLOCK. exploit Mem.alloc_result; eauto. intros RES. constructor. - xomega. - unfold block in *; xomega. + extlia. + unfold block in *; extlia. auto. constructor; intros. rewrite H3. rewrite PTree.gempty. constructor. - xomega. + extlia. rewrite PTree.gempty in H4; discriminate. eelim Mem.fresh_block_alloc; eauto. eapply Mem.valid_block_inject_2; eauto. rewrite RES. change (Mem.valid_block tm tb). eapply Mem.valid_block_inject_2; eauto. @@ -719,23 +719,23 @@ Proof. exploit Mem.alloc_result; eauto. intros RES. assert (LO: Ple lo (Mem.nextblock m1)) by (eapply me_low_high; eauto). constructor. - xomega. + extlia. auto. eapply match_temps_invariant; eauto. eapply match_env_alloc; eauto. red; intros. rewrite PTree.gsspec in H. destruct (peq id0 id). inversion H. subst b0 sz0 id0. eapply Mem.perm_alloc_3; eauto. eapply BOUND0; eauto. eapply Mem.perm_alloc_4; eauto. - exploit me_bounded; eauto. unfold block in *; xomega. + exploit me_bounded; eauto. unfold block in *; extlia. red; intros. exploit PERM; eauto. intros [A|A]. auto. right. inv A. apply is_reachable_intro with id0 b0 sz0 delta; auto. rewrite PTree.gso. auto. congruence. eapply match_callstack_invariant with (m1 := m1); eauto. intros. eapply Mem.perm_alloc_4; eauto. - unfold block in *; xomega. - intros. apply H4. unfold block in *; xomega. + unfold block in *; extlia. + intros. apply H4. unfold block in *; extlia. intros. destruct (eq_block b0 b). - subst b0. rewrite H3 in H. inv H. xomegaContradiction. + subst b0. rewrite H3 in H. inv H. extlia. rewrite H4 in H; auto. Qed. @@ -828,11 +828,11 @@ Proof. eexact MINJ. eexact H. eexact VALID. - instantiate (1 := ofs). zify. omega. - intros. exploit STKSIZE; eauto. omega. - intros. apply STKPERMS. zify. omega. - replace (sz - 0) with sz by omega. auto. - intros. eapply SEP2. eauto with coqlib. eexact CENV. eauto. eauto. omega. + instantiate (1 := ofs). zify. lia. + intros. exploit STKSIZE; eauto. lia. + intros. apply STKPERMS. zify. lia. + replace (sz - 0) with sz by lia. auto. + intros. eapply SEP2. eauto with coqlib. eexact CENV. eauto. eauto. lia. intros [f2 [A [B [C D]]]]. exploit (IHalloc_variables f2); eauto. red; intros. eapply COMPAT. auto with coqlib. @@ -841,7 +841,7 @@ Proof. subst b. rewrite C in H5; inv H5. exploit SEP1. eapply in_eq. eapply in_cons; eauto. eauto. eauto. red; intros; subst id0. elim H3. change id with (fst (id, sz0)). apply in_map; auto. - omega. + lia. eapply SEP2. apply in_cons; eauto. eauto. rewrite D in H5; eauto. eauto. auto. intros. rewrite PTree.gso. eapply UNBOUND; eauto with coqlib. @@ -890,9 +890,9 @@ Remark block_alignment_pos: forall sz, block_alignment sz > 0. Proof. unfold block_alignment; intros. - destruct (zlt sz 2). omega. - destruct (zlt sz 4). omega. - destruct (zlt sz 8); omega. + destruct (zlt sz 2). lia. + destruct (zlt sz 4). lia. + destruct (zlt sz 8); lia. Qed. Remark assign_variable_incr: @@ -901,8 +901,8 @@ Remark assign_variable_incr: Proof. simpl; intros. inv H. generalize (align_le stksz (block_alignment sz) (block_alignment_pos sz)). - assert (0 <= Z.max 0 sz). apply Zmax_bound_l. omega. - omega. + assert (0 <= Z.max 0 sz). apply Zmax_bound_l. lia. + lia. Qed. Remark assign_variables_incr: @@ -910,7 +910,7 @@ Remark assign_variables_incr: assign_variables (cenv, sz) vars = (cenv', sz') -> sz <= sz'. Proof. induction vars; intros until sz'. - simpl; intros. inv H. omega. + simpl; intros. inv H. lia. Opaque assign_variable. destruct a as [id s]. simpl. intros. destruct (assign_variable (cenv, sz) (id, s)) as [cenv1 sz1] eqn:?. @@ -931,11 +931,11 @@ Proof. assert (2 | 8). exists 4; auto. assert (4 | 8). exists 2; auto. destruct (zlt sz 2). - destruct chunk; simpl in *; auto; omegaContradiction. + destruct chunk; simpl in *; auto; extlia. destruct (zlt sz 4). - destruct chunk; simpl in *; auto; omegaContradiction. + destruct chunk; simpl in *; auto; extlia. destruct (zlt sz 8). - destruct chunk; simpl in *; auto; omegaContradiction. + destruct chunk; simpl in *; auto; extlia. destruct chunk; simpl; auto. apply align_divides. apply block_alignment_pos. Qed. @@ -948,7 +948,7 @@ Proof. replace (block_alignment sz) with (block_alignment (Z.max 0 sz)). apply inj_offset_aligned_block. rewrite Zmax_spec. destruct (zlt sz 0); auto. - transitivity 1. reflexivity. unfold block_alignment. rewrite zlt_true. auto. omega. + transitivity 1. reflexivity. unfold block_alignment. rewrite zlt_true. auto. lia. Qed. Lemma assign_variable_sound: @@ -976,23 +976,23 @@ Proof. exploit COMPAT; eauto. intros [ofs [A [B [C D]]]]. exists ofs. split. rewrite PTree.gso; auto. - split. auto. split. auto. zify; omega. + split. auto. split. auto. zify; lia. inv P. exists (align sz1 (block_alignment sz)). split. apply PTree.gss. split. apply inj_offset_aligned_block. - split. omega. - omega. + split. lia. + lia. apply EITHER in H; apply EITHER in H0. destruct H as [[P Q] | P]; destruct H0 as [[R S] | R]. rewrite PTree.gso in *; auto. eapply SEP; eauto. inv R. rewrite PTree.gso in H1; auto. rewrite PTree.gss in H2; inv H2. exploit COMPAT; eauto. intros [ofs [A [B [C D]]]]. assert (ofs = ofs1) by congruence. subst ofs. - left. zify; omega. + left. zify; lia. inv P. rewrite PTree.gso in H2; auto. rewrite PTree.gss in H1; inv H1. exploit COMPAT; eauto. intros [ofs [A [B [C D]]]]. assert (ofs = ofs2) by congruence. subst ofs. - right. zify; omega. + right. zify; lia. congruence. Qed. @@ -1023,7 +1023,7 @@ Proof. split. rewrite map_app. apply list_norepet_append_commut. simpl. constructor; auto. rewrite map_app. simpl. red; intros. rewrite in_app in H4. destruct H4. eauto. simpl in H4. destruct H4. subst y. red; intros; subst x. tauto. tauto. - generalize (assign_variable_incr _ _ _ _ _ _ Heqp). omega. + generalize (assign_variable_incr _ _ _ _ _ _ Heqp). lia. auto. auto. rewrite app_ass. auto. Qed. @@ -1054,7 +1054,7 @@ Proof. eexact H. simpl. rewrite app_nil_r. apply permutation_norepet with (map fst vars1); auto. apply Permutation_map. auto. - omega. + lia. red; intros. contradiction. red; intros. contradiction. destruct H1 as [A B]. split. @@ -1681,11 +1681,11 @@ Lemma switch_table_default: /\ snd (switch_table sl base) = (n + base)%nat. Proof. induction sl; simpl; intros. -- exists O; split. constructor. omega. +- exists O; split. constructor. lia. - destruct o. + destruct (IHsl (S base)) as (n & P & Q). exists (S n); split. constructor; auto. - destruct (switch_table sl (S base)) as [tbl dfl]; simpl in *. omega. + destruct (switch_table sl (S base)) as [tbl dfl]; simpl in *. lia. + exists O; split. constructor. destruct (switch_table sl (S base)) as [tbl dfl]; simpl in *. auto. Qed. @@ -1709,11 +1709,11 @@ Proof. exists O; split; auto. constructor. specialize (IHsl (S base) dfl). rewrite ST in IHsl. simpl in *. destruct (select_switch_case i sl). - destruct IHsl as (x & P & Q). exists (S x); split. constructor; auto. omega. + destruct IHsl as (x & P & Q). exists (S x); split. constructor; auto. lia. auto. specialize (IHsl (S base) dfl). rewrite ST in IHsl. simpl in *. destruct (select_switch_case i sl). - destruct IHsl as (x & P & Q). exists (S x); split. constructor; auto. omega. + destruct IHsl as (x & P & Q). exists (S x); split. constructor; auto. lia. auto. Qed. @@ -1726,10 +1726,10 @@ Proof. unfold select_switch; intros. generalize (switch_table_case i sl O (snd (switch_table sl O))). destruct (select_switch_case i sl) as [sl'|]. - intros (n & P & Q). replace (n + O)%nat with n in Q by omega. congruence. + intros (n & P & Q). replace (n + O)%nat with n in Q by lia. congruence. intros E; rewrite E. destruct (switch_table_default sl O) as (n & P & Q). - replace (n + O)%nat with n in Q by omega. congruence. + replace (n + O)%nat with n in Q by lia. congruence. Qed. Inductive transl_lblstmt_cont(cenv: compilenv) (xenv: exit_env): lbl_stmt -> cont -> cont -> Prop := @@ -2040,7 +2040,7 @@ Proof. apply match_callstack_incr_bound with (Mem.nextblock m) (Mem.nextblock tm). eapply match_callstack_external_call; eauto. intros. eapply external_call_max_perm; eauto. - xomega. xomega. + extlia. extlia. eapply external_call_nextblock; eauto. eapply external_call_nextblock; eauto. econstructor; eauto. @@ -2192,7 +2192,7 @@ Opaque PTree.set. apply match_callstack_incr_bound with (Mem.nextblock m) (Mem.nextblock tm). eapply match_callstack_external_call; eauto. intros. eapply external_call_max_perm; eauto. - xomega. xomega. + extlia. extlia. eapply external_call_nextblock; eauto. eapply external_call_nextblock; eauto. @@ -2236,7 +2236,7 @@ Proof. eapply match_callstate with (f := Mem.flat_inj (Mem.nextblock m0)) (cs := @nil frame) (cenv := PTree.empty Z). auto. eapply Genv.initmem_inject; eauto. - apply mcs_nil with (Mem.nextblock m0). apply match_globalenvs_init; auto. xomega. xomega. + apply mcs_nil with (Mem.nextblock m0). apply match_globalenvs_init; auto. extlia. extlia. constructor. red; auto. constructor. Qed. diff --git a/cfrontend/Csem.v b/cfrontend/Csem.v index 6d2b470f..4fa70ae2 100644 --- a/cfrontend/Csem.v +++ b/cfrontend/Csem.v @@ -839,11 +839,11 @@ Proof. unfold semantics; intros; red; simpl; intros. set (ge := globalenv p) in *. assert (DEREF: forall chunk m b ofs t v, deref_loc ge chunk m b ofs t v -> (length t <= 1)%nat). - intros. inv H0; simpl; try omega. inv H3; simpl; try omega. + intros. inv H0; simpl; try lia. inv H3; simpl; try lia. assert (ASSIGN: forall chunk m b ofs t v m', assign_loc ge chunk m b ofs v t m' -> (length t <= 1)%nat). - intros. inv H0; simpl; try omega. inv H3; simpl; try omega. + intros. inv H0; simpl; try lia. inv H3; simpl; try lia. destruct H. - inv H; simpl; try omega. inv H0; eauto; simpl; try omega. + inv H; simpl; try lia. inv H0; eauto; simpl; try lia. eapply external_call_trace_length; eauto. - inv H; simpl; try omega. eapply external_call_trace_length; eauto. + inv H; simpl; try lia. eapply external_call_trace_length; eauto. Qed. diff --git a/cfrontend/Cshmgenproof.v b/cfrontend/Cshmgenproof.v index c5ba19d5..715ba472 100644 --- a/cfrontend/Cshmgenproof.v +++ b/cfrontend/Cshmgenproof.v @@ -694,32 +694,32 @@ Proof. destruct (zlt 0 sz); try discriminate. destruct (zle sz Ptrofs.max_signed); simpl in SEM; inv SEM. assert (E1: Ptrofs.signed (Ptrofs.repr sz) = sz). - { apply Ptrofs.signed_repr. generalize Ptrofs.min_signed_neg; omega. } + { apply Ptrofs.signed_repr. generalize Ptrofs.min_signed_neg; lia. } destruct Archi.ptr64 eqn:SF; inversion EQ0; clear EQ0; subst c. + assert (E: Int64.signed (Int64.repr sz) = sz). { apply Int64.signed_repr. replace Int64.max_signed with Ptrofs.max_signed. - generalize Int64.min_signed_neg; omega. + generalize Int64.min_signed_neg; lia. unfold Ptrofs.max_signed, Ptrofs.half_modulus; rewrite Ptrofs.modulus_eq64 by auto. reflexivity. } econstructor; eauto with cshm. rewrite SF, dec_eq_true. simpl. predSpec Int64.eq Int64.eq_spec (Int64.repr sz) Int64.zero. - rewrite H in E; rewrite Int64.signed_zero in E; omegaContradiction. + rewrite H in E; rewrite Int64.signed_zero in E; extlia. predSpec Int64.eq Int64.eq_spec (Int64.repr sz) Int64.mone. - rewrite H0 in E; rewrite Int64.signed_mone in E; omegaContradiction. + rewrite H0 in E; rewrite Int64.signed_mone in E; extlia. rewrite andb_false_r; simpl. unfold Vptrofs; rewrite SF. apply f_equal. apply f_equal. symmetry. auto with ptrofs. + assert (E: Int.signed (Int.repr sz) = sz). { apply Int.signed_repr. replace Int.max_signed with Ptrofs.max_signed. - generalize Int.min_signed_neg; omega. + generalize Int.min_signed_neg; lia. unfold Ptrofs.max_signed, Ptrofs.half_modulus, Ptrofs.modulus, Ptrofs.wordsize, Wordsize_Ptrofs.wordsize. rewrite SF. reflexivity. } econstructor; eauto with cshm. rewrite SF, dec_eq_true. simpl. predSpec Int.eq Int.eq_spec (Int.repr sz) Int.zero. - rewrite H in E; rewrite Int.signed_zero in E; omegaContradiction. + rewrite H in E; rewrite Int.signed_zero in E; extlia. predSpec Int.eq Int.eq_spec (Int.repr sz) Int.mone. - rewrite H0 in E; rewrite Int.signed_mone in E; omegaContradiction. + rewrite H0 in E; rewrite Int.signed_mone in E; extlia. rewrite andb_false_r; simpl. unfold Vptrofs; rewrite SF. apply f_equal. apply f_equal. symmetry. auto with ptrofs. - destruct Archi.ptr64 eqn:SF; inv EQ0; rewrite (transl_sizeof _ _ _ _ LINK EQ). @@ -777,7 +777,7 @@ Proof. assert (Int64.unsigned i = Int.unsigned (Int64.loword i)). { unfold Int64.loword. rewrite Int.unsigned_repr; auto. - comput Int.max_unsigned; omega. + comput Int.max_unsigned; lia. } split; auto. unfold Int.ltu. apply zlt_true. rewrite <- H0. tauto. Qed. @@ -791,7 +791,7 @@ Proof. assert (Int64.unsigned i = Int.unsigned (Int64.loword i)). { unfold Int64.loword. rewrite Int.unsigned_repr; auto. - comput Int.max_unsigned; omega. + comput Int.max_unsigned; lia. } unfold Int.ltu. apply zlt_true. rewrite <- H0. tauto. Qed. @@ -802,7 +802,7 @@ Lemma small_shift_amount_3: Int64.unsigned (Int64.repr (Int.unsigned i)) = Int.unsigned i. Proof. intros. apply Int.ltu_inv in H. comput (Int.unsigned Int64.iwordsize'). - apply Int64.unsigned_repr. comput Int64.max_unsigned; omega. + apply Int64.unsigned_repr. comput Int64.max_unsigned; lia. Qed. Lemma make_shl_correct: shift_constructor_correct make_shl sem_shl. diff --git a/cfrontend/Cstrategy.v b/cfrontend/Cstrategy.v index c235031f..30e5c2ae 100644 --- a/cfrontend/Cstrategy.v +++ b/cfrontend/Cstrategy.v @@ -1553,13 +1553,13 @@ Proof. exploit external_call_trace_length; eauto. destruct t1; simpl; intros. exploit external_call_receptive; eauto. intros [vres2 [m2 EC2]]. econstructor; econstructor. left; eapply step_builtin; eauto. - omegaContradiction. + extlia. (* external calls *) inv H1. exploit external_call_trace_length; eauto. destruct t1; simpl; intros. exploit external_call_receptive; eauto. intros [vres2 [m2 EC2]]. exists (Returnstate vres2 k m2); exists E0; right; econstructor; eauto. - omegaContradiction. + extlia. (* well-behaved traces *) red; intros. inv H; inv H0; simpl; auto. (* valof volatile *) @@ -1582,10 +1582,10 @@ Proof. exploit deref_loc_trace; eauto. destruct t; auto. destruct t; tauto. (* builtins *) exploit external_call_trace_length; eauto. - destruct t; simpl; auto. destruct t; simpl; auto. intros; omegaContradiction. + destruct t; simpl; auto. destruct t; simpl; auto. intros; extlia. (* external calls *) exploit external_call_trace_length; eauto. - destruct t; simpl; auto. destruct t; simpl; auto. intros; omegaContradiction. + destruct t; simpl; auto. destruct t; simpl; auto. intros; extlia. Qed. (** The main simulation result. *) @@ -2734,7 +2734,7 @@ Proof. cofix COEL. intros. inv H. (* cons left *) - eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; omega. + eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; lia. eapply COE with (C := fun x => C(Ecall a1 (exprlist_app al (Econs x al0)) ty)). eauto. eapply leftcontext_compose; eauto. constructor. auto. apply exprlist_app_leftcontext; auto. traceEq. @@ -2745,7 +2745,7 @@ Proof. eapply leftcontext_compose; eauto. repeat constructor. auto. apply exprlist_app_leftcontext; auto. eapply forever_N_star with (a2 := (esizelist al0)). - eexact R. simpl; omega. + eexact R. simpl; lia. change (Econs a1' al0) with (exprlist_app (Econs a1' Enil) al0). rewrite <- exprlist_app_assoc. eapply COEL. eauto. auto. auto. @@ -2754,42 +2754,42 @@ Proof. intros. inv H. (* field *) - eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; omega. + eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; lia. eapply COE with (C := fun x => C(Efield x f0 ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* valof *) - eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; omega. + eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; lia. eapply COE with (C := fun x => C(Evalof x ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* deref *) - eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; omega. + eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; lia. eapply COE with (C := fun x => C(Ederef x ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* addrof *) - eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; omega. + eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; lia. eapply COE with (C := fun x => C(Eaddrof x ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* unop *) - eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; omega. + eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; lia. eapply COE with (C := fun x => C(Eunop op x ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* binop left *) - eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; omega. + eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; lia. eapply COE with (C := fun x => C(Ebinop op x a2 ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* binop right *) destruct (eval_expr_to_steps _ _ _ _ _ _ _ H1 (fun x => C(Ebinop op x a2 ty)) f k) as [P [Q R]]. eapply leftcontext_compose; eauto. repeat constructor. - eapply forever_N_star with (a2 := (esize a2)). eexact R. simpl; omega. + eapply forever_N_star with (a2 := (esize a2)). eexact R. simpl; lia. eapply COE with (C := fun x => C(Ebinop op a1' x ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. auto. traceEq. (* cast *) - eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; omega. + eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; lia. eapply COE with (C := fun x => C(Ecast x ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* seqand left *) - eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; omega. + eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; lia. eapply COE with (C := fun x => C(Eseqand x a2 ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* seqand 2 *) @@ -2802,7 +2802,7 @@ Proof. eapply COE with (C := fun x => (C (Eparen x type_bool ty))). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* seqor left *) - eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; omega. + eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; lia. eapply COE with (C := fun x => C(Eseqor x a2 ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* seqor 2 *) @@ -2815,7 +2815,7 @@ Proof. eapply COE with (C := fun x => (C (Eparen x type_bool ty))). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* condition top *) - eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; omega. + eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; lia. eapply COE with (C := fun x => C(Econdition x a2 a3 ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* condition *) @@ -2828,33 +2828,33 @@ Proof. eapply COE with (C := fun x => (C (Eparen x ty ty))). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* assign left *) - eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; omega. + eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; lia. eapply COE with (C := fun x => C(Eassign x a2 ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* assign right *) destruct (eval_expr_to_steps _ _ _ _ _ _ _ H1 (fun x => C(Eassign x a2 ty)) f k) as [P [Q R]]. eapply leftcontext_compose; eauto. repeat constructor. - eapply forever_N_star with (a2 := (esize a2)). eexact R. simpl; omega. + eapply forever_N_star with (a2 := (esize a2)). eexact R. simpl; lia. eapply COE with (C := fun x => C(Eassign a1' x ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. auto. traceEq. (* assignop left *) - eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; omega. + eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; lia. eapply COE with (C := fun x => C(Eassignop op x a2 tyres ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* assignop right *) destruct (eval_expr_to_steps _ _ _ _ _ _ _ H1 (fun x => C(Eassignop op x a2 tyres ty)) f k) as [P [Q R]]. eapply leftcontext_compose; eauto. repeat constructor. - eapply forever_N_star with (a2 := (esize a2)). eexact R. simpl; omega. + eapply forever_N_star with (a2 := (esize a2)). eexact R. simpl; lia. eapply COE with (C := fun x => C(Eassignop op a1' x tyres ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. auto. traceEq. (* postincr *) - eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; omega. + eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; lia. eapply COE with (C := fun x => C(Epostincr id x ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* comma left *) - eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; omega. + eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; lia. eapply COE with (C := fun x => C(Ecomma x a2 ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* comma right *) @@ -2865,14 +2865,14 @@ Proof. left; eapply step_comma; eauto. reflexivity. eapply COE with (C := C); eauto. traceEq. (* call left *) - eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; omega. + eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; lia. eapply COE with (C := fun x => C(Ecall x a2 ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* call right *) destruct (eval_expr_to_steps _ _ _ _ _ _ _ H1 (fun x => C(Ecall x a2 ty)) f k) as [P [Q R]]. eapply leftcontext_compose; eauto. repeat constructor. - eapply forever_N_star with (a2 := (esizelist a2)). eexact R. simpl; omega. + eapply forever_N_star with (a2 := (esizelist a2)). eexact R. simpl; lia. eapply COEL with (al := Enil). eauto. auto. auto. auto. traceEq. (* call *) destruct (eval_expr_to_steps _ _ _ _ _ _ _ H1 (fun x => C(Ecall x rargs ty)) f k) diff --git a/cfrontend/Ctypes.v b/cfrontend/Ctypes.v index 664a60c5..0de5075c 100644 --- a/cfrontend/Ctypes.v +++ b/cfrontend/Ctypes.v @@ -94,6 +94,7 @@ Proof. decide equality. decide equality. decide equality. + decide equality. Defined. Opaque type_eq typelist_eq. @@ -349,13 +350,16 @@ Fixpoint sizeof (env: composite_env) (t: type) : Z := Lemma sizeof_pos: forall env t, sizeof env t >= 0. Proof. - induction t; simpl; try omega. - destruct i; omega. - destruct f; omega. - destruct Archi.ptr64; omega. - change 0 with (0 * Z.max 0 z) at 2. apply Zmult_ge_compat_r. auto. xomega. - destruct (env!i). apply co_sizeof_pos. omega. - destruct (env!i). apply co_sizeof_pos. omega. + induction t; simpl. +- lia. +- destruct i; lia. +- lia. +- destruct f; lia. +- destruct Archi.ptr64; lia. +- change 0 with (0 * Z.max 0 z) at 2. apply Zmult_ge_compat_r. auto. lia. +- lia. +- destruct (env!i). apply co_sizeof_pos. lia. +- destruct (env!i). apply co_sizeof_pos. lia. Qed. (** The size of a type is an integral multiple of its alignment, @@ -434,18 +438,18 @@ Lemma sizeof_struct_incr: forall env m cur, cur <= sizeof_struct env cur m. Proof. induction m as [|[id t]]; simpl; intros. -- omega. +- lia. - apply Z.le_trans with (align cur (alignof env t)). apply align_le. apply alignof_pos. apply Z.le_trans with (align cur (alignof env t) + sizeof env t). - generalize (sizeof_pos env t); omega. + generalize (sizeof_pos env t); lia. apply IHm. Qed. Lemma sizeof_union_pos: forall env m, 0 <= sizeof_union env m. Proof. - induction m as [|[id t]]; simpl; xomega. + induction m as [|[id t]]; simpl; extlia. Qed. (** ** Byte offset for a field of a structure *) @@ -489,7 +493,7 @@ Proof. apply align_le. apply alignof_pos. apply sizeof_struct_incr. exploit IHfld; eauto. intros [A B]. split; auto. eapply Z.le_trans; eauto. apply Z.le_trans with (align pos (alignof env t)). - apply align_le. apply alignof_pos. generalize (sizeof_pos env t). omega. + apply align_le. apply alignof_pos. generalize (sizeof_pos env t). lia. Qed. Lemma field_offset_in_range: @@ -636,7 +640,7 @@ Proof. destruct n; auto. right; right; right. apply Z.min_l. rewrite two_power_nat_two_p. rewrite ! Nat2Z.inj_succ. - change 8 with (two_p 3). apply two_p_monotone. omega. + change 8 with (two_p 3). apply two_p_monotone. lia. } induction ty; simpl. auto. @@ -653,7 +657,7 @@ Qed. Lemma alignof_blockcopy_pos: forall env ty, alignof_blockcopy env ty > 0. Proof. - intros. generalize (alignof_blockcopy_1248 env ty). simpl. intuition omega. + intros. generalize (alignof_blockcopy_1248 env ty). simpl. intuition lia. Qed. Lemma sizeof_alignof_blockcopy_compat: @@ -669,8 +673,8 @@ Proof. apply Z.min_case. exists (two_p (Z.of_nat n)). change 8 with (two_p 3). - rewrite <- two_p_is_exp by omega. - rewrite two_power_nat_two_p. rewrite !Nat2Z.inj_succ. f_equal. omega. + rewrite <- two_p_is_exp by lia. + rewrite two_power_nat_two_p. rewrite !Nat2Z.inj_succ. f_equal. lia. apply Z.divide_refl. } induction ty; simpl. @@ -1089,8 +1093,8 @@ Remark rank_type_members: forall ce id t m, In (id, t) m -> (rank_type ce t <= rank_members ce m)%nat. Proof. induction m; simpl; intros; intuition auto. - subst a. xomega. - xomega. + subst a. extlia. + extlia. Qed. Lemma rank_struct_member: @@ -1103,7 +1107,7 @@ Proof. intros; simpl. rewrite H0. erewrite co_consistent_rank by eauto. exploit (rank_type_members ce); eauto. - omega. + lia. Qed. Lemma rank_union_member: @@ -1116,7 +1120,7 @@ Proof. intros; simpl. rewrite H0. erewrite co_consistent_rank by eauto. exploit (rank_type_members ce); eauto. - omega. + lia. Qed. (** * Programs and compilation units *) diff --git a/cfrontend/Ctyping.v b/cfrontend/Ctyping.v index bde4001f..45fa424a 100644 --- a/cfrontend/Ctyping.v +++ b/cfrontend/Ctyping.v @@ -171,7 +171,7 @@ Definition floatsize_eq: forall (x y: floatsize), {x=y} + {x<>y}. Proof. decide equality. Defined. Definition callconv_combine (cc1 cc2: calling_convention) : res calling_convention := - if bool_eq cc1.(cc_vararg) cc2.(cc_vararg) then + if option_eq Z.eq_dec cc1.(cc_vararg) cc2.(cc_vararg) then OK {| cc_vararg := cc1.(cc_vararg); cc_unproto := cc1.(cc_unproto) && cc2.(cc_unproto); cc_structret := cc1.(cc_structret) |} @@ -538,9 +538,9 @@ Inductive wt_program : program -> Prop := wt_fundef p.(prog_comp_env) e fd) -> wt_program p. -Hint Constructors wt_val wt_rvalue wt_lvalue wt_stmt wt_lblstmts: ty. -Hint Extern 1 (wt_int _ _ _) => exact I: ty. -Hint Extern 1 (wt_int _ _ _) => reflexivity: ty. +Global Hint Constructors wt_val wt_rvalue wt_lvalue wt_stmt wt_lblstmts: ty. +Global Hint Extern 1 (wt_int _ _ _) => exact I: ty. +Global Hint Extern 1 (wt_int _ _ _) => reflexivity: ty. Ltac DestructCases := match goal with @@ -956,7 +956,7 @@ Proof. destruct (classify_bool t); congruence. Qed. -Hint Resolve check_cast_sound check_bool_sound: ty. +Global Hint Resolve check_cast_sound check_bool_sound: ty. Lemma check_arguments_sound: forall el tl x, check_arguments el tl = OK x -> wt_arguments el tl. @@ -1429,8 +1429,8 @@ Lemma pres_cast_int_int: forall sz sg n, wt_int (cast_int_int sz sg n) sz sg. Proof. intros. unfold cast_int_int. destruct sz; simpl. -- destruct sg. apply Int.sign_ext_idem; omega. apply Int.zero_ext_idem; omega. -- destruct sg. apply Int.sign_ext_idem; omega. apply Int.zero_ext_idem; omega. +- destruct sg. apply Int.sign_ext_idem; lia. apply Int.zero_ext_idem; lia. +- destruct sg. apply Int.sign_ext_idem; lia. apply Int.zero_ext_idem; lia. - auto. - destruct (Int.eq n Int.zero); auto. Qed. @@ -1619,12 +1619,12 @@ Proof. unfold access_mode, Val.load_result. remember Archi.ptr64 as ptr64. intros until v; intros AC. destruct ty; simpl in AC; try discriminate AC. - destruct i; [destruct s|destruct s|idtac|idtac]; inv AC; simpl. - destruct v; auto with ty. constructor; red. apply Int.sign_ext_idem; omega. - destruct v; auto with ty. constructor; red. apply Int.zero_ext_idem; omega. - destruct v; auto with ty. constructor; red. apply Int.sign_ext_idem; omega. - destruct v; auto with ty. constructor; red. apply Int.zero_ext_idem; omega. + destruct v; auto with ty. constructor; red. apply Int.sign_ext_idem; lia. + destruct v; auto with ty. constructor; red. apply Int.zero_ext_idem; lia. + destruct v; auto with ty. constructor; red. apply Int.sign_ext_idem; lia. + destruct v; auto with ty. constructor; red. apply Int.zero_ext_idem; lia. destruct Archi.ptr64 eqn:SF; destruct v; auto with ty. - destruct v; auto with ty. constructor; red. apply Int.zero_ext_idem; omega. + destruct v; auto with ty. constructor; red. apply Int.zero_ext_idem; lia. - inv AC. destruct Archi.ptr64 eqn:SF; destruct v; auto with ty. - destruct f; inv AC; destruct v; auto with ty. - inv AC. unfold Mptr. destruct Archi.ptr64 eqn:SF; destruct v; auto with ty. @@ -1640,16 +1640,16 @@ Proof. destruct ty; simpl in ACC; try discriminate. - destruct i; [destruct s|destruct s|idtac|idtac]; inv ACC; unfold decode_val. destruct (proj_bytes vl); auto with ty. - constructor; red. apply Int.sign_ext_idem; omega. + constructor; red. apply Int.sign_ext_idem; lia. destruct (proj_bytes vl); auto with ty. - constructor; red. apply Int.zero_ext_idem; omega. + constructor; red. apply Int.zero_ext_idem; lia. destruct (proj_bytes vl); auto with ty. - constructor; red. apply Int.sign_ext_idem; omega. + constructor; red. apply Int.sign_ext_idem; lia. destruct (proj_bytes vl); auto with ty. - constructor; red. apply Int.zero_ext_idem; omega. + constructor; red. apply Int.zero_ext_idem; lia. destruct (proj_bytes vl). auto with ty. destruct Archi.ptr64 eqn:SF; auto with ty. destruct (proj_bytes vl); auto with ty. - constructor; red. apply Int.zero_ext_idem; omega. + constructor; red. apply Int.zero_ext_idem; lia. - inv ACC. unfold decode_val. destruct (proj_bytes vl). auto with ty. destruct Archi.ptr64 eqn:SF; auto with ty. - destruct f; inv ACC; unfold decode_val; destruct (proj_bytes vl); auto with ty. diff --git a/cfrontend/Initializersproof.v b/cfrontend/Initializersproof.v index 272b929f..10ccbeff 100644 --- a/cfrontend/Initializersproof.v +++ b/cfrontend/Initializersproof.v @@ -561,7 +561,7 @@ Local Opaque sizeof. + destruct (zeq sz 0). inv TR. exists (@nil init_data); split; auto. constructor. destruct (zle 0 sz). - inv TR. econstructor; split. constructor. omega. auto. + inv TR. econstructor; split. constructor. lia. auto. discriminate. + monadInv TR. destruct (transl_init_rec_spec _ _ _ _ EQ) as (d1 & A1 & B1). @@ -672,8 +672,8 @@ Remark padding_size: forall frm to, frm <= to -> idlsize (tr_padding frm to) = to - frm. Proof. unfold tr_padding; intros. destruct (zlt frm to). - simpl. xomega. - simpl. omega. + simpl. extlia. + simpl. lia. Qed. Remark idlsize_app: @@ -681,7 +681,7 @@ Remark idlsize_app: Proof. induction d1; simpl; intros. auto. - rewrite IHd1. omega. + rewrite IHd1. lia. Qed. Remark union_field_size: @@ -690,8 +690,8 @@ Proof. induction fl as [|[i t]]; simpl; intros. - inv H. - destruct (ident_eq f i). - + inv H. xomega. - + specialize (IHfl H). xomega. + + inv H. extlia. + + specialize (IHfl H). extlia. Qed. Hypothesis ce_consistent: composite_env_consistent ge. @@ -712,16 +712,16 @@ with tr_init_struct_size: Proof. Local Opaque sizeof. - destruct 1; simpl. -+ erewrite transl_init_single_size by eauto. omega. ++ erewrite transl_init_single_size by eauto. lia. + Local Transparent sizeof. simpl. eapply tr_init_array_size; eauto. -+ replace (idlsize d) with (idlsize d + 0) by omega. ++ replace (idlsize d) with (idlsize d + 0) by lia. eapply tr_init_struct_size; eauto. simpl. unfold lookup_composite in H. destruct (ge.(genv_cenv)!id) as [co'|] eqn:?; inv H. erewrite co_consistent_sizeof by (eapply ce_consistent; eauto). unfold sizeof_composite. rewrite H0. apply align_le. destruct (co_alignof_two_p co) as [n EQ]. rewrite EQ. apply two_power_nat_pos. + rewrite idlsize_app, padding_size. - exploit tr_init_size; eauto. intros EQ; rewrite EQ. omega. + exploit tr_init_size; eauto. intros EQ; rewrite EQ. lia. simpl. unfold lookup_composite in H. destruct (ge.(genv_cenv)!id) as [co'|] eqn:?; inv H. apply Z.le_trans with (sizeof_union ge (co_members co)). eapply union_field_size; eauto. @@ -730,21 +730,21 @@ Local Opaque sizeof. destruct (co_alignof_two_p co) as [n EQ]. rewrite EQ. apply two_power_nat_pos. - destruct 1; simpl. -+ omega. ++ lia. + rewrite Z.mul_comm. assert (0 <= sizeof ge ty * sz). - { apply Zmult_gt_0_le_0_compat. omega. generalize (sizeof_pos ge ty); omega. } - xomega. + { apply Zmult_gt_0_le_0_compat. lia. generalize (sizeof_pos ge ty); lia. } + extlia. + rewrite idlsize_app. erewrite tr_init_size by eauto. erewrite tr_init_array_size by eauto. ring. - destruct 1; simpl; intros. -+ rewrite padding_size by auto. omega. ++ rewrite padding_size by auto. lia. + rewrite ! idlsize_app, padding_size. erewrite tr_init_size by eauto. - rewrite <- (tr_init_struct_size _ _ _ _ _ H0 H1). omega. + rewrite <- (tr_init_struct_size _ _ _ _ _ H0 H1). lia. unfold pos1. apply align_le. apply alignof_pos. Qed. @@ -806,7 +806,7 @@ Remark exec_init_array_length: forall m b ofs ty sz il m', exec_init_array m b ofs ty sz il m' -> sz >= 0. Proof. - induction 1; omega. + induction 1; lia. Qed. Lemma store_init_data_list_app: @@ -847,10 +847,10 @@ Local Opaque sizeof. inv H3. simpl. erewrite transl_init_single_steps by eauto. auto. - (* array *) inv H1. replace (Z.max 0 sz) with sz in H7. eauto. - assert (sz >= 0) by (eapply exec_init_array_length; eauto). xomega. + assert (sz >= 0) by (eapply exec_init_array_length; eauto). extlia. - (* struct *) inv H3. unfold lookup_composite in H7. rewrite H in H7. inv H7. - replace ofs with (ofs + 0) by omega. eauto. + replace ofs with (ofs + 0) by lia. eauto. - (* union *) inv H4. unfold lookup_composite in H9. rewrite H in H9. inv H9. rewrite H1 in H12; inv H12. eapply store_init_data_list_app. eauto. @@ -870,7 +870,7 @@ Local Opaque sizeof. inv H4. simpl in H3; inv H3. eapply store_init_data_list_app. apply store_init_data_list_padding. rewrite padding_size. - replace (ofs + pos0 + (pos2 - pos0)) with (ofs + pos2) by omega. + replace (ofs + pos0 + (pos2 - pos0)) with (ofs + pos2) by lia. eapply store_init_data_list_app. eauto. rewrite (tr_init_size _ _ _ H9). diff --git a/cfrontend/PrintCsyntax.ml b/cfrontend/PrintCsyntax.ml index cfb2b584..ef3c134f 100644 --- a/cfrontend/PrintCsyntax.ml +++ b/cfrontend/PrintCsyntax.ml @@ -112,8 +112,8 @@ let rec name_cdecl id ty = | Tnil -> if first then Buffer.add_string b - (if cconv.cc_vararg then "..." else "void") - else if cconv.cc_vararg then + (if cconv.cc_vararg <> None then "..." else "void") + else if cconv.cc_vararg <> None then Buffer.add_string b ", ..." else () @@ -402,11 +402,11 @@ let name_function_parameters name_param fun_name params cconv = Buffer.add_char b '('; begin match params with | [] -> - Buffer.add_string b (if cconv.cc_vararg then "..." else "void") + Buffer.add_string b (if cconv.cc_vararg <> None then "..." else "void") | _ -> let rec add_params first = function | [] -> - if cconv.cc_vararg then Buffer.add_string b ",..." + if cconv.cc_vararg <> None then Buffer.add_string b ",..." | (id, ty) :: rem -> if not first then Buffer.add_string b ", "; Buffer.add_string b (name_cdecl (name_param id) ty); diff --git a/cfrontend/SimplExprproof.v b/cfrontend/SimplExprproof.v index 9a3f32ec..2d059ddd 100644 --- a/cfrontend/SimplExprproof.v +++ b/cfrontend/SimplExprproof.v @@ -1449,13 +1449,13 @@ Proof. (* for val *) intros [SL1 [TY1 EV1]]. subst sl. econstructor; split. - right; split. apply star_refl. destruct r; simpl; (contradiction || omega). + right; split. apply star_refl. destruct r; simpl; (contradiction || lia). econstructor; eauto. instantiate (1 := tmps). apply tr_top_val_val; auto. (* for effects *) intros SL1. subst sl. econstructor; split. - right; split. apply star_refl. destruct r; simpl; (contradiction || omega). + right; split. apply star_refl. destruct r; simpl; (contradiction || lia). econstructor; eauto. instantiate (1 := tmps). apply tr_top_base. constructor. (* for set *) @@ -1779,7 +1779,7 @@ Proof. subst; simpl Kseqlist. econstructor; split. right; split. rewrite app_ass. rewrite Kseqlist_app. eexact EXEC. - simpl. omega. + simpl. lia. constructor. (* for value *) exploit tr_simple_lvalue; eauto. intros [SL1 [TY1 EV1]]. @@ -1788,7 +1788,7 @@ Proof. subst; simpl Kseqlist. econstructor; split. right; split. rewrite app_ass. rewrite Kseqlist_app. eexact EXEC. - simpl. omega. + simpl. lia. constructor. (* postincr *) exploit tr_top_leftcontext; eauto. clear H14. @@ -1846,7 +1846,7 @@ Proof. subst. simpl Kseqlist. econstructor; split. right; split. rewrite app_ass; rewrite Kseqlist_app. eexact EXEC. - simpl; omega. + simpl; lia. constructor. (* for value *) exploit tr_simple_lvalue; eauto. intros [SL1 [TY1 EV1]]. @@ -1863,7 +1863,7 @@ Proof. subst sl0; simpl Kseqlist. econstructor; split. right; split. apply star_refl. simpl. apply plus_lt_compat_r. - apply (leftcontext_size _ _ _ H). simpl. omega. + apply (leftcontext_size _ _ _ H). simpl. lia. econstructor; eauto. apply S. eapply tr_expr_monotone; eauto. auto. auto. @@ -1885,7 +1885,7 @@ Proof. (* for effects *) econstructor; split. right; split. apply star_refl. simpl. apply plus_lt_compat_r. - apply (leftcontext_size _ _ _ H). simpl. omega. + apply (leftcontext_size _ _ _ H). simpl. lia. econstructor; eauto. exploit tr_simple_rvalue; eauto. simpl. intros A. subst sl1. apply S. constructor; auto. auto. auto. @@ -2015,12 +2015,12 @@ Proof. inv H6. inv H0. econstructor; split. right; split. apply push_seq. - simpl. omega. + simpl. lia. econstructor; eauto. constructor. auto. (* do 2 *) inv H7. inv H6. inv H. econstructor; split. - right; split. apply star_refl. simpl. omega. + right; split. apply star_refl. simpl. lia. econstructor; eauto. constructor. (* seq *) diff --git a/cfrontend/SimplLocals.v b/cfrontend/SimplLocals.v index f54aa60d..0a164e29 100644 --- a/cfrontend/SimplLocals.v +++ b/cfrontend/SimplLocals.v @@ -18,7 +18,7 @@ Require FSetAVL. Require Import Coqlib Ordered Errors. Require Import AST Linking. Require Import Ctypes Cop Clight. -Require Compopts. +Require Compopts Conventions1. Open Scope error_monad_scope. Open Scope string_scope. @@ -157,15 +157,20 @@ with simpl_lblstmt (cenv: compilenv) (ls: labeled_statements) : res labeled_stat end. (** Function parameters that are not lifted to temporaries must be - stored in the corresponding local variable at function entry. *) + stored in the corresponding local variable at function entry. + The other function parameters may need to be normalized to their types, + to support interoperability with code generated by other C compilers. *) Fixpoint store_params (cenv: compilenv) (params: list (ident * type)) (s: statement): statement := match params with | nil => s | (id, ty) :: params' => - if VSet.mem id cenv - then store_params cenv params' s + if VSet.mem id cenv then + if Conventions1.parameter_needs_normalization (rettype_of_type ty) + then Ssequence (Sset id (make_cast (Etempvar id ty) ty)) + (store_params cenv params' s) + else store_params cenv params' s else Ssequence (Sassign (Evar id ty) (Etempvar id ty)) (store_params cenv params' s) end. diff --git a/cfrontend/SimplLocalsproof.v b/cfrontend/SimplLocalsproof.v index 2dd34389..988988a1 100644 --- a/cfrontend/SimplLocalsproof.v +++ b/cfrontend/SimplLocalsproof.v @@ -173,10 +173,10 @@ Proof. eapply H1; eauto. destruct (f' b) as [[b' delta]|] eqn:?; auto. exploit H2; eauto. unfold Mem.valid_block. intros [A B]. - xomegaContradiction. + extlia. intros. destruct (f b) as [[b'' delta']|] eqn:?. eauto. exploit H2; eauto. unfold Mem.valid_block. intros [A B]. - xomegaContradiction. + extlia. Qed. (** Properties of values resulting from a cast *) @@ -606,7 +606,7 @@ Proof. generalize (alloc_variables_nextblock _ _ _ _ _ _ H0). intros A B C. subst b. split. apply Ple_refl. eapply Pos.lt_le_trans; eauto. rewrite B. apply Plt_succ. auto. - right. exploit Mem.nextblock_alloc; eauto. intros B. rewrite B in A. xomega. + right. exploit Mem.nextblock_alloc; eauto. intros B. rewrite B in A. extlia. Qed. Lemma alloc_variables_injective: @@ -622,12 +622,12 @@ Proof. repeat rewrite PTree.gsspec; intros. destruct (peq id1 id); destruct (peq id2 id). congruence. - inv H6. exploit Mem.alloc_result; eauto. exploit H2; eauto. unfold block; xomega. - inv H7. exploit Mem.alloc_result; eauto. exploit H2; eauto. unfold block; xomega. + inv H6. exploit Mem.alloc_result; eauto. exploit H2; eauto. unfold block; extlia. + inv H7. exploit Mem.alloc_result; eauto. exploit H2; eauto. unfold block; extlia. eauto. intros. rewrite PTree.gsspec in H6. destruct (peq id0 id). inv H6. - exploit Mem.alloc_result; eauto. exploit Mem.nextblock_alloc; eauto. unfold block; xomega. - exploit H2; eauto. exploit Mem.nextblock_alloc; eauto. unfold block; xomega. + exploit Mem.alloc_result; eauto. exploit Mem.nextblock_alloc; eauto. unfold block; extlia. + exploit H2; eauto. exploit Mem.nextblock_alloc; eauto. unfold block; extlia. Qed. Lemma match_alloc_variables: @@ -719,7 +719,7 @@ Proof. eapply Mem.valid_new_block; eauto. eapply Q; eauto. unfold Mem.valid_block in *. exploit Mem.nextblock_alloc. eexact A. exploit Mem.alloc_result. eexact A. - unfold block; xomega. + unfold block; extlia. split. intros. destruct (ident_eq id0 id). (* same var *) subst id0. @@ -760,7 +760,7 @@ Proof. destruct ty; try destruct i; try destruct s; try destruct f; inv H; auto; unfold Mptr; simpl; destruct Archi.ptr64; auto. } - omega. + lia. Qed. Definition env_initial_value (e: env) (m: mem) := @@ -778,7 +778,7 @@ Proof. apply IHalloc_variables. red; intros. rewrite PTree.gsspec in H2. destruct (peq id0 id). inv H2. eapply Mem.load_alloc_same'; eauto. - omega. rewrite Z.add_0_l. eapply sizeof_by_value; eauto. + lia. rewrite Z.add_0_l. eapply sizeof_by_value; eauto. apply Z.divide_0_r. eapply Mem.load_alloc_other; eauto. Qed. @@ -985,7 +985,7 @@ Proof. (* flat *) exploit alloc_variables_range. eexact A. eauto. rewrite PTree.gempty. intros [P|P]. congruence. - exploit K; eauto. unfold Mem.valid_block. xomega. + exploit K; eauto. unfold Mem.valid_block. extlia. intros [id0 [ty0 [U [V W]]]]. split; auto. destruct (ident_eq id id0). congruence. assert (b' <> b'). @@ -1032,34 +1032,34 @@ Proof. + (* special case size = 0 *) assert (bytes = nil). { exploit (Mem.loadbytes_empty m bsrc (Ptrofs.unsigned osrc) (sizeof tge ty)). - omega. congruence. } + lia. congruence. } subst. destruct (Mem.range_perm_storebytes tm bdst' (Ptrofs.unsigned (Ptrofs.add odst (Ptrofs.repr delta))) nil) as [tm' SB]. - simpl. red; intros; omegaContradiction. + simpl. red; intros; extlia. exists tm'. split. eapply assign_loc_copy; eauto. - intros; omegaContradiction. - intros; omegaContradiction. - rewrite e; right; omega. - apply Mem.loadbytes_empty. omega. + intros; extlia. + intros; extlia. + rewrite e; right; lia. + apply Mem.loadbytes_empty. lia. split. eapply Mem.storebytes_empty_inject; eauto. intros. rewrite <- H0. eapply Mem.load_storebytes_other; eauto. left. congruence. + (* general case size > 0 *) exploit Mem.loadbytes_length; eauto. intros LEN. assert (SZPOS: sizeof tge ty > 0). - { generalize (sizeof_pos tge ty); omega. } + { generalize (sizeof_pos tge ty); lia. } assert (RPSRC: Mem.range_perm m bsrc (Ptrofs.unsigned osrc) (Ptrofs.unsigned osrc + sizeof tge ty) Cur Nonempty). eapply Mem.range_perm_implies. eapply Mem.loadbytes_range_perm; eauto. auto with mem. assert (RPDST: Mem.range_perm m bdst (Ptrofs.unsigned odst) (Ptrofs.unsigned odst + sizeof tge ty) Cur Nonempty). replace (sizeof tge ty) with (Z.of_nat (List.length bytes)). eapply Mem.range_perm_implies. eapply Mem.storebytes_range_perm; eauto. auto with mem. - rewrite LEN. apply Z2Nat.id. omega. + rewrite LEN. apply Z2Nat.id. lia. assert (PSRC: Mem.perm m bsrc (Ptrofs.unsigned osrc) Cur Nonempty). - apply RPSRC. omega. + apply RPSRC. lia. assert (PDST: Mem.perm m bdst (Ptrofs.unsigned odst) Cur Nonempty). - apply RPDST. omega. + apply RPDST. lia. exploit Mem.address_inject. eauto. eexact PSRC. eauto. intros EQ1. exploit Mem.address_inject. eauto. eexact PDST. eauto. intros EQ2. exploit Mem.loadbytes_inject; eauto. intros [bytes2 [A B]]. @@ -1108,23 +1108,37 @@ Theorem store_params_correct: /\ match_envs j cenv e le m' lo hi te tle tlo thi /\ Mem.nextblock tm' = Mem.nextblock tm. Proof. +Local Opaque Conventions1.parameter_needs_normalization. induction 1; simpl; intros until targs; intros NOREPET CASTED VINJ MENV MINJ TLE LE. - (* base case *) +- (* base case *) inv VINJ. exists tle2; exists tm; split. apply star_refl. split. auto. split. auto. split. apply match_envs_temps_exten with tle1; auto. auto. - (* inductive case *) +- (* inductive case *) inv NOREPET. inv CASTED. inv VINJ. exploit me_vars; eauto. instantiate (1 := id); intros MV. - destruct (VSet.mem id cenv) eqn:?. - (* lifted to temp *) - eapply IHbind_parameters with (tle1 := PTree.set id v' tle1); eauto. - eapply match_envs_assign_lifted; eauto. - inv MV; try congruence. rewrite ENV in H; inv H. - inv H0; try congruence. - unfold Mem.storev in H2. eapply Mem.store_unmapped_inject; eauto. - intros. repeat rewrite PTree.gsspec. destruct (peq id0 id). auto. - apply TLE. intuition. - (* still in memory *) + destruct (VSet.mem id cenv) eqn:LIFTED. ++ (* lifted to temp *) + exploit (IHbind_parameters s tm (PTree.set id v' tle1) (PTree.set id v' tle2)). + eauto. eauto. eauto. + eapply match_envs_assign_lifted; eauto. + inv MV; try congruence. rewrite ENV in H; inv H. + inv H0; try congruence. + unfold Mem.storev in H2. eapply Mem.store_unmapped_inject; eauto. + intros. repeat rewrite PTree.gsspec. destruct (peq id0 id). auto. + apply TLE. intuition. + eauto. + intros (tle & tm' & U & V & X & Y & Z). + exists tle, tm'; split; [|auto]. + destruct (Conventions1.parameter_needs_normalization (rettype_of_type ty)); [|assumption]. + assert (A: tle!id = Some v'). + { erewrite bind_parameter_temps_inv by eauto. apply PTree.gss. } + eapply star_left. constructor. + eapply star_left. econstructor. eapply make_cast_correct. + constructor; eauto. apply cast_val_casted; auto. eapply val_casted_inject; eauto. + rewrite PTree.gsident by auto. + eapply star_left. constructor. eassumption. + traceEq. traceEq. traceEq. ++ (* still in memory *) inv MV; try congruence. rewrite ENV in H; inv H. exploit assign_loc_inject; eauto. intros [tm1 [A [B C]]]. @@ -1244,7 +1258,7 @@ Proof. destruct (Mem.range_perm_free m b lo hi) as [m1 A]; auto. rewrite A. apply IHl; auto. intros. red; intros. eapply Mem.perm_free_1; eauto. - exploit H1; eauto. intros [B|B]. auto. right; omega. + exploit H1; eauto. intros [B|B]. auto. right; lia. eapply H; eauto. Qed. @@ -1276,11 +1290,11 @@ Proof. change id' with (fst (id', (b', ty'))). apply List.in_map; auto. } assert (Mem.perm m b0 0 Max Nonempty). { apply Mem.perm_cur_max. apply Mem.perm_implies with Freeable. - eapply PERMS; eauto. omega. auto with mem. } + eapply PERMS; eauto. lia. auto with mem. } assert (Mem.perm m b0' 0 Max Nonempty). { apply Mem.perm_cur_max. apply Mem.perm_implies with Freeable. - eapply PERMS; eauto. omega. auto with mem. } - exploit Mem.mi_no_overlap; eauto. intros [A|A]. auto. omegaContradiction. + eapply PERMS; eauto. lia. auto with mem. } + exploit Mem.mi_no_overlap; eauto. intros [A|A]. auto. extlia. Qed. Lemma free_list_right_inject: @@ -1326,7 +1340,7 @@ Local Opaque ge tge. unfold block_of_binding in EQ; inv EQ. exploit me_mapped; eauto. eapply PTree.elements_complete; eauto. intros [b [A B]]. - change 0 with (0 + 0). replace (sizeof ge ty) with (sizeof ge ty + 0) by omega. + change 0 with (0 + 0). replace (sizeof ge ty) with (sizeof ge ty + 0) by lia. eapply Mem.range_perm_inject; eauto. eapply free_blocks_of_env_perm_2; eauto. - (* no overlap *) @@ -1343,7 +1357,7 @@ Local Opaque ge tge. intros [[id [b' ty]] [EQ IN]]. unfold block_of_binding in EQ. inv EQ. exploit me_flat; eauto. apply PTree.elements_complete; eauto. intros [P Q]. subst delta. eapply free_blocks_of_env_perm_1 with (m := m); eauto. - rewrite <- comp_env_preserved. omega. + rewrite <- comp_env_preserved. lia. Qed. (** Matching global environments *) @@ -1577,17 +1591,17 @@ Proof. induction 1; intros LOAD INCR INJ1 INJ2; econstructor; eauto. (* globalenvs *) inv H. constructor; intros; eauto. - assert (f b1 = Some (b2, delta)). rewrite <- H; symmetry; eapply INJ2; eauto. xomega. + assert (f b1 = Some (b2, delta)). rewrite <- H; symmetry; eapply INJ2; eauto. extlia. eapply IMAGE; eauto. (* call *) eapply match_envs_invariant; eauto. - intros. apply LOAD; auto. xomega. - intros. apply INJ1; auto; xomega. - intros. eapply INJ2; eauto; xomega. + intros. apply LOAD; auto. extlia. + intros. apply INJ1; auto; extlia. + intros. eapply INJ2; eauto; extlia. eapply IHmatch_cont; eauto. - intros; apply LOAD; auto. inv H0; xomega. - intros; apply INJ1. inv H0; xomega. - intros; eapply INJ2; eauto. inv H0; xomega. + intros; apply LOAD; auto. inv H0; extlia. + intros; apply INJ1. inv H0; extlia. + intros; eapply INJ2; eauto. inv H0; extlia. Qed. (** Invariance by assignment to location "above" *) @@ -1602,9 +1616,9 @@ Proof. intros. eapply match_cont_invariant; eauto. intros. rewrite <- H4. inv H0. (* scalar *) - simpl in H6. eapply Mem.load_store_other; eauto. left. unfold block; xomega. + simpl in H6. eapply Mem.load_store_other; eauto. left. unfold block; extlia. (* block copy *) - eapply Mem.load_storebytes_other; eauto. left. unfold block; xomega. + eapply Mem.load_storebytes_other; eauto. left. unfold block; extlia. Qed. (** Invariance by external calls *) @@ -1622,9 +1636,9 @@ Proof. intros. eapply Mem.load_unchanged_on; eauto. red in H2. intros. destruct (f b) as [[b' delta] | ] eqn:?. auto. destruct (f' b) as [[b' delta] | ] eqn:?; auto. - exploit H2; eauto. unfold Mem.valid_block. intros [A B]. xomegaContradiction. + exploit H2; eauto. unfold Mem.valid_block. intros [A B]. extlia. red in H2. intros. destruct (f b) as [[b'' delta''] | ] eqn:?. auto. - exploit H2; eauto. unfold Mem.valid_block. intros [A B]. xomegaContradiction. + exploit H2; eauto. unfold Mem.valid_block. intros [A B]. extlia. Qed. (** Invariance by change of bounds *) @@ -1636,7 +1650,7 @@ Lemma match_cont_incr_bounds: Ple bound bound' -> Ple tbound tbound' -> match_cont f cenv k tk m bound' tbound'. Proof. - induction 1; intros; econstructor; eauto; xomega. + induction 1; intros; econstructor; eauto; extlia. Qed. (** [match_cont] and call continuations. *) @@ -1690,7 +1704,7 @@ Proof. inv H; auto. destruct a. destruct p. destruct (Mem.free m b z0 z) as [m1|] eqn:?; try discriminate. transitivity (Mem.load chunk m1 b' 0). eauto. - eapply Mem.load_free. eauto. left. assert (Plt b' b) by eauto. unfold block; xomega. + eapply Mem.load_free. eauto. left. assert (Plt b' b) by eauto. unfold block; extlia. Qed. Lemma match_cont_free_env: @@ -1708,9 +1722,9 @@ Proof. intros. rewrite <- H7. eapply free_list_load; eauto. unfold blocks_of_env; intros. exploit list_in_map_inv; eauto. intros [[id [b1 ty]] [P Q]]. simpl in P. inv P. - exploit me_range; eauto. eapply PTree.elements_complete; eauto. xomega. - rewrite (free_list_nextblock _ _ _ H3). inv H; xomega. - rewrite (free_list_nextblock _ _ _ H4). inv H; xomega. + exploit me_range; eauto. eapply PTree.elements_complete; eauto. extlia. + rewrite (free_list_nextblock _ _ _ H3). inv H; extlia. + rewrite (free_list_nextblock _ _ _ H4). inv H; extlia. Qed. (** Matching of global environments *) @@ -1979,7 +1993,7 @@ Lemma find_label_store_params: forall s k params, find_label lbl (store_params cenv params s) k = find_label lbl s k. Proof. induction params; simpl. auto. - destruct a as [id ty]. destruct (VSet.mem id cenv); auto. + destruct a as [id ty]. destruct (VSet.mem id cenv); [destruct Conventions1.parameter_needs_normalization|]; auto. Qed. Lemma find_label_add_debug_vars: @@ -2018,7 +2032,7 @@ Proof. eapply step_Sset_debug. eauto. rewrite typeof_simpl_expr. eauto. econstructor; eauto with compat. eapply match_envs_assign_lifted; eauto. eapply cast_val_is_casted; eauto. - eapply match_cont_assign_loc; eauto. exploit me_range; eauto. xomega. + eapply match_cont_assign_loc; eauto. exploit me_range; eauto. extlia. inv MV; try congruence. inv H2; try congruence. unfold Mem.storev in H3. eapply Mem.store_unmapped_inject; eauto. congruence. erewrite assign_loc_nextblock; eauto. @@ -2068,7 +2082,7 @@ Proof. eapply match_envs_set_opttemp; eauto. eapply match_envs_extcall; eauto. eapply match_cont_extcall; eauto. - inv MENV; xomega. inv MENV; xomega. + inv MENV; extlia. inv MENV; extlia. eapply Ple_trans; eauto. eapply external_call_nextblock; eauto. eapply Ple_trans; eauto. eapply external_call_nextblock; eauto. @@ -2212,11 +2226,11 @@ Proof. eapply bind_parameters_load; eauto. intros. exploit alloc_variables_range. eexact H1. eauto. unfold empty_env. rewrite PTree.gempty. intros [?|?]. congruence. - red; intros; subst b'. xomega. + red; intros; subst b'. extlia. eapply alloc_variables_load; eauto. apply compat_cenv_for. - rewrite (bind_parameters_nextblock _ _ _ _ _ _ H2). xomega. - rewrite T; xomega. + rewrite (bind_parameters_nextblock _ _ _ _ _ _ H2). extlia. + rewrite T; extlia. (* external function *) monadInv TRFD. inv FUNTY. @@ -2227,7 +2241,7 @@ Proof. apply plus_one. econstructor; eauto. eapply external_call_symbols_preserved; eauto. apply senv_preserved. econstructor; eauto. intros. apply match_cont_incr_bounds with (Mem.nextblock m) (Mem.nextblock tm). - eapply match_cont_extcall; eauto. xomega. xomega. + eapply match_cont_extcall; eauto. extlia. extlia. eapply external_call_nextblock; eauto. eapply external_call_nextblock; eauto. @@ -2262,7 +2276,7 @@ Proof. eapply Genv.find_symbol_not_fresh; eauto. eapply Genv.find_funct_ptr_not_fresh; eauto. eapply Genv.find_var_info_not_fresh; eauto. - xomega. xomega. + extlia. extlia. eapply Genv.initmem_inject; eauto. constructor. Qed. diff --git a/common/AST.v b/common/AST.v index 979db4b9..9fe32331 100644 --- a/common/AST.v +++ b/common/AST.v @@ -61,7 +61,7 @@ Definition typesize (ty: typ) : Z := end. Lemma typesize_pos: forall ty, typesize ty > 0. -Proof. destruct ty; simpl; omega. Qed. +Proof. destruct ty; simpl; lia. Qed. Lemma typesize_Tptr: typesize Tptr = if Archi.ptr64 then 8 else 4. Proof. unfold Tptr; destruct Archi.ptr64; auto. Qed. @@ -122,17 +122,17 @@ These signatures are used in particular to determine appropriate calling conventions for the function. *) Record calling_convention : Type := mkcallconv { - cc_vararg: bool; (**r variable-arity function *) - cc_unproto: bool; (**r old-style unprototyped function *) - cc_structret: bool (**r function returning a struct *) + cc_vararg: option Z; (**r variable-arity function (+ number of fixed args) *) + cc_unproto: bool; (**r old-style unprototyped function *) + cc_structret: bool (**r function returning a struct *) }. Definition cc_default := - {| cc_vararg := false; cc_unproto := false; cc_structret := false |}. + {| cc_vararg := None; cc_unproto := false; cc_structret := false |}. Definition calling_convention_eq (x y: calling_convention) : {x=y} + {x<>y}. Proof. - decide equality; apply bool_dec. + decide equality; try (apply bool_dec). decide equality; apply Z.eq_dec. Defined. Global Opaque calling_convention_eq. @@ -275,13 +275,13 @@ Fixpoint init_data_list_size (il: list init_data) {struct il} : Z := Lemma init_data_size_pos: forall i, init_data_size i >= 0. Proof. - destruct i; simpl; try xomega. destruct Archi.ptr64; omega. + destruct i; simpl; try extlia. destruct Archi.ptr64; lia. Qed. Lemma init_data_list_size_pos: forall il, init_data_list_size il >= 0. Proof. - induction il; simpl. omega. generalize (init_data_size_pos a); omega. + induction il; simpl. lia. generalize (init_data_size_pos a); lia. Qed. (** Information attached to global variables. *) diff --git a/common/Events.v b/common/Events.v index 033e2e03..13741ebd 100644 --- a/common/Events.v +++ b/common/Events.v @@ -798,7 +798,7 @@ Proof. exists f; exists v'; exists m1'; intuition. constructor; auto. red; intros. congruence. (* trace length *) -- inv H; inv H0; simpl; omega. +- inv H; inv H0; simpl; lia. (* receptive *) - inv H. exploit volatile_load_receptive; eauto. intros [v2 A]. exists v2; exists m1; constructor; auto. @@ -925,7 +925,7 @@ Proof. eelim H3; eauto. exploit Mem.store_valid_access_3. eexact H0. intros [X Y]. apply Mem.perm_cur_max. apply Mem.perm_implies with Writable; auto with mem. - apply X. omega. + apply X. lia. Qed. Lemma volatile_store_receptive: @@ -960,7 +960,7 @@ Proof. exploit volatile_store_inject; eauto. intros [m2' [A [B [C D]]]]. exists f; exists Vundef; exists m2'; intuition. constructor; auto. red; intros; congruence. (* trace length *) -- inv H; inv H0; simpl; omega. +- inv H; inv H0; simpl; lia. (* receptive *) - assert (t1 = t2). inv H. eapply volatile_store_receptive; eauto. subst t2; exists vres1; exists m1; auto. @@ -1042,7 +1042,7 @@ Proof. subst b1. rewrite C in H2. inv H2. eauto with mem. rewrite D in H2 by auto. congruence. (* trace length *) -- inv H; simpl; omega. +- inv H; simpl; lia. (* receptive *) - assert (t1 = t2). inv H; inv H0; auto. subst t2. exists vres1; exists m1; auto. @@ -1122,21 +1122,21 @@ Proof. exploit Mem.address_inject; eauto. apply Mem.perm_implies with Freeable; auto with mem. apply P. instantiate (1 := lo). - generalize (size_chunk_pos Mptr); omega. + generalize (size_chunk_pos Mptr); lia. intro EQ. exploit Mem.free_parallel_inject; eauto. intros (m2' & C & D). exists f, Vundef, m2'; split. apply extcall_free_sem_ptr with (sz := sz) (m' := m2'). - rewrite EQ. rewrite <- A. f_equal. omega. + rewrite EQ. rewrite <- A. f_equal. lia. auto. auto. - rewrite ! EQ. rewrite <- C. f_equal; omega. + rewrite ! EQ. rewrite <- C. f_equal; lia. split. auto. split. auto. split. eapply Mem.free_unchanged_on; eauto. unfold loc_unmapped. intros; congruence. split. eapply Mem.free_unchanged_on; eauto. unfold loc_out_of_reach. intros. red; intros. eelim H2; eauto. apply Mem.perm_cur_max. apply Mem.perm_implies with Freeable; auto with mem. - apply P. omega. + apply P. lia. split. auto. red; intros. congruence. + inv H2. inv H6. replace v' with Vnullptr. @@ -1145,7 +1145,7 @@ Proof. red; intros; congruence. unfold Vnullptr in *; destruct Archi.ptr64; inv H4; auto. (* trace length *) -- inv H; simpl; omega. +- inv H; simpl; lia. (* receptive *) - assert (t1 = t2) by (inv H; inv H0; auto). subst t2. exists vres1; exists m1; auto. @@ -1217,23 +1217,23 @@ Proof. destruct (zeq sz 0). + (* special case sz = 0 *) assert (bytes = nil). - { exploit (Mem.loadbytes_empty m1 bsrc (Ptrofs.unsigned osrc) sz). omega. congruence. } + { exploit (Mem.loadbytes_empty m1 bsrc (Ptrofs.unsigned osrc) sz). lia. congruence. } subst. destruct (Mem.range_perm_storebytes m1' b0 (Ptrofs.unsigned (Ptrofs.add odst (Ptrofs.repr delta0))) nil) as [m2' SB]. - simpl. red; intros; omegaContradiction. + simpl. red; intros; extlia. exists f, Vundef, m2'. split. econstructor; eauto. - intros; omegaContradiction. - intros; omegaContradiction. - right; omega. - apply Mem.loadbytes_empty. omega. + intros; extlia. + intros; extlia. + right; lia. + apply Mem.loadbytes_empty. lia. split. auto. split. eapply Mem.storebytes_empty_inject; eauto. split. eapply Mem.storebytes_unchanged_on; eauto. unfold loc_unmapped; intros. congruence. split. eapply Mem.storebytes_unchanged_on; eauto. - simpl; intros; omegaContradiction. + simpl; intros; extlia. split. apply inject_incr_refl. red; intros; congruence. + (* general case sz > 0 *) @@ -1243,11 +1243,11 @@ Proof. assert (RPDST: Mem.range_perm m1 bdst (Ptrofs.unsigned odst) (Ptrofs.unsigned odst + sz) Cur Nonempty). replace sz with (Z.of_nat (length bytes)). eapply Mem.range_perm_implies. eapply Mem.storebytes_range_perm; eauto. auto with mem. - rewrite LEN. apply Z2Nat.id. omega. + rewrite LEN. apply Z2Nat.id. lia. assert (PSRC: Mem.perm m1 bsrc (Ptrofs.unsigned osrc) Cur Nonempty). - apply RPSRC. omega. + apply RPSRC. lia. assert (PDST: Mem.perm m1 bdst (Ptrofs.unsigned odst) Cur Nonempty). - apply RPDST. omega. + apply RPDST. lia. exploit Mem.address_inject. eauto. eexact PSRC. eauto. intros EQ1. exploit Mem.address_inject. eauto. eexact PDST. eauto. intros EQ2. exploit Mem.loadbytes_inject; eauto. intros [bytes2 [A B]]. @@ -1258,7 +1258,7 @@ Proof. intros; eapply Mem.aligned_area_inject with (m := m1); eauto. eapply Mem.disjoint_or_equal_inject with (m := m1); eauto. apply Mem.range_perm_max with Cur; auto. - apply Mem.range_perm_max with Cur; auto. omega. + apply Mem.range_perm_max with Cur; auto. lia. split. constructor. split. auto. split. eapply Mem.storebytes_unchanged_on; eauto. unfold loc_unmapped; intros. @@ -1268,11 +1268,11 @@ Proof. apply Mem.perm_cur_max. apply Mem.perm_implies with Writable; auto with mem. eapply Mem.storebytes_range_perm; eauto. erewrite list_forall2_length; eauto. - omega. + lia. split. apply inject_incr_refl. red; intros; congruence. - (* trace length *) - intros; inv H. simpl; omega. + intros; inv H. simpl; lia. - (* receptive *) intros. assert (t1 = t2). inv H; inv H0; auto. subst t2. @@ -1318,7 +1318,7 @@ Proof. eapply eventval_list_match_inject; eauto. red; intros; congruence. (* trace length *) -- inv H; simpl; omega. +- inv H; simpl; lia. (* receptive *) - assert (t1 = t2). inv H; inv H0; auto. exists vres1; exists m1; congruence. @@ -1363,7 +1363,7 @@ Proof. eapply eventval_match_inject; eauto. red; intros; congruence. (* trace length *) -- inv H; simpl; omega. +- inv H; simpl; lia. (* receptive *) - assert (t1 = t2). inv H; inv H0; auto. subst t2. exists vres1; exists m1; auto. @@ -1409,7 +1409,7 @@ Proof. econstructor; eauto. red; intros; congruence. (* trace length *) -- inv H; simpl; omega. +- inv H; simpl; lia. (* receptive *) - inv H; inv H0. exists Vundef, m1; constructor. (* determ *) @@ -1497,7 +1497,7 @@ Proof. constructor; auto. red; intros; congruence. (* trace length *) -- inv H; simpl; omega. +- inv H; simpl; lia. (* receptive *) - inv H; inv H0. exists vres1, m1; constructor; auto. (* determ *) @@ -1623,7 +1623,7 @@ Proof. intros. destruct (plt (Mem.nextblock m2) (Mem.nextblock m1)). exploit external_call_valid_block; eauto. intros. eelim Plt_strict; eauto. - unfold Plt, Ple in *; zify; omega. + unfold Plt, Ple in *; zify; lia. Qed. (** Special case of [external_call_mem_inject_gen] (for backward compatibility) *) @@ -1738,7 +1738,7 @@ Qed. End EVAL_BUILTIN_ARG. -Hint Constructors eval_builtin_arg: barg. +Global Hint Constructors eval_builtin_arg: barg. (** Invariance by change of global environment. *) diff --git a/common/Globalenvs.v b/common/Globalenvs.v index d37fbd46..40496044 100644 --- a/common/Globalenvs.v +++ b/common/Globalenvs.v @@ -55,7 +55,7 @@ Function store_zeros (m: mem) (b: block) (p: Z) (n: Z) {wf (Zwf 0) n}: option me | None => None end. Proof. - intros. red. omega. + intros. red. lia. apply Zwf_well_founded. Qed. @@ -849,8 +849,8 @@ Proof. intros until n. functional induction (store_zeros m b p n); intros. - inv H; apply Mem.unchanged_on_refl. - apply Mem.unchanged_on_trans with m'. -+ eapply Mem.store_unchanged_on; eauto. simpl. intros. apply H0. omega. -+ apply IHo; auto. intros; apply H0; omega. ++ eapply Mem.store_unchanged_on; eauto. simpl. intros. apply H0. lia. ++ apply IHo; auto. intros; apply H0; lia. - discriminate. Qed. @@ -879,7 +879,7 @@ Proof. - destruct (store_init_data m b p a) as [m1|] eqn:?; try congruence. apply Mem.unchanged_on_trans with m1. eapply store_init_data_unchanged; eauto. intros; apply H0; tauto. - eapply IHil; eauto. intros; apply H0. generalize (init_data_size_pos a); omega. + eapply IHil; eauto. intros; apply H0. generalize (init_data_size_pos a); lia. Qed. (** Properties related to [loadbytes] *) @@ -895,24 +895,24 @@ Lemma store_zeros_loadbytes: readbytes_as_zero m' b p n. Proof. intros until n; functional induction (store_zeros m b p n); red; intros. -- destruct n0. simpl. apply Mem.loadbytes_empty. omega. - rewrite Nat2Z.inj_succ in H1. omegaContradiction. +- destruct n0. simpl. apply Mem.loadbytes_empty. lia. + rewrite Nat2Z.inj_succ in H1. extlia. - destruct (zeq p0 p). - + subst p0. destruct n0. simpl. apply Mem.loadbytes_empty. omega. + + subst p0. destruct n0. simpl. apply Mem.loadbytes_empty. lia. rewrite Nat2Z.inj_succ in H1. rewrite Nat2Z.inj_succ. - replace (Z.succ (Z.of_nat n0)) with (1 + Z.of_nat n0) by omega. + replace (Z.succ (Z.of_nat n0)) with (1 + Z.of_nat n0) by lia. change (list_repeat (S n0) (Byte Byte.zero)) with ((Byte Byte.zero :: nil) ++ list_repeat n0 (Byte Byte.zero)). apply Mem.loadbytes_concat. eapply Mem.loadbytes_unchanged_on with (P := fun b1 ofs1 => ofs1 = p). - eapply store_zeros_unchanged; eauto. intros; omega. - intros; omega. + eapply store_zeros_unchanged; eauto. intros; lia. + intros; lia. replace (Byte Byte.zero :: nil) with (encode_val Mint8unsigned Vzero). change 1 with (size_chunk Mint8unsigned). eapply Mem.loadbytes_store_same; eauto. unfold encode_val; unfold encode_int; unfold rev_if_be; destruct Archi.big_endian; reflexivity. - eapply IHo; eauto. omega. omega. omega. omega. - + eapply IHo; eauto. omega. omega. + eapply IHo; eauto. lia. lia. lia. lia. + + eapply IHo; eauto. lia. lia. - discriminate. Qed. @@ -947,8 +947,8 @@ Proof. intros; destruct i; simpl in H; try apply (Mem.loadbytes_store_same _ _ _ _ _ _ H). - inv H. simpl. assert (EQ: Z.of_nat (Z.to_nat z) = Z.max z 0). - { destruct (zle 0 z). rewrite Z2Nat.id; xomega. destruct z; try discriminate. simpl. xomega. } - rewrite <- EQ. apply H0. omega. simpl. omega. + { destruct (zle 0 z). rewrite Z2Nat.id; extlia. destruct z; try discriminate. simpl. extlia. } + rewrite <- EQ. apply H0. lia. simpl. lia. - rewrite init_data_size_addrof. simpl. destruct (find_symbol ge i) as [b'|]; try discriminate. rewrite (Mem.loadbytes_store_same _ _ _ _ _ _ H). @@ -968,23 +968,23 @@ Lemma store_init_data_list_loadbytes: Mem.loadbytes m' b p (init_data_list_size il) = Some (bytes_of_init_data_list il). Proof. induction il as [ | i1 il]; simpl; intros. -- apply Mem.loadbytes_empty. omega. +- apply Mem.loadbytes_empty. lia. - generalize (init_data_size_pos i1) (init_data_list_size_pos il); intros P1 PL. destruct (store_init_data m b p i1) as [m1|] eqn:S; try discriminate. apply Mem.loadbytes_concat. eapply Mem.loadbytes_unchanged_on with (P := fun b1 ofs1 => ofs1 < p + init_data_size i1). eapply store_init_data_list_unchanged; eauto. - intros; omega. - intros; omega. + intros; lia. + intros; lia. eapply store_init_data_loadbytes; eauto. - red; intros; apply H0. omega. omega. + red; intros; apply H0. lia. lia. apply IHil with m1; auto. red; intros. eapply Mem.loadbytes_unchanged_on with (P := fun b1 ofs1 => p + init_data_size i1 <= ofs1). eapply store_init_data_unchanged; eauto. - intros; omega. - intros; omega. - apply H0. omega. omega. + intros; lia. + intros; lia. + apply H0. lia. lia. auto. auto. Qed. @@ -1011,7 +1011,7 @@ Remark read_as_zero_unchanged: read_as_zero m' b ofs len. Proof. intros; red; intros. eapply Mem.load_unchanged_on; eauto. - intros; apply H1. omega. + intros; apply H1. lia. Qed. Lemma store_zeros_read_as_zero: @@ -1068,7 +1068,7 @@ Proof. { intros. eapply Mem.load_unchanged_on with (P := fun b' ofs' => ofs' < p + size_chunk chunk). - eapply store_init_data_list_unchanged; eauto. intros; omega. + eapply store_init_data_list_unchanged; eauto. intros; lia. intros; tauto. eapply Mem.load_store_same; eauto. } @@ -1078,10 +1078,10 @@ Proof. exploit IHil; eauto. set (P := fun (b': block) ofs' => p + init_data_size a <= ofs'). apply read_as_zero_unchanged with (m := m) (P := P). - red; intros; apply H0; auto. generalize (init_data_size_pos a); omega. omega. + red; intros; apply H0; auto. generalize (init_data_size_pos a); lia. lia. eapply store_init_data_unchanged with (P := P); eauto. - intros; unfold P. omega. - intros; unfold P. omega. + intros; unfold P. lia. + intros; unfold P. lia. intro D. destruct a; simpl in Heqo. + split; auto. eapply (A Mint8unsigned (Vint i)); eauto. @@ -1093,10 +1093,10 @@ Proof. + split; auto. set (P := fun (b': block) ofs' => ofs' < p + init_data_size (Init_space z)). inv Heqo. apply read_as_zero_unchanged with (m := m1) (P := P). - red; intros. apply H0; auto. simpl. generalize (init_data_list_size_pos il); xomega. + red; intros. apply H0; auto. simpl. generalize (init_data_list_size_pos il); extlia. eapply store_init_data_list_unchanged; eauto. - intros; unfold P. omega. - intros; unfold P. simpl; xomega. + intros; unfold P. lia. + intros; unfold P. simpl; extlia. + rewrite init_data_size_addrof in *. split; auto. destruct (find_symbol ge i); try congruence. @@ -1195,11 +1195,11 @@ Proof. * destruct (Mem.alloc m 0 1) as [m1 b] eqn:ALLOC. exploit Mem.alloc_result; eauto. intros RES. rewrite H, <- RES. split. - eapply Mem.perm_drop_1; eauto. omega. + eapply Mem.perm_drop_1; eauto. lia. intros. assert (0 <= ofs < 1). { eapply Mem.perm_alloc_3; eauto. eapply Mem.perm_drop_4; eauto. } exploit Mem.perm_drop_2; eauto. intros ORD. - split. omega. inv ORD; auto. + split. lia. inv ORD; auto. * set (init := gvar_init v) in *. set (sz := init_data_list_size init) in *. destruct (Mem.alloc m 0 sz) as [m1 b] eqn:?. @@ -1442,7 +1442,7 @@ Proof. exploit alloc_global_neutral; eauto. assert (Ple (Pos.succ (Mem.nextblock m)) (Mem.nextblock m')). { rewrite EQ. apply advance_next_le. } - unfold Plt, Ple in *; zify; omega. + unfold Plt, Ple in *; zify; lia. Qed. End INITMEM_INJ. @@ -1563,9 +1563,9 @@ Lemma store_zeros_exists: Proof. intros until n. functional induction (store_zeros m b p n); intros PERM. - exists m; auto. -- apply IHo. red; intros. eapply Mem.perm_store_1; eauto. apply PERM. omega. +- apply IHo. red; intros. eapply Mem.perm_store_1; eauto. apply PERM. lia. - destruct (Mem.valid_access_store m Mint8unsigned b p Vzero) as (m' & STORE). - split. red; intros. apply Mem.perm_cur. apply PERM. simpl in H. omega. + split. red; intros. apply Mem.perm_cur. apply PERM. simpl in H. lia. simpl. apply Z.divide_1_l. congruence. Qed. @@ -1603,10 +1603,10 @@ Proof. - exists m; auto. - destruct H0. destruct (@store_init_data_exists m b p i1) as (m1 & S1); eauto. - red; intros. apply H. generalize (init_data_list_size_pos il); omega. + red; intros. apply H. generalize (init_data_list_size_pos il); lia. rewrite S1. apply IHil; eauto. - red; intros. erewrite <- store_init_data_perm by eauto. apply H. generalize (init_data_size_pos i1); omega. + red; intros. erewrite <- store_init_data_perm by eauto. apply H. generalize (init_data_size_pos i1); lia. Qed. Lemma alloc_global_exists: diff --git a/common/Linking.v b/common/Linking.v index ec828ea4..a5cf0a4a 100644 --- a/common/Linking.v +++ b/common/Linking.v @@ -123,7 +123,7 @@ Defined. Next Obligation. inv H; inv H0; constructor; auto. congruence. - simpl. generalize (init_data_list_size_pos z). xomega. + simpl. generalize (init_data_list_size_pos z). extlia. Defined. Next Obligation. revert H; unfold link_varinit. diff --git a/common/Memdata.v b/common/Memdata.v index a09b90f5..1d651db2 100644 --- a/common/Memdata.v +++ b/common/Memdata.v @@ -54,7 +54,7 @@ Qed. Lemma size_chunk_pos: forall chunk, size_chunk chunk > 0. Proof. - intros. destruct chunk; simpl; omega. + intros. destruct chunk; simpl; lia. Qed. Definition size_chunk_nat (chunk: memory_chunk) : nat := @@ -72,7 +72,7 @@ Proof. intros. generalize (size_chunk_pos chunk). rewrite size_chunk_conv. destruct (size_chunk_nat chunk). - simpl; intros; omegaContradiction. + simpl; intros; extlia. intros; exists n; auto. Qed. @@ -108,7 +108,7 @@ Definition align_chunk (chunk: memory_chunk) : Z := Lemma align_chunk_pos: forall chunk, align_chunk chunk > 0. Proof. - intro. destruct chunk; simpl; omega. + intro. destruct chunk; simpl; lia. Qed. Lemma align_chunk_Mptr: align_chunk Mptr = if Archi.ptr64 then 8 else 4. @@ -127,7 +127,7 @@ Lemma align_le_divides: align_chunk chunk1 <= align_chunk chunk2 -> (align_chunk chunk1 | align_chunk chunk2). Proof. intros. destruct chunk1; destruct chunk2; simpl in *; - solve [ omegaContradiction + solve [ extlia | apply Z.divide_refl | exists 2; reflexivity | exists 4; reflexivity @@ -223,12 +223,12 @@ Proof. simpl. rewrite Zmod_1_r. auto. Opaque Byte.wordsize. rewrite Nat2Z.inj_succ. simpl. - replace (Z.succ (Z.of_nat n) * 8) with (Z.of_nat n * 8 + 8) by omega. - rewrite two_p_is_exp; try omega. + replace (Z.succ (Z.of_nat n) * 8) with (Z.of_nat n * 8 + 8) by lia. + rewrite two_p_is_exp; try lia. rewrite Zmod_recombine. rewrite IHn. rewrite Z.add_comm. change (Byte.unsigned (Byte.repr x)) with (Byte.Z_mod_modulus x). rewrite Byte.Z_mod_modulus_eq. reflexivity. - apply two_p_gt_ZERO. omega. apply two_p_gt_ZERO. omega. + apply two_p_gt_ZERO. lia. apply two_p_gt_ZERO. lia. Qed. Lemma rev_if_be_involutive: @@ -287,15 +287,15 @@ Proof. intros; simpl; auto. intros until y. rewrite Nat2Z.inj_succ. - replace (Z.succ (Z.of_nat n) * 8) with (Z.of_nat n * 8 + 8) by omega. - rewrite two_p_is_exp; try omega. + replace (Z.succ (Z.of_nat n) * 8) with (Z.of_nat n * 8 + 8) by lia. + rewrite two_p_is_exp; try lia. intro EQM. simpl; decEq. apply Byte.eqm_samerepr. red. eapply eqmod_divides; eauto. apply Z.divide_factor_r. apply IHn. destruct EQM as [k EQ]. exists k. rewrite EQ. - rewrite <- Z_div_plus_full_l. decEq. change (two_p 8) with 256. ring. omega. + rewrite <- Z_div_plus_full_l. decEq. change (two_p 8) with 256. ring. lia. Qed. Lemma encode_int_8_mod: @@ -524,9 +524,9 @@ Ltac solve_decode_encode_val_general := | |- context [ Int.repr(decode_int (encode_int 2 (Int.unsigned _))) ] => rewrite decode_encode_int_2 | |- context [ Int.repr(decode_int (encode_int 4 (Int.unsigned _))) ] => rewrite decode_encode_int_4 | |- context [ Int64.repr(decode_int (encode_int 8 (Int64.unsigned _))) ] => rewrite decode_encode_int_8 - | |- Vint (Int.sign_ext _ (Int.sign_ext _ _)) = Vint _ => f_equal; apply Int.sign_ext_idem; omega - | |- Vint (Int.zero_ext _ (Int.zero_ext _ _)) = Vint _ => f_equal; apply Int.zero_ext_idem; omega - | |- Vint (Int.sign_ext _ (Int.zero_ext _ _)) = Vint _ => f_equal; apply Int.sign_ext_zero_ext; omega + | |- Vint (Int.sign_ext _ (Int.sign_ext _ _)) = Vint _ => f_equal; apply Int.sign_ext_idem; lia + | |- Vint (Int.zero_ext _ (Int.zero_ext _ _)) = Vint _ => f_equal; apply Int.zero_ext_idem; lia + | |- Vint (Int.sign_ext _ (Int.zero_ext _ _)) = Vint _ => f_equal; apply Int.sign_ext_zero_ext; lia end. Lemma decode_encode_val_general: @@ -550,7 +550,7 @@ Lemma decode_encode_val_similar: v2 = Val.load_result chunk2 v1. Proof. intros until v2; intros TY SZ DE. - destruct chunk1; destruct chunk2; simpl in TY; try discriminate; simpl in SZ; try omegaContradiction; + destruct chunk1; destruct chunk2; simpl in TY; try discriminate; simpl in SZ; try extlia; destruct v1; auto. Qed. @@ -560,7 +560,7 @@ Lemma decode_val_rettype: Proof. intros. unfold decode_val. destruct (proj_bytes cl). -- destruct chunk; simpl; rewrite ? Int.sign_ext_idem, ? Int.zero_ext_idem by omega; auto. +- destruct chunk; simpl; rewrite ? Int.sign_ext_idem, ? Int.zero_ext_idem by lia; auto. - Local Opaque Val.load_result. destruct chunk; simpl; (exact I || apply Val.load_result_type || destruct Archi.ptr64; (exact I || apply Val.load_result_type)). @@ -660,7 +660,7 @@ Proof. exists j, mv = Fragment v q j /\ S j <> size_quantity_nat q). { induction n; simpl; intros. contradiction. destruct H0. - exists n; split; auto. omega. apply IHn; auto. omega. + exists n; split; auto. lia. apply IHn; auto. lia. } assert (B: forall q, q = quantity_chunk chunk -> @@ -670,7 +670,7 @@ Proof. Local Transparent inj_value. intros. unfold inj_value. destruct (size_quantity_nat_pos q) as [sz' EQ']. rewrite EQ'. simpl. constructor; auto. - intros; eapply A; eauto. omega. + intros; eapply A; eauto. lia. } assert (C: forall bl, match v with Vint _ => True | Vlong _ => True | Vfloat _ => True | Vsingle _ => True | _ => False end -> @@ -726,8 +726,8 @@ Proof. induction n; destruct mvs; simpl; intros; try discriminate. contradiction. destruct m; try discriminate. InvBooleans. apply beq_nat_true in H4. subst. - destruct H0. subst mv. exists n0; split; auto. omega. - eapply IHn; eauto. omega. + destruct H0. subst mv. exists n0; split; auto. lia. + eapply IHn; eauto. lia. } assert (U: forall mvs, shape_decoding chunk mvs (Val.load_result chunk Vundef)). { @@ -747,7 +747,7 @@ Proof. simpl. apply beq_nat_true in EQN. subst n q0. constructor. auto. destruct H0 as [E|[E|[E|E]]]; subst chunk; destruct q; auto || discriminate. congruence. - intros. eapply B; eauto. omega. + intros. eapply B; eauto. lia. } unfold decode_val. destruct (proj_bytes (mv1 :: mvl)) as [bl|] eqn:PB. @@ -962,22 +962,22 @@ Proof. induction l1; simpl int_of_bytes; intros. simpl. ring. simpl length. rewrite Nat2Z.inj_succ. - replace (Z.succ (Z.of_nat (length l1)) * 8) with (Z.of_nat (length l1) * 8 + 8) by omega. + replace (Z.succ (Z.of_nat (length l1)) * 8) with (Z.of_nat (length l1) * 8 + 8) by lia. rewrite two_p_is_exp. change (two_p 8) with 256. rewrite IHl1. ring. - omega. omega. + lia. lia. Qed. Lemma int_of_bytes_range: forall l, 0 <= int_of_bytes l < two_p (Z.of_nat (length l) * 8). Proof. induction l; intros. - simpl. omega. + simpl. lia. simpl length. rewrite Nat2Z.inj_succ. - replace (Z.succ (Z.of_nat (length l)) * 8) with (Z.of_nat (length l) * 8 + 8) by omega. + replace (Z.succ (Z.of_nat (length l)) * 8) with (Z.of_nat (length l) * 8 + 8) by lia. rewrite two_p_is_exp. change (two_p 8) with 256. simpl int_of_bytes. generalize (Byte.unsigned_range a). - change Byte.modulus with 256. omega. - omega. omega. + change Byte.modulus with 256. lia. + lia. lia. Qed. Lemma length_proj_bytes: @@ -1021,7 +1021,7 @@ Proof. intros. apply Int.unsigned_repr. generalize (int_of_bytes_range l). rewrite H2. change (two_p (Z.of_nat 4 * 8)) with (Int.max_unsigned + 1). - omega. + lia. apply Val.lessdef_same. unfold decode_int, rev_if_be. destruct Archi.big_endian; rewrite B1; rewrite B2. + rewrite <- (rev_length b1) in L1. @@ -1043,18 +1043,18 @@ Lemma bytes_of_int_append: bytes_of_int n1 x1 ++ bytes_of_int n2 x2. Proof. induction n1; intros. -- simpl in *. f_equal. omega. +- simpl in *. f_equal. lia. - assert (E: two_p (Z.of_nat (S n1) * 8) = two_p (Z.of_nat n1 * 8) * 256). { rewrite Nat2Z.inj_succ. change 256 with (two_p 8). rewrite <- two_p_is_exp. - f_equal. omega. omega. omega. + f_equal. lia. lia. lia. } rewrite E in *. simpl. f_equal. apply Byte.eqm_samerepr. exists (x2 * two_p (Z.of_nat n1 * 8)). change Byte.modulus with 256. ring. rewrite Z.mul_assoc. rewrite Z_div_plus. apply IHn1. - apply Zdiv_interval_1. omega. apply two_p_gt_ZERO; omega. omega. - assumption. omega. + apply Zdiv_interval_1. lia. apply two_p_gt_ZERO; lia. lia. + assumption. lia. Qed. Lemma bytes_of_int64: diff --git a/common/Memory.v b/common/Memory.v index 65f36966..2851fd26 100644 --- a/common/Memory.v +++ b/common/Memory.v @@ -212,11 +212,11 @@ Proof. induction lo using (well_founded_induction_type (Zwf_up_well_founded hi)). destruct (zlt lo hi). destruct (perm_dec m b lo k p). - destruct (H (lo + 1)). red. omega. - left; red; intros. destruct (zeq lo ofs). congruence. apply r. omega. - right; red; intros. elim n. red; intros; apply H0; omega. - right; red; intros. elim n. apply H0. omega. - left; red; intros. omegaContradiction. + destruct (H (lo + 1)). red. lia. + left; red; intros. destruct (zeq lo ofs). congruence. apply r. lia. + right; red; intros. elim n. red; intros; apply H0; lia. + right; red; intros. elim n. apply H0. lia. + left; red; intros. extlia. Defined. (** [valid_access m chunk b ofs p] holds if a memory access @@ -257,7 +257,7 @@ Theorem valid_access_valid_block: Proof. intros. destruct H. assert (perm m b ofs Cur Nonempty). - apply H. generalize (size_chunk_pos chunk). omega. + apply H. generalize (size_chunk_pos chunk). lia. eauto with mem. Qed. @@ -268,7 +268,7 @@ Lemma valid_access_perm: valid_access m chunk b ofs p -> perm m b ofs k p. Proof. - intros. destruct H. apply perm_cur. apply H. generalize (size_chunk_pos chunk). omega. + intros. destruct H. apply perm_cur. apply H. generalize (size_chunk_pos chunk). lia. Qed. Lemma valid_access_compat: @@ -314,9 +314,9 @@ Theorem valid_pointer_valid_access: Proof. intros. rewrite valid_pointer_nonempty_perm. split; intros. - split. simpl; red; intros. replace ofs0 with ofs by omega. auto. + split. simpl; red; intros. replace ofs0 with ofs by lia. auto. simpl. apply Z.divide_1_l. - destruct H. apply H. simpl. omega. + destruct H. apply H. simpl. lia. Qed. (** C allows pointers one past the last element of an array. These are not @@ -486,8 +486,8 @@ Proof. auto. simpl length in H. rewrite Nat2Z.inj_succ in H. transitivity (ZMap.get q (ZMap.set p a c)). - apply IHvl. intros. apply H. omega. - apply ZMap.gso. apply not_eq_sym. apply H. omega. + apply IHvl. intros. apply H. lia. + apply ZMap.gso. apply not_eq_sym. apply H. lia. Qed. Remark setN_outside: @@ -496,7 +496,7 @@ Remark setN_outside: ZMap.get q (setN vl p c) = ZMap.get q c. Proof. intros. apply setN_other. - intros. omega. + intros. lia. Qed. Remark getN_setN_same: @@ -506,7 +506,7 @@ Proof. induction vl; intros; simpl. auto. decEq. - rewrite setN_outside. apply ZMap.gss. omega. + rewrite setN_outside. apply ZMap.gss. lia. apply IHvl. Qed. @@ -516,7 +516,7 @@ Remark getN_exten: getN n p c1 = getN n p c2. Proof. induction n; intros. auto. rewrite Nat2Z.inj_succ in H. simpl. decEq. - apply H. omega. apply IHn. intros. apply H. omega. + apply H. lia. apply IHn. intros. apply H. lia. Qed. Remark getN_setN_disjoint: @@ -682,7 +682,7 @@ Qed. Theorem valid_access_empty: forall chunk b ofs p, ~valid_access empty chunk b ofs p. Proof. intros. red; intros. elim (perm_empty b ofs Cur p). apply H. - generalize (size_chunk_pos chunk); omega. + generalize (size_chunk_pos chunk); lia. Qed. (** ** Properties related to [load] *) @@ -847,7 +847,7 @@ Theorem loadbytes_empty: n <= 0 -> loadbytes m b ofs n = Some nil. Proof. intros. unfold loadbytes. rewrite pred_dec_true. rewrite Z_to_nat_neg; auto. - red; intros. omegaContradiction. + red; intros. extlia. Qed. Lemma getN_concat: @@ -855,9 +855,9 @@ Lemma getN_concat: getN (n1 + n2)%nat p c = getN n1 p c ++ getN n2 (p + Z.of_nat n1) c. Proof. induction n1; intros. - simpl. decEq. omega. + simpl. decEq. lia. rewrite Nat2Z.inj_succ. simpl. decEq. - replace (p + Z.succ (Z.of_nat n1)) with ((p + 1) + Z.of_nat n1) by omega. + replace (p + Z.succ (Z.of_nat n1)) with ((p + 1) + Z.of_nat n1) by lia. auto. Qed. @@ -871,12 +871,12 @@ Proof. unfold loadbytes; intros. destruct (range_perm_dec m b ofs (ofs + n1) Cur Readable); try congruence. destruct (range_perm_dec m b (ofs + n1) (ofs + n1 + n2) Cur Readable); try congruence. - rewrite pred_dec_true. rewrite Z2Nat.inj_add by omega. - rewrite getN_concat. rewrite Z2Nat.id by omega. + rewrite pred_dec_true. rewrite Z2Nat.inj_add by lia. + rewrite getN_concat. rewrite Z2Nat.id by lia. congruence. red; intros. - assert (ofs0 < ofs + n1 \/ ofs0 >= ofs + n1) by omega. - destruct H4. apply r; omega. apply r0; omega. + assert (ofs0 < ofs + n1 \/ ofs0 >= ofs + n1) by lia. + destruct H4. apply r; lia. apply r0; lia. Qed. Theorem loadbytes_split: @@ -891,13 +891,13 @@ Proof. unfold loadbytes; intros. destruct (range_perm_dec m b ofs (ofs + (n1 + n2)) Cur Readable); try congruence. - rewrite Z2Nat.inj_add in H by omega. rewrite getN_concat in H. - rewrite Z2Nat.id in H by omega. + rewrite Z2Nat.inj_add in H by lia. rewrite getN_concat in H. + rewrite Z2Nat.id in H by lia. repeat rewrite pred_dec_true. econstructor; econstructor. split. reflexivity. split. reflexivity. congruence. - red; intros; apply r; omega. - red; intros; apply r; omega. + red; intros; apply r; lia. + red; intros; apply r; lia. Qed. Theorem load_rep: @@ -917,13 +917,13 @@ Proof. revert ofs H; induction n; intros; simpl; auto. f_equal. rewrite Nat2Z.inj_succ in H. - replace ofs with (ofs+0) by omega. - apply H; omega. + replace ofs with (ofs+0) by lia. + apply H; lia. apply IHn. intros. rewrite <- Z.add_assoc. apply H. - rewrite Nat2Z.inj_succ. omega. + rewrite Nat2Z.inj_succ. lia. Qed. Theorem load_int64_split: @@ -938,7 +938,7 @@ Proof. exploit load_valid_access; eauto. intros [A B]. simpl in *. exploit load_loadbytes. eexact H. simpl. intros [bytes [LB EQ]]. change 8 with (4 + 4) in LB. - exploit loadbytes_split. eexact LB. omega. omega. + exploit loadbytes_split. eexact LB. lia. lia. intros (bytes1 & bytes2 & LB1 & LB2 & APP). change 4 with (size_chunk Mint32) in LB1. exploit loadbytes_load. eexact LB1. @@ -970,11 +970,11 @@ Proof. change (Int.unsigned (Int.repr 4)) with 4. apply Ptrofs.unsigned_repr. exploit (Zdivide_interval (Ptrofs.unsigned i) Ptrofs.modulus 8). - omega. apply Ptrofs.unsigned_range. auto. + lia. apply Ptrofs.unsigned_range. auto. exists (two_p (Ptrofs.zwordsize - 3)). unfold Ptrofs.modulus, Ptrofs.zwordsize, Ptrofs.wordsize. unfold Wordsize_Ptrofs.wordsize. destruct Archi.ptr64; reflexivity. - unfold Ptrofs.max_unsigned. omega. + unfold Ptrofs.max_unsigned. lia. Qed. Theorem loadv_int64_split: @@ -1131,7 +1131,7 @@ Qed. Theorem load_store_same: load chunk m2 b ofs = Some (Val.load_result chunk v). Proof. - apply load_store_similar_2; auto. omega. + apply load_store_similar_2; auto. lia. Qed. Theorem load_store_other: @@ -1183,9 +1183,9 @@ Proof. destruct H. congruence. destruct (zle n 0) as [z | n0]. rewrite (Z_to_nat_neg _ z). auto. - destruct H. omegaContradiction. + destruct H. extlia. apply getN_setN_outside. rewrite encode_val_length. rewrite <- size_chunk_conv. - rewrite Z2Nat.id. auto. omega. + rewrite Z2Nat.id. auto. lia. auto. red; intros. eauto with mem. rewrite pred_dec_false. auto. @@ -1198,11 +1198,11 @@ Lemma setN_in: In (ZMap.get q (setN vl p c)) vl. Proof. induction vl; intros. - simpl in H. omegaContradiction. + simpl in H. extlia. simpl length in H. rewrite Nat2Z.inj_succ in H. simpl. destruct (zeq p q). subst q. rewrite setN_outside. rewrite ZMap.gss. - auto with coqlib. omega. - right. apply IHvl. omega. + auto with coqlib. lia. + right. apply IHvl. lia. Qed. Lemma getN_in: @@ -1211,10 +1211,10 @@ Lemma getN_in: In (ZMap.get q c) (getN n p c). Proof. induction n; intros. - simpl in H; omegaContradiction. + simpl in H; extlia. rewrite Nat2Z.inj_succ in H. simpl. destruct (zeq p q). subst q. auto. - right. apply IHn. omega. + right. apply IHn. lia. Qed. End STORE. @@ -1363,28 +1363,28 @@ Proof. split. rewrite V', SIZE'. apply decode_val_shape. destruct (zeq ofs' ofs). - subst ofs'. left; split. auto. unfold c'. simpl. - rewrite setN_outside by omega. apply ZMap.gss. + rewrite setN_outside by lia. apply ZMap.gss. - right. destruct (zlt ofs ofs'). (* If ofs < ofs': the load reads (at ofs') a continuation byte from the write. ofs ofs' ofs+|chunk| [-------------------] write [-------------------] read *) -+ left; split. omega. unfold c'. simpl. apply setN_in. ++ left; split. lia. unfold c'. simpl. apply setN_in. assert (Z.of_nat (length (mv1 :: mvl)) = size_chunk chunk). { rewrite <- ENC; rewrite encode_val_length. rewrite size_chunk_conv; auto. } - simpl length in H3. rewrite Nat2Z.inj_succ in H3. omega. + simpl length in H3. rewrite Nat2Z.inj_succ in H3. lia. (* If ofs > ofs': the load reads (at ofs) the first byte from the write. ofs' ofs ofs'+|chunk'| [-------------------] write [----------------] read *) -+ right; split. omega. replace mv1 with (ZMap.get ofs c'). ++ right; split. lia. replace mv1 with (ZMap.get ofs c'). apply getN_in. assert (size_chunk chunk' = Z.succ (Z.of_nat sz')). { rewrite size_chunk_conv. rewrite SIZE'. rewrite Nat2Z.inj_succ; auto. } - omega. - unfold c'. simpl. rewrite setN_outside by omega. apply ZMap.gss. + lia. + unfold c'. simpl. rewrite setN_outside by lia. apply ZMap.gss. Qed. Definition compat_pointer_chunks (chunk1 chunk2: memory_chunk) : Prop := @@ -1471,10 +1471,10 @@ Theorem load_store_pointer_mismatch: Proof. intros. exploit load_store_overlap; eauto. - generalize (size_chunk_pos chunk'); omega. - generalize (size_chunk_pos chunk); omega. + generalize (size_chunk_pos chunk'); lia. + generalize (size_chunk_pos chunk); lia. intros (mv1 & mvl & mv1' & mvl' & ENC & DEC & CASES). - destruct CASES as [(A & B) | [(A & B) | (A & B)]]; try omegaContradiction. + destruct CASES as [(A & B) | [(A & B) | (A & B)]]; try extlia. inv ENC; inv DEC; auto. - elim H1. apply compat_pointer_chunks_true; auto. - contradiction. @@ -1496,8 +1496,8 @@ Proof. destruct (valid_access_dec m chunk1 b ofs Writable); destruct (valid_access_dec m chunk2 b ofs Writable); auto. f_equal. apply mkmem_ext; auto. congruence. - elim n. apply valid_access_compat with chunk1; auto. omega. - elim n. apply valid_access_compat with chunk2; auto. omega. + elim n. apply valid_access_compat with chunk1; auto. lia. + elim n. apply valid_access_compat with chunk2; auto. lia. Qed. Theorem store_signed_unsigned_8: @@ -1543,7 +1543,7 @@ Proof. destruct (valid_access_dec m Mfloat64 b ofs Writable); try discriminate. destruct (valid_access_dec m Mfloat64al32 b ofs Writable). rewrite <- H. f_equal. apply mkmem_ext; auto. - elim n. apply valid_access_compat with Mfloat64; auto. simpl; omega. + elim n. apply valid_access_compat with Mfloat64; auto. simpl; lia. Qed. Theorem storev_float64al32: @@ -1706,7 +1706,7 @@ Proof. rewrite pred_dec_true. rewrite storebytes_mem_contents. decEq. rewrite PMap.gsspec. destruct (peq b' b). subst b'. - apply getN_setN_disjoint. rewrite Z2Nat.id by omega. intuition congruence. + apply getN_setN_disjoint. rewrite Z2Nat.id by lia. intuition congruence. auto. red; auto with mem. apply pred_dec_false. @@ -1751,8 +1751,8 @@ Lemma setN_concat: setN (bytes1 ++ bytes2) ofs c = setN bytes2 (ofs + Z.of_nat (length bytes1)) (setN bytes1 ofs c). Proof. induction bytes1; intros. - simpl. decEq. omega. - simpl length. rewrite Nat2Z.inj_succ. simpl. rewrite IHbytes1. decEq. omega. + simpl. decEq. lia. + simpl length. rewrite Nat2Z.inj_succ. simpl. rewrite IHbytes1. decEq. lia. Qed. Theorem storebytes_concat: @@ -1771,8 +1771,8 @@ Proof. elim n. rewrite app_length. rewrite Nat2Z.inj_add. red; intros. destruct (zlt ofs0 (ofs + Z.of_nat(length bytes1))). - apply r. omega. - eapply perm_storebytes_2; eauto. apply r0. omega. + apply r. lia. + eapply perm_storebytes_2; eauto. apply r0. lia. Qed. Theorem storebytes_split: @@ -1785,10 +1785,10 @@ Proof. intros. destruct (range_perm_storebytes m b ofs bytes1) as [m1 ST1]. red; intros. exploit storebytes_range_perm; eauto. rewrite app_length. - rewrite Nat2Z.inj_add. omega. + rewrite Nat2Z.inj_add. lia. destruct (range_perm_storebytes m1 b (ofs + Z.of_nat (length bytes1)) bytes2) as [m2' ST2]. red; intros. eapply perm_storebytes_1; eauto. exploit storebytes_range_perm. - eexact H. instantiate (1 := ofs0). rewrite app_length. rewrite Nat2Z.inj_add. omega. + eexact H. instantiate (1 := ofs0). rewrite app_length. rewrite Nat2Z.inj_add. lia. auto. assert (Some m2 = Some m2'). rewrite <- H. eapply storebytes_concat; eauto. @@ -1896,7 +1896,7 @@ Theorem perm_alloc_2: Proof. unfold perm; intros. injection ALLOC; intros. rewrite <- H1; simpl. subst b. rewrite PMap.gss. unfold proj_sumbool. rewrite zle_true. - rewrite zlt_true. simpl. auto with mem. omega. omega. + rewrite zlt_true. simpl. auto with mem. lia. lia. Qed. Theorem perm_alloc_inv: @@ -1940,7 +1940,7 @@ Theorem valid_access_alloc_same: valid_access m2 chunk b ofs Freeable. Proof. intros. constructor; auto with mem. - red; intros. apply perm_alloc_2. omega. + red; intros. apply perm_alloc_2. lia. Qed. Local Hint Resolve valid_access_alloc_other valid_access_alloc_same: mem. @@ -1955,11 +1955,11 @@ Proof. intros. inv H. generalize (size_chunk_pos chunk); intro. destruct (eq_block b' b). subst b'. - assert (perm m2 b ofs Cur p). apply H0. omega. - assert (perm m2 b (ofs + size_chunk chunk - 1) Cur p). apply H0. omega. + assert (perm m2 b ofs Cur p). apply H0. lia. + assert (perm m2 b (ofs + size_chunk chunk - 1) Cur p). apply H0. lia. exploit perm_alloc_inv. eexact H2. rewrite dec_eq_true. intro. exploit perm_alloc_inv. eexact H3. rewrite dec_eq_true. intro. - intuition omega. + intuition lia. split; auto. red; intros. exploit perm_alloc_inv. apply H0. eauto. rewrite dec_eq_false; auto. Qed. @@ -2006,7 +2006,7 @@ Theorem load_alloc_same': Proof. intros. assert (exists v, load chunk m2 b ofs = Some v). apply valid_access_load. constructor; auto. - red; intros. eapply perm_implies. apply perm_alloc_2. omega. auto with mem. + red; intros. eapply perm_implies. apply perm_alloc_2. lia. auto with mem. destruct H2 as [v LOAD]. rewrite LOAD. decEq. eapply load_alloc_same; eauto. Qed. @@ -2116,7 +2116,7 @@ Theorem perm_free_2: Proof. intros. rewrite free_result. unfold perm, unchecked_free; simpl. rewrite PMap.gss. unfold proj_sumbool. rewrite zle_true. rewrite zlt_true. - simpl. tauto. omega. omega. + simpl. tauto. lia. lia. Qed. Theorem perm_free_3: @@ -2149,7 +2149,7 @@ Theorem valid_access_free_1: Proof. intros. inv H. constructor; auto with mem. red; intros. eapply perm_free_1; eauto. - destruct (zlt lo hi). intuition. right. omega. + destruct (zlt lo hi). intuition. right. lia. Qed. Theorem valid_access_free_2: @@ -2161,9 +2161,9 @@ Proof. generalize (size_chunk_pos chunk); intros. destruct (zlt ofs lo). elim (perm_free_2 lo Cur p). - omega. apply H3. omega. + lia. apply H3. lia. elim (perm_free_2 ofs Cur p). - omega. apply H3. omega. + lia. apply H3. lia. Qed. Theorem valid_access_free_inv_1: @@ -2189,7 +2189,7 @@ Proof. destruct (zlt lo hi); auto. destruct (zle (ofs + size_chunk chunk) lo); auto. destruct (zle hi ofs); auto. - elim (valid_access_free_2 chunk ofs p); auto. omega. + elim (valid_access_free_2 chunk ofs p); auto. lia. Qed. Theorem load_free: @@ -2227,7 +2227,7 @@ Proof. red; intros. eapply perm_free_3; eauto. rewrite pred_dec_false; auto. red; intros. elim n0; red; intros. - eapply perm_free_1; eauto. destruct H; auto. right; omega. + eapply perm_free_1; eauto. destruct H; auto. right; lia. Qed. Theorem loadbytes_free_2: @@ -2297,7 +2297,7 @@ Proof. unfold drop_perm in DROP. destruct (range_perm_dec m b lo hi Cur Freeable); inv DROP. unfold perm. simpl. rewrite PMap.gss. unfold proj_sumbool. rewrite zle_true. rewrite zlt_true. simpl. constructor. - omega. omega. + lia. lia. Qed. Theorem perm_drop_2: @@ -2307,7 +2307,7 @@ Proof. unfold drop_perm in DROP. destruct (range_perm_dec m b lo hi Cur Freeable); inv DROP. revert H0. unfold perm; simpl. rewrite PMap.gss. unfold proj_sumbool. rewrite zle_true. rewrite zlt_true. simpl. auto. - omega. omega. + lia. lia. Qed. Theorem perm_drop_3: @@ -2317,7 +2317,7 @@ Proof. unfold drop_perm in DROP. destruct (range_perm_dec m b lo hi Cur Freeable); inv DROP. unfold perm; simpl. rewrite PMap.gsspec. destruct (peq b' b). subst b'. unfold proj_sumbool. destruct (zle lo ofs). destruct (zlt ofs hi). - byContradiction. intuition omega. + byContradiction. intuition lia. auto. auto. auto. Qed. @@ -2343,7 +2343,7 @@ Proof. destruct (eq_block b' b). subst b'. destruct (zlt ofs0 lo). eapply perm_drop_3; eauto. destruct (zle hi ofs0). eapply perm_drop_3; eauto. - apply perm_implies with p. eapply perm_drop_1; eauto. omega. + apply perm_implies with p. eapply perm_drop_1; eauto. lia. generalize (size_chunk_pos chunk); intros. intuition. eapply perm_drop_3; eauto. Qed. @@ -2385,7 +2385,7 @@ Proof. destruct (eq_block b' b). subst b'. destruct (zlt ofs0 lo). eapply perm_drop_3; eauto. destruct (zle hi ofs0). eapply perm_drop_3; eauto. - apply perm_implies with p. eapply perm_drop_1; eauto. omega. intuition. + apply perm_implies with p. eapply perm_drop_1; eauto. lia. intuition. eapply perm_drop_3; eauto. rewrite pred_dec_false; eauto. red; intros; elim n0; red; intros. @@ -2443,8 +2443,8 @@ Lemma range_perm_inj: range_perm m2 b2 (lo + delta) (hi + delta) k p. Proof. intros; red; intros. - replace ofs with ((ofs - delta) + delta) by omega. - eapply perm_inj; eauto. apply H0. omega. + replace ofs with ((ofs - delta) + delta) by lia. + eapply perm_inj; eauto. apply H0. lia. Qed. Lemma valid_access_inj: @@ -2456,7 +2456,7 @@ Lemma valid_access_inj: Proof. intros. destruct H1 as [A B]. constructor. replace (ofs + delta + size_chunk chunk) - with ((ofs + size_chunk chunk) + delta) by omega. + with ((ofs + size_chunk chunk) + delta) by lia. eapply range_perm_inj; eauto. apply Z.divide_add_r; auto. eapply mi_align; eauto with mem. Qed. @@ -2478,9 +2478,9 @@ Proof. rewrite Nat2Z.inj_succ in H1. constructor. eapply mi_memval; eauto. - apply H1. omega. - replace (ofs + delta + 1) with ((ofs + 1) + delta) by omega. - apply IHn. red; intros; apply H1; omega. + apply H1. lia. + replace (ofs + delta + 1) with ((ofs + 1) + delta) by lia. + apply IHn. red; intros; apply H1; lia. Qed. Lemma load_inj: @@ -2511,11 +2511,11 @@ Proof. destruct (range_perm_dec m1 b1 ofs (ofs + len) Cur Readable); inv H0. exists (getN (Z.to_nat len) (ofs + delta) (m2.(mem_contents)#b2)). split. apply pred_dec_true. - replace (ofs + delta + len) with ((ofs + len) + delta) by omega. + replace (ofs + delta + len) with ((ofs + len) + delta) by lia. eapply range_perm_inj; eauto with mem. apply getN_inj; auto. - destruct (zle 0 len). rewrite Z2Nat.id by omega. auto. - rewrite Z_to_nat_neg by omega. simpl. red; intros; omegaContradiction. + destruct (zle 0 len). rewrite Z2Nat.id by lia. auto. + rewrite Z_to_nat_neg by lia. simpl. red; intros; extlia. Qed. (** Preservation of stores. *) @@ -2530,11 +2530,11 @@ Lemma setN_inj: Proof. induction 1; intros; simpl. auto. - replace (p + delta + 1) with ((p + 1) + delta) by omega. + replace (p + delta + 1) with ((p + 1) + delta) by lia. apply IHlist_forall2; auto. intros. rewrite ZMap.gsspec at 1. destruct (ZIndexed.eq q0 p). subst q0. rewrite ZMap.gss. auto. - rewrite ZMap.gso. auto. unfold ZIndexed.t in *. omega. + rewrite ZMap.gso. auto. unfold ZIndexed.t in *. lia. Qed. Definition meminj_no_overlap (f: meminj) (m: mem) : Prop := @@ -2589,8 +2589,8 @@ Proof. assert (b2 <> b2 \/ ofs0 + delta0 <> (r - delta) + delta). eapply H1; eauto. eauto 6 with mem. exploit store_valid_access_3. eexact H0. intros [A B]. - eapply perm_implies. apply perm_cur_max. apply A. omega. auto with mem. - destruct H8. congruence. omega. + eapply perm_implies. apply perm_cur_max. apply A. lia. auto with mem. + destruct H8. congruence. lia. (* block <> b1, block <> b2 *) eapply mi_memval; eauto. eauto with mem. Qed. @@ -2637,8 +2637,8 @@ Proof. rewrite setN_outside. auto. rewrite encode_val_length. rewrite <- size_chunk_conv. destruct (zlt (ofs0 + delta) ofs); auto. - destruct (zle (ofs + size_chunk chunk) (ofs0 + delta)). omega. - byContradiction. eapply H0; eauto. omega. + destruct (zle (ofs + size_chunk chunk) (ofs0 + delta)). lia. + byContradiction. eapply H0; eauto. lia. eauto with mem. Qed. @@ -2659,7 +2659,7 @@ Proof. with ((ofs + Z.of_nat (length bytes1)) + delta). eapply range_perm_inj; eauto with mem. eapply storebytes_range_perm; eauto. - rewrite (list_forall2_length H3). omega. + rewrite (list_forall2_length H3). lia. destruct (range_perm_storebytes _ _ _ _ H4) as [n2 STORE]. exists n2; split. eauto. constructor. @@ -2690,9 +2690,9 @@ Proof. eapply H1; eauto 6 with mem. exploit storebytes_range_perm. eexact H0. instantiate (1 := r - delta). - rewrite (list_forall2_length H3). omega. + rewrite (list_forall2_length H3). lia. eauto 6 with mem. - destruct H9. congruence. omega. + destruct H9. congruence. lia. (* block <> b1, block <> b2 *) eauto. Qed. @@ -2739,8 +2739,8 @@ Proof. rewrite PMap.gsspec. destruct (peq b2 b). subst b2. rewrite setN_outside. auto. destruct (zlt (ofs0 + delta) ofs); auto. - destruct (zle (ofs + Z.of_nat (length bytes2)) (ofs0 + delta)). omega. - byContradiction. eapply H0; eauto. omega. + destruct (zle (ofs + Z.of_nat (length bytes2)) (ofs0 + delta)). lia. + byContradiction. eapply H0; eauto. lia. eauto with mem. Qed. @@ -2837,10 +2837,10 @@ Proof. intros. destruct (eq_block b0 b1). subst b0. assert (delta0 = delta) by congruence. subst delta0. assert (lo <= ofs < hi). - { eapply perm_alloc_3; eauto. apply H6. generalize (size_chunk_pos chunk); omega. } + { eapply perm_alloc_3; eauto. apply H6. generalize (size_chunk_pos chunk); lia. } assert (lo <= ofs + size_chunk chunk - 1 < hi). - { eapply perm_alloc_3; eauto. apply H6. generalize (size_chunk_pos chunk); omega. } - apply H2. omega. + { eapply perm_alloc_3; eauto. apply H6. generalize (size_chunk_pos chunk); lia. } + apply H2. lia. eapply mi_align0 with (ofs := ofs) (p := p); eauto. red; intros. eapply perm_alloc_4; eauto. (* mem_contents *) @@ -2885,7 +2885,7 @@ Proof. intros. eapply perm_free_1; eauto. destruct (eq_block b2 b); auto. subst b. right. assert (~ (lo <= ofs + delta < hi)). red; intros; eapply H1; eauto. - omega. + lia. constructor. (* perm *) auto. @@ -2930,8 +2930,8 @@ Proof. intros. assert ({ m2' | drop_perm m2 b2 (lo + delta) (hi + delta) p = Some m2' }). apply range_perm_drop_2. red; intros. - replace ofs with ((ofs - delta) + delta) by omega. - eapply perm_inj; eauto. eapply range_perm_drop_1; eauto. omega. + replace ofs with ((ofs - delta) + delta) by lia. + eapply perm_inj; eauto. eapply range_perm_drop_1; eauto. lia. destruct X as [m2' DROP]. exists m2'; split; auto. inv H. constructor. @@ -2945,9 +2945,9 @@ Proof. destruct (zlt (ofs + delta0) (lo + delta0)). eapply perm_drop_3; eauto. destruct (zle (hi + delta0) (ofs + delta0)). eapply perm_drop_3; eauto. assert (perm_order p p0). - eapply perm_drop_2. eexact H0. instantiate (1 := ofs). omega. eauto. + eapply perm_drop_2. eexact H0. instantiate (1 := ofs). lia. eauto. apply perm_implies with p; auto. - eapply perm_drop_1. eauto. omega. + eapply perm_drop_1. eauto. lia. (* b1 <> b0 *) eapply perm_drop_3; eauto. destruct (eq_block b3 b2); auto. @@ -2956,7 +2956,7 @@ Proof. exploit H1; eauto. instantiate (1 := ofs + delta0 - delta). apply perm_cur_max. apply perm_implies with Freeable. - eapply range_perm_drop_1; eauto. omega. auto with mem. + eapply range_perm_drop_1; eauto. lia. auto with mem. eapply perm_drop_4; eauto. eapply perm_max. apply perm_implies with p0. eauto. eauto with mem. intuition. @@ -2987,7 +2987,7 @@ Proof. destruct (eq_block b2 b); auto. subst b2. right. destruct (zlt (ofs + delta) lo); auto. destruct (zle hi (ofs + delta)); auto. - byContradiction. exploit H1; eauto. omega. + byContradiction. exploit H1; eauto. lia. (* align *) eapply mi_align0; eauto. (* contents *) @@ -3020,9 +3020,9 @@ Theorem extends_refl: forall m, extends m m. Proof. intros. constructor. auto. constructor. - intros. unfold inject_id in H; inv H. replace (ofs + 0) with ofs by omega. auto. + intros. unfold inject_id in H; inv H. replace (ofs + 0) with ofs by lia. auto. intros. unfold inject_id in H; inv H. apply Z.divide_0_r. - intros. unfold inject_id in H; inv H. replace (ofs + 0) with ofs by omega. + intros. unfold inject_id in H; inv H. replace (ofs + 0) with ofs by lia. apply memval_lessdef_refl. tauto. Qed. @@ -3035,7 +3035,7 @@ Theorem load_extends: Proof. intros. inv H. exploit load_inj; eauto. unfold inject_id; reflexivity. intros [v2 [A B]]. exists v2; split. - replace (ofs + 0) with ofs in A by omega. auto. + replace (ofs + 0) with ofs in A by lia. auto. rewrite val_inject_id in B. auto. Qed. @@ -3059,7 +3059,7 @@ Theorem loadbytes_extends: /\ list_forall2 memval_lessdef bytes1 bytes2. Proof. intros. inv H. - replace ofs with (ofs + 0) by omega. eapply loadbytes_inj; eauto. + replace ofs with (ofs + 0) by lia. eapply loadbytes_inj; eauto. Qed. Theorem store_within_extends: @@ -3078,7 +3078,7 @@ Proof. rewrite val_inject_id. eauto. intros [m2' [A B]]. exists m2'; split. - replace (ofs + 0) with ofs in A by omega. auto. + replace (ofs + 0) with ofs in A by lia. auto. constructor; auto. rewrite (nextblock_store _ _ _ _ _ _ H0). rewrite (nextblock_store _ _ _ _ _ _ A). @@ -3096,7 +3096,7 @@ Proof. intros. inversion H. constructor. rewrite (nextblock_store _ _ _ _ _ _ H0). auto. eapply store_outside_inj; eauto. - unfold inject_id; intros. inv H2. eapply H1; eauto. omega. + unfold inject_id; intros. inv H2. eapply H1; eauto. lia. intros. eauto using perm_store_2. Qed. @@ -3130,7 +3130,7 @@ Proof. unfold inject_id; reflexivity. intros [m2' [A B]]. exists m2'; split. - replace (ofs + 0) with ofs in A by omega. auto. + replace (ofs + 0) with ofs in A by lia. auto. constructor; auto. rewrite (nextblock_storebytes _ _ _ _ _ H0). rewrite (nextblock_storebytes _ _ _ _ _ A). @@ -3148,7 +3148,7 @@ Proof. intros. inversion H. constructor. rewrite (nextblock_storebytes _ _ _ _ _ H0). auto. eapply storebytes_outside_inj; eauto. - unfold inject_id; intros. inv H2. eapply H1; eauto. omega. + unfold inject_id; intros. inv H2. eapply H1; eauto. lia. intros. eauto using perm_storebytes_2. Qed. @@ -3180,12 +3180,12 @@ Proof. intros. eapply perm_implies with Freeable; auto with mem. eapply perm_alloc_2; eauto. - omega. + lia. intros. eapply perm_alloc_inv in H; eauto. generalize (perm_alloc_inv _ _ _ _ _ H0 b0 ofs Max Nonempty); intros PERM. destruct (eq_block b0 b). subst b0. - assert (EITHER: lo1 <= ofs < hi1 \/ ~(lo1 <= ofs < hi1)) by omega. + assert (EITHER: lo1 <= ofs < hi1 \/ ~(lo1 <= ofs < hi1)) by lia. destruct EITHER. left. apply perm_implies with Freeable; auto with mem. eapply perm_alloc_2; eauto. right; tauto. @@ -3217,7 +3217,7 @@ Proof. intros. inv H. constructor. rewrite (nextblock_free _ _ _ _ _ H0). auto. eapply free_right_inj; eauto. - unfold inject_id; intros. inv H. eapply H1; eauto. omega. + unfold inject_id; intros. inv H. eapply H1; eauto. lia. intros. eauto using perm_free_3. Qed. @@ -3232,7 +3232,7 @@ Proof. intros. inversion H. assert ({ m2': mem | free m2 b lo hi = Some m2' }). apply range_perm_free. red; intros. - replace ofs with (ofs + 0) by omega. + replace ofs with (ofs + 0) by lia. eapply perm_inj with (b1 := b); eauto. eapply free_range_perm; eauto. destruct X as [m2' FREE]. exists m2'; split; auto. @@ -3242,7 +3242,7 @@ Proof. eapply free_right_inj with (m1 := m1'); eauto. eapply free_left_inj; eauto. unfold inject_id; intros. inv H1. - eapply perm_free_2. eexact H0. instantiate (1 := ofs); omega. eauto. + eapply perm_free_2. eexact H0. instantiate (1 := ofs); lia. eauto. intros. exploit mext_perm_inv0; eauto using perm_free_3. intros [A|A]. eapply perm_free_inv in A; eauto. destruct A as [[A B]|A]; auto. subst b0. right; eapply perm_free_2; eauto. @@ -3261,7 +3261,7 @@ Theorem perm_extends: forall m1 m2 b ofs k p, extends m1 m2 -> perm m1 b ofs k p -> perm m2 b ofs k p. Proof. - intros. inv H. replace ofs with (ofs + 0) by omega. + intros. inv H. replace ofs with (ofs + 0) by lia. eapply perm_inj; eauto. Qed. @@ -3276,7 +3276,7 @@ Theorem valid_access_extends: forall m1 m2 chunk b ofs p, extends m1 m2 -> valid_access m1 chunk b ofs p -> valid_access m2 chunk b ofs p. Proof. - intros. inv H. replace ofs with (ofs + 0) by omega. + intros. inv H. replace ofs with (ofs + 0) by lia. eapply valid_access_inj; eauto. auto. Qed. @@ -3421,7 +3421,7 @@ Theorem weak_valid_pointer_inject: weak_valid_pointer m2 b2 (ofs + delta) = true. Proof. intros until 2. unfold weak_valid_pointer. rewrite !orb_true_iff. - replace (ofs + delta - 1) with ((ofs - 1) + delta) by omega. + replace (ofs + delta - 1) with ((ofs - 1) + delta) by lia. intros []; eauto using valid_pointer_inject. Qed. @@ -3439,8 +3439,8 @@ Proof. assert (perm m1 b1 (Ptrofs.unsigned ofs1) Max Nonempty) by eauto with mem. exploit mi_representable; eauto. intros [A B]. assert (0 <= delta <= Ptrofs.max_unsigned). - generalize (Ptrofs.unsigned_range ofs1). omega. - unfold Ptrofs.add. repeat rewrite Ptrofs.unsigned_repr; omega. + generalize (Ptrofs.unsigned_range ofs1). lia. + unfold Ptrofs.add. repeat rewrite Ptrofs.unsigned_repr; lia. Qed. Lemma address_inject': @@ -3451,7 +3451,7 @@ Lemma address_inject': Ptrofs.unsigned (Ptrofs.add ofs1 (Ptrofs.repr delta)) = Ptrofs.unsigned ofs1 + delta. Proof. intros. destruct H0. eapply address_inject; eauto. - apply H0. generalize (size_chunk_pos chunk). omega. + apply H0. generalize (size_chunk_pos chunk). lia. Qed. Theorem weak_valid_pointer_inject_no_overflow: @@ -3466,7 +3466,7 @@ Proof. exploit mi_representable; eauto. destruct H0; eauto with mem. intros [A B]. pose proof (Ptrofs.unsigned_range ofs). - rewrite Ptrofs.unsigned_repr; omega. + rewrite Ptrofs.unsigned_repr; lia. Qed. Theorem valid_pointer_inject_no_overflow: @@ -3506,7 +3506,7 @@ Proof. exploit mi_representable; eauto. destruct H0; eauto with mem. intros [A B]. pose proof (Ptrofs.unsigned_range ofs). - unfold Ptrofs.add. repeat rewrite Ptrofs.unsigned_repr; auto; omega. + unfold Ptrofs.add. repeat rewrite Ptrofs.unsigned_repr; auto; lia. Qed. Theorem inject_no_overlap: @@ -3541,8 +3541,8 @@ Proof. rewrite (address_inject' _ _ _ _ _ _ _ _ H H2 H4). inv H1. simpl in H5. inv H2. simpl in H1. eapply mi_no_overlap; eauto. - apply perm_cur_max. apply (H5 (Ptrofs.unsigned ofs1)). omega. - apply perm_cur_max. apply (H1 (Ptrofs.unsigned ofs2)). omega. + apply perm_cur_max. apply (H5 (Ptrofs.unsigned ofs1)). lia. + apply perm_cur_max. apply (H1 (Ptrofs.unsigned ofs2)). lia. Qed. Theorem disjoint_or_equal_inject: @@ -3561,16 +3561,16 @@ Proof. intros. destruct (eq_block b1 b2). assert (b1' = b2') by congruence. assert (delta1 = delta2) by congruence. subst. - destruct H5. congruence. right. destruct H5. left; congruence. right. omega. + destruct H5. congruence. right. destruct H5. left; congruence. right. lia. destruct (eq_block b1' b2'); auto. subst. right. right. set (i1 := (ofs1 + delta1, ofs1 + delta1 + sz)). set (i2 := (ofs2 + delta2, ofs2 + delta2 + sz)). change (snd i1 <= fst i2 \/ snd i2 <= fst i1). - apply Intv.range_disjoint'; simpl; try omega. + apply Intv.range_disjoint'; simpl; try lia. unfold Intv.disjoint, Intv.In; simpl; intros. red; intros. exploit mi_no_overlap; eauto. - instantiate (1 := x - delta1). apply H2. omega. - instantiate (1 := x - delta2). apply H3. omega. + instantiate (1 := x - delta1). apply H2. lia. + instantiate (1 := x - delta2). apply H3. lia. intuition. Qed. @@ -3585,9 +3585,9 @@ Theorem aligned_area_inject: (al | ofs + delta). Proof. intros. - assert (P: al > 0) by omega. - assert (Q: Z.abs al <= Z.abs sz). apply Zdivide_bounds; auto. omega. - rewrite Z.abs_eq in Q; try omega. rewrite Z.abs_eq in Q; try omega. + assert (P: al > 0) by lia. + assert (Q: Z.abs al <= Z.abs sz). apply Zdivide_bounds; auto. lia. + rewrite Z.abs_eq in Q; try lia. rewrite Z.abs_eq in Q; try lia. assert (R: exists chunk, al = align_chunk chunk /\ al = size_chunk chunk). destruct H0. subst; exists Mint8unsigned; auto. destruct H0. subst; exists Mint16unsigned; auto. @@ -3595,7 +3595,7 @@ Proof. subst; exists Mint64; auto. destruct R as [chunk [A B]]. assert (valid_access m chunk b ofs Nonempty). - split. red; intros; apply H3. omega. congruence. + split. red; intros; apply H3. lia. congruence. exploit valid_access_inject; eauto. intros [C D]. congruence. Qed. @@ -3952,7 +3952,7 @@ Proof. unfold f'; intros. destruct (eq_block b0 b1). inversion H8. subst b0 b3 delta0. elim (fresh_block_alloc _ _ _ _ _ H0). - eapply perm_valid_block with (ofs := ofs). apply H9. generalize (size_chunk_pos chunk); omega. + eapply perm_valid_block with (ofs := ofs). apply H9. generalize (size_chunk_pos chunk); lia. eauto. unfold f'; intros. destruct (eq_block b0 b1). inversion H8. subst b0 b3 delta0. @@ -3975,10 +3975,10 @@ Proof. congruence. inversion H10; subst b0 b1' delta1. destruct (eq_block b2 b2'); auto. subst b2'. right; red; intros. - eapply H6; eauto. omega. + eapply H6; eauto. lia. inversion H11; subst b3 b2' delta2. destruct (eq_block b1' b2); auto. subst b1'. right; red; intros. - eapply H6; eauto. omega. + eapply H6; eauto. lia. eauto. (* representable *) unfold f'; intros. @@ -3986,16 +3986,16 @@ Proof. subst. injection H9; intros; subst b' delta0. destruct H10. exploit perm_alloc_inv; eauto; rewrite dec_eq_true; intro. exploit H3. apply H4 with (k := Max) (p := Nonempty); eauto. - generalize (Ptrofs.unsigned_range_2 ofs). omega. + generalize (Ptrofs.unsigned_range_2 ofs). lia. exploit perm_alloc_inv; eauto; rewrite dec_eq_true; intro. exploit H3. apply H4 with (k := Max) (p := Nonempty); eauto. - generalize (Ptrofs.unsigned_range_2 ofs). omega. + generalize (Ptrofs.unsigned_range_2 ofs). lia. eapply mi_representable0; try eassumption. destruct H10; eauto using perm_alloc_4. (* perm inv *) intros. unfold f' in H9; destruct (eq_block b0 b1). inversion H9; clear H9; subst b0 b3 delta0. - assert (EITHER: lo <= ofs < hi \/ ~(lo <= ofs < hi)) by omega. + assert (EITHER: lo <= ofs < hi \/ ~(lo <= ofs < hi)) by lia. destruct EITHER. left. apply perm_implies with Freeable; auto with mem. eapply perm_alloc_2; eauto. right; intros A. eapply perm_alloc_inv in A; eauto. rewrite dec_eq_true in A. tauto. @@ -4026,10 +4026,10 @@ Proof. eapply alloc_right_inject; eauto. eauto. instantiate (1 := b2). eauto with mem. - instantiate (1 := 0). unfold Ptrofs.max_unsigned. generalize Ptrofs.modulus_pos; omega. + instantiate (1 := 0). unfold Ptrofs.max_unsigned. generalize Ptrofs.modulus_pos; lia. auto. intros. apply perm_implies with Freeable; auto with mem. - eapply perm_alloc_2; eauto. omega. + eapply perm_alloc_2; eauto. lia. red; intros. apply Z.divide_0_r. intros. apply (valid_not_valid_diff m2 b2 b2); eauto with mem. intros [f' [A [B [C D]]]]. @@ -4152,13 +4152,13 @@ Proof. simpl; rewrite H0; auto. intros. destruct (eq_block b1 b). subst b1. rewrite H1 in H2; inv H2. - exists lo, hi; split; auto with coqlib. omega. + exists lo, hi; split; auto with coqlib. lia. exploit mi_no_overlap. eexact H. eexact n. eauto. eauto. eapply perm_max. eapply perm_implies. eauto. auto with mem. instantiate (1 := ofs + delta0 - delta). apply perm_cur_max. apply perm_implies with Freeable; auto with mem. - eapply free_range_perm; eauto. omega. - intros [A|A]. congruence. omega. + eapply free_range_perm; eauto. lia. + intros [A|A]. congruence. lia. Qed. Lemma drop_outside_inject: forall f m1 m2 b lo hi p m2', @@ -4185,7 +4185,7 @@ Proof. (* perm *) destruct (f b1) as [[b' delta'] |] eqn:?; try discriminate. destruct (f' b') as [[b'' delta''] |] eqn:?; inv H. - replace (ofs + (delta' + delta'')) with ((ofs + delta') + delta'') by omega. + replace (ofs + (delta' + delta'')) with ((ofs + delta') + delta'') by lia. eauto. (* align *) destruct (f b1) as [[b' delta'] |] eqn:?; try discriminate. @@ -4193,12 +4193,12 @@ Proof. apply Z.divide_add_r. eapply mi_align0; eauto. eapply mi_align1 with (ofs := ofs + delta') (p := p); eauto. - red; intros. replace ofs0 with ((ofs0 - delta') + delta') by omega. - eapply mi_perm0; eauto. apply H0. omega. + red; intros. replace ofs0 with ((ofs0 - delta') + delta') by lia. + eapply mi_perm0; eauto. apply H0. lia. (* memval *) destruct (f b1) as [[b' delta'] |] eqn:?; try discriminate. destruct (f' b') as [[b'' delta''] |] eqn:?; inv H. - replace (ofs + (delta' + delta'')) with ((ofs + delta') + delta'') by omega. + replace (ofs + (delta' + delta'')) with ((ofs + delta') + delta'') by lia. eapply memval_inject_compose; eauto. Qed. @@ -4227,11 +4227,11 @@ Proof. exploit mi_no_overlap0; eauto. intros A. destruct (eq_block b1x b2x). subst b1x. destruct A. congruence. - assert (delta1y = delta2y) by congruence. right; omega. + assert (delta1y = delta2y) by congruence. right; lia. exploit mi_no_overlap1. eauto. eauto. eauto. eapply perm_inj. eauto. eexact H2. eauto. eapply perm_inj. eauto. eexact H3. eauto. - intuition omega. + intuition lia. (* representable *) intros. destruct (f b) as [[b1 delta1] |] eqn:?; try discriminate. @@ -4243,15 +4243,15 @@ Proof. exploit mi_representable1. eauto. instantiate (1 := ofs'). rewrite H. replace (Ptrofs.unsigned ofs + delta1 - 1) with - ((Ptrofs.unsigned ofs - 1) + delta1) by omega. + ((Ptrofs.unsigned ofs - 1) + delta1) by lia. destruct H0; eauto using perm_inj. - rewrite H. omega. + rewrite H. lia. (* perm inv *) intros. destruct (f b1) as [[b' delta'] |] eqn:?; try discriminate. destruct (f' b') as [[b'' delta''] |] eqn:?; try discriminate. inversion H; clear H; subst b'' delta. - replace (ofs + (delta' + delta'')) with ((ofs + delta') + delta'') in H0 by omega. + replace (ofs + (delta' + delta'')) with ((ofs + delta') + delta'') in H0 by lia. exploit mi_perm_inv1; eauto. intros [A|A]. eapply mi_perm_inv0; eauto. right; red; intros. elim A. eapply perm_inj; eauto. @@ -4303,7 +4303,7 @@ Proof. (* inj *) replace f with (compose_meminj f inject_id). eapply mem_inj_compose; eauto. apply extensionality; intros. unfold compose_meminj, inject_id. - destruct (f x) as [[y delta] | ]; auto. decEq. decEq. omega. + destruct (f x) as [[y delta] | ]; auto. decEq. decEq. lia. (* unmapped *) eauto. (* mapped *) @@ -4368,7 +4368,7 @@ Proof. apply flat_inj_no_overlap. (* range *) unfold flat_inj; intros. - destruct (plt b (nextblock m)); inv H0. generalize (Ptrofs.unsigned_range_2 ofs); omega. + destruct (plt b (nextblock m)); inv H0. generalize (Ptrofs.unsigned_range_2 ofs); lia. (* perm inv *) unfold flat_inj; intros. destruct (plt b1 (nextblock m)); inv H0. @@ -4381,7 +4381,7 @@ Proof. intros; red; constructor. (* perm *) unfold flat_inj; intros. destruct (plt b1 thr); inv H. - replace (ofs + 0) with ofs by omega; auto. + replace (ofs + 0) with ofs by lia; auto. (* align *) unfold flat_inj; intros. destruct (plt b1 thr); inv H. apply Z.divide_0_r. (* mem_contents *) @@ -4401,7 +4401,7 @@ Proof. red. intros. apply Z.divide_0_r. intros. apply perm_implies with Freeable; auto with mem. - eapply perm_alloc_2; eauto. omega. + eapply perm_alloc_2; eauto. lia. unfold flat_inj. apply pred_dec_true. rewrite (alloc_result _ _ _ _ _ H). auto. Qed. @@ -4417,7 +4417,7 @@ Proof. intros; red. exploit store_mapped_inj. eauto. eauto. apply flat_inj_no_overlap. unfold flat_inj. apply pred_dec_true; auto. eauto. - replace (ofs + 0) with ofs by omega. + replace (ofs + 0) with ofs by lia. intros [m'' [A B]]. congruence. Qed. @@ -4464,7 +4464,7 @@ Lemma valid_block_unchanged_on: forall m m' b, unchanged_on m m' -> valid_block m b -> valid_block m' b. Proof. - unfold valid_block; intros. apply unchanged_on_nextblock in H. xomega. + unfold valid_block; intros. apply unchanged_on_nextblock in H. extlia. Qed. Lemma perm_unchanged_on: @@ -4507,7 +4507,7 @@ Proof. + unfold loadbytes. destruct H. destruct (range_perm_dec m b ofs (ofs + n) Cur Readable). rewrite pred_dec_true. f_equal. - apply getN_exten. intros. rewrite Z2Nat.id in H by omega. + apply getN_exten. intros. rewrite Z2Nat.id in H by lia. apply unchanged_on_contents0; auto. red; intros. apply unchanged_on_perm0; auto. rewrite pred_dec_false. auto. @@ -4525,7 +4525,7 @@ Proof. destruct (zle n 0). + erewrite loadbytes_empty in * by assumption. auto. + rewrite <- H1. apply loadbytes_unchanged_on_1; auto. - exploit loadbytes_range_perm; eauto. instantiate (1 := ofs). omega. + exploit loadbytes_range_perm; eauto. instantiate (1 := ofs). lia. intros. eauto with mem. Qed. @@ -4568,7 +4568,7 @@ Proof. rewrite encode_val_length. rewrite <- size_chunk_conv. destruct (zlt ofs0 ofs); auto. destruct (zlt ofs0 (ofs + size_chunk chunk)); auto. - elim (H0 ofs0). omega. auto. + elim (H0 ofs0). lia. auto. Qed. Lemma storebytes_unchanged_on: @@ -4584,7 +4584,7 @@ Proof. destruct (peq b0 b); auto. subst b0. apply setN_outside. destruct (zlt ofs0 ofs); auto. destruct (zlt ofs0 (ofs + Z.of_nat (length bytes))); auto. - elim (H0 ofs0). omega. auto. + elim (H0 ofs0). lia. auto. Qed. Lemma alloc_unchanged_on: @@ -4613,7 +4613,7 @@ Proof. - split; intros. eapply perm_free_1; eauto. destruct (eq_block b0 b); auto. destruct (zlt ofs lo); auto. destruct (zle hi ofs); auto. - subst b0. elim (H0 ofs). omega. auto. + subst b0. elim (H0 ofs). lia. auto. eapply perm_free_3; eauto. - unfold free in H. destruct (range_perm_dec m b lo hi Cur Freeable); inv H. simpl. auto. @@ -4631,7 +4631,7 @@ Proof. destruct (eq_block b0 b); auto. subst b0. assert (~ (lo <= ofs < hi)). { red; intros; eelim H0; eauto. } - right; omega. + right; lia. eapply perm_drop_4; eauto. - unfold drop_perm in H. destruct (range_perm_dec m b lo hi Cur Freeable); inv H; simpl. auto. @@ -4658,7 +4658,7 @@ Notation mem := Mem.mem. Global Opaque Mem.alloc Mem.free Mem.store Mem.load Mem.storebytes Mem.loadbytes. -Hint Resolve +Global Hint Resolve Mem.valid_not_valid_diff Mem.perm_implies Mem.perm_cur diff --git a/common/Memtype.v b/common/Memtype.v index ca9c6f1f..1d6f252b 100644 --- a/common/Memtype.v +++ b/common/Memtype.v @@ -60,7 +60,7 @@ Inductive perm_order: permission -> permission -> Prop := | perm_W_R: perm_order Writable Readable | perm_any_N: forall p, perm_order p Nonempty. -Hint Constructors perm_order: mem. +Global Hint Constructors perm_order: mem. Lemma perm_order_trans: forall p1 p2 p3, perm_order p1 p2 -> perm_order p2 p3 -> perm_order p1 p3. diff --git a/common/Sections.ml b/common/Sections.ml index ea0b6dbc..a1256600 100644 --- a/common/Sections.ml +++ b/common/Sections.ml @@ -15,13 +15,17 @@ (* Handling of linker sections *) +type initialized = + | Uninit (* uninitialized data area *) + | Init (* initialized with fixed, non-relocatable data *) + | Init_reloc (* initialized with relocatable data (symbol addresses) *) + type section_name = | Section_text - | Section_data of bool (* true = init data, false = uninit data *) - * bool (* thread local? *) - | Section_small_data of bool - | Section_const of bool - | Section_small_const of bool + | Section_data of initialized * bool (* true = thread local ? *) + | Section_small_data of initialized + | Section_const of initialized + | Section_small_const of initialized | Section_string | Section_literal | Section_jumptable @@ -41,6 +45,7 @@ type access_mode = type section_info = { sec_name_init: section_name; + sec_name_init_reloc: section_name; sec_name_uninit: section_name; sec_writable: bool; sec_executable: bool; @@ -48,8 +53,9 @@ type section_info = { } let default_section_info = { - sec_name_init = Section_data (true, false); - sec_name_uninit = Section_data (false, false); + sec_name_init = Section_data (Init, false); + sec_name_init_reloc = Section_data (Init_reloc, false); + sec_name_uninit = Section_data (Uninit, false); sec_writable = true; sec_executable = false; sec_access = Access_default @@ -60,46 +66,55 @@ let default_section_info = { let builtin_sections = [ "CODE", {sec_name_init = Section_text; + sec_name_init_reloc = Section_text; sec_name_uninit = Section_text; sec_writable = false; sec_executable = true; sec_access = Access_default}; "DATA", - {sec_name_init = Section_data (true, false); - sec_name_uninit = Section_data (false, false); + {sec_name_init = Section_data (Init, false); + sec_name_init_reloc = Section_data (Init_reloc, false); + sec_name_uninit = Section_data (Uninit, false); sec_writable = true; sec_executable = false; sec_access = Access_default}; "TDATA", - {sec_name_init = Section_data (true, true); - sec_name_uninit = Section_data (false, true); + {sec_name_init = Section_data (Init, true); + sec_name_init_reloc = Section_data (Init_reloc, true); + sec_name_uninit = Section_data (Uninit, true); sec_writable = true; sec_executable = false; sec_access = Access_default}; "SDATA", - {sec_name_init = Section_small_data true; - sec_name_uninit = Section_small_data false; + {sec_name_init = Section_small_data Init; + sec_name_init_reloc = Section_small_data Init_reloc; + sec_name_uninit = Section_small_data Uninit; sec_writable = true; sec_executable = false; sec_access = Access_near}; "CONST", - {sec_name_init = Section_const true; - sec_name_uninit = Section_const false; + {sec_name_init = Section_const Init; + sec_name_init_reloc = Section_const Init_reloc; + sec_name_uninit = Section_const Uninit; sec_writable = false; sec_executable = false; sec_access = Access_default}; "SCONST", - {sec_name_init = Section_small_const true; - sec_name_uninit = Section_small_const false; + {sec_name_init = Section_small_const Init; + sec_name_init_reloc = Section_small_const Init_reloc; + sec_name_uninit = Section_small_const Uninit; sec_writable = false; sec_executable = false; sec_access = Access_near}; "STRING", {sec_name_init = Section_string; + sec_name_init_reloc = Section_string; sec_name_uninit = Section_string; sec_writable = false; sec_executable = false; sec_access = Access_default}; "LITERAL", {sec_name_init = Section_literal; + sec_name_init_reloc = Section_literal; sec_name_uninit = Section_literal; sec_writable = false; sec_executable = false; sec_access = Access_default}; "JUMPTABLE", {sec_name_init = Section_jumptable; + sec_name_init_reloc = Section_jumptable; sec_name_uninit = Section_jumptable; sec_writable = false; sec_executable = false; sec_access = Access_default} @@ -134,15 +149,19 @@ let define_section name ?iname ?uname ?writable ?executable ?access () = match executable with Some b -> b | None -> si.sec_executable and access = match access with Some b -> b | None -> si.sec_access in - let iname = + let i = match iname with Some s -> Section_user(s, writable, executable) | None -> si.sec_name_init in - let uname = + let ir = + match iname with Some s -> Section_user(s, writable, executable) + | None -> si.sec_name_init_reloc in + let u = match uname with Some s -> Section_user(s, writable, executable) | None -> si.sec_name_uninit in let new_si = - { sec_name_init = iname; - sec_name_uninit = uname; + { sec_name_init = i; + sec_name_init_reloc = ir; + sec_name_uninit = u; sec_writable = writable; sec_executable = executable; sec_access = access } in @@ -162,7 +181,7 @@ let use_section_for id name = let gcc_section name readonly exec = let sn = Section_user(name, not readonly, exec) in - { sec_name_init = sn; sec_name_uninit = sn; + { sec_name_init = sn; sec_name_init_reloc = sn; sec_name_uninit = sn; sec_writable = not readonly; sec_executable = exec; sec_access = Access_default } @@ -206,7 +225,12 @@ let for_variable env loc id ty init thrl = Hashtbl.find current_section_table name with Not_found -> assert false in - ((if init then si.sec_name_init else si.sec_name_uninit), si.sec_access) + let secname = + match init with + | Uninit -> si.sec_name_uninit + | Init -> si.sec_name_init + | Init_reloc -> si.sec_name_init_reloc in + (secname, si.sec_access) (* Determine sections for a function definition *) diff --git a/common/Sections.mli b/common/Sections.mli index 00c06c20..1471a240 100644 --- a/common/Sections.mli +++ b/common/Sections.mli @@ -16,13 +16,17 @@ (* Handling of linker sections *) +type initialized = + | Uninit (* uninitialized data area *) + | Init (* initialized with fixed, non-relocatable data *) + | Init_reloc (* initialized with relocatable data (symbol addresses) *) + type section_name = | Section_text - | Section_data of bool (* true = init data, false = uninit data *) - * bool (* thread local? *) - | Section_small_data of bool - | Section_const of bool - | Section_small_const of bool + | Section_data of initialized * bool (* true = thread local? *) + | Section_small_data of initialized + | Section_const of initialized + | Section_small_const of initialized | Section_string | Section_literal | Section_jumptable @@ -47,7 +51,7 @@ val define_section: -> ?writable:bool -> ?executable:bool -> ?access:access_mode -> unit -> unit val use_section_for: AST.ident -> string -> bool -val for_variable: Env.t -> C.location -> AST.ident -> C.typ -> bool -> bool -> +val for_variable: Env.t -> C.location -> AST.ident -> C.typ -> initialized -> bool -> section_name * access_mode val for_function: Env.t -> C.location -> AST.ident -> C.attributes -> section_name list val for_stringlit: unit -> section_name diff --git a/common/Separation.v b/common/Separation.v index 27065d1f..bf134a18 100644 --- a/common/Separation.v +++ b/common/Separation.v @@ -113,7 +113,7 @@ Proof. intros P Q [[A B] [C D]]. split; auto. Qed. -Hint Resolve massert_imp_refl massert_eqv_refl : core. +Global Hint Resolve massert_imp_refl massert_eqv_refl : core. (** * Separating conjunction *) @@ -355,12 +355,12 @@ Proof. intros. rewrite <- sep_assoc. eapply sep_imp; eauto. split; simpl; intros. - intuition auto. -+ omega. -+ apply H5; omega. -+ omega. -+ apply H5; omega. -+ red; simpl; intros; omega. -- intuition omega. ++ lia. ++ apply H5; lia. ++ lia. ++ apply H5; lia. ++ red; simpl; intros; lia. +- intuition lia. Qed. Lemma range_drop_left: @@ -392,12 +392,12 @@ Proof. assert (mid <= align mid al) by (apply align_le; auto). split; simpl; intros. - intuition auto. -+ omega. -+ apply H7; omega. -+ omega. -+ apply H7; omega. -+ red; simpl; intros; omega. -- intuition omega. ++ lia. ++ apply H7; lia. ++ lia. ++ apply H7; lia. ++ red; simpl; intros; lia. +- intuition lia. Qed. Lemma range_preserved: @@ -493,7 +493,7 @@ Proof. split; [|split]. - assert (Mem.valid_access m chunk b ofs Freeable). { split; auto. red; auto. } - split. generalize (size_chunk_pos chunk). unfold Ptrofs.max_unsigned. omega. + split. generalize (size_chunk_pos chunk). unfold Ptrofs.max_unsigned. lia. split. auto. + destruct (Mem.valid_access_load m chunk b ofs) as [v LOAD]. eauto with mem. @@ -616,7 +616,7 @@ Next Obligation. assert (IMG: forall b1 b2 delta ofs k p, j b1 = Some (b2, delta) -> Mem.perm m0 b1 ofs k p -> img b2 (ofs + delta)). { intros. red. exists b1, delta; split; auto. - replace (ofs + delta - delta) with ofs by omega. + replace (ofs + delta - delta) with ofs by lia. eauto with mem. } destruct H. constructor. - destruct mi_inj. constructor; intros. @@ -668,7 +668,7 @@ Proof. intros; red; intros. eelim C; eauto. simpl. exists b1, delta; split; auto. destruct VALID as [V1 V2]. apply Mem.perm_cur_max. apply Mem.perm_implies with Writable; auto with mem. - apply V1. omega. + apply V1. lia. - red; simpl; intros. destruct H1 as (b0 & delta0 & U & V). eelim C; eauto. simpl. exists b0, delta0; eauto with mem. Qed. @@ -690,7 +690,7 @@ Lemma alloc_parallel_rule: /\ (forall b, b <> b1 -> j' b = j b). Proof. intros until delta; intros SEP ALLOC1 ALLOC2 ALIGN LO HI RANGE1 RANGE2 RANGE3. - assert (RANGE4: lo <= hi) by xomega. + assert (RANGE4: lo <= hi) by extlia. assert (FRESH1: ~Mem.valid_block m1 b1) by (eapply Mem.fresh_block_alloc; eauto). assert (FRESH2: ~Mem.valid_block m2 b2) by (eapply Mem.fresh_block_alloc; eauto). destruct SEP as (INJ & SP & DISJ). simpl in INJ. @@ -698,10 +698,10 @@ Proof. - eapply Mem.alloc_right_inject; eauto. - eexact ALLOC1. - instantiate (1 := b2). eauto with mem. -- instantiate (1 := delta). xomega. -- intros. assert (0 <= ofs < sz2) by (eapply Mem.perm_alloc_3; eauto). omega. +- instantiate (1 := delta). extlia. +- intros. assert (0 <= ofs < sz2) by (eapply Mem.perm_alloc_3; eauto). lia. - intros. apply Mem.perm_implies with Freeable; auto with mem. - eapply Mem.perm_alloc_2; eauto. xomega. + eapply Mem.perm_alloc_2; eauto. extlia. - red; intros. apply Z.divide_trans with 8; auto. exists (8 / align_chunk chunk). destruct chunk; reflexivity. - intros. elim FRESH2. eapply Mem.valid_block_inject_2; eauto. @@ -709,19 +709,19 @@ Proof. exists j'; split; auto. rewrite <- ! sep_assoc. split; [|split]. -+ simpl. intuition auto; try (unfold Ptrofs.max_unsigned in *; omega). ++ simpl. intuition auto; try (unfold Ptrofs.max_unsigned in *; lia). * apply Mem.perm_implies with Freeable; auto with mem. - eapply Mem.perm_alloc_2; eauto. omega. + eapply Mem.perm_alloc_2; eauto. lia. * apply Mem.perm_implies with Freeable; auto with mem. - eapply Mem.perm_alloc_2; eauto. omega. -* red; simpl; intros. destruct H1, H2. omega. + eapply Mem.perm_alloc_2; eauto. lia. +* red; simpl; intros. destruct H1, H2. lia. * red; simpl; intros. assert (b = b2) by tauto. subst b. assert (0 <= ofs < lo \/ hi <= ofs < sz2) by tauto. clear H1. destruct H2 as (b0 & delta0 & D & E). eapply Mem.perm_alloc_inv in E; eauto. destruct (eq_block b0 b1). - subst b0. rewrite J2 in D. inversion D; clear D; subst delta0. xomega. + subst b0. rewrite J2 in D. inversion D; clear D; subst delta0. extlia. rewrite J3 in D by auto. elim FRESH2. eapply Mem.valid_block_inject_2; eauto. + apply (m_invar P) with m2; auto. eapply Mem.alloc_unchanged_on; eauto. + red; simpl; intros. @@ -753,11 +753,11 @@ Proof. simpl in E. assert (PERM: Mem.range_perm m2 b2 0 sz2 Cur Freeable). { red; intros. - destruct (zlt ofs lo). apply J; omega. - destruct (zle hi ofs). apply K; omega. - replace ofs with ((ofs - delta) + delta) by omega. + destruct (zlt ofs lo). apply J; lia. + destruct (zle hi ofs). apply K; lia. + replace ofs with ((ofs - delta) + delta) by lia. eapply Mem.perm_inject; eauto. - eapply Mem.free_range_perm; eauto. xomega. + eapply Mem.free_range_perm; eauto. extlia. } destruct (Mem.range_perm_free _ _ _ _ PERM) as [m2' FREE]. exists m2'; split; auto. split; [|split]. @@ -768,16 +768,16 @@ Proof. destruct (zle hi (ofs + delta0)). intuition auto. destruct (eq_block b0 b1). * subst b0. rewrite H1 in H; inversion H; clear H; subst delta0. - eelim (Mem.perm_free_2 m1); eauto. xomega. + eelim (Mem.perm_free_2 m1); eauto. extlia. * exploit Mem.mi_no_overlap; eauto. apply Mem.perm_max with k. apply Mem.perm_implies with p; auto with mem. eapply Mem.perm_free_3; eauto. apply Mem.perm_cur_max. apply Mem.perm_implies with Freeable; auto with mem. eapply (Mem.free_range_perm m1); eauto. - instantiate (1 := ofs + delta0 - delta). xomega. - intros [X|X]. congruence. omega. + instantiate (1 := ofs + delta0 - delta). extlia. + intros [X|X]. congruence. lia. + simpl. exists b0, delta0; split; auto. - replace (ofs + delta0 - delta0) with ofs by omega. + replace (ofs + delta0 - delta0) with ofs by lia. apply Mem.perm_max with k. apply Mem.perm_implies with p; auto with mem. eapply Mem.perm_free_3; eauto. - apply (m_invar P) with m2; auto. @@ -787,7 +787,7 @@ Proof. destruct (zle hi i). intuition auto. right; exists b1, delta; split; auto. apply Mem.perm_cur_max. apply Mem.perm_implies with Freeable; auto with mem. - eapply Mem.free_range_perm; eauto. xomega. + eapply Mem.free_range_perm; eauto. extlia. - red; simpl; intros. eelim C; eauto. simpl. right. destruct H as (b0 & delta0 & U & V). exists b0, delta0; split; auto. diff --git a/common/Smallstep.v b/common/Smallstep.v index 27ad0a2d..5ac67c96 100644 --- a/common/Smallstep.v +++ b/common/Smallstep.v @@ -893,8 +893,8 @@ Proof. exploit (sd_traces DET). eexact H3. intros L2. assert (t1 = t0 /\ t2 = t3). destruct t1. inv MT. auto. - destruct t1; simpl in L1; try omegaContradiction. - destruct t0. inv MT. destruct t0; simpl in L2; try omegaContradiction. + destruct t1; simpl in L1; try extlia. + destruct t0. inv MT. destruct t0; simpl in L2; try extlia. simpl in H5. split. congruence. congruence. destruct H1; subst. assert (s2 = s4) by (eapply sd_determ_2; eauto). subst s4. @@ -974,7 +974,7 @@ Proof. destruct C as [P | [P Q]]; auto using lex_ord_left. + exploit sd_determ_3. eauto. eexact A. eauto. intros [P Q]; subst t s1'0. exists (i, n), s2; split; auto. - right; split. apply star_refl. apply lex_ord_right. omega. + right; split. apply star_refl. apply lex_ord_right. lia. - exact public_preserved. Qed. @@ -1256,7 +1256,7 @@ Proof. subst t. assert (EITHER: t1 = E0 \/ t2 = E0). unfold Eapp in H2; rewrite app_length in H2. - destruct t1; auto. destruct t2; auto. simpl in H2; omegaContradiction. + destruct t1; auto. destruct t2; auto. simpl in H2; extlia. destruct EITHER; subst. exploit IHstar; eauto. intros [s2x [s2y [A [B C]]]]. exists s2x; exists s2y; intuition. eapply star_left; eauto. @@ -1305,7 +1305,7 @@ Proof. - (* 1 L2 makes one or several transitions *) assert (EITHER: t = E0 \/ (length t = 1)%nat). { exploit L3_single_events; eauto. - destruct t; auto. destruct t; auto. simpl. intros. omegaContradiction. } + destruct t; auto. destruct t; auto. simpl. intros. extlia. } destruct EITHER. + (* 1.1 these are silent transitions *) subst t. exploit (bsim_E0_plus S12); eauto. @@ -1473,7 +1473,7 @@ Remark not_silent_length: forall t1 t2, (length (t1 ** t2) <= 1)%nat -> t1 = E0 \/ t2 = E0. Proof. unfold Eapp, E0; intros. rewrite app_length in H. - destruct t1; destruct t2; auto. simpl in H. omegaContradiction. + destruct t1; destruct t2; auto. simpl in H. extlia. Qed. Lemma f2b_determinacy_inv: @@ -1622,7 +1622,7 @@ Proof. intros [[EQ1 [EQ2 EQ3]] | [NOT1 [NOT2 MT]]]. + (* 2.1 L2 makes a silent transition: remain in "before" state *) subst. simpl in *. exists (F2BI_before n0); exists s1; split. - right; split. apply star_refl. constructor. omega. + right; split. apply star_refl. constructor. lia. econstructor; eauto. eapply star_right; eauto. + (* 2.2 L2 make a non-silent transition *) exploit not_silent_length. eapply (sr_traces L1_receptive); eauto. intros [EQ | EQ]. @@ -1650,7 +1650,7 @@ Proof. exploit f2b_determinacy_inv. eexact H2. eexact STEP2. intros [[EQ1 [EQ2 EQ3]] | [NOT1 [NOT2 MT]]]. subst. exists (F2BI_after n); exists s1; split. - right; split. apply star_refl. constructor; omega. + right; split. apply star_refl. constructor; lia. eapply f2b_match_after'; eauto. congruence. Qed. @@ -1763,7 +1763,7 @@ Proof. destruct IHstar as [s2x [A B]]. exists s2x; split; auto. eapply plus_left. eauto. apply plus_star; eauto. auto. destruct t1. simpl in *. subst t. exists s2; split; auto. apply plus_one; auto. - simpl in LEN. omegaContradiction. + simpl in LEN. extlia. Qed. Lemma ffs_simulation: @@ -1955,7 +1955,7 @@ Proof. assert (t2 = ev :: nil). inv H1; simpl in H0; tauto. subst t2. exists (t, s0). constructor; auto. simpl; auto. (* single-event *) - red. intros. inv H0; simpl; omega. + red. intros. inv H0; simpl; lia. Qed. (** * Connections with big-step semantics *) diff --git a/common/Subtyping.v b/common/Subtyping.v index 26b282e0..f1047d45 100644 --- a/common/Subtyping.v +++ b/common/Subtyping.v @@ -222,7 +222,7 @@ Definition weight_bounds (ob: option bounds) : nat := Lemma weight_bounds_1: forall lo hi s, weight_bounds (Some (B lo hi s)) < weight_bounds None. Proof. - intros; simpl. generalize (T.weight_range hi); omega. + intros; simpl. generalize (T.weight_range hi); lia. Qed. Lemma weight_bounds_2: @@ -233,8 +233,8 @@ Proof. intros; simpl. generalize (T.weight_sub _ _ s1) (T.weight_sub _ _ s2) (T.weight_sub _ _ H) (T.weight_sub _ _ H0); intros. destruct H1. - assert (T.weight lo2 < T.weight lo1) by (apply T.weight_sub_strict; auto). omega. - assert (T.weight hi1 < T.weight hi2) by (apply T.weight_sub_strict; auto). omega. + assert (T.weight lo2 < T.weight lo1) by (apply T.weight_sub_strict; auto). lia. + assert (T.weight hi1 < T.weight hi2) by (apply T.weight_sub_strict; auto). lia. Qed. Hint Resolve T.sub_refl: ty. @@ -250,11 +250,11 @@ Lemma weight_type_move: Proof. unfold type_move; intros. destruct (peq r1 r2). - inv H. split; auto. split; intros. omega. discriminate. + inv H. split; auto. split; intros. lia. discriminate. destruct (te_typ e)!r1 as [[lo1 hi1 s1]|] eqn:E1; destruct (te_typ e)!r2 as [[lo2 hi2 s2]|] eqn:E2. - destruct (T.sub_dec hi1 lo2). - inv H. split; auto. split; intros. omega. discriminate. + inv H. split; auto. split; intros. lia. discriminate. destruct (T.sub_dec lo1 hi2); try discriminate. set (lo2' := T.lub lo1 lo2) in *. set (hi1' := T.glb hi1 hi2) in *. @@ -264,45 +264,45 @@ Proof. set (b2 := B lo2' hi2 (T.lub_min lo1 lo2 hi2 s s2)) in *. Local Opaque weight_bounds. destruct (T.eq lo2 lo2'); destruct (T.eq hi1 hi1'); inversion H; clear H; subst changed e'; simpl. -+ split; auto. split; intros. omega. discriminate. ++ split; auto. split; intros. lia. discriminate. + assert (weight_bounds (Some b1) < weight_bounds (Some (B lo1 hi1 s1))) by (apply weight_bounds_2; auto with ty). split; auto. split; intros. - rewrite PTree.gsspec. destruct (peq r r1). subst r. rewrite E1. omega. omega. - rewrite PTree.gss. rewrite PTree.gso by auto. rewrite E2. omega. + rewrite PTree.gsspec. destruct (peq r r1). subst r. rewrite E1. lia. lia. + rewrite PTree.gss. rewrite PTree.gso by auto. rewrite E2. lia. + assert (weight_bounds (Some b2) < weight_bounds (Some (B lo2 hi2 s2))) by (apply weight_bounds_2; auto with ty). split; auto. split; intros. - rewrite PTree.gsspec. destruct (peq r r2). subst r. rewrite E2. omega. omega. - rewrite PTree.gss. rewrite PTree.gso by auto. rewrite E1. omega. + rewrite PTree.gsspec. destruct (peq r r2). subst r. rewrite E2. lia. lia. + rewrite PTree.gss. rewrite PTree.gso by auto. rewrite E1. lia. + assert (weight_bounds (Some b1) < weight_bounds (Some (B lo1 hi1 s1))) by (apply weight_bounds_2; auto with ty). assert (weight_bounds (Some b2) < weight_bounds (Some (B lo2 hi2 s2))) by (apply weight_bounds_2; auto with ty). split; auto. split; intros. rewrite ! PTree.gsspec. - destruct (peq r r2). subst r. rewrite E2. omega. - destruct (peq r r1). subst r. rewrite E1. omega. - omega. - rewrite PTree.gss. rewrite PTree.gso by auto. rewrite PTree.gss. omega. + destruct (peq r r2). subst r. rewrite E2. lia. + destruct (peq r r1). subst r. rewrite E1. lia. + lia. + rewrite PTree.gss. rewrite PTree.gso by auto. rewrite PTree.gss. lia. - set (b2 := B lo1 (T.high_bound lo1) (T.high_bound_sub lo1)) in *. assert (weight_bounds (Some b2) < weight_bounds None) by (apply weight_bounds_1). inv H; simpl. split. destruct (T.sub_dec hi1 lo1); auto. split; intros. - rewrite PTree.gsspec. destruct (peq r r2). subst r; rewrite E2; omega. omega. - rewrite PTree.gss. rewrite PTree.gso by auto. rewrite E1. omega. + rewrite PTree.gsspec. destruct (peq r r2). subst r; rewrite E2; lia. lia. + rewrite PTree.gss. rewrite PTree.gso by auto. rewrite E1. lia. - set (b1 := B (T.low_bound hi2) hi2 (T.low_bound_sub hi2)) in *. assert (weight_bounds (Some b1) < weight_bounds None) by (apply weight_bounds_1). inv H; simpl. split. destruct (T.sub_dec hi2 lo2); auto. split; intros. - rewrite PTree.gsspec. destruct (peq r r1). subst r; rewrite E1; omega. omega. - rewrite PTree.gss. rewrite PTree.gso by auto. rewrite E2. omega. + rewrite PTree.gsspec. destruct (peq r r1). subst r; rewrite E1; lia. lia. + rewrite PTree.gss. rewrite PTree.gso by auto. rewrite E2. lia. -- inv H. split; auto. simpl; split; intros. omega. congruence. +- inv H. split; auto. simpl; split; intros. lia. congruence. Qed. Definition weight_constraints (b: PTree.t bounds) (cstr: list constraint) : nat := @@ -312,7 +312,7 @@ Remark weight_constraints_tighter: forall b1 b2, (forall r, weight_bounds b1!r <= weight_bounds b2!r) -> forall q, weight_constraints b1 q <= weight_constraints b2 q. Proof. - induction q; simpl. omega. generalize (H (fst a)) (H (snd a)); omega. + induction q; simpl. lia. generalize (H (fst a)) (H (snd a)); lia. Qed. Lemma weight_solve_rec: @@ -323,8 +323,8 @@ Lemma weight_solve_rec: <= weight_constraints e.(te_typ) e.(te_sub) + weight_constraints e.(te_typ) q. Proof. induction q; simpl; intros. -- inv H. split. intros; omega. replace (changed' && negb changed') with false. - omega. destruct changed'; auto. +- inv H. split. intros; lia. replace (changed' && negb changed') with false. + lia. destruct changed'; auto. - destruct a as [r1 r2]; monadInv H; simpl. rename x into changed1. rename x0 into e1. exploit weight_type_move; eauto. intros [A [B C]]. @@ -336,7 +336,7 @@ Proof. assert (Q: weight_constraints (te_typ e1) (te_sub e1) <= weight_constraints (te_typ e1) (te_sub e) + weight_bounds (te_typ e1)!r1 + weight_bounds (te_typ e1)!r2). - { destruct A as [Q|Q]; rewrite Q. omega. simpl. omega. } + { destruct A as [Q|Q]; rewrite Q. lia. simpl. lia. } assert (R: weight_constraints (te_typ e1) q <= weight_constraints (te_typ e) q) by (apply weight_constraints_tighter; auto). set (ch1 := if changed' && negb (changed || changed1) then 1 else 0) in *. @@ -344,11 +344,11 @@ Proof. destruct changed1. assert (ch2 <= ch1 + 1). { unfold ch2, ch1. rewrite orb_true_r. simpl. rewrite andb_false_r. - destruct (changed' && negb changed); omega. } - exploit C; eauto. omega. + destruct (changed' && negb changed); lia. } + exploit C; eauto. lia. assert (ch2 <= ch1). - { unfold ch2, ch1. rewrite orb_false_r. omega. } - generalize (B r1) (B r2); omega. + { unfold ch2, ch1. rewrite orb_false_r. lia. } + generalize (B r1) (B r2); lia. Qed. Definition weight_typenv (e: typenv) : nat := @@ -364,7 +364,7 @@ Function solve_constraints (e: typenv) {measure weight_typenv e}: res typenv := end. Proof. intros. exploit weight_solve_rec; eauto. simpl. intros [A B]. - unfold weight_typenv. omega. + unfold weight_typenv. lia. Qed. Definition typassign := positive -> T.t. diff --git a/common/Switch.v b/common/Switch.v index 5a6d4c63..748aa459 100644 --- a/common/Switch.v +++ b/common/Switch.v @@ -235,8 +235,8 @@ Proof. destruct (split_lt n cases) as [lc rc] eqn:SEQ. rewrite (IHcases lc rc) by auto. destruct (zlt key n); intros EQ; inv EQ; simpl. -+ destruct (zeq v key). rewrite zlt_true by omega. auto. auto. -+ destruct (zeq v key). rewrite zlt_false by omega. auto. auto. ++ destruct (zeq v key). rewrite zlt_true by lia. auto. auto. ++ destruct (zeq v key). rewrite zlt_false by lia. auto. auto. Qed. Lemma split_between_prop: @@ -269,12 +269,12 @@ Lemma validate_jumptable_correct_rec: list_nth_z tbl v = Some(ZMap.get (base + v) cases). Proof. induction tbl; simpl; intros. -- unfold list_length_z in H0. simpl in H0. omegaContradiction. +- unfold list_length_z in H0. simpl in H0. extlia. - InvBooleans. rewrite list_length_z_cons in H0. apply beq_nat_true in H1. destruct (zeq v 0). - + replace (base + v) with base by omega. congruence. - + replace (base + v) with (Z.succ base + Z.pred v) by omega. - apply IHtbl. auto. omega. + + replace (base + v) with base by lia. congruence. + + replace (base + v) with (Z.succ base + Z.pred v) by lia. + apply IHtbl. auto. lia. Qed. Lemma validate_jumptable_correct: @@ -288,12 +288,12 @@ Lemma validate_jumptable_correct: Proof. intros. rewrite (validate_jumptable_correct_rec cases tbl ofs); auto. -- f_equal. f_equal. rewrite Z.mod_small. omega. - destruct (zle ofs v). omega. +- f_equal. f_equal. rewrite Z.mod_small. lia. + destruct (zle ofs v). lia. assert (M: ((v - ofs) + 1 * modulus) mod modulus = (v - ofs) + modulus). - { rewrite Z.mod_small. omega. omega. } - rewrite Z_mod_plus in M by auto. rewrite M in H0. omega. -- generalize (Z_mod_lt (v - ofs) modulus modulus_pos). omega. + { rewrite Z.mod_small. lia. lia. } + rewrite Z_mod_plus in M by auto. rewrite M in H0. lia. +- generalize (Z_mod_lt (v - ofs) modulus modulus_pos). lia. Qed. Lemma validate_correct_rec: @@ -309,7 +309,7 @@ Proof. destruct cases as [ | [key1 act1] cases1]; intros. + apply beq_nat_true in H. subst act. reflexivity. + InvBooleans. apply beq_nat_true in H2. subst. simpl. - destruct (zeq v hi). auto. omegaContradiction. + destruct (zeq v hi). auto. extlia. - (* eq node *) destruct (split_eq key cases) as [optact others] eqn:EQ. intros. destruct optact as [act1|]; InvBooleans; try discriminate. @@ -319,19 +319,19 @@ Proof. + congruence. + eapply IHt; eauto. unfold refine_low_bound, refine_high_bound. split. - destruct (zeq key lo); omega. - destruct (zeq key hi); omega. + destruct (zeq key lo); lia. + destruct (zeq key hi); lia. - (* lt node *) destruct (split_lt key cases) as [lcases rcases] eqn:EQ; intros; InvBooleans. rewrite (split_lt_prop v default _ _ _ _ EQ). destruct (zlt v key). - eapply IHt1. eauto. omega. - eapply IHt2. eauto. omega. + eapply IHt1. eauto. lia. + eapply IHt2. eauto. lia. - (* jumptable node *) destruct (split_between default ofs sz cases) as [ins outs] eqn:EQ; intros; InvBooleans. rewrite (split_between_prop v _ _ _ _ _ _ EQ). - assert (0 <= (v - ofs) mod modulus < modulus) by (apply Z_mod_lt; omega). + assert (0 <= (v - ofs) mod modulus < modulus) by (apply Z_mod_lt; lia). destruct (zlt ((v - ofs) mod modulus) sz). - rewrite Z.mod_small by omega. eapply validate_jumptable_correct; eauto. + rewrite Z.mod_small by lia. eapply validate_jumptable_correct; eauto. eapply IHt; eauto. Qed. @@ -346,7 +346,7 @@ Theorem validate_switch_correct: Proof. unfold validate_switch, table_tree_agree; split. eapply validate_wf; eauto. - intros; eapply validate_correct_rec; eauto. omega. + intros; eapply validate_correct_rec; eauto. lia. Qed. End COMPTREE. diff --git a/common/Unityping.v b/common/Unityping.v index 28bcfb5c..6dbd3c48 100644 --- a/common/Unityping.v +++ b/common/Unityping.v @@ -126,12 +126,12 @@ Lemma length_move: length e'.(te_equ) + (if changed then 1 else 0) <= S(length e.(te_equ)). Proof. unfold move; intros. - destruct (peq r1 r2). inv H. omega. + destruct (peq r1 r2). inv H. lia. destruct e.(te_typ)!r1 as [ty1|]; destruct e.(te_typ)!r2 as [ty2|]; inv H; simpl. - destruct (T.eq ty1 ty2); inv H1. omega. - omega. - omega. - omega. + destruct (T.eq ty1 ty2); inv H1. lia. + lia. + lia. + lia. Qed. Lemma length_solve_rec: @@ -140,14 +140,14 @@ Lemma length_solve_rec: length e'.(te_equ) + (if ch' && negb ch then 1 else 0) <= length e.(te_equ) + length q. Proof. induction q; simpl; intros. -- inv H. replace (ch' && negb ch') with false. omega. destruct ch'; auto. +- inv H. replace (ch' && negb ch') with false. lia. destruct ch'; auto. - destruct a as [r1 r2]; monadInv H. rename x0 into e0. rename x into ch0. exploit IHq; eauto. intros A. exploit length_move; eauto. intros B. set (X := (if ch' && negb (ch || ch0) then 1 else 0)) in *. set (Y := (if ch0 then 1 else 0)) in *. set (Z := (if ch' && negb ch then 1 else 0)) in *. - cut (Z <= X + Y). intros. omega. + cut (Z <= X + Y). intros. lia. unfold X, Y, Z. destruct ch'; destruct ch; destruct ch0; simpl; auto. Qed. @@ -164,7 +164,7 @@ Function solve_constraints (e: typenv) {measure weight_typenv e}: res typenv := end. Proof. intros. exploit length_solve_rec; eauto. simpl. intros. - unfold weight_typenv. omega. + unfold weight_typenv. lia. Qed. Definition typassign := positive -> T.t. @@ -199,7 +199,7 @@ Proof. apply A. rewrite PTree.gso by congruence. auto. Qed. -Hint Resolve set_incr: ty. +Global Hint Resolve set_incr: ty. Lemma set_sound: forall te x ty e e', set e x ty = OK e' -> satisf te e' -> te x = ty. @@ -216,7 +216,7 @@ Proof. induction xl; destruct tyl; simpl; intros; monadInv H; eauto with ty. Qed. -Hint Resolve set_list_incr: ty. +Global Hint Resolve set_list_incr: ty. Lemma set_list_sound: forall te xl tyl e e', set_list e xl tyl = OK e' -> satisf te e' -> map te xl = tyl. @@ -242,7 +242,7 @@ Proof. - inv H; simpl in *; split; auto. Qed. -Hint Resolve move_incr: ty. +Global Hint Resolve move_incr: ty. Lemma move_sound: forall te e r1 r2 e' changed, diff --git a/common/Values.v b/common/Values.v index 5d32e54e..1d272932 100644 --- a/common/Values.v +++ b/common/Values.v @@ -1045,10 +1045,10 @@ Lemma load_result_rettype: forall chunk v, has_rettype (load_result chunk v) (rettype_of_chunk chunk). Proof. intros. unfold has_rettype; destruct chunk; destruct v; simpl; auto. -- rewrite Int.sign_ext_idem by omega; auto. -- rewrite Int.zero_ext_idem by omega; auto. -- rewrite Int.sign_ext_idem by omega; auto. -- rewrite Int.zero_ext_idem by omega; auto. +- rewrite Int.sign_ext_idem by lia; auto. +- rewrite Int.zero_ext_idem by lia; auto. +- rewrite Int.sign_ext_idem by lia; auto. +- rewrite Int.zero_ext_idem by lia; auto. - destruct Archi.ptr64 eqn:SF; simpl; auto. - destruct Archi.ptr64 eqn:SF; simpl; auto. - destruct Archi.ptr64 eqn:SF; simpl; auto. @@ -1074,14 +1074,14 @@ Theorem cast8unsigned_and: forall x, zero_ext 8 x = and x (Vint(Int.repr 255)). Proof. destruct x; simpl; auto. decEq. - change 255 with (two_p 8 - 1). apply Int.zero_ext_and. omega. + change 255 with (two_p 8 - 1). apply Int.zero_ext_and. lia. Qed. Theorem cast16unsigned_and: forall x, zero_ext 16 x = and x (Vint(Int.repr 65535)). Proof. destruct x; simpl; auto. decEq. - change 65535 with (two_p 16 - 1). apply Int.zero_ext_and. omega. + change 65535 with (two_p 16 - 1). apply Int.zero_ext_and. lia. Qed. Theorem bool_of_val_of_bool: @@ -1318,7 +1318,7 @@ Proof. unfold divs. rewrite Int.eq_false; try discriminate. simpl. rewrite (Int.eq_false Int.one Int.mone); try discriminate. rewrite andb_false_intro2; auto. f_equal. f_equal. - rewrite Int.divs_one; auto. replace Int.zwordsize with 32; auto. omega. + rewrite Int.divs_one; auto. replace Int.zwordsize with 32; auto. lia. Qed. Theorem divu_pow2: @@ -1445,7 +1445,7 @@ Proof. destruct (Int.ltu i0 (Int.repr 31)) eqn:?; inv H1. exploit Int.ltu_inv; eauto. change (Int.unsigned (Int.repr 31)) with 31. intros. assert (Int.ltu i0 Int.iwordsize = true). - unfold Int.ltu. apply zlt_true. change (Int.unsigned Int.iwordsize) with 32. omega. + unfold Int.ltu. apply zlt_true. change (Int.unsigned Int.iwordsize) with 32. lia. simpl. rewrite H0. simpl. decEq. rewrite Int.shrx_carry; auto. Qed. @@ -1460,7 +1460,7 @@ Proof. destruct (Int.ltu i0 (Int.repr 31)) eqn:?; inv H1. exploit Int.ltu_inv; eauto. change (Int.unsigned (Int.repr 31)) with 31. intros. assert (Int.ltu i0 Int.iwordsize = true). - unfold Int.ltu. apply zlt_true. change (Int.unsigned Int.iwordsize) with 32. omega. + unfold Int.ltu. apply zlt_true. change (Int.unsigned Int.iwordsize) with 32. lia. exists i; exists i0; intuition. rewrite Int.shrx_shr; auto. destruct (Int.lt i Int.zero); simpl; rewrite H0; auto. Qed. @@ -1483,12 +1483,12 @@ Proof. replace (Int.ltu (Int.sub (Int.repr 32) n) Int.iwordsize) with true. simpl. replace (Int.ltu n Int.iwordsize) with true. f_equal; apply Int.shrx_shr_2; assumption. - symmetry; apply zlt_true. change (Int.unsigned n < 32); omega. + symmetry; apply zlt_true. change (Int.unsigned n < 32); lia. symmetry; apply zlt_true. unfold Int.sub. change (Int.unsigned (Int.repr 32)) with 32. assert (Int.unsigned n <> 0). { red; intros; elim H. rewrite <- (Int.repr_unsigned n), H0. auto. } rewrite Int.unsigned_repr. - change (Int.unsigned Int.iwordsize) with 32; omega. - assert (32 < Int.max_unsigned) by reflexivity. omega. + change (Int.unsigned Int.iwordsize) with 32; lia. + assert (32 < Int.max_unsigned) by reflexivity. lia. Qed. Theorem shrx1_shr: @@ -1732,7 +1732,7 @@ Proof. rewrite (Int64.eq_false Int64.one Int64.mone); try discriminate. rewrite andb_false_intro2; auto. simpl. f_equal. f_equal. apply Int64.divs_one. - replace Int64.zwordsize with 64; auto. omega. + replace Int64.zwordsize with 64; auto. lia. Qed. Theorem divlu_pow2: @@ -1775,7 +1775,7 @@ Proof. destruct (Int.ltu i0 (Int.repr 63)) eqn:?; inv H1. exploit Int.ltu_inv; eauto. change (Int.unsigned (Int.repr 63)) with 63. intros. assert (Int.ltu i0 Int64.iwordsize' = true). - unfold Int.ltu. apply zlt_true. change (Int.unsigned Int64.iwordsize') with 64. omega. + unfold Int.ltu. apply zlt_true. change (Int.unsigned Int64.iwordsize') with 64. lia. simpl. rewrite H0. simpl. decEq. rewrite Int64.shrx'_carry; auto. Qed. @@ -1796,12 +1796,12 @@ Proof. replace (Int.ltu (Int.sub (Int.repr 64) n) Int64.iwordsize') with true. simpl. replace (Int.ltu n Int64.iwordsize') with true. f_equal; apply Int64.shrx'_shr_2; assumption. - symmetry; apply zlt_true. change (Int.unsigned n < 64); omega. + symmetry; apply zlt_true. change (Int.unsigned n < 64); lia. symmetry; apply zlt_true. unfold Int.sub. change (Int.unsigned (Int.repr 64)) with 64. assert (Int.unsigned n <> 0). { red; intros; elim H. rewrite <- (Int.repr_unsigned n), H0. auto. } rewrite Int.unsigned_repr. - change (Int.unsigned Int64.iwordsize') with 64; omega. - assert (64 < Int.max_unsigned) by reflexivity. omega. + change (Int.unsigned Int64.iwordsize') with 64; lia. + assert (64 < Int.max_unsigned) by reflexivity. lia. Qed. Theorem shrxl1_shrl: @@ -2127,7 +2127,7 @@ Inductive lessdef_list: list val -> list val -> Prop := lessdef v1 v2 -> lessdef_list vl1 vl2 -> lessdef_list (v1 :: vl1) (v2 :: vl2). -Hint Resolve lessdef_refl lessdef_undef lessdef_list_nil lessdef_list_cons : core. +Global Hint Resolve lessdef_refl lessdef_undef lessdef_list_nil lessdef_list_cons : core. Lemma lessdef_list_inv: forall vl1 vl2, lessdef_list vl1 vl2 -> vl1 = vl2 \/ In Vundef vl1. @@ -2352,7 +2352,7 @@ Inductive inject (mi: meminj): val -> val -> Prop := | val_inject_undef: forall v, inject mi Vundef v. -Hint Constructors inject : core. +Global Hint Constructors inject : core. Inductive inject_list (mi: meminj): list val -> list val-> Prop:= | inject_list_nil : @@ -2361,7 +2361,7 @@ Inductive inject_list (mi: meminj): list val -> list val-> Prop:= inject mi v v' -> inject_list mi vl vl'-> inject_list mi (v :: vl) (v' :: vl'). -Hint Resolve inject_list_nil inject_list_cons : core. +Global Hint Resolve inject_list_nil inject_list_cons : core. Lemma inject_ptrofs: forall mi i, inject mi (Vptrofs i) (Vptrofs i). @@ -2369,7 +2369,7 @@ Proof. unfold Vptrofs; intros. destruct Archi.ptr64; auto. Qed. -Hint Resolve inject_ptrofs : core. +Global Hint Resolve inject_ptrofs : core. Section VAL_INJ_OPS. @@ -2721,7 +2721,7 @@ Proof. constructor. eapply val_inject_incr; eauto. auto. Qed. -Hint Resolve inject_incr_refl val_inject_incr val_inject_list_incr : core. +Global Hint Resolve inject_incr_refl val_inject_incr val_inject_list_incr : core. Lemma val_inject_lessdef: forall v1 v2, Val.lessdef v1 v2 <-> Val.inject (fun b => Some(b, 0)) v1 v2. @@ -18,6 +18,7 @@ prefix='/usr/local' bindir='$(PREFIX)/bin' libdir='$(PREFIX)/lib/compcert' +mandir='$(PREFIX)/share/man' coqdevdir='$(PREFIX)/lib/compcert/coq' toolprefix='' target='' @@ -25,7 +26,6 @@ has_runtime_lib=true has_standard_headers=true clightgen=false install_coqdev=false -responsefile="gnu" ignore_coq_version=false library_Flocq=local library_MenhirLib=local @@ -53,13 +53,14 @@ Supported targets: x86_32-cygwin (x86 32 bits, Cygwin environment under Windows) x86_64-linux (x86 64 bits, Linux) x86_64-bsd (x86 64 bits, BSD) - x86_64-macosx (x86 64 bits, MacOS X) + x86_64-macos (x86 64 bits, MacOS X) x86_64-cygwin (x86 64 bits, Cygwin environment under Windows) rv32-linux (RISC-V 32 bits, Linux) rv64-linux (RISC-V 64 bits, Linux) kvx-mbr (Kalray KVX, bare runtime) kvx-cos (Kalray KVX, ClusterOS) aarch64-linux (AArch64, i.e. ARMv8 in 64-bit mode, Linux) + aarch64-macos (AArch64, i.e. Apple silicon, MacOS) manual (edit configuration file by hand) For x86 targets, the "x86_32-" prefix can also be written "ia32-" or "i386-". @@ -87,6 +88,7 @@ Options: -prefix <dir> Install in <dir>/bin and <dir>/lib/compcert -bindir <dir> Install binaries in <dir> -libdir <dir> Install libraries in <dir> + -mandir <dir> Install man pages in <dir> -coqdevdir <dir> Install Coq development (.vo files) in <dir> -toolprefix <pref> Prefix names of tools ("gcc", etc) with <pref> -use-external-Flocq Use an already-installed Flocq library @@ -116,6 +118,8 @@ while : ; do bindir="$2"; shift;; -libdir|--libdir) libdir="$2"; shift;; + -mandir|--mandir) + mandir="$2"; shift;; -coqdevdir|--coqdevdir) coqdevdir="$2"; install_coqdev=true; shift;; -toolprefix|--toolprefix) @@ -209,13 +213,24 @@ target=${target#[a-zA-Z0-9]*-} # Per-target configuration +# We start with reasonable defaults, +# then redefine the required parameters for each target, +# then check for missing parameters and derive values for them. + asm_supports_cfi="" -casm_options="" +cc="${toolprefix}gcc" +cc_options="" +casm="${toolprefix}gcc" +casm_options="-c" casmruntime="" -clinker_needs_no_pie=true +clinker="${toolprefix}gcc" clinker_options="" -cprepro_options="" - +clinker_needs_no_pie=true +cprepro="${toolprefix}gcc" +cprepro_options="-E" +archiver="${toolprefix}ar rcs" +libmath="-lm" +responsefile="gnu" # # ARM Target Configuration @@ -235,13 +250,7 @@ if test "$arch" = "arm"; then exit 2;; esac - casm="${toolprefix}gcc" - casm_options="-c" - cc="${toolprefix}gcc" - clinker="${toolprefix}gcc" - cprepro="${toolprefix}gcc" cprepro_options="-std=c99 -U__GNUC__ '-D__REDIRECT(name,proto,alias)=name proto' '-D__REDIRECT_NTH(name,proto,alias)=name proto' -E" - libmath="-lm" system="linux" fi @@ -279,19 +288,14 @@ if test "$arch" = "powerpc"; then clinker="${toolprefix}dcc" cprepro="${toolprefix}dcc" cprepro_options="-E -D__GNUC__" + archiver="${toolprefix}dar -q" libmath="-lm" system="diab" responsefile="diab" ;; *) - casm="${toolprefix}gcc" - casm_options="-c" casmruntime="${toolprefix}gcc -c -Wa,-mregnames" - cc="${toolprefix}gcc" - clinker="${toolprefix}gcc" - cprepro="${toolprefix}gcc" cprepro_options="-std=c99 -U__GNUC__ -E" - libmath="-lm" system="linux" ;; esac @@ -306,38 +310,26 @@ if test "$arch" = "x86" -a "$bitsize" = "32"; then case "$target" in bsd) abi="standard" - casm="${toolprefix}gcc" + cc_options="-m32" casm_options="-m32 -c" - cc="${toolprefix}gcc -m32" - clinker="${toolprefix}gcc" clinker_options="-m32" - cprepro="${toolprefix}gcc" cprepro_options="-std=c99 -m32 -U__GNUC__ -E" - libmath="-lm" system="bsd" ;; cygwin) abi="standard" - casm="${toolprefix}gcc" + cc_options="-m32" casm_options="-m32 -c" - cc="${toolprefix}gcc -m32" - clinker="${toolprefix}gcc" clinker_options="-m32" - cprepro="${toolprefix}gcc" cprepro_options="-std=c99 -m32 -U__GNUC__ '-D__attribute__(x)=' -E" - libmath="-lm" system="cygwin" ;; linux) abi="standard" - casm="${toolprefix}gcc" + cc_options="-m32" casm_options="-m32 -c" - cc="${toolprefix}gcc -m32" - clinker="${toolprefix}gcc" clinker_options="-m32" - cprepro="${toolprefix}gcc" cprepro_options="-std=c99 -m32 -U__GNUC__ -E" - libmath="-lm" system="linux" ;; *) @@ -355,53 +347,36 @@ if test "$arch" = "x86" -a "$bitsize" = "64"; then case "$target" in bsd) abi="standard" - casm="${toolprefix}gcc" + cc_options="-m64" casm_options="-m64 -c" - cc="${toolprefix}gcc -m64" - clinker="${toolprefix}gcc" clinker_options="-m64" - cprepro="${toolprefix}gcc" cprepro_options="-std=c99 -m64 -U__GNUC__ -E" - libmath="-lm" system="bsd" ;; linux) abi="standard" - casm="${toolprefix}gcc" + cc_options="-m64" casm_options="-m64 -c" - cc="${toolprefix}gcc -m64" - clinker="${toolprefix}gcc" clinker_options="-m64" - cprepro="${toolprefix}gcc" cprepro_options="-std=c99 -m64 -U__GNUC__ -E" - libmath="-lm" system="linux" ;; - macosx) - # kernel major versions count upwards from 4 for OSX 10.0 to 15 for OSX 10.11 - kernel_major=`uname -r | cut -d "." -f 1` - - abi="macosx" - casm="${toolprefix}gcc" + macos|macosx) + abi="macos" + cc_options="-arch x86_64" casm_options="-arch x86_64 -c" - cc="${toolprefix}gcc -arch x86_64" - clinker="${toolprefix}gcc" + clinker_options="-arch x86_64" clinker_needs_no_pie=false - cprepro="${toolprefix}gcc" - cprepro_options="-std=c99 -arch x86_64 -U__GNUC__ -U__clang__ -U__BLOCKS__ '-D__attribute__(x)=' '-D__asm(x)=' '-D_Nullable=' '-D_Nonnull=' -E" + cprepro_options="-std=c99 -arch x86_64 -U__GNUC__ -U__clang__ -U__BLOCKS__ '-D__attribute__(x)=' '-D__asm(x)=' '-D_Nullable=' '-D_Nonnull=' -Wno-\\#warnings -E" libmath="" - system="macosx" + system="macos" ;; cygwin) abi="standard" - casm="${toolprefix}gcc" + cc_options="-m64" casm_options="-m64 -c" - cc="${toolprefix}gcc -m64" - clinker="${toolprefix}gcc" clinker_options="-m64" - cprepro="${toolprefix}gcc" cprepro_options="-std=c99 -m64 -U__GNUC__ '-D__attribute__(x)=' -E" - libmath="-lm" system="cygwin" ;; *) @@ -422,14 +397,10 @@ if test "$arch" = "riscV"; then model_options="-march=rv32imafd -mabi=ilp32d" fi abi="standard" - casm="${toolprefix}gcc" + cc_options="$model_options" casm_options="$model_options -c" - cc="${toolprefix}gcc $model_options" - clinker="${toolprefix}gcc" clinker_options="$model_options" - cprepro="${toolprefix}gcc" cprepro_options="$model_options -std=c99 -U__GNUC__ -E" - libmath="-lm" system="linux" fi @@ -474,15 +445,20 @@ if test "$arch" = "aarch64"; then case "$target" in linux) abi="standard" - casm="${toolprefix}gcc" - casm_options="-c" - cc="${toolprefix}gcc" - clinker="${toolprefix}gcc" - clinker_options="" - cprepro="${toolprefix}gcc" cprepro_options="-std=c99 -U__GNUC__ -E" - libmath="-lm" system="linux";; + macos|macosx) + abi="apple" + casm="${toolprefix}cc" + casm_options="-c -arch arm64" + cc="${toolprefix}cc -arch arm64" + clinker="${toolprefix}cc" + clinker_needs_no_pie=false + cprepro="${toolprefix}cc" + cprepro_options="-std=c99 -arch arm64 -U__GNUC__ -U__clang__ -U__BLOCKS__ '-D__attribute__(x)=' '-D__asm(x)=' '-D_Nullable=' '-D_Nonnull=' -Wno-\\#warnings -E" + libmath="" + system="macos" + ;; *) echo "Error: invalid eabi/system '$target' for architecture AArch64." 1>&2 echo "$usage" 1>&2 @@ -565,19 +541,19 @@ missingtools=false echo "Testing Coq... " | tr -d '\n' coq_ver=$(${COQBIN}coqc -v 2>/dev/null | sed -n -e 's/The Coq Proof Assistant, version \([^ ]*\).*$/\1/p') case "$coq_ver" in - 8.8.0|8.8.1|8.8.2|8.9.0|8.9.1|8.10.0|8.10.1|8.10.2|8.11.0|8.11.1|8.11.2|8.12.0|8.12.1|8.12.2) + 8.8.0|8.8.1|8.8.2|8.9.0|8.9.1|8.10.0|8.10.1|8.10.2|8.11.0|8.11.1|8.11.2|8.12.0|8.12.1|8.12.2|8.13.0|8.13.1) echo "version $coq_ver -- good!";; ?*) echo "version $coq_ver -- UNSUPPORTED" if $ignore_coq_version; then echo "Warning: this version of Coq is unsupported, proceed at your own risks." else - echo "Error: CompCert requires a version of Coq between 8.8.0 and 8.12.1" + echo "Error: CompCert requires a version of Coq between 8.8.0 and 8.13.1" missingtools=true fi;; "") echo "NOT FOUND" - echo "Error: make sure Coq version 8.11.2 is installed." + echo "Error: make sure Coq version 8.12.2 is installed." missingtools=true;; esac @@ -680,7 +656,7 @@ cat > Makefile.config <<EOF PREFIX=$prefix BINDIR=$bindir LIBDIR=$libdir -MANDIR=$sharedir/man +MANDIR=$mandir SHAREDIR=$sharedir COQDEVDIR=$coqdevdir OCAML_NATIVE_COMP=$ocaml_native_comp @@ -698,12 +674,13 @@ BITSIZE=$bitsize CASM=$casm CASM_OPTIONS=$casm_options CASMRUNTIME=$casmruntime -CC=$cc +CC=$cc $cc_options CLIGHTGEN=$clightgen CLINKER=$clinker CLINKER_OPTIONS=$clinker_options CPREPRO=$cprepro CPREPRO_OPTIONS=$cprepro_options +ARCHIVER=$archiver ENDIANNESS=$endianness HAS_RUNTIME_LIB=$has_runtime_lib HAS_STANDARD_HEADERS=$has_standard_headers @@ -769,26 +746,32 @@ ENDIANNESS= # Possible choices for x86: # SYSTEM=linux # SYSTEM=bsd -# SYSTEM=macosx +# SYSTEM=macos # SYSTEM=cygwin SYSTEM= -# C compiler for compiling runtime library files and some tests -CC=gcc +# C compiler (for testing only) +CC=cc -# Preprocessor for .c files -CPREPRO=gcc -U__GNUC__ -E - -# Assembler for assembling .s files -CASM=gcc -c +# Assembler for assembling compiled files +CASM=cc +CASM_OPTIONS=-c # Assembler for assembling runtime library files -CASMRUNTIME=gcc -c +CASMRUNTIME=$(CASM) $(CASM_OPTIONS) # Linker -CLINKER=gcc +CLINKER=cc +CLINKER_OPTIONS=-no-pie + +# Preprocessor for .c files +CPREPRO=cc +CPREPRO_OPTIONS=-std c99 -U__GNUC__ -E + +# Archiver to build .a libraries +ARCHIVER=ar rcs -# Math library. Set to empty under MacOS X +# Math library. Set to empty under macOS LIBMATH=-lm # Turn on/off the installation and use of the runtime support library @@ -804,8 +787,8 @@ ASM_SUPPORTS_CFI=false # Turn on/off compilation of clightgen CLIGHTGEN=false -# Whether the other tools support responsefiles in gnu syntax -RESPONSEFILE="none" +# Whether the other tools support responsefiles in GNU syntax or Diab syntax +RESPONSEFILE=gnu # diab # Whether to use the local copies of Flocq and MenhirLib LIBRARY_FLOCQ=local # external @@ -876,7 +859,7 @@ B cparser B extraction EOF -make CoqProject +$make CoqProject # # Clean up target-dependent files to force their recompilation @@ -894,9 +877,9 @@ Please finish the configuration by editing file ./Makefile.config. EOF else -bindirexp=`echo "$bindir" | sed -e "s|\\\$(PREFIX)|$prefix|"` -libdirexp=`echo "$libdir" | sed -e "s|\\\$(PREFIX)|$prefix|"` -coqdevdirexp=`echo "$coqdevdir" | sed -e "s|\\\$(PREFIX)|$prefix|"` +expandprefix() { + echo "$1" | sed -e "s|\\\$(PREFIX)|$prefix|" +} cat <<EOF @@ -906,28 +889,29 @@ CompCert configuration: Application binary interface.. $abi Endianness.................... $endianness OS and development env........ $system - C compiler.................... $cc - C preprocessor................ $cprepro - Assembler..................... $casm + C compiler.................... $cc $cc_options + C preprocessor................ $cprepro $cprepro_options + Assembler..................... $casm $casm_options Assembler supports CFI........ $asm_supports_cfi Assembler for runtime lib..... $casmruntime - Linker........................ $clinker - Linker needs '-no-pie'........ $clinker_needs_no_pie + Linker........................ $clinker $clinker_options + Archiver...................... $archiver Math library.................. $libmath Build command to use.......... $make Menhir API library............ $menhir_dir The Flocq library............. $library_Flocq The MenhirLib library......... $library_MenhirLib - Binaries installed in......... $bindirexp + Binaries installed in......... $(expandprefix $bindir) Runtime library provided...... $has_runtime_lib - Library files installed in.... $libdirexp + Library files installed in.... $(expandprefix $libdir) + Man pages installed in........ $(expandprefix $mandir) Standard headers provided..... $has_standard_headers - Standard headers installed in. $libdirexp/include + Standard headers installed in. $(expandprefix $libdir)/include EOF if $install_coqdev; then cat <<EOF - Coq development installed in.. $coqdevdirexp + Coq development installed in.. $(expandprefix $coqdevdir) EOF else cat <<EOF diff --git a/cparser/Elab.ml b/cparser/Elab.ml index e822dfcb..46163104 100644 --- a/cparser/Elab.ml +++ b/cparser/Elab.ml @@ -2901,7 +2901,10 @@ let elab_definition (for_loop: bool) (local: bool) (nonstatic_inline: bool) (* pragma *) | PRAGMA(s, loc) -> - emit_elab env loc (Gpragma s); + if local then + warning loc Unnamed "pragmas are ignored inside functions" + else + emit_elab env loc (Gpragma s); ([], env) (* static assertion *) diff --git a/cparser/Lexer.mll b/cparser/Lexer.mll index f5e8edb3..d20ac50e 100644 --- a/cparser/Lexer.mll +++ b/cparser/Lexer.mll @@ -96,7 +96,8 @@ let () = (* We can ignore the __extension__ GCC keyword. *) ignored_keywords := SSet.add "__extension__" !ignored_keywords -let init_ctx = SSet.singleton "__builtin_va_list" +let init_ctx = SSet.of_list (List.map fst CBuiltins.builtins.C.builtin_typedefs) + let types_context : SSet.t ref = ref init_ctx let _ = diff --git a/cparser/Machine.ml b/cparser/Machine.ml index 73b71ea0..36a6c023 100644 --- a/cparser/Machine.ml +++ b/cparser/Machine.ml @@ -183,12 +183,12 @@ let x86_32 = struct_passing_style = SP_split_args; struct_return_style = SR_ref} -let x86_32_macosx = +let x86_32_macos = {x86_32 with struct_passing_style = SP_split_args; struct_return_style = SR_int1248 } let x86_32_bsd = - x86_32_macosx + x86_32_macos let x86_64 = { i32lpll64 with name = "x86_64"; char_signed = true; @@ -283,6 +283,9 @@ let aarch64 = struct_passing_style = SP_ref_callee; (* Wrong *) struct_return_style = SR_ref } (* Wrong *) +let aarch64_apple = + { aarch64 with char_signed = true } + (* Add GCC extensions re: sizeof and alignof *) let gcc_extensions c = diff --git a/cparser/Machine.mli b/cparser/Machine.mli index 54436758..5bf95bb6 100644 --- a/cparser/Machine.mli +++ b/cparser/Machine.mli @@ -73,7 +73,7 @@ val ilp32ll64 : t val i32lpll64 : t val il32pll64 : t val x86_32 : t -val x86_32_macosx : t +val x86_32_macos : t val x86_32_bsd : t val x86_64 : t val win32 : t @@ -90,6 +90,7 @@ val rv32 : t val rv64 : t val kvx : t val aarch64 : t +val aarch64_apple : t val gcc_extensions : t -> t val compcert_interpreter : t -> t diff --git a/debug/Dwarfgen.ml b/debug/Dwarfgen.ml index 020ac60e..d9e941fb 100644 --- a/debug/Dwarfgen.ml +++ b/debug/Dwarfgen.ml @@ -594,7 +594,7 @@ let gnu_file_loc (f,l) = let string_table: (string,int) Hashtbl.t = Hashtbl.create 7 let gnu_string_entry s = - if (String.length s < 4 && Configuration.system <> "macosx") (* macosx needs debug_str *) + if (String.length s < 4 && Configuration.system <> "macos") (* macos needs debug_str *) || Configuration.system = "cygwin" then (*Cygwin does not use the debug_str section*) Simple_string s else diff --git a/driver/Configuration.ml b/driver/Configuration.ml index 1d40214a..3c9aff5e 100644 --- a/driver/Configuration.ml +++ b/driver/Configuration.ml @@ -157,4 +157,4 @@ let response_file_style = let gnu_toolchain = system <> "diab" -let elf_target = system <> "macosx" && system <> "cygwin" +let elf_target = system <> "macos" && system <> "cygwin" diff --git a/driver/Frontend.ml b/driver/Frontend.ml index c99da945..9dec32fa 100644 --- a/driver/Frontend.ml +++ b/driver/Frontend.ml @@ -109,8 +109,8 @@ let init () = | "x86" -> if Configuration.model = "64" then Machine.x86_64 else - if Configuration.abi = "macosx" - then Machine.x86_32_macosx + if Configuration.abi = "macos" + then Machine.x86_32_macos else if Configuration.system = "bsd" then Machine.x86_32_bsd else Machine.x86_32 @@ -118,7 +118,9 @@ let init () = then Machine.rv64 else Machine.rv32 | "kvx" -> Machine.kvx - | "aarch64" -> Machine.aarch64 + | "aarch64" -> if Configuration.abi = "apple" + then Machine.aarch64_apple + else Machine.aarch64 | _ -> assert false end; Env.set_builtins C2C.builtins; diff --git a/exportclight/ExportClight.ml b/exportclight/ExportClight.ml index 4ff901eb..7604175e 100644 --- a/exportclight/ExportClight.ml +++ b/exportclight/ExportClight.ml @@ -216,8 +216,8 @@ and typlist p = function and callconv p cc = if cc = cc_default then fprintf p "cc_default" - else fprintf p "{|cc_vararg:=%b; cc_unproto:=%b; cc_structret:=%b|}" - cc.cc_vararg cc.cc_unproto cc.cc_structret + else fprintf p "{|cc_vararg:=%a; cc_unproto:=%b; cc_structret:=%b|}" + (print_option coqZ) cc.cc_vararg cc.cc_unproto cc.cc_structret (* External functions *) diff --git a/flocq/Calc/Bracket.v b/flocq/Calc/Bracket.v index 83714e87..838cadfa 100644 --- a/flocq/Calc/Bracket.v +++ b/flocq/Calc/Bracket.v @@ -19,15 +19,19 @@ COPYING file for more details. (** * Locations: where a real number is positioned with respect to its rounded-down value in an arbitrary format. *) +From Coq Require Import Lia. Require Import Raux Defs Float_prop. +Require Import SpecFloatCompat. + +Notation location := location (only parsing). +Notation loc_Exact := loc_Exact (only parsing). +Notation loc_Inexact := loc_Inexact (only parsing). Section Fcalc_bracket. Variable d u : R. Hypothesis Hdu : (d < u)%R. -Inductive location := loc_Exact | loc_Inexact : comparison -> location. - Variable x : R. Definition inbetween_loc := @@ -233,7 +237,7 @@ apply Rplus_le_compat_l. apply Rmult_le_compat_r. now apply Rlt_le. apply IZR_le. -omega. +lia. (* . *) now rewrite middle_range. Qed. @@ -246,7 +250,7 @@ Theorem inbetween_step_Lo : Proof. intros x k l Hx Hk1 Hk2. apply inbetween_step_not_Eq with (1 := Hx). -omega. +lia. apply Rcompare_Lt. assert (Hx' := inbetween_bounds _ _ (ordered_steps _) _ _ Hx). apply Rlt_le_trans with (1 := proj2 Hx'). @@ -255,7 +259,7 @@ rewrite Rcompare_plus_l, Rcompare_mult_r, Rcompare_half_l. apply Rcompare_not_Lt. rewrite <- mult_IZR. apply IZR_le. -omega. +lia. exact Hstep. Qed. @@ -267,7 +271,7 @@ Theorem inbetween_step_Hi : Proof. intros x k l Hx Hk1 Hk2. apply inbetween_step_not_Eq with (1 := Hx). -omega. +lia. apply Rcompare_Gt. assert (Hx' := inbetween_bounds _ _ (ordered_steps _) _ _ Hx). apply Rlt_le_trans with (2 := proj1 Hx'). @@ -276,7 +280,7 @@ rewrite Rcompare_plus_l, Rcompare_mult_r, Rcompare_half_l. apply Rcompare_Lt. rewrite <- mult_IZR. apply IZR_lt. -omega. +lia. exact Hstep. Qed. @@ -331,7 +335,7 @@ Theorem inbetween_step_any_Mi_odd : Proof. intros x k l Hx Hk. apply inbetween_step_not_Eq with (1 := Hx). -omega. +lia. inversion_clear Hx as [|l' _ Hl]. now rewrite (middle_odd _ Hk) in Hl. Qed. @@ -344,7 +348,7 @@ Theorem inbetween_step_Lo_Mi_Eq_odd : Proof. intros x k Hx Hk. apply inbetween_step_not_Eq with (1 := Hx). -omega. +lia. inversion_clear Hx as [Hl|]. rewrite Hl. rewrite Rcompare_plus_l, Rcompare_mult_r, Rcompare_half_r. @@ -365,7 +369,7 @@ Theorem inbetween_step_Hi_Mi_even : Proof. intros x k l Hx Hl Hk. apply inbetween_step_not_Eq with (1 := Hx). -omega. +lia. apply Rcompare_Gt. assert (Hx' := inbetween_bounds_not_Eq _ _ _ _ Hx Hl). apply Rle_lt_trans with (2 := proj1 Hx'). @@ -387,7 +391,7 @@ Theorem inbetween_step_Mi_Mi_even : Proof. intros x k Hx Hk. apply inbetween_step_not_Eq with (1 := Hx). -omega. +lia. apply Rcompare_Eq. inversion_clear Hx as [Hx'|]. rewrite Hx', <- Hk, mult_IZR. @@ -433,10 +437,10 @@ now apply inbetween_step_Lo_not_Eq with (2 := H1). destruct (Zcompare_spec (2 * k) nb_steps) as [Hk1|Hk1|Hk1]. (* . 2 * k < nb_steps *) apply inbetween_step_Lo with (1 := Hx). -omega. +lia. destruct (Zeven_ex nb_steps). rewrite He in H. -omega. +lia. (* . 2 * k = nb_steps *) set (l' := match l with loc_Exact => Eq | _ => Gt end). assert ((l = loc_Exact /\ l' = Eq) \/ (l <> loc_Exact /\ l' = Gt)). @@ -490,7 +494,7 @@ now apply inbetween_step_Lo_not_Eq with (2 := H1). destruct (Zcompare_spec (2 * k + 1) nb_steps) as [Hk1|Hk1|Hk1]. (* . 2 * k + 1 < nb_steps *) apply inbetween_step_Lo with (1 := Hx) (3 := Hk1). -omega. +lia. (* . 2 * k + 1 = nb_steps *) destruct l. apply inbetween_step_Lo_Mi_Eq_odd with (1 := Hx) (2 := Hk1). @@ -499,7 +503,7 @@ apply inbetween_step_any_Mi_odd with (1 := Hx) (2 := Hk1). apply inbetween_step_Hi with (1 := Hx). destruct (Zeven_ex nb_steps). rewrite Ho in H. -omega. +lia. apply Hk. Qed. @@ -612,7 +616,7 @@ clear -Hk. intros m. rewrite (F2R_change_exp beta e). apply (f_equal (fun r => F2R (Float beta (m * Zpower _ r) e))). ring. -omega. +lia. assert (Hp: (Zpower beta k > 0)%Z). apply Z.lt_gt. apply Zpower_gt_0. @@ -622,7 +626,7 @@ rewrite 2!Hr. rewrite Zmult_plus_distr_l, Zmult_1_l. unfold F2R at 2. simpl. rewrite plus_IZR, Rmult_plus_distr_r. -apply new_location_correct. +apply new_location_correct; unfold F2R; simpl. apply bpow_gt_0. now apply Zpower_gt_1. now apply Z_mod_lt. @@ -665,7 +669,7 @@ rewrite <- Hm in H'. clear -H H'. apply inbetween_unique with (1 := H) (2 := H'). destruct (inbetween_float_bounds x m e l H) as (H1,H2). destruct (inbetween_float_bounds x m' e l' H') as (H3,H4). -cut (m < m' + 1 /\ m' < m + 1)%Z. clear ; omega. +cut (m < m' + 1 /\ m' < m + 1)%Z. clear ; lia. now split ; apply lt_F2R with beta e ; apply Rle_lt_trans with x. Qed. diff --git a/flocq/Calc/Div.v b/flocq/Calc/Div.v index 65195562..48e3bb51 100644 --- a/flocq/Calc/Div.v +++ b/flocq/Calc/Div.v @@ -19,6 +19,7 @@ COPYING file for more details. (** * Helper function and theorem for computing the rounded quotient of two floating-point numbers. *) +From Coq Require Import Lia. Require Import Raux Defs Generic_fmt Float_prop Digits Bracket. Set Implicit Arguments. @@ -80,7 +81,7 @@ assert ((F2R (Float beta m1 e1) / F2R (Float beta m2 e2) = IZR m1' / IZR m2' * b destruct (Zle_bool e (e1 - e2)) eqn:He' ; injection Hm ; intros ; subst. - split ; try easy. apply Zle_bool_imp_le in He'. - rewrite mult_IZR, IZR_Zpower by omega. + rewrite mult_IZR, IZR_Zpower by lia. unfold Zminus ; rewrite 2!bpow_plus, 2!bpow_opp. field. repeat split ; try apply Rgt_not_eq, bpow_gt_0. @@ -88,8 +89,8 @@ assert ((F2R (Float beta m1 e1) / F2R (Float beta m2 e2) = IZR m1' / IZR m2' * b - apply Z.leb_gt in He'. split ; cycle 1. { apply Z.mul_pos_pos with (1 := Hm2). - apply Zpower_gt_0 ; omega. } - rewrite mult_IZR, IZR_Zpower by omega. + apply Zpower_gt_0 ; lia. } + rewrite mult_IZR, IZR_Zpower by lia. unfold Zminus ; rewrite bpow_plus, bpow_opp, bpow_plus, bpow_opp. field. repeat split ; try apply Rgt_not_eq, bpow_gt_0. @@ -113,7 +114,7 @@ destruct (Z_lt_le_dec 1 m2') as [Hm2''|Hm2'']. now apply IZR_neq, Zgt_not_eq. field. now apply IZR_neq, Zgt_not_eq. -- assert (r = 0 /\ m2' = 1)%Z as [-> ->] by (clear -Hr Hm2'' ; omega). +- assert (r = 0 /\ m2' = 1)%Z as [-> ->] by (clear -Hr Hm2'' ; lia). unfold Rdiv. rewrite Rmult_1_l, Rplus_0_r, Rinv_1, Rmult_1_r. now constructor. @@ -150,10 +151,10 @@ unfold cexp. destruct (Zle_lt_or_eq _ _ H1) as [H|H]. - replace (fexp (mag _ _)) with (fexp (e + 1)). apply Z.le_min_r. - clear -H1 H2 H ; apply f_equal ; omega. + clear -H1 H2 H ; apply f_equal ; lia. - replace (fexp (mag _ _)) with (fexp e). apply Z.le_min_l. - clear -H1 H2 H ; apply f_equal ; omega. + clear -H1 H2 H ; apply f_equal ; lia. Qed. End Fcalc_div. diff --git a/flocq/Calc/Operations.v b/flocq/Calc/Operations.v index 3416cb4e..ac93d412 100644 --- a/flocq/Calc/Operations.v +++ b/flocq/Calc/Operations.v @@ -17,7 +17,9 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the COPYING file for more details. *) -(** Basic operations on floats: alignment, addition, multiplication *) +(** * Basic operations on floats: alignment, addition, multiplication *) + +From Coq Require Import Lia. Require Import Raux Defs Float_prop. Set Implicit Arguments. @@ -50,7 +52,7 @@ case (Zle_bool e1 e2) ; intros He ; split ; trivial. now rewrite <- F2R_change_exp. rewrite <- F2R_change_exp. apply refl_equal. -omega. +lia. Qed. Theorem Falign_spec_exp: diff --git a/flocq/Calc/Round.v b/flocq/Calc/Round.v index 5bde6af4..704a1ab2 100644 --- a/flocq/Calc/Round.v +++ b/flocq/Calc/Round.v @@ -19,6 +19,7 @@ COPYING file for more details. (** * Helper function for computing the rounded value of a real number. *) +From Coq Require Import Lia. Require Import Core Digits Float_prop Bracket. Section Fcalc_round. @@ -88,7 +89,7 @@ destruct Px as [Px|Px]. destruct Bx as [Bx1 Bx2]. apply lt_0_F2R in Bx1. apply gt_0_F2R in Bx2. - omega. + lia. Qed. (** Relates location and rounding. *) @@ -585,7 +586,7 @@ apply Zlt_succ. rewrite Zle_bool_true with (1 := Hm). rewrite Zle_bool_false. now case Rlt_bool. -omega. +lia. Qed. Definition truncate_aux t k := @@ -674,7 +675,7 @@ unfold cexp. rewrite mag_F2R_Zdigits. 2: now apply Zgt_not_eq. unfold k in Hk. clear -Hk. -omega. +lia. rewrite <- Hm', F2R_0. apply generic_format_0. Qed. @@ -717,14 +718,14 @@ simpl. apply Zfloor_div. intros H. generalize (Zpower_pos_gt_0 beta k) (Zle_bool_imp_le _ _ (radix_prop beta)). -omega. +lia. rewrite scaled_mantissa_generic with (1 := Fx). now rewrite Zfloor_IZR. (* *) split. apply refl_equal. unfold k in Hk. -omega. +lia. Qed. Theorem truncate_correct_partial' : @@ -744,7 +745,7 @@ destruct Zlt_bool ; intros Hk. now apply inbetween_float_new_location. ring. - apply (conj H1). - omega. + lia. Qed. Theorem truncate_correct_partial : @@ -790,7 +791,7 @@ intros x m e l [Hx|Hx] H1 H2. destruct Zlt_bool. intros H. apply False_ind. - omega. + lia. intros _. apply (conj H1). right. @@ -803,7 +804,7 @@ intros x m e l [Hx|Hx] H1 H2. rewrite mag_F2R_Zdigits with (1 := Zm). now apply Zlt_le_weak. - assert (Hm: m = 0%Z). - cut (m <= 0 < m + 1)%Z. omega. + cut (m <= 0 < m + 1)%Z. lia. assert (F2R (Float beta m e) <= x < F2R (Float beta (m + 1) e))%R as Hx'. apply inbetween_float_bounds with (1 := H1). rewrite <- Hx in Hx'. @@ -1156,7 +1157,7 @@ exact H1. unfold k in Hk. destruct H2 as [H2|H2]. left. -omega. +lia. right. split. exact H2. @@ -1165,7 +1166,7 @@ inversion_clear H1. rewrite H. apply generic_format_F2R. unfold cexp. -omega. +lia. Qed. End Fcalc_round. diff --git a/flocq/Calc/Sqrt.v b/flocq/Calc/Sqrt.v index 8843d21e..4d267d21 100644 --- a/flocq/Calc/Sqrt.v +++ b/flocq/Calc/Sqrt.v @@ -19,6 +19,7 @@ COPYING file for more details. (** * Helper functions and theorems for computing the rounded square root of a floating-point number. *) +From Coq Require Import Lia. Require Import Raux Defs Digits Generic_fmt Float_prop Bracket. Set Implicit Arguments. @@ -86,7 +87,7 @@ assert (sqrt (F2R (Float beta m1 e1)) = sqrt (IZR m') * bpow e)%R as Hf. { rewrite <- (sqrt_Rsqr (bpow e)) by apply bpow_ge_0. rewrite <- sqrt_mult. unfold Rsqr, m'. - rewrite mult_IZR, IZR_Zpower by omega. + rewrite mult_IZR, IZR_Zpower by lia. rewrite Rmult_assoc, <- 2!bpow_plus. now replace (_ + _)%Z with e1 by ring. now apply IZR_le. @@ -106,7 +107,7 @@ fold (Rsqr (IZR q)). rewrite sqrt_Rsqr. now constructor. apply IZR_le. -clear -Hr ; omega. +clear -Hr ; lia. (* .. r <> 0 *) constructor. split. @@ -117,14 +118,14 @@ fold (Rsqr (IZR q)). rewrite sqrt_Rsqr. apply Rle_refl. apply IZR_le. -clear -Hr ; omega. +clear -Hr ; lia. apply sqrt_lt_1. rewrite mult_IZR. apply Rle_0_sqr. rewrite <- Hq. now apply IZR_le. apply IZR_lt. -omega. +lia. apply Rlt_le_trans with (sqrt (IZR ((q + 1) * (q + 1)))). apply sqrt_lt_1. rewrite <- Hq. @@ -133,13 +134,13 @@ rewrite mult_IZR. apply Rle_0_sqr. apply IZR_lt. ring_simplify. -omega. +lia. rewrite mult_IZR. fold (Rsqr (IZR (q + 1))). rewrite sqrt_Rsqr. apply Rle_refl. apply IZR_le. -clear -Hr ; omega. +clear -Hr ; lia. (* ... location *) rewrite Rcompare_half_r. generalize (Rcompare_sqr (2 * sqrt (IZR (q * q + r))) (IZR q + IZR (q + 1))). @@ -154,14 +155,14 @@ replace ((q + (q + 1)) * (q + (q + 1)))%Z with (4 * (q * q) + 4 * q + 1)%Z by ri generalize (Zle_cases r q). case (Zle_bool r q) ; intros Hr''. change (4 * (q * q + r) < 4 * (q * q) + 4 * q + 1)%Z. -omega. +lia. change (4 * (q * q + r) > 4 * (q * q) + 4 * q + 1)%Z. -omega. +lia. rewrite <- Hq. now apply IZR_le. rewrite <- plus_IZR. apply IZR_le. -clear -Hr ; omega. +clear -Hr ; lia. apply Rmult_le_pos. now apply IZR_le. apply sqrt_ge_0. @@ -188,7 +189,7 @@ set (e := Z.min _ _). assert (2 * e <= e1)%Z as He. { assert (e <= Z.div2 e1)%Z by apply Z.le_min_r. rewrite (Zdiv2_odd_eqn e1). - destruct Z.odd ; omega. } + destruct Z.odd ; lia. } generalize (Fsqrt_core_correct m1 e1 e Hm1 He). destruct Fsqrt_core as [m l]. apply conj. diff --git a/flocq/Core/Defs.v b/flocq/Core/Defs.v index f5c6f33b..27342df9 100644 --- a/flocq/Core/Defs.v +++ b/flocq/Core/Defs.v @@ -80,4 +80,8 @@ Definition Rnd_NA_pt (F : R -> Prop) (x f : R) := Rnd_N_pt F x f /\ forall f2 : R, Rnd_N_pt F x f2 -> (Rabs f2 <= Rabs f)%R. +Definition Rnd_N0_pt (F : R -> Prop) (x f : R) := + Rnd_N_pt F x f /\ + forall f2 : R, Rnd_N_pt F x f2 -> (Rabs f <= Rabs f2)%R. + End RND. diff --git a/flocq/Core/Digits.v b/flocq/Core/Digits.v index bed2e20a..a18ff8d6 100644 --- a/flocq/Core/Digits.v +++ b/flocq/Core/Digits.v @@ -17,8 +17,13 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the COPYING file for more details. *) -Require Import ZArith Zquot. +From Coq Require Import Lia ZArith Zquot. + Require Import Zaux. +Require Import SpecFloatCompat. + +Notation digits2_pos := digits2_pos (only parsing). +Notation Zdigits2 := Zdigits2 (only parsing). (** Number of bits (radix 2) of a positive integer. @@ -41,9 +46,9 @@ intros n d. unfold d. clear. assert (Hp: forall m, (Zpower_nat 2 (S m) = 2 * Zpower_nat 2 m)%Z) by easy. induction n ; simpl digits2_Pnat. rewrite Zpos_xI, 2!Hp. -omega. +lia. rewrite (Zpos_xO n), 2!Hp. -omega. +lia. now split. Qed. @@ -185,13 +190,13 @@ apply Zgt_not_eq. now apply Zpower_gt_0. now apply Zle_minus_le_0. destruct (Zle_or_lt 0 k) as [H0|H0]. -rewrite (Zdigit_lt n) by omega. +rewrite (Zdigit_lt n) by lia. unfold Zdigit. replace k' with (k' - k + k)%Z by ring. rewrite Zpower_plus with (2 := H0). rewrite Zmult_assoc, Z_quot_mult. replace (k' - k)%Z with (k' - k - 1 + 1)%Z by ring. -rewrite Zpower_exp by omega. +rewrite Zpower_exp by lia. rewrite Zmult_assoc. change (Zpower beta 1) with (beta * 1)%Z. rewrite Zmult_1_r. @@ -203,7 +208,7 @@ now apply Zlt_le_weak. rewrite Zdigit_lt with (1 := H0). apply sym_eq. apply Zdigit_lt. -omega. +lia. Qed. Theorem Zdigit_div_pow : @@ -227,7 +232,7 @@ unfold Zdigit. rewrite <- 2!ZOdiv_mod_mult. apply (f_equal (fun x => Z.quot x (beta ^ k))). replace k' with (k + 1 + (k' - (k + 1)))%Z by ring. -rewrite Zpower_exp by omega. +rewrite Zpower_exp by lia. rewrite Zmult_comm. rewrite Zpower_plus by easy. change (Zpower beta 1) with (beta * 1)%Z. @@ -449,7 +454,7 @@ unfold Zscale. case Zle_bool_spec ; intros Hk. now apply Zdigit_mul_pow. apply Zdigit_div_pow with (1 := Hk'). -omega. +lia. Qed. Theorem Zscale_0 : @@ -492,7 +497,7 @@ now rewrite Zpower_plus. now apply Zplus_le_0_compat. case Zle_bool_spec ; intros Hk''. pattern k at 1 ; replace k with (k + k' + -k')%Z by ring. -assert (0 <= -k')%Z by omega. +assert (0 <= -k')%Z by lia. rewrite Zpower_plus by easy. rewrite Zmult_assoc, Z_quot_mult. apply refl_equal. @@ -503,7 +508,7 @@ rewrite Zpower_plus with (2 := Hk). apply Zquot_mult_cancel_r. apply Zgt_not_eq. now apply Zpower_gt_0. -omega. +lia. Qed. Theorem Zscale_scale : @@ -532,7 +537,7 @@ rewrite Zdigit_mod_pow by apply Hk. rewrite Zdigit_scale by apply Hk. unfold Zminus. now rewrite Z.opp_involutive, Zplus_comm. -omega. +lia. Qed. Theorem Zdigit_slice_out : @@ -589,16 +594,16 @@ destruct (Zle_or_lt k2' k) as [Hk''|Hk'']. now apply Zdigit_slice_out. rewrite Zdigit_slice by now split. apply Zdigit_slice_out. -zify ; omega. -rewrite Zdigit_slice by (zify ; omega). +zify ; lia. +rewrite Zdigit_slice by (zify ; lia). rewrite (Zdigit_slice n (k1 + k1')) by now split. rewrite Zdigit_slice. now rewrite Zplus_assoc. -zify ; omega. +zify ; lia. unfold Zslice. rewrite Z.min_r. now rewrite Zle_bool_false. -omega. +lia. Qed. Theorem Zslice_mul_pow : @@ -624,14 +629,14 @@ case Zle_bool_spec ; intros Hk2. apply (f_equal (fun x => Z.rem x (beta ^ k2))). unfold Zscale. case Zle_bool_spec ; intros Hk1'. -replace k1 with Z0 by omega. +replace k1 with Z0 by lia. case Zle_bool_spec ; intros Hk'. -replace k with Z0 by omega. +replace k with Z0 by lia. simpl. now rewrite Z.quot_1_r. rewrite Z.opp_involutive. apply Zmult_1_r. -rewrite Zle_bool_false by omega. +rewrite Zle_bool_false by lia. rewrite 2!Z.opp_involutive, Zplus_comm. rewrite Zpower_plus by assumption. apply Zquot_Zquot. @@ -646,7 +651,7 @@ unfold Zscale. case Zle_bool_spec; intros Hk. now apply Zslice_mul_pow. apply Zslice_div_pow with (2 := Hk1). -omega. +lia. Qed. Theorem Zslice_div_pow_scale : @@ -666,7 +671,7 @@ apply Zdigit_slice_out. now apply Zplus_le_compat_l. rewrite Zdigit_slice by now split. destruct (Zle_or_lt 0 (k1 + k')) as [Hk1'|Hk1']. -rewrite Zdigit_slice by omega. +rewrite Zdigit_slice by lia. rewrite Zdigit_div_pow by assumption. apply f_equal. ring. @@ -685,15 +690,15 @@ rewrite Zdigit_plus. rewrite Zdigit_scale with (1 := Hk). destruct (Zle_or_lt (l1 + l2) k) as [Hk2|Hk2]. rewrite Zdigit_slice_out with (1 := Hk2). -now rewrite 2!Zdigit_slice_out by omega. +now rewrite 2!Zdigit_slice_out by lia. rewrite Zdigit_slice with (1 := conj Hk Hk2). destruct (Zle_or_lt l1 k) as [Hk1|Hk1]. rewrite Zdigit_slice_out with (1 := Hk1). -rewrite Zdigit_slice by omega. +rewrite Zdigit_slice by lia. simpl ; apply f_equal. ring. rewrite Zdigit_slice with (1 := conj Hk Hk1). -rewrite (Zdigit_lt _ (k - l1)) by omega. +rewrite (Zdigit_lt _ (k - l1)) by lia. apply Zplus_0_r. rewrite Zmult_comm. apply Zsame_sign_trans_weak with n. @@ -713,7 +718,7 @@ left. now apply Zdigit_slice_out. right. apply Zdigit_lt. -omega. +lia. Qed. Section digits_aux. @@ -788,7 +793,7 @@ pattern (radix_val beta) at 2 5 ; replace (radix_val beta) with (Zpower beta 1) rewrite <- Zpower_plus. rewrite Zplus_comm. apply IHu. -clear -Hv ; omega. +clear -Hv ; lia. split. now ring_simplify (1 + v - 1)%Z. now rewrite Zplus_assoc. @@ -928,7 +933,7 @@ intros x y Zx Hxy. assert (Hx := Zdigits_correct x). assert (Hy := Zdigits_correct y). apply (Zpower_lt_Zpower beta). -zify ; omega. +zify ; lia. Qed. Theorem lt_Zdigits : @@ -938,7 +943,7 @@ Theorem lt_Zdigits : (x < y)%Z. Proof. intros x y Hy. -cut (y <= x -> Zdigits y <= Zdigits x)%Z. omega. +cut (y <= x -> Zdigits y <= Zdigits x)%Z. lia. now apply Zdigits_le. Qed. @@ -951,7 +956,7 @@ intros e x Hex. destruct (Zdigits_correct x) as [H1 H2]. apply Z.le_trans with (2 := H1). apply Zpower_le. -clear -Hex ; omega. +clear -Hex ; lia. Qed. Theorem Zdigits_le_Zpower : @@ -961,7 +966,7 @@ Theorem Zdigits_le_Zpower : Proof. intros e x. generalize (Zpower_le_Zdigits e x). -omega. +lia. Qed. Theorem Zpower_gt_Zdigits : @@ -982,7 +987,7 @@ Theorem Zdigits_gt_Zpower : Proof. intros e x Hex. generalize (Zpower_gt_Zdigits e x). -omega. +lia. Qed. (** Number of digits of a product. @@ -1010,8 +1015,8 @@ apply Zdigits_correct. apply Zlt_le_succ. rewrite <- (Z.abs_eq y) at 1 by easy. apply Zdigits_correct. -clear -Hx ; omega. -clear -Hy ; omega. +clear -Hx ; lia. +clear -Hy ; lia. change Z0 with (0 + 0 + 0)%Z. apply Zplus_le_compat. now apply Zplus_le_compat. @@ -1031,7 +1036,7 @@ apply Zdigits_le. apply Zabs_pos. rewrite Zabs_Zmult. generalize (Zabs_pos x) (Zabs_pos y). -omega. +lia. apply Zdigits_mult_strong ; apply Zabs_pos. Qed. @@ -1041,7 +1046,7 @@ Theorem Zdigits_mult_ge : (Zdigits x + Zdigits y - 1 <= Zdigits (x * y))%Z. Proof. intros x y Zx Zy. -cut ((Zdigits x - 1) + (Zdigits y - 1) < Zdigits (x * y))%Z. omega. +cut ((Zdigits x - 1) + (Zdigits y - 1) < Zdigits (x * y))%Z. lia. apply Zdigits_gt_Zpower. rewrite Zabs_Zmult. rewrite Zpower_exp. @@ -1052,8 +1057,8 @@ apply Zpower_le_Zdigits. apply Zlt_pred. apply Zpower_ge_0. apply Zpower_ge_0. -generalize (Zdigits_gt_0 x). omega. -generalize (Zdigits_gt_0 y). omega. +generalize (Zdigits_gt_0 x). lia. +generalize (Zdigits_gt_0 y). lia. Qed. Theorem Zdigits_div_Zpower : @@ -1073,7 +1078,7 @@ destruct (Zle_lt_or_eq _ _ (proj2 He)) as [He'|He']. replace (Zdigits m - e - 1)%Z with (Zdigits m - 1 - e)%Z by ring. rewrite Z.pow_sub_r. 2: apply Zgt_not_eq, radix_gt_0. - 2: clear -He He' ; omega. + 2: clear -He He' ; lia. apply Z_div_le with (2 := H1). now apply Z.lt_gt, Zpower_gt_0. apply Zmult_lt_reg_r with (Zpower beta e). @@ -1118,13 +1123,6 @@ rewrite <- Zpower_nat_Z. apply digits2_Pnat_correct. Qed. -Fixpoint digits2_pos (n : positive) : positive := - match n with - | xH => xH - | xO p => Pos.succ (digits2_pos p) - | xI p => Pos.succ (digits2_pos p) - end. - Theorem Zpos_digits2_pos : forall m : positive, Zpos (digits2_pos m) = Zdigits radix2 (Zpos m). @@ -1137,13 +1135,6 @@ induction m ; simpl ; try easy ; apply f_equal, IHm. Qed. -Definition Zdigits2 n := - match n with - | Z0 => n - | Zpos p => Zpos (digits2_pos p) - | Zneg p => Zpos (digits2_pos p) - end. - Lemma Zdigits2_Zdigits : forall n, Zdigits2 n = Zdigits radix2 n. Proof. diff --git a/flocq/Core/FIX.v b/flocq/Core/FIX.v index 4e0a25e6..779d94cb 100644 --- a/flocq/Core/FIX.v +++ b/flocq/Core/FIX.v @@ -18,6 +18,8 @@ COPYING file for more details. *) (** * Fixed-point format *) + +From Coq Require Import Lia. Require Import Raux Defs Round_pred Generic_fmt Ulp Round_NE. Section RND_FIX. @@ -86,9 +88,16 @@ intros x; unfold ulp. case Req_bool_spec; intros Zx. case (negligible_exp_spec FIX_exp). intros T; specialize (T (emin-1)%Z); contradict T. -unfold FIX_exp; omega. +unfold FIX_exp; lia. intros n _; reflexivity. reflexivity. Qed. +Global Instance exists_NE_FIX : + Exists_NE beta FIX_exp. +Proof. +unfold Exists_NE, FIX_exp; simpl. +right; split; auto. +Qed. + End RND_FIX. diff --git a/flocq/Core/FLT.v b/flocq/Core/FLT.v index bd48d4b7..7301328d 100644 --- a/flocq/Core/FLT.v +++ b/flocq/Core/FLT.v @@ -46,7 +46,7 @@ intros k. unfold FLT_exp. generalize (prec_gt_0 prec). repeat split ; - intros ; zify ; omega. + intros ; zify ; lia. Qed. Theorem generic_format_FLT : @@ -93,24 +93,28 @@ simpl in ex. specialize (He Hx0). apply Rlt_le_trans with (1 := proj2 He). apply bpow_le. -cut (ex' - prec <= ex)%Z. omega. +cut (ex' - prec <= ex)%Z. lia. unfold ex, FLT_exp. apply Z.le_max_l. apply Z.le_max_r. Qed. - -Theorem FLT_format_bpow : +Theorem generic_format_FLT_bpow : forall e, (emin <= e)%Z -> generic_format beta FLT_exp (bpow e). Proof. intros e He. apply generic_format_bpow; unfold FLT_exp. apply Z.max_case; try assumption. -unfold Prec_gt_0 in prec_gt_0_; omega. +unfold Prec_gt_0 in prec_gt_0_; lia. Qed. - - +Theorem FLT_format_bpow : + forall e, (emin <= e)%Z -> FLT_format (bpow e). +Proof. +intros e He. +apply FLT_format_generic. +now apply generic_format_FLT_bpow. +Qed. Theorem FLT_format_satisfies_any : satisfies_any FLT_format. @@ -136,12 +140,40 @@ apply Zmax_left. destruct (mag beta x) as (ex, He). unfold FLX_exp. simpl. specialize (He Hx0). -cut (emin + prec - 1 < ex)%Z. omega. +cut (emin + prec - 1 < ex)%Z. lia. apply (lt_bpow beta). apply Rle_lt_trans with (1 := Hx). apply He. Qed. +(** FLT is a nice format: it has a monotone exponent... *) +Global Instance FLT_exp_monotone : Monotone_exp FLT_exp. +Proof. +intros ex ey. +unfold FLT_exp. +zify ; lia. +Qed. + +(** and it allows a rounding to nearest, ties to even. *) +Global Instance exists_NE_FLT : + (Z.even beta = false \/ (1 < prec)%Z) -> + Exists_NE beta FLT_exp. +Proof. +intros [H|H]. +now left. +right. +intros e. +unfold FLT_exp. +destruct (Zmax_spec (e - prec) emin) as [(H1,H2)|(H1,H2)] ; + rewrite H2 ; clear H2. +generalize (Zmax_spec (e + 1 - prec) emin). +generalize (Zmax_spec (e - prec + 1 - prec) emin). +lia. +generalize (Zmax_spec (e + 1 - prec) emin). +generalize (Zmax_spec (emin + 1 - prec) emin). +lia. +Qed. + (** Links between FLT and FLX *) Theorem generic_format_FLT_FLX : forall x : R, @@ -192,7 +224,7 @@ apply Zmax_right. unfold FIX_exp. destruct (mag beta x) as (ex, Hex). simpl. -cut (ex - 1 < emin + prec)%Z. omega. +cut (ex - 1 < emin + prec)%Z. lia. apply (lt_bpow beta). apply Rle_lt_trans with (2 := Hx). now apply Hex. @@ -222,7 +254,7 @@ apply generic_inclusion_le... intros e He. unfold FIX_exp. apply Z.max_lub. -omega. +lia. apply Z.le_refl. Qed. @@ -238,45 +270,53 @@ destruct (Z.max_spec (n - prec) emin) as [(Hm, Hm')|(Hm, Hm')]. revert Hn prec_gt_0_; unfold FLT_exp, Prec_gt_0; rewrite Hm'; lia. Qed. -Theorem generic_format_FLT_1 (Hemin : (emin <= 0)%Z) : +Theorem generic_format_FLT_1 : + (emin <= 0)%Z -> generic_format beta FLT_exp 1. Proof. -unfold generic_format, scaled_mantissa, cexp, F2R; simpl. -rewrite Rmult_1_l, (mag_unique beta 1 1). -{ unfold FLT_exp. - destruct (Z.max_spec_le (1 - prec) emin) as [(H,Hm)|(H,Hm)]; rewrite Hm; - (rewrite <- IZR_Zpower; [|unfold Prec_gt_0 in prec_gt_0_; omega]); - (rewrite Ztrunc_IZR, IZR_Zpower, <-bpow_plus; - [|unfold Prec_gt_0 in prec_gt_0_; omega]); - now replace (_ + _)%Z with Z0 by ring. } -rewrite Rabs_R1; simpl; split; [now right|]. -rewrite IZR_Zpower_pos; simpl; rewrite Rmult_1_r; apply IZR_lt. -apply (Z.lt_le_trans _ 2); [omega|]; apply Zle_bool_imp_le, beta. +intros Hemin. +now apply (generic_format_FLT_bpow 0). Qed. -Theorem ulp_FLT_small: forall x, (Rabs x < bpow (emin+prec))%R -> - ulp beta FLT_exp x = bpow emin. -Proof with auto with typeclass_instances. +Theorem ulp_FLT_0 : + ulp beta FLT_exp 0 = bpow emin. +Proof. +unfold ulp. +rewrite Req_bool_true by easy. +case negligible_exp_spec. +- intros T. + elim Zle_not_lt with (2 := T emin). + apply Z.le_max_r. +- intros n Hn. + apply f_equal. + assert (H: FLT_exp emin = emin). + apply Z.max_r. + generalize (prec_gt_0 prec). + clear ; lia. + rewrite <- H. + apply fexp_negligible_exp_eq. + apply FLT_exp_valid. + exact Hn. + rewrite H. + apply Z.le_refl. +Qed. + +Theorem ulp_FLT_small : + forall x, (Rabs x < bpow (emin + prec))%R -> + ulp beta FLT_exp x = bpow emin. +Proof. intros x Hx. -unfold ulp; case Req_bool_spec; intros Hx2. -(* x = 0 *) -case (negligible_exp_spec FLT_exp). -intros T; specialize (T (emin-1)%Z); contradict T. -apply Zle_not_lt; unfold FLT_exp. -apply Z.le_trans with (2:=Z.le_max_r _ _); omega. -assert (V:FLT_exp emin = emin). -unfold FLT_exp; apply Z.max_r. -unfold Prec_gt_0 in prec_gt_0_; omega. -intros n H2; rewrite <-V. -apply f_equal, fexp_negligible_exp_eq... -omega. -(* x <> 0 *) -apply f_equal; unfold cexp, FLT_exp. +destruct (Req_dec x 0%R) as [Zx|Zx]. +{ rewrite Zx. + apply ulp_FLT_0. } +rewrite ulp_neq_0 by easy. +apply f_equal. apply Z.max_r. -assert (mag beta x-1 < emin+prec)%Z;[idtac|omega]. -destruct (mag beta x) as (e,He); simpl. +destruct (mag beta x) as [e He]. +simpl. +cut (e - 1 < emin + prec)%Z. lia. apply lt_bpow with beta. -apply Rle_lt_trans with (2:=Hx). +apply Rle_lt_trans with (2 := Hx). now apply He. Qed. @@ -295,8 +335,8 @@ apply Rle_trans with (bpow (e-1)*bpow (1-prec))%R. rewrite <- bpow_plus. right; apply f_equal. replace (e - 1 + (1 - prec))%Z with (e - prec)%Z by ring. -apply Z.max_l. -assert (emin+prec-1 < e)%Z; try omega. +apply Z.max_l; simpl. +assert (emin+prec-1 < e)%Z; try lia. apply lt_bpow with beta. apply Rle_lt_trans with (1:=Hx). now apply He. @@ -334,7 +374,7 @@ unfold ulp; rewrite Req_bool_false; [|now intro H; apply Nzx, (Rmult_eq_reg_r (bpow e)); [rewrite Rmult_0_l|apply Rgt_not_eq, Rlt_gt, bpow_gt_0]]. rewrite (Req_bool_false _ _ Nzx), <- bpow_plus; f_equal; unfold cexp, FLT_exp. -rewrite (mag_mult_bpow _ _ _ Nzx), !Z.max_l; omega. +rewrite (mag_mult_bpow _ _ _ Nzx), !Z.max_l; lia. Qed. Lemma succ_FLT_exact_shift_pos : @@ -375,32 +415,106 @@ fold (Req_bool (-x) (bpow (mag beta (-x) - 1))); case Req_bool. rewrite ulp_FLT_exact_shift; [ring|lra| |]; rewrite mag_opp; lia. Qed. -(** FLT is a nice format: it has a monotone exponent... *) -Global Instance FLT_exp_monotone : Monotone_exp FLT_exp. -Proof. -intros ex ey. -unfold FLT_exp. -zify ; omega. -Qed. - -(** and it allows a rounding to nearest, ties to even. *) -Hypothesis NE_prop : Z.even beta = false \/ (1 < prec)%Z. - -Global Instance exists_NE_FLT : Exists_NE beta FLT_exp. +Theorem ulp_FLT_pred_pos : + forall x, + generic_format beta FLT_exp x -> + (0 <= x)%R -> + ulp beta FLT_exp (pred beta FLT_exp x) = ulp beta FLT_exp x \/ + (x = bpow (mag beta x - 1) /\ ulp beta FLT_exp (pred beta FLT_exp x) = (ulp beta FLT_exp x / IZR beta)%R). Proof. -destruct NE_prop as [H|H]. -now left. -right. -intros e. -unfold FLT_exp. -destruct (Zmax_spec (e - prec) emin) as [(H1,H2)|(H1,H2)] ; - rewrite H2 ; clear H2. -generalize (Zmax_spec (e + 1 - prec) emin). -generalize (Zmax_spec (e - prec + 1 - prec) emin). -omega. -generalize (Zmax_spec (e + 1 - prec) emin). -generalize (Zmax_spec (emin + 1 - prec) emin). -omega. +intros x Fx [Hx|Hx] ; cycle 1. +{ rewrite <- Hx. + rewrite pred_0. + rewrite ulp_opp. + left. + apply ulp_ulp_0. + apply FLT_exp_valid. + typeclasses eauto. } +assert (Hp: (0 <= pred beta FLT_exp x)%R). +{ apply pred_ge_gt ; try easy. + apply FLT_exp_valid. + apply generic_format_0. } +destruct (Rle_or_lt (bpow (emin + prec)) x) as [Hs|Hs]. +- unfold ulp. + rewrite Req_bool_false ; cycle 1. + { intros Zp. + apply Rle_not_lt with (1 := Hs). + generalize (f_equal (succ beta FLT_exp) Zp). + rewrite succ_pred. + rewrite succ_0, ulp_FLT_0. + intros H. + rewrite H. + apply bpow_lt. + generalize (prec_gt_0 prec). + lia. + apply FLT_exp_valid. + exact Fx. } + rewrite Req_bool_false by now apply Rgt_not_eq. + unfold cexp. + destruct (mag beta x) as [e He]. + simpl. + specialize (He (Rgt_not_eq _ _ Hx)). + rewrite Rabs_pos_eq in He by now apply Rlt_le. + destruct (proj1 He) as [Hb|Hb]. + + left. + apply (f_equal (fun v => bpow (FLT_exp v))). + apply mag_unique. + rewrite Rabs_pos_eq by easy. + split. + * apply pred_ge_gt ; try easy. + apply FLT_exp_valid. + apply generic_format_FLT_bpow. + apply Z.lt_le_pred. + apply lt_bpow with beta. + apply Rle_lt_trans with (2 := proj2 He). + apply Rle_trans with (2 := Hs). + apply bpow_le. + generalize (prec_gt_0 prec). + lia. + * apply pred_lt_le. + now apply Rgt_not_eq. + now apply Rlt_le. + + right. + split. + easy. + replace (FLT_exp _) with (FLT_exp e + -1)%Z. + rewrite bpow_plus. + now rewrite <- (Zmult_1_r beta). + rewrite <- Hb. + unfold FLT_exp at 1 2. + replace (mag_val _ _ (mag _ _)) with (e - 1)%Z. + rewrite <- Hb in Hs. + apply le_bpow in Hs. + zify ; lia. + apply eq_sym, mag_unique. + rewrite Hb. + rewrite Rabs_pos_eq by easy. + split ; cycle 1. + { apply pred_lt_id. + now apply Rgt_not_eq. } + apply pred_ge_gt. + apply FLT_exp_valid. + apply generic_format_FLT_bpow. + cut (emin + 1 < e)%Z. lia. + apply lt_bpow with beta. + apply Rle_lt_trans with (2 := proj2 He). + apply Rle_trans with (2 := Hs). + apply bpow_le. + generalize (prec_gt_0 prec). + lia. + exact Fx. + apply Rlt_le_trans with (2 := proj1 He). + apply bpow_lt. + apply Z.lt_pred_l. +- left. + rewrite (ulp_FLT_small x). + apply ulp_FLT_small. + rewrite Rabs_pos_eq by easy. + apply pred_lt_le. + now apply Rgt_not_eq. + now apply Rlt_le. + rewrite Rabs_pos_eq by now apply Rlt_le. + exact Hs. Qed. End RND_FLT. diff --git a/flocq/Core/FLX.v b/flocq/Core/FLX.v index 803d96ef..78bffba5 100644 --- a/flocq/Core/FLX.v +++ b/flocq/Core/FLX.v @@ -48,7 +48,7 @@ Proof. intros k. unfold FLX_exp. generalize prec_gt_0. -repeat split ; intros ; omega. +repeat split ; intros ; lia. Qed. Theorem FIX_format_FLX : @@ -212,7 +212,7 @@ Proof. case (negligible_exp_spec FLX_exp). intros _; reflexivity. intros n H2; contradict H2. -unfold FLX_exp; unfold Prec_gt_0 in prec_gt_0_; omega. +unfold FLX_exp; unfold Prec_gt_0 in prec_gt_0_; lia. Qed. Theorem generic_format_FLX_1 : @@ -221,13 +221,13 @@ Proof. unfold generic_format, scaled_mantissa, cexp, F2R; simpl. rewrite Rmult_1_l, (mag_unique beta 1 1). { unfold FLX_exp. - rewrite <- IZR_Zpower; [|unfold Prec_gt_0 in prec_gt_0_; omega]. - rewrite Ztrunc_IZR, IZR_Zpower; [|unfold Prec_gt_0 in prec_gt_0_; omega]. + rewrite <- IZR_Zpower; [|unfold Prec_gt_0 in prec_gt_0_; lia]. + rewrite Ztrunc_IZR, IZR_Zpower; [|unfold Prec_gt_0 in prec_gt_0_; lia]. rewrite <- bpow_plus. now replace (_ + _)%Z with Z0 by ring. } rewrite Rabs_R1; simpl; split; [now right|]. unfold Z.pow_pos; simpl; rewrite Zmult_1_r; apply IZR_lt. -assert (H := Zle_bool_imp_le _ _ (radix_prop beta)); omega. +assert (H := Zle_bool_imp_le _ _ (radix_prop beta)); lia. Qed. Theorem ulp_FLX_0: (ulp beta FLX_exp 0 = 0)%R. @@ -356,7 +356,7 @@ destruct NE_prop as [H|H]. now left. right. unfold FLX_exp. -split ; omega. +split ; lia. Qed. End RND_FLX. diff --git a/flocq/Core/FTZ.v b/flocq/Core/FTZ.v index 1a93bcd9..d6bae6ea 100644 --- a/flocq/Core/FTZ.v +++ b/flocq/Core/FTZ.v @@ -18,6 +18,8 @@ COPYING file for more details. *) (** * Floating-point format with abrupt underflow *) + +From Coq Require Import Lia. Require Import Raux Defs Round_pred Generic_fmt. Require Import Float_prop Ulp FLX. @@ -48,22 +50,22 @@ unfold FTZ_exp. generalize (Zlt_cases (k - prec) emin). case (Zlt_bool (k - prec) emin) ; intros H1. split ; intros H2. -omega. +lia. split. generalize (Zlt_cases (emin + prec + 1 - prec) emin). case (Zlt_bool (emin + prec + 1 - prec) emin) ; intros H3. -omega. +lia. generalize (Zlt_cases (emin + prec - 1 + 1 - prec) emin). generalize (prec_gt_0 prec). -case (Zlt_bool (emin + prec - 1 + 1 - prec) emin) ; omega. +case (Zlt_bool (emin + prec - 1 + 1 - prec) emin) ; lia. intros l H3. generalize (Zlt_cases (l - prec) emin). -case (Zlt_bool (l - prec) emin) ; omega. +case (Zlt_bool (l - prec) emin) ; lia. split ; intros H2. generalize (Zlt_cases (k + 1 - prec) emin). -case (Zlt_bool (k + 1 - prec) emin) ; omega. +case (Zlt_bool (k + 1 - prec) emin) ; lia. generalize (prec_gt_0 prec). -split ; intros ; omega. +split ; intros ; lia. Qed. Theorem FLXN_format_FTZ : @@ -94,7 +96,7 @@ rewrite Zlt_bool_false. apply Z.le_refl. rewrite Hx1, mag_F2R with (1 := Zxm). cut (prec - 1 < mag beta (IZR xm))%Z. -clear -Hx3 ; omega. +clear -Hx3 ; lia. apply mag_gt_Zpower with (1 := Zxm). apply Hx2. apply generic_format_FLXN. @@ -135,7 +137,7 @@ change (0 < F2R (Float beta (Z.abs (Ztrunc (x * bpow (- (emin + prec - 1))))) (e rewrite F2R_Zabs, <- Hx2. now apply Rabs_pos_lt. apply bpow_le. -omega. +lia. rewrite Hx2. eexists ; repeat split ; simpl. apply le_IZR. @@ -186,7 +188,7 @@ intros e He. unfold FTZ_exp. rewrite Zlt_bool_false. apply Z.le_refl. -omega. +lia. Qed. Theorem ulp_FTZ_0 : @@ -196,12 +198,12 @@ unfold ulp; rewrite Req_bool_true; trivial. case (negligible_exp_spec FTZ_exp). intros T; specialize (T (emin-1)%Z); contradict T. apply Zle_not_lt; unfold FTZ_exp; unfold Prec_gt_0 in prec_gt_0_. -rewrite Zlt_bool_true; omega. +rewrite Zlt_bool_true; lia. assert (V:(FTZ_exp (emin+prec-1) = emin+prec-1)%Z). -unfold FTZ_exp; rewrite Zlt_bool_true; omega. +unfold FTZ_exp; rewrite Zlt_bool_true; lia. intros n H2; rewrite <-V. apply f_equal, fexp_negligible_exp_eq... -omega. +lia. Qed. @@ -290,12 +292,12 @@ apply Rle_trans with (2 := proj1 He). apply bpow_le. unfold FLX_exp. generalize (prec_gt_0 prec). -clear -He' ; omega. +clear -He' ; lia. apply bpow_ge_0. unfold FLX_exp, FTZ_exp. rewrite Zlt_bool_false. apply refl_equal. -clear -He' ; omega. +clear -He' ; lia. Qed. Theorem round_FTZ_small : @@ -331,7 +333,7 @@ intros He'. elim Rlt_not_le with (1 := Hx). apply Rle_trans with (2 := proj1 He). apply bpow_le. -omega. +lia. apply bpow_ge_0. Qed. diff --git a/flocq/Core/Float_prop.v b/flocq/Core/Float_prop.v index 804dd397..a1f48d04 100644 --- a/flocq/Core/Float_prop.v +++ b/flocq/Core/Float_prop.v @@ -18,6 +18,8 @@ COPYING file for more details. *) (** * Basic properties of floating-point formats: lemmas about mantissa, exponent... *) + +From Coq Require Import Lia. Require Import Raux Defs Digits. Section Float_prop. @@ -360,7 +362,7 @@ unfold F2R. simpl. apply Rmult_le_compat_r. apply bpow_ge_0. apply IZR_le. -omega. +lia. Qed. Theorem F2R_lt_bpow : @@ -379,7 +381,7 @@ rewrite <-IZR_Zpower. 2: now apply Zle_left. now apply IZR_lt. elim Zlt_not_le with (1 := Hm). simpl. -cut (e' - e < 0)%Z. 2: omega. +cut (e' - e < 0)%Z. 2: lia. clear. case (e' - e)%Z ; try easy. intros p _. @@ -413,7 +415,7 @@ now elim (Zle_not_lt _ _ (Zabs_pos m)). (* . *) replace (e - e' + p)%Z with (e - (e' - p))%Z by ring. apply F2R_change_exp. -cut (e' - 1 < e + p)%Z. omega. +cut (e' - 1 < e + p)%Z. lia. apply (lt_bpow beta). apply Rle_lt_trans with (1 := Hf). rewrite <- F2R_Zabs, Zplus_comm, bpow_plus. @@ -472,10 +474,10 @@ assert (Hd := Zdigits_correct beta n). assert (Hd' := Zdigits_gt_0 beta n). apply Zle_antisym ; apply (bpow_lt_bpow beta). apply Rle_lt_trans with (2 := proj2 He). -rewrite <- IZR_Zpower by omega. +rewrite <- IZR_Zpower by lia. now apply IZR_le. apply Rle_lt_trans with (1 := proj1 He). -rewrite <- IZR_Zpower by omega. +rewrite <- IZR_Zpower by lia. now apply IZR_lt. Qed. diff --git a/flocq/Core/Generic_fmt.v b/flocq/Core/Generic_fmt.v index cb37bd91..af1bf3c1 100644 --- a/flocq/Core/Generic_fmt.v +++ b/flocq/Core/Generic_fmt.v @@ -18,6 +18,8 @@ COPYING file for more details. *) (** * What is a real number belonging to a format, and many properties. *) + +From Coq Require Import Lia. Require Import Raux Defs Round_pred Float_prop. Section Generic. @@ -52,7 +54,7 @@ apply Znot_ge_lt. intros Hl. apply Z.ge_le in Hl. assert (H' := proj2 (proj2 (valid_exp l) Hl) k). -omega. +lia. Qed. Theorem valid_exp_large' : @@ -67,7 +69,7 @@ apply Z.ge_le in H'. assert (Hl := Z.le_trans _ _ _ H H'). apply valid_exp in Hl. assert (H1 := proj2 Hl k H'). -omega. +lia. Qed. Definition cexp x := @@ -425,7 +427,7 @@ rewrite Gx. replace (Ztrunc (scaled_mantissa x)) with Z0. apply F2R_0. cut (Z.abs (Ztrunc (scaled_mantissa x)) < 1)%Z. -clear ; zify ; omega. +clear ; zify ; lia. apply lt_IZR. rewrite abs_IZR. now rewrite <- scaled_mantissa_generic. @@ -522,7 +524,7 @@ specialize (Ex Hxz). apply Rlt_le_trans with (1 := proj2 Ex). apply bpow_le. specialize (Hp ex). -omega. +lia. Qed. Theorem generic_format_bpow_inv' : @@ -544,7 +546,7 @@ apply bpow_gt_0. split. apply bpow_ge_0. apply (bpow_lt _ _ 0). -clear -He ; omega. +clear -He ; lia. Qed. Theorem generic_format_bpow_inv : @@ -555,7 +557,7 @@ Proof. intros e He. apply generic_format_bpow_inv' in He. assert (H := valid_exp_large' (e + 1) e). -omega. +lia. Qed. Section Fcore_generic_round_pos. @@ -587,7 +589,7 @@ rewrite <- (Zrnd_IZR (Zceil x)). apply Zrnd_le. apply Zceil_ub. rewrite Zceil_floor_neq. -omega. +lia. intros H. rewrite <- H in Hx. rewrite Zfloor_IZR, Zrnd_IZR in Hx. @@ -630,7 +632,7 @@ apply Rmult_le_compat_r. apply bpow_ge_0. assert (Hf: IZR (Zpower beta (ex - 1 - fexp ex)) = bpow (ex - 1 + - fexp ex)). apply IZR_Zpower. -omega. +lia. rewrite <- Hf. apply IZR_le. apply Zfloor_lub. @@ -657,7 +659,7 @@ apply Rmult_le_compat_r. apply bpow_ge_0. assert (Hf: IZR (Zpower beta (ex - fexp ex)) = bpow (ex - fexp ex)). apply IZR_Zpower. -omega. +lia. rewrite <- Hf. apply IZR_le. apply Zceil_glb. @@ -738,7 +740,7 @@ destruct (Zle_or_lt ex (fexp ex)) as [Hx1|Hx1]. apply bpow_le. apply valid_exp, proj2 in Hx1. specialize (Hx1 ey). - omega. + lia. apply Rle_trans with (bpow ex). now apply round_bounded_large_pos. apply bpow_le. @@ -1380,7 +1382,7 @@ specialize (He (Rgt_not_eq _ _ Hx)). rewrite Rabs_pos_eq in He. 2: now apply Rlt_le. apply Rle_trans with (bpow (ex - 1)). apply bpow_le. -cut (e < ex)%Z. omega. +cut (e < ex)%Z. lia. apply (lt_bpow beta). now apply Rle_lt_trans with (2 := proj2 He). destruct (Zle_or_lt ex (fexp ex)). @@ -1389,7 +1391,7 @@ rewrite Hr in Hd. elim Rlt_irrefl with (1 := Hd). rewrite Hr. apply bpow_le. -omega. +lia. apply (round_bounded_large_pos rnd x ex H He). Qed. @@ -1526,7 +1528,7 @@ unfold cexp. set (ex := mag beta x). generalize (exp_not_FTZ ex). generalize (proj2 (proj2 (valid_exp _) He) (fexp ex + 1)%Z). -omega. +lia. rewrite <- H. rewrite <- mult_IZR, Ztrunc_IZR. unfold F2R. simpl. @@ -1802,7 +1804,7 @@ Theorem Znearest_imp : Proof. intros x n Hd. cut (Z.abs (Znearest x - n) < 1)%Z. -clear ; zify ; omega. +clear ; zify ; lia. apply lt_IZR. rewrite abs_IZR, minus_IZR. replace (IZR (Znearest x) - IZR n)%R with (- (x - IZR (Znearest x)) + (x - IZR n))%R by ring. @@ -1937,7 +1939,7 @@ replace (- _ + _)%Z with 0%Z by ring; simpl; rewrite Rmult_1_r. apply (Rlt_le_trans _ _ _ (proj2 Hex)). apply Rle_trans with (bpow (fexp (mag beta x) - 1)). - apply bpow_le. - rewrite (mag_unique beta x ex); [omega|]. + rewrite (mag_unique beta x ex); [lia|]. now rewrite Rabs_right. - unfold Zminus; rewrite bpow_plus. rewrite Rmult_comm. @@ -2012,6 +2014,68 @@ Qed. End rndNA. +Notation Znearest0 := (Znearest (fun x => (Zlt_bool x 0))). + +Section rndN0. + +Global Instance valid_rnd_N0 : Valid_rnd Znearest0 := valid_rnd_N _. + +Theorem round_N0_pt : + forall x, + Rnd_N0_pt generic_format x (round Znearest0 x). +Proof. +intros x. +generalize (round_N_pt (fun t => Zlt_bool t 0) x). +set (f := round (Znearest (fun t => Zlt_bool t 0)) x). +intros Rxf. +destruct (Req_dec (x - round Zfloor x) (round Zceil x - x)) as [Hm|Hm]. +(* *) +apply Rnd_N0_pt_N. +apply generic_format_0. +exact Rxf. +destruct (Rle_or_lt 0 x) as [Hx|Hx]. +(* . *) +rewrite Rabs_pos_eq with (1 := Hx). +rewrite Rabs_pos_eq. +unfold f. +rewrite round_N_middle with (1 := Hm). +rewrite Zlt_bool_false. +now apply round_DN_pt. +apply Zfloor_lub. +apply Rmult_le_pos with (1 := Hx). +apply bpow_ge_0. +apply Rnd_N_pt_ge_0 with (2 := Hx) (3 := Rxf). +apply generic_format_0. +(* . *) +rewrite Rabs_left with (1 := Hx). +rewrite Rabs_left1. +apply Ropp_le_contravar. +unfold f. +rewrite round_N_middle with (1 := Hm). +rewrite Zlt_bool_true. +now apply round_UP_pt. +apply lt_IZR. +apply Rle_lt_trans with (scaled_mantissa x). +apply Zfloor_lb. +simpl. +rewrite <- (Rmult_0_l (bpow (- (cexp x))%Z)%R). +apply Rmult_lt_compat_r with (2 := Hx). +apply bpow_gt_0. +apply Rnd_N_pt_le_0 with (3 := Rxf). +apply generic_format_0. +now apply Rlt_le. +(* *) +split. +apply Rxf. +intros g Rxg. +rewrite Rnd_N_pt_unique with (3 := Hm) (4 := Rxf) (5 := Rxg). +apply Rle_refl. +apply round_DN_pt; easy. +apply round_UP_pt; easy. +Qed. + +End rndN0. + Section rndN_opp. Theorem Znearest_opp : @@ -2055,6 +2119,31 @@ rewrite opp_IZR. now rewrite Ropp_mult_distr_l_reverse. Qed. +Lemma round_N0_opp : + forall x, + (round Znearest0 (- x) = - round Znearest0 x)%R. +Proof. +intros x. +rewrite round_N_opp. +apply Ropp_eq_compat. +apply round_ext. +clear x; intro x. +unfold Znearest. +case_eq (Rcompare (x - IZR (Zfloor x)) (/ 2)); intro C; +[|reflexivity|reflexivity]. +apply Rcompare_Eq_inv in C. +assert (H : negb (- (Zfloor x + 1) <? 0)%Z = (Zfloor x <? 0)%Z); + [|now rewrite H]. +rewrite negb_Zlt_bool. +case_eq (Zfloor x <? 0)%Z; intro C'. +apply Zlt_is_lt_bool in C'. +apply Zle_bool_true. +lia. +apply Z.ltb_ge in C'. +apply Zle_bool_false. +lia. +Qed. + End rndN_opp. Lemma round_N_small : @@ -2293,10 +2382,10 @@ rewrite negb_Zle_bool. case_eq (0 <=? Zfloor x)%Z; intro C'. - apply Zle_bool_imp_le in C'. apply Zlt_bool_true. - omega. + lia. - rewrite Z.leb_gt in C'. apply Zlt_bool_false. - omega. + lia. Qed. End rndNA_opp. diff --git a/flocq/Core/Raux.v b/flocq/Core/Raux.v index 8273a55b..455190dc 100644 --- a/flocq/Core/Raux.v +++ b/flocq/Core/Raux.v @@ -18,7 +18,7 @@ COPYING file for more details. *) (** * Missing definitions/lemmas *) -Require Import Psatz. +Require Export Psatz. Require Export Reals ZArith. Require Export Zaux. @@ -907,6 +907,18 @@ rewrite Ropp_involutive. apply Zfloor_lb. Qed. +Theorem Zceil_lb : + forall x : R, + (IZR (Zceil x) < x + 1)%R. +Proof. +intros x. +unfold Zceil. +rewrite opp_IZR. +rewrite <-(Ropp_involutive (x + 1)), Ropp_plus_distr. +apply Ropp_lt_contravar, (Rplus_lt_reg_r 1); ring_simplify. +apply Zfloor_ub. +Qed. + Theorem Zceil_glb : forall n x, (x <= IZR n)%R -> @@ -1305,9 +1317,9 @@ rewrite Ropp_inv_permute with (1 := Zy'). rewrite <- 2!opp_IZR. rewrite <- Zmod_opp_opp. apply H. -clear -Hy. omega. +clear -Hy. lia. apply H. -clear -Zy Hy. omega. +clear -Zy Hy. lia. (* *) split. pattern (IZR (x / y)) at 1 ; rewrite <- Rplus_0_r. @@ -1454,7 +1466,7 @@ rewrite <- (Rmult_1_r (bpow e1)). rewrite bpow_plus. apply Rmult_lt_compat_l. apply bpow_gt_0. -assert (0 < e2 - e1)%Z by omega. +assert (0 < e2 - e1)%Z by lia. destruct (e2 - e1)%Z ; try discriminate H0. clear. rewrite <- IZR_Zpower by easy. @@ -1756,7 +1768,7 @@ rewrite Rabs_right in Hex; [|now apply Rle_ge; apply Rlt_le]. rewrite Rabs_right in Hey; [|now apply Rle_ge; apply Rlt_le]. apply (Rlt_le_trans _ _ _ Hex). apply Rle_trans with (bpow (ey - 1)); [|exact Hey]. -now apply bpow_le; omega. +now apply bpow_le; lia. Qed. Theorem mag_bpow : @@ -1900,7 +1912,7 @@ apply bpow_le. now apply Zlt_le_weak. apply IZR_le. clear -Zm. -zify ; omega. +zify ; lia. Qed. Lemma mag_mult : @@ -1999,7 +2011,7 @@ assert (Hbeta : (2 <= r)%Z). { destruct r as (beta_val,beta_prop). now apply Zle_bool_imp_le. } intros x y Px Py Hln. -assert (Oxy : (y < x)%R); [apply lt_mag;[assumption|omega]|]. +assert (Oxy : (y < x)%R); [apply lt_mag;[assumption|lia]|]. destruct (mag x) as (ex,Hex). destruct (mag y) as (ey,Hey). simpl in Hln |- *. @@ -2096,7 +2108,7 @@ split. unfold Rsqr ; rewrite <- bpow_plus. apply bpow_le. generalize (Zdiv2_odd_eqn (e + 1)). - destruct Z.odd ; intros ; omega. + destruct Z.odd ; intros ; lia. - rewrite <- (Rabs_pos_eq (bpow _)) by apply bpow_ge_0. apply Rsqr_lt_abs_0. rewrite Rsqr_sqrt by now apply Rlt_le. @@ -2104,7 +2116,7 @@ split. unfold Rsqr ; rewrite <- bpow_plus. apply bpow_le. generalize (Zdiv2_odd_eqn (e + 1)). - destruct Z.odd ; intros ; omega. + destruct Z.odd ; intros ; lia. Qed. Lemma mag_1 : mag 1 = 1%Z :> Z. @@ -2324,7 +2336,7 @@ refine (Rle_not_lt _ _ (lub (/ (INR (S N) + 1))%R _) _). refine (H _ _ Py). apply INR_lt in Hy. clear -Hy HyN. - omega. + lia. now apply Rlt_le, Rinv_0_lt_compat. rewrite S_INR, HN. ring_simplify (IZR (up (/ l)) - 1 + 1)%R. @@ -2369,7 +2381,7 @@ rewrite <- (Z.opp_involutive n). rewrite <- (Z.abs_neq n). rewrite <- Zabs2Nat.id_abs. apply K. -omega. +lia. Qed. diff --git a/flocq/Core/Round_NE.v b/flocq/Core/Round_NE.v index 20b60ef5..b7387a62 100644 --- a/flocq/Core/Round_NE.v +++ b/flocq/Core/Round_NE.v @@ -18,6 +18,8 @@ COPYING file for more details. *) (** * Rounding to nearest, ties to even: existence, unicity... *) + +From Coq Require Import Lia. Require Import Raux Defs Round_pred Generic_fmt Float_prop Ulp. Notation ZnearestE := (Znearest (fun x => negb (Z.even x))). @@ -148,7 +150,7 @@ split. apply (round_DN_pt beta fexp x). apply generic_format_bpow. ring_simplify (ex - 1 + 1)%Z. -omega. +lia. apply Hex. apply Rle_lt_trans with (2 := proj2 Hex). apply (round_DN_pt beta fexp x). @@ -209,14 +211,14 @@ rewrite Z.even_add. rewrite eqb_sym. simpl. fold (negb (Z.even (beta ^ (ex - fexp ex)))). rewrite Bool.negb_involutive. -rewrite (Z.even_pow beta (ex - fexp ex)). 2: omega. +rewrite (Z.even_pow beta (ex - fexp ex)) by lia. destruct exists_NE_. rewrite H. apply Zeven_Zpower_odd with (2 := H). now apply Zle_minus_le_0. apply Z.even_pow. specialize (H ex). -omega. +lia. (* - xu < bpow ex *) revert Hud. rewrite ulp_neq_0;[idtac|now apply Rgt_not_eq]. @@ -413,18 +415,18 @@ now rewrite Hs in Hr. destruct (Hs ex) as (H,_). rewrite Z.even_pow. exact Hr. -omega. +lia. assert (Z.even (Zfloor mx) = true). 2: now rewrite H in Hmx. -replace (Zfloor mx) with (Zceil mx + -1)%Z by omega. +replace (Zfloor mx) with (Zceil mx + -1)%Z by lia. rewrite Z.even_add. apply eqb_true. unfold mx. replace (Zceil (scaled_mantissa beta fexp x)) with (Zpower beta (ex - fexp ex)). rewrite Zeven_Zpower_odd with (2 := Hr). easy. -omega. +lia. apply eq_IZR. -rewrite IZR_Zpower. 2: omega. +rewrite IZR_Zpower by lia. apply Rmult_eq_reg_r with (bpow (fexp ex)). unfold Zminus. rewrite bpow_plus. @@ -434,7 +436,7 @@ now apply sym_eq. apply Rgt_not_eq. apply bpow_gt_0. generalize (proj1 (valid_exp ex) He). -omega. +lia. (* .. small pos *) assert (Z.even (Zfloor mx) = true). 2: now rewrite H in Hmx. unfold mx, scaled_mantissa. diff --git a/flocq/Core/Round_pred.v b/flocq/Core/Round_pred.v index 428a4bac..b7b6778f 100644 --- a/flocq/Core/Round_pred.v +++ b/flocq/Core/Round_pred.v @@ -42,6 +42,9 @@ Definition Rnd_NG (F : R -> Prop) (P : R -> R -> Prop) (rnd : R -> R) := Definition Rnd_NA (F : R -> Prop) (rnd : R -> R) := forall x : R, Rnd_NA_pt F x (rnd x). +Definition Rnd_N0 (F : R -> Prop) (rnd : R -> R) := + forall x : R, Rnd_N0_pt F x (rnd x). + Theorem round_val_of_pred : forall rnd : R -> R -> Prop, round_pred rnd -> @@ -1021,6 +1024,251 @@ intros F x f (Hf,_) Hx. now apply Rnd_N_pt_idempotent with F. Qed. +Theorem Rnd_N0_NG_pt : + forall F : R -> Prop, + F 0 -> + forall x f, + Rnd_N0_pt F x f <-> Rnd_NG_pt F (fun x f => Rabs f <= Rabs x) x f. +Proof. +intros F HF x f. +destruct (Rle_or_lt 0 x) as [Hx|Hx]. +(* *) +split ; intros (H1, H2). +(* . *) +assert (Hf := Rnd_N_pt_ge_0 F HF x f Hx H1). +split. +exact H1. +destruct (Rnd_N_pt_DN_or_UP _ _ _ H1) as [H3|H3]. +(* . . *) +left. +rewrite Rabs_pos_eq with (1 := Hf). +rewrite Rabs_pos_eq with (1 := Hx). +apply H3. +(* . . *) +right. +intros f2 Hxf2. +specialize (H2 _ Hxf2). +destruct (Rnd_N_pt_DN_or_UP _ _ _ Hxf2) as [H4|H4]. +apply Rle_antisym. +apply Rle_trans with x. +apply H4. +apply H3. +rewrite Rabs_pos_eq with (1 := Hf) in H2. +rewrite Rabs_pos_eq in H2. +exact H2. +now apply Rnd_N_pt_ge_0 with F x. +eapply Rnd_UP_pt_unique ; eassumption. +(* . *) +split. +exact H1. +intros f2 Hxf2. +destruct H2 as [H2|H2]. +assert (Hf := Rnd_N_pt_ge_0 F HF x f Hx H1). +assert (Hf2 := Rnd_N_pt_ge_0 F HF x f2 Hx Hxf2). +rewrite 2!Rabs_pos_eq ; trivial. +rewrite 2!Rabs_pos_eq in H2 ; trivial. +destruct (Rnd_N_pt_DN_or_UP _ _ _ Hxf2) as [H3|H3]. +apply H3. +apply H1. +apply H2. +apply Rle_trans with (1 := H2). +apply H3. +rewrite (H2 _ Hxf2). +apply Rle_refl. +(* *) +assert (Hx' := Rlt_le _ _ Hx). +clear Hx. rename Hx' into Hx. +split ; intros (H1, H2). +(* . *) +assert (Hf := Rnd_N_pt_le_0 F HF x f Hx H1). +split. +exact H1. +destruct (Rnd_N_pt_DN_or_UP _ _ _ H1) as [H3|H3]. +(* . . *) +right. +intros f2 Hxf2. +specialize (H2 _ Hxf2). +destruct (Rnd_N_pt_DN_or_UP _ _ _ Hxf2) as [H4|H4]. +eapply Rnd_DN_pt_unique ; eassumption. +apply Rle_antisym. +2: apply Rle_trans with x. +2: apply H3. +2: apply H4. +rewrite Rabs_left1 with (1 := Hf) in H2. +rewrite Rabs_left1 in H2. +now apply Ropp_le_cancel. +now apply Rnd_N_pt_le_0 with F x. +(* . . *) +left. +rewrite Rabs_left1 with (1 := Hf). +rewrite Rabs_left1 with (1 := Hx). +apply Ropp_le_contravar. +apply H3. +(* . *) +split. +exact H1. +intros f2 Hxf2. +destruct H2 as [H2|H2]. +assert (Hf := Rnd_N_pt_le_0 F HF x f Hx H1). +assert (Hf2 := Rnd_N_pt_le_0 F HF x f2 Hx Hxf2). +rewrite 2!Rabs_left1 ; trivial. +rewrite 2!Rabs_left1 in H2 ; trivial. +apply Ropp_le_contravar. +apply Ropp_le_cancel in H2. +destruct (Rnd_N_pt_DN_or_UP _ _ _ Hxf2) as [H3|H3]. +2: apply H3. +2: apply H1. +2: apply H2. +apply Rle_trans with (2 := H2). +apply H3. +rewrite (H2 _ Hxf2). +apply Rle_refl. +Qed. + +Lemma Rnd_N0_pt_unique_prop : + forall F : R -> Prop, + F 0 -> + Rnd_NG_pt_unique_prop F (fun x f => Rabs f <= Rabs x). +Proof. +intros F HF x d u Hxd1 Hxd2 Hxu1 Hxu2 Hd Hu. +apply Rle_antisym. +apply Rle_trans with x. +apply Hxd1. +apply Hxu1. +destruct (Rle_or_lt 0 x) as [Hx|Hx]. +apply Hxd1. +apply Hxu1. +rewrite Rabs_pos_eq with (1 := Hx) in Hu. +rewrite Rabs_pos_eq in Hu. +exact Hu. +apply Rle_trans with (1:=Hx). +apply Hxu1. +(* *) +apply Hxu1. +apply Hxd1. +rewrite Rabs_left with (1 := Hx) in Hd. +rewrite Rabs_left1 in Hd. +now apply Ropp_le_cancel. +apply Rlt_le, Rle_lt_trans with (2:=Hx). +apply Hxd1. +Qed. + +Theorem Rnd_N0_pt_unique : + forall F : R -> Prop, + F 0 -> + forall x f1 f2 : R, + Rnd_N0_pt F x f1 -> Rnd_N0_pt F x f2 -> + f1 = f2. +Proof. +intros F HF x f1 f2 H1 H2. +apply (Rnd_NG_pt_unique F _ (Rnd_N0_pt_unique_prop F HF) x). +now apply -> Rnd_N0_NG_pt. +now apply -> Rnd_N0_NG_pt. +Qed. + +Theorem Rnd_N0_pt_N : + forall F : R -> Prop, + F 0 -> + forall x f : R, + Rnd_N_pt F x f -> + (Rabs f <= Rabs x)%R -> + Rnd_N0_pt F x f. +Proof. +intros F HF x f Rxf Hxf. +split. +apply Rxf. +intros g Rxg. +destruct (Rabs_eq_Rabs (f - x) (g - x)) as [H|H]. +apply Rle_antisym. +apply Rxf. +apply Rxg. +apply Rxg. +apply Rxf. +(* *) +replace g with f. +apply Rle_refl. +apply Rplus_eq_reg_r with (1 := H). +(* *) +assert (g = 2 * x - f)%R. +replace (2 * x - f)%R with (x - (f - x))%R by ring. +rewrite H. +ring. +destruct (Rle_lt_dec 0 x) as [Hx|Hx]. +(* . *) +revert Hxf. +rewrite Rabs_pos_eq with (1 := Hx). +rewrite 2!Rabs_pos_eq ; try ( apply (Rnd_N_pt_ge_0 F HF x) ; assumption ). +intros Hxf. +rewrite H0. +apply Rplus_le_reg_r with f. +ring_simplify. +apply Rmult_le_compat_l with (2 := Hxf). +now apply IZR_le. +(* . *) +revert Hxf. +apply Rlt_le in Hx. +rewrite Rabs_left1 with (1 := Hx). +rewrite 2!Rabs_left1 ; try ( apply (Rnd_N_pt_le_0 F HF x) ; assumption ). +intros Hxf. +rewrite H0. +apply Ropp_le_contravar. +apply Rplus_le_reg_r with f. +ring_simplify. +apply Rmult_le_compat_l. +now apply IZR_le. +now apply Ropp_le_cancel. +Qed. + +Theorem Rnd_N0_unique : + forall (F : R -> Prop), + F 0 -> + forall rnd1 rnd2 : R -> R, + Rnd_N0 F rnd1 -> Rnd_N0 F rnd2 -> + forall x, rnd1 x = rnd2 x. +Proof. +intros F HF rnd1 rnd2 H1 H2 x. +now apply Rnd_N0_pt_unique with F x. +Qed. + +Theorem Rnd_N0_pt_monotone : + forall F : R -> Prop, + F 0 -> + round_pred_monotone (Rnd_N0_pt F). +Proof. +intros F HF x y f g Hxf Hyg Hxy. +apply (Rnd_NG_pt_monotone F _ (Rnd_N0_pt_unique_prop F HF) x y). +now apply -> Rnd_N0_NG_pt. +now apply -> Rnd_N0_NG_pt. +exact Hxy. +Qed. + +Theorem Rnd_N0_pt_refl : + forall F : R -> Prop, + forall x : R, F x -> + Rnd_N0_pt F x x. +Proof. +intros F x Hx. +split. +now apply Rnd_N_pt_refl. +intros f Hxf. +apply Req_le. +apply f_equal. +now apply sym_eq, Rnd_N_pt_idempotent with (1 := Hxf). +Qed. + +Theorem Rnd_N0_pt_idempotent : + forall F : R -> Prop, + forall x f : R, + Rnd_N0_pt F x f -> F x -> + f = x. +Proof. +intros F x f (Hf,_) Hx. +now apply Rnd_N_pt_idempotent with F. +Qed. + + + + Theorem round_pred_ge_0 : forall P : R -> R -> Prop, round_pred_monotone P -> @@ -1405,4 +1653,38 @@ apply Rnd_NA_pt_monotone. apply Hany. Qed. +Theorem satisfies_any_imp_N0 : + forall F : R -> Prop, + F 0 -> satisfies_any F -> + round_pred (Rnd_N0_pt F). +Proof. +intros F HF0 Hany. +split. +assert (H : round_pred_total (Rnd_NG_pt F (fun a b => (Rabs b <= Rabs a)%R))). +apply satisfies_any_imp_NG. +apply Hany. +intros x d u Hf Hd Hu. +destruct (Rle_lt_dec 0 x) as [Hx|Hx]. +right. +rewrite Rabs_pos_eq with (1 := Hx). +rewrite Rabs_pos_eq. +apply Hd. +apply Hd; try easy. +left. +rewrite Rabs_left with (1 := Hx). +rewrite Rabs_left1. +apply Ropp_le_contravar. +apply Hu. +apply Hu; try easy. +now apply Rlt_le. +intros x. +destruct (H x) as (f, Hf). +exists f. +apply <- Rnd_N0_NG_pt. +apply Hf. +apply HF0. +apply Rnd_N0_pt_monotone. +apply HF0. +Qed. + End RND_prop. diff --git a/flocq/Core/Ulp.v b/flocq/Core/Ulp.v index 4f4a5674..c42b3e65 100644 --- a/flocq/Core/Ulp.v +++ b/flocq/Core/Ulp.v @@ -57,7 +57,7 @@ Proof. unfold negligible_exp; destruct LPO_Z as [(n,Hn)|Hn]. now apply negligible_Some. apply negligible_None. -intros n; specialize (Hn n); omega. +intros n; specialize (Hn n); lia. Qed. Lemma negligible_exp_spec': (negligible_exp = None /\ forall n, (fexp n < n)%Z) @@ -66,7 +66,7 @@ Proof. unfold negligible_exp; destruct LPO_Z as [(n,Hn)|Hn]. right; simpl; exists n; now split. left; split; trivial. -intros n; specialize (Hn n); omega. +intros n; specialize (Hn n); lia. Qed. Context { valid_exp : Valid_exp fexp }. @@ -75,8 +75,8 @@ Lemma fexp_negligible_exp_eq: forall n m, (n <= fexp n)%Z -> (m <= fexp m)%Z -> Proof. intros n m Hn Hm. case (Zle_or_lt n m); intros H. -apply valid_exp; omega. -apply sym_eq, valid_exp; omega. +apply valid_exp; lia. +apply sym_eq, valid_exp; lia. Qed. @@ -198,6 +198,17 @@ rewrite V. apply generic_format_0. Qed. +Theorem ulp_canonical : + forall m e, + m <> 0%Z -> + canonical beta fexp (Float beta m e) -> + ulp (F2R (Float beta m e)) = bpow e. +Proof. +intros m e Hm Hc. +rewrite ulp_neq_0 by now apply F2R_neq_0. +apply f_equal. +now apply sym_eq. +Qed. Theorem ulp_bpow : forall e, ulp (bpow e) = bpow (fexp (e + 1)). @@ -216,7 +227,6 @@ apply bpow_ge_0. apply Rgt_not_eq, Rlt_gt, bpow_gt_0. Qed. - Lemma generic_format_ulp_0 : F (ulp 0). Proof. @@ -238,17 +248,17 @@ rewrite Req_bool_true; trivial. case negligible_exp_spec. intros H1 _. apply generic_format_bpow. -specialize (H1 (e+1)%Z); omega. +specialize (H1 (e+1)%Z); lia. intros n H1 H2. apply generic_format_bpow. case (Zle_or_lt (e+1) (fexp (e+1))); intros H4. absurd (e+1 <= e)%Z. -omega. +lia. apply Z.le_trans with (1:=H4). replace (fexp (e+1)) with (fexp n). now apply le_bpow with beta. now apply fexp_negligible_exp_eq. -omega. +lia. Qed. (** The three following properties are equivalent: @@ -300,10 +310,10 @@ case (Zle_or_lt l (fexp l)); intros Hl. rewrite (fexp_negligible_exp_eq n l); trivial; apply Z.le_refl. case (Zle_or_lt (fexp n) (fexp l)); trivial; intros K. absurd (fexp n <= fexp l)%Z. -omega. +lia. apply Z.le_trans with (2:= H _). apply Zeq_le, sym_eq, valid_exp; trivial. -omega. +lia. Qed. Lemma not_FTZ_ulp_ge_ulp_0: @@ -374,8 +384,6 @@ rewrite Hn1 in H; discriminate. now apply bpow_mag_le. Qed. - - (** Definition and properties of pred and succ *) Definition pred_pos x := @@ -432,6 +440,17 @@ unfold pred. now rewrite Ropp_involutive. Qed. +Theorem pred_bpow : + forall e, pred (bpow e) = (bpow e - bpow (fexp e))%R. +Proof. +intros e. +rewrite pred_eq_pos by apply bpow_ge_0. +unfold pred_pos. +rewrite mag_bpow. +replace (e + 1 - 1)%Z with e by ring. +now rewrite Req_bool_true. +Qed. + (** pred and succ are in the format *) (* cannont be x <> ulp 0, due to the counter-example 1-bit FP format fexp: e -> e-1 *) @@ -450,7 +469,7 @@ apply gt_0_F2R with beta (cexp beta fexp x). rewrite <- Fx. apply Rle_lt_trans with (2:=Hx). apply bpow_ge_0. -omega. +lia. case (Zle_lt_or_eq _ _ H); intros Hm. (* *) pattern x at 1 ; rewrite Fx. @@ -533,7 +552,7 @@ rewrite ulp_neq_0. intro H. assert (ex-1 < cexp beta fexp x < ex)%Z. split ; apply (lt_bpow beta) ; rewrite <- H ; easy. -clear -H0. omega. +clear -H0. lia. now apply Rgt_not_eq. apply Ex'. apply Rle_lt_trans with (2 := proj2 Ex'). @@ -555,7 +574,7 @@ apply gt_0_F2R with beta (cexp beta fexp x). rewrite <- Fx. apply Rle_lt_trans with (2:=proj1 Ex'). apply bpow_ge_0. -omega. +lia. now apply Rgt_not_eq. Qed. @@ -579,7 +598,7 @@ rewrite minus_IZR, IZR_Zpower. rewrite Rmult_minus_distr_r, Rmult_1_l. rewrite <- bpow_plus. now replace (e - 1 - fexp (e - 1) + fexp (e - 1))%Z with (e-1)%Z by ring. -omega. +lia. rewrite H. apply generic_format_F2R. intros _. @@ -592,7 +611,7 @@ split. apply Rplus_le_reg_l with (bpow (fexp (e-1))). ring_simplify. apply Rle_trans with (bpow (e - 2) + bpow (e - 2))%R. -apply Rplus_le_compat ; apply bpow_le ; omega. +apply Rplus_le_compat ; apply bpow_le ; lia. apply Rle_trans with (2*bpow (e - 2))%R;[right; ring|idtac]. apply Rle_trans with (bpow 1*bpow (e - 2))%R. apply Rmult_le_compat_r. @@ -614,7 +633,7 @@ apply Ropp_lt_contravar. apply bpow_gt_0. apply Rle_ge; apply Rle_0_minus. apply bpow_le. -omega. +lia. replace f with 0%R. apply generic_format_0. unfold f. @@ -842,7 +861,7 @@ assert (ex - 1 < fexp ex < ex)%Z. split ; apply (lt_bpow beta) ; rewrite <- M by easy. lra. apply Hex. -omega. +lia. rewrite 2!ulp_neq_0 by lra. apply f_equal. unfold cexp ; apply f_equal. @@ -907,7 +926,7 @@ split. apply Rplus_le_reg_l with (bpow (fexp (e-1))). ring_simplify. apply Rle_trans with (bpow (e - 2) + bpow (e - 2))%R. -apply Rplus_le_compat; apply bpow_le; omega. +apply Rplus_le_compat; apply bpow_le; lia. apply Rle_trans with (2*bpow (e - 2))%R;[right; ring|idtac]. apply Rle_trans with (bpow 1*bpow (e - 2))%R. apply Rmult_le_compat_r. @@ -930,7 +949,7 @@ apply bpow_gt_0. apply Rle_ge; apply Rle_0_minus. rewrite Hxe. apply bpow_le. -omega. +lia. (* *) contradict Zp. rewrite Hxe, He; ring. @@ -953,12 +972,12 @@ unfold ulp; rewrite Req_bool_true; trivial. case negligible_exp_spec. intros K. specialize (K (e-1)%Z). -contradict K; omega. +contradict K; lia. intros n Hn. rewrite H3; apply f_equal. case (Zle_or_lt n (e-1)); intros H6. -apply valid_exp; omega. -apply sym_eq, valid_exp; omega. +apply valid_exp; lia. +apply sym_eq, valid_exp; lia. Qed. (** The following one is false for x = 0 in FTZ *) @@ -1081,7 +1100,7 @@ exfalso ; lra. intros n Hn H. assert (fexp (mag beta eps) = fexp n). apply valid_exp; try assumption. -assert(mag beta eps-1 < fexp n)%Z;[idtac|omega]. +assert(mag beta eps-1 < fexp n)%Z;[idtac|lia]. apply lt_bpow with beta. apply Rle_lt_trans with (2:=proj2 H). destruct (mag beta eps) as (e,He). @@ -1105,7 +1124,6 @@ rewrite <- P, round_0; trivial. apply valid_rnd_DN. Qed. - Theorem round_UP_plus_eps_pos : forall x, (0 <= x)%R -> F x -> forall eps, (0 < eps <= ulp x)%R -> @@ -1147,7 +1165,7 @@ lra. intros n Hn H. assert (fexp (mag beta eps) = fexp n). apply valid_exp; try assumption. -assert(mag beta eps-1 < fexp n)%Z;[idtac|omega]. +assert(mag beta eps-1 < fexp n)%Z;[idtac|lia]. apply lt_bpow with beta. apply Rle_lt_trans with (2:=H). destruct (mag beta eps) as (e,He). @@ -1172,7 +1190,6 @@ apply round_generic... apply generic_format_ulp_0. Qed. - Theorem round_UP_pred_plus_eps_pos : forall x, (0 < x)%R -> F x -> forall eps, (0 < eps <= ulp (pred x) )%R -> @@ -1210,7 +1227,6 @@ apply Ropp_lt_contravar. now apply Heps. Qed. - Theorem round_DN_plus_eps: forall x, F x -> forall eps, (0 <= eps < if (Rle_bool 0 x) then (ulp x) @@ -1248,7 +1264,6 @@ now apply Ropp_0_gt_lt_contravar. now apply generic_format_opp. Qed. - Theorem round_UP_plus_eps : forall x, F x -> forall eps, (0 < eps <= if (Rle_bool 0 x) then (ulp x) @@ -1334,11 +1349,11 @@ now apply Rgt_not_eq. case (Zle_lt_or_eq _ _ H2); intros Hexy. assert (fexp ex = fexp (ey-1))%Z. apply valid_exp. -omega. +lia. rewrite <- H1. -omega. +lia. absurd (0 < Ztrunc (scaled_mantissa beta fexp x) < 1)%Z. -omega. +lia. split. apply gt_0_F2R with beta (cexp beta fexp x). now rewrite <- Fx. @@ -1380,9 +1395,9 @@ apply sym_eq; apply mag_unique. rewrite H1, Rabs_right. split. apply bpow_le. -omega. +lia. apply bpow_lt. -omega. +lia. apply Rle_ge; apply bpow_ge_0. apply mag_unique. apply Hey. @@ -1527,7 +1542,7 @@ rewrite mag_bpow. replace (fexp n + 1 - 1)%Z with (fexp n) by ring. rewrite Req_bool_true; trivial. apply Rminus_diag_eq, f_equal. -apply sym_eq, valid_exp; omega. +apply sym_eq, valid_exp; lia. Qed. Theorem succ_0 : @@ -1904,7 +1919,7 @@ rewrite ulp_neq_0; trivial. apply f_equal. unfold cexp. apply valid_exp; trivial. -assert (mag beta x -1 < fexp n)%Z;[idtac|omega]. +assert (mag beta x -1 < fexp n)%Z;[idtac|lia]. apply lt_bpow with beta. destruct (mag beta x) as (e,He). simpl. @@ -2252,9 +2267,9 @@ rewrite Hn1; easy. now apply ulp_ge_ulp_0. Qed. - -Lemma ulp_succ_pos : forall x, F x -> (0 < x)%R -> - ulp (succ x) = ulp x \/ succ x = bpow (mag beta x). +Lemma ulp_succ_pos : + forall x, F x -> (0 < x)%R -> + ulp (succ x) = ulp x \/ succ x = bpow (mag beta x). Proof with auto with typeclass_instances. intros x Fx Hx. generalize (Rlt_le _ _ Hx); intros Hx'. @@ -2281,6 +2296,39 @@ apply ulp_ge_0. now apply sym_eq, mag_unique_pos. Qed. +Theorem ulp_pred_pos : + forall x, F x -> (0 < pred x)%R -> + ulp (pred x) = ulp x \/ x = bpow (mag beta x - 1). +Proof. +intros x Fx Hx. +assert (Hx': (0 < x)%R). + apply Rlt_le_trans with (1 := Hx). + apply pred_le_id. +assert (Zx : x <> 0%R). + now apply Rgt_not_eq. +rewrite (ulp_neq_0 x) by easy. +unfold cexp. +destruct (mag beta x) as [e He]. +simpl. +assert (bpow (e - 1) <= x < bpow e)%R. + rewrite <- (Rabs_pos_eq x) by now apply Rlt_le. + now apply He. +destruct (proj1 H) as [H1|H1]. +2: now right. +left. +apply pred_ge_gt with (2 := Fx) in H1. +rewrite ulp_neq_0 by now apply Rgt_not_eq. +apply (f_equal (fun e => bpow (fexp e))). +apply mag_unique_pos. +apply (conj H1). +apply Rle_lt_trans with (2 := proj2 H). +apply pred_le_id. +apply generic_format_bpow. +apply Z.lt_le_pred. +replace (_ + 1)%Z with e by ring. +rewrite <- (mag_unique_pos _ _ _ H). +now apply mag_generic_gt. +Qed. Lemma ulp_round_pos : forall { Not_FTZ_ : Exp_not_FTZ fexp}, @@ -2333,7 +2381,6 @@ replace (fexp n) with (fexp e); try assumption. now apply fexp_negligible_exp_eq. Qed. - Theorem ulp_round : forall { Not_FTZ_ : Exp_not_FTZ fexp}, forall rnd { Zrnd : Valid_rnd rnd } x, ulp (round beta fexp rnd x) = ulp x @@ -2373,6 +2420,18 @@ destruct (round_DN_or_UP beta fexp rnd x) as [Hr|Hr]; rewrite Hr. apply succ_ge_id. Qed. +Lemma pred_round_le_id : + forall rnd { Zrnd : Valid_rnd rnd } x, + (pred (round beta fexp rnd x) <= x)%R. +Proof. +intros rnd Vrnd x. +apply (Rle_trans _ (round beta fexp Raux.Zfloor x)). +2: now apply round_DN_pt. +destruct (round_DN_or_UP beta fexp rnd x) as [Hr|Hr]; rewrite Hr. +2: now apply pred_UP_le_DN. +apply pred_le_id. +Qed. + (** Properties of rounding to nearest and ulp *) Theorem round_N_le_midp: forall choice u v, @@ -2432,6 +2491,73 @@ unfold pred. right; field. Qed. +Lemma round_N_ge_ge_midp : forall choice u v, + F u -> + (u <= round beta fexp (Znearest choice) v)%R -> + ((u + pred u) / 2 <= v)%R. +Proof with auto with typeclass_instances. +intros choice u v Hu H2. +assert (K: ((u=0)%R /\ negligible_exp = None) \/ (pred u < u)%R). +case (Req_dec u 0); intros Zu. +case_eq (negligible_exp). +intros n Hn; right. +rewrite Zu, pred_0. +unfold ulp; rewrite Req_bool_true, Hn; try easy. +rewrite <- Ropp_0. +apply Ropp_lt_contravar, bpow_gt_0. +intros _; left; split; easy. +right. +apply pred_lt_id... +(* *) +case K. +intros (K1,K2). +(* . *) +rewrite K1, pred_0. +unfold ulp; rewrite Req_bool_true, K2; try easy. +replace ((0+-0)/2)%R with 0%R by field. +case (Rle_or_lt 0 v); try easy. +intros H3; contradict H2. +rewrite K1; apply Rlt_not_le. +assert (H4: (round beta fexp (Znearest choice) v <= 0)%R). +apply round_le_generic... +apply generic_format_0... +now left. +case H4; try easy. +intros H5. +absurd (v=0)%R; try auto with real. +apply eq_0_round_0_negligible_exp with (Znearest choice)... +(* . *) +intros K1. +case (Rle_or_lt ((u + pred u) / 2) v); try easy. +intros H3. +absurd (u <= round beta fexp (Znearest choice) v)%R; try easy. +apply Rlt_not_le. +apply Rle_lt_trans with (2:=K1). +apply round_N_le_midp... +apply generic_format_pred... +rewrite succ_pred... +apply Rlt_le_trans with (1:=H3). +right; f_equal; ring. +Qed. + + +Lemma round_N_le_le_midp : forall choice u v, + F u -> + (round beta fexp (Znearest choice) v <= u)%R -> + (v <= (u + succ u) / 2)%R. +Proof with auto with typeclass_instances. +intros choice u v Hu H2. +apply Ropp_le_cancel. +apply Rle_trans with (((-u)+pred (-u))/2)%R. +rewrite pred_opp; right; field. +apply round_N_ge_ge_midp with + (choice := fun t:Z => negb (choice (- (t + 1))%Z))... +apply generic_format_opp... +rewrite <- (Ropp_involutive (round _ _ _ _)). +rewrite <- round_N_opp, Ropp_involutive. +apply Ropp_le_contravar; easy. +Qed. + Lemma round_N_eq_DN: forall choice x, let d:=round beta fexp Zfloor x in @@ -2518,4 +2644,18 @@ rewrite round_generic; [now apply succ_le_plus_ulp|now simpl|]. now apply generic_format_plus_ulp, generic_format_round. Qed. + +Lemma round_N_eq_ties: forall c1 c2 x, + (x - round beta fexp Zfloor x <> round beta fexp Zceil x - x)%R -> + (round beta fexp (Znearest c1) x = round beta fexp (Znearest c2) x)%R. +Proof with auto with typeclass_instances. +intros c1 c2 x. +pose (d:=round beta fexp Zfloor x); pose (u:=round beta fexp Zceil x); fold d; fold u; intros H. +case (Rle_or_lt ((d+u)/2) x); intros L. +2:rewrite 2!round_N_eq_DN... +destruct L as [L|L]. +rewrite 2!round_N_eq_UP... +contradict H; rewrite <- L; field. +Qed. + End Fcore_ulp. diff --git a/flocq/Core/Zaux.v b/flocq/Core/Zaux.v index e21d93a4..b40b0c4f 100644 --- a/flocq/Core/Zaux.v +++ b/flocq/Core/Zaux.v @@ -17,8 +17,12 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the COPYING file for more details. *) -Require Import ZArith Omega. -Require Import Zquot. +From Coq Require Import ZArith Lia Zquot. + +Require Import SpecFloatCompat. + +Notation cond_Zopp := cond_Zopp (only parsing). +Notation iter_pos := iter_pos (only parsing). Section Zmissing. @@ -262,7 +266,7 @@ apply Z.le_refl. split. easy. apply Zpower_gt_1. -clear -He ; omega. +clear -He ; lia. apply Zle_minus_le_0. now apply Zlt_le_weak. revert H1. @@ -282,7 +286,7 @@ apply Znot_gt_le. intros H. apply Zlt_not_le with (1 := He). apply Zpower_le. -clear -H ; omega. +clear -H ; lia. Qed. Theorem Zpower_gt_id : @@ -302,7 +306,7 @@ clear. apply Zlt_0_minus_lt. replace (r * (Z_of_nat n0 + 1) - (Z_of_nat n0 + 1))%Z with ((r - 1) * (Z_of_nat n0 + 1))%Z by ring. apply Zmult_lt_0_compat. -cut (2 <= r)%Z. omega. +cut (2 <= r)%Z. lia. apply Zle_bool_imp_le. apply r. apply (Zle_lt_succ 0). @@ -420,7 +424,7 @@ apply Z.opp_inj. rewrite <- Zquot_opp_l, Z.opp_0. apply Z.quot_small. generalize (Zabs_non_eq a). -omega. +lia. Qed. Theorem ZOmod_small_abs : @@ -437,7 +441,7 @@ apply Z.opp_inj. rewrite <- Zrem_opp_l. apply Z.rem_small. generalize (Zabs_non_eq a). -omega. +lia. Qed. Theorem ZOdiv_plus : @@ -702,8 +706,6 @@ End Zcompare. Section cond_Zopp. -Definition cond_Zopp (b : bool) m := if b then Z.opp m else m. - Theorem cond_Zopp_negb : forall x y, cond_Zopp (negb x) y = Z.opp (cond_Zopp x y). Proof. @@ -921,16 +923,9 @@ intros x. apply IHp. Qed. -Fixpoint iter_pos (n : positive) (x : A) {struct n} : A := - match n with - | xI n' => iter_pos n' (iter_pos n' (f x)) - | xO n' => iter_pos n' (iter_pos n' x) - | xH => f x - end. - Lemma iter_pos_nat : forall (p : positive) (x : A), - iter_pos p x = iter_nat (Pos.to_nat p) x. + iter_pos f p x = iter_nat (Pos.to_nat p) x. Proof. induction p ; intros x. rewrite Pos2Nat.inj_xI. diff --git a/flocq/IEEE754/Binary.v b/flocq/IEEE754/Binary.v index ac38c761..35d15cb3 100644 --- a/flocq/IEEE754/Binary.v +++ b/flocq/IEEE754/Binary.v @@ -627,6 +627,52 @@ Proof. now rewrite Pcompare_antisym. Qed. +Theorem bounded_le_emax_minus_prec : + forall mx ex, + bounded mx ex = true -> + (F2R (Float radix2 (Zpos mx) ex) + <= bpow radix2 emax - bpow radix2 (emax - prec))%R. +Proof. +intros mx ex Hx. +destruct (andb_prop _ _ Hx) as (H1,H2). +generalize (Zeq_bool_eq _ _ H1). clear H1. intro H1. +generalize (Zle_bool_imp_le _ _ H2). clear H2. intro H2. +generalize (mag_F2R_Zdigits radix2 (Zpos mx) ex). +destruct (mag radix2 (F2R (Float radix2 (Zpos mx) ex))) as (e',Ex). +unfold mag_val. +intros H. +elim Ex; [|now apply Rgt_not_eq, F2R_gt_0]; intros _. +rewrite <-F2R_Zabs; simpl; clear Ex; intros Ex. +generalize (Rmult_lt_compat_r (bpow radix2 (-ex)) _ _ (bpow_gt_0 _ _) Ex). +unfold F2R; simpl; rewrite Rmult_assoc, <-!bpow_plus. +rewrite H; [|intro H'; discriminate H']. +rewrite <-Z.add_assoc, Z.add_opp_diag_r, Z.add_0_r, Rmult_1_r. +rewrite <-(IZR_Zpower _ _ (Zdigits_ge_0 _ _)); clear Ex; intro Ex. +generalize (Zlt_le_succ _ _ (lt_IZR _ _ Ex)); clear Ex; intro Ex. +generalize (IZR_le _ _ Ex). +rewrite succ_IZR; clear Ex; intro Ex. +generalize (Rplus_le_compat_r (-1) _ _ Ex); clear Ex; intro Ex. +ring_simplify in Ex; revert Ex. +rewrite (IZR_Zpower _ _ (Zdigits_ge_0 _ _)); intro Ex. +generalize (Rmult_le_compat_r (bpow radix2 ex) _ _ (bpow_ge_0 _ _) Ex). +intro H'; apply (Rle_trans _ _ _ H'). +rewrite Rmult_minus_distr_r, Rmult_1_l, <-bpow_plus. +revert H1; unfold fexp, FLT_exp; intro H1. +generalize (Z.le_max_l (Z.pos (digits2_pos mx) + ex - prec) emin). +rewrite H1; intro H1'. +generalize (proj1 (Z.le_sub_le_add_r _ _ _) H1'). +rewrite Zpos_digits2_pos; clear H1'; intro H1'. +apply (Rle_trans _ _ _ (Rplus_le_compat_r _ _ _ (bpow_le _ _ _ H1'))). +replace emax with (emax - prec - ex + (ex + prec))%Z at 1 by ring. +replace (emax - prec)%Z with (emax - prec - ex + ex)%Z at 2 by ring. +do 2 rewrite (bpow_plus _ (emax - prec - ex)). +rewrite <-Rmult_minus_distr_l. +rewrite <-(Rmult_1_l (_ + _)). +apply Rmult_le_compat_r. +{ apply Rle_0_minus, bpow_le; unfold Prec_gt_0 in prec_gt_0_; lia. } +change 1%R with (bpow radix2 0); apply bpow_le; lia. +Qed. + Theorem bounded_lt_emax : forall mx ex, bounded mx ex = true -> @@ -651,7 +697,7 @@ rewrite H. 2: discriminate. revert H1. clear -H2. rewrite Zpos_digits2_pos. unfold fexp, FLT_exp. -intros ; zify ; omega. +intros ; zify ; lia. Qed. Theorem bounded_ge_emin : @@ -679,7 +725,18 @@ unfold fexp, FLT_exp. clear -prec_gt_0_. unfold Prec_gt_0 in prec_gt_0_. clearbody emin. -intros ; zify ; omega. +intros ; zify ; lia. +Qed. + +Theorem abs_B2R_le_emax_minus_prec : + forall x, + (Rabs (B2R x) <= bpow radix2 emax - bpow radix2 (emax - prec))%R. +Proof. +intros [sx|sx|sx plx Hx|sx mx ex Hx] ; simpl ; + [rewrite Rabs_R0 ; apply Rle_0_minus, bpow_le ; + revert prec_gt_0_; unfold Prec_gt_0; lia..|]. +rewrite <- F2R_Zabs, abs_cond_Zopp. +now apply bounded_le_emax_minus_prec. Qed. Theorem abs_B2R_lt_emax : @@ -728,7 +785,7 @@ rewrite Cx. unfold cexp, fexp, FLT_exp. destruct (mag radix2 (F2R (Float radix2 (Zpos mx) ex))) as (e',Ex). simpl. apply Z.max_lub. -cut (e' - 1 < emax)%Z. clear ; omega. +cut (e' - 1 < emax)%Z. clear ; lia. apply lt_bpow with radix2. apply Rle_lt_trans with (2 := Bx). change (Zpos mx) with (Z.abs (Zpos mx)). @@ -738,7 +795,7 @@ apply Rgt_not_eq. now apply F2R_gt_0. unfold emin. generalize (prec_gt_0 prec). -clear -Hmax ; omega. +clear -Hmax ; lia. Qed. (** Truncation *) @@ -889,7 +946,7 @@ now inversion H. (* *) intros p Hp. assert (He: (e <= fexp (Zdigits radix2 m + e))%Z). -clear -Hp ; zify ; omega. +clear -Hp ; zify ; lia. destruct (inbetween_float_ex radix2 m e l) as (x, Hx). generalize (inbetween_shr x m e l (fexp (Zdigits radix2 m + e) - e) Hm Hx). assert (Hx0 : (0 <= x)%R). @@ -1091,18 +1148,18 @@ rewrite Zpos_digits2_pos. replace (Zdigits radix2 (Zpos (match (Zpower 2 prec - 1)%Z with Zpos p => p | _ => xH end))) with prec. unfold fexp, FLT_exp, emin. generalize (prec_gt_0 prec). -clear -Hmax ; zify ; omega. +clear -Hmax ; zify ; lia. change 2%Z with (radix_val radix2). case_eq (Zpower radix2 prec - 1)%Z. simpl Zdigits. generalize (Zpower_gt_1 radix2 prec (prec_gt_0 prec)). -clear ; omega. +clear ; lia. intros p Hp. apply Zle_antisym. -cut (prec - 1 < Zdigits radix2 (Zpos p))%Z. clear ; omega. +cut (prec - 1 < Zdigits radix2 (Zpos p))%Z. clear ; lia. apply Zdigits_gt_Zpower. simpl Z.abs. rewrite <- Hp. -cut (Zpower radix2 (prec - 1) < Zpower radix2 prec)%Z. clear ; omega. +cut (Zpower radix2 (prec - 1) < Zpower radix2 prec)%Z. clear ; lia. apply lt_IZR. rewrite 2!IZR_Zpower. 2: now apply Zlt_le_weak. apply bpow_lt. @@ -1113,7 +1170,7 @@ simpl Z.abs. rewrite <- Hp. apply Zlt_pred. intros p Hp. generalize (Zpower_gt_1 radix2 _ (prec_gt_0 prec)). -clear -Hp ; zify ; omega. +clear -Hp ; zify ; lia. apply Rnot_lt_le. intros Hx. generalize (refl_equal (bounded m2 e2)). @@ -1271,18 +1328,18 @@ rewrite Zpos_digits2_pos. replace (Zdigits radix2 (Zpos (match (Zpower 2 prec - 1)%Z with Zpos p => p | _ => xH end))) with prec. unfold fexp, FLT_exp, emin. generalize (prec_gt_0 prec). -clear -Hmax ; zify ; omega. +clear -Hmax ; zify ; lia. change 2%Z with (radix_val radix2). case_eq (Zpower radix2 prec - 1)%Z. simpl Zdigits. generalize (Zpower_gt_1 radix2 prec (prec_gt_0 prec)). -clear ; omega. +clear ; lia. intros p Hp. apply Zle_antisym. -cut (prec - 1 < Zdigits radix2 (Zpos p))%Z. clear ; omega. +cut (prec - 1 < Zdigits radix2 (Zpos p))%Z. clear ; lia. apply Zdigits_gt_Zpower. simpl Z.abs. rewrite <- Hp. -cut (Zpower radix2 (prec - 1) < Zpower radix2 prec)%Z. clear ; omega. +cut (Zpower radix2 (prec - 1) < Zpower radix2 prec)%Z. clear ; lia. apply lt_IZR. rewrite 2!IZR_Zpower. 2: now apply Zlt_le_weak. apply bpow_lt. @@ -1293,7 +1350,7 @@ simpl Z.abs. rewrite <- Hp. apply Zlt_pred. intros p Hp. generalize (Zpower_gt_1 radix2 _ (prec_gt_0 prec)). -clear -Hp ; zify ; omega. +clear -Hp ; zify ; lia. apply Rnot_lt_le. intros Hx. generalize (refl_equal (bounded m2 e2)). @@ -1370,7 +1427,7 @@ clear -Hmax. unfold emin. intros dx dy dxy Hx Hy Hxy. zify ; intros ; subst. -omega. +lia. (* *) case sx ; case sy. apply Rlt_bool_false. @@ -1479,7 +1536,7 @@ case_eq (ex' - ex)%Z ; simpl. intros H. now rewrite Zminus_eq with (1 := H). intros p. -clear -He ; zify ; omega. +clear -He ; zify ; lia. intros. apply refl_equal. Qed. @@ -1580,7 +1637,7 @@ now rewrite is_finite_FF2B. rewrite Bsign_FF2B, Rz''. rewrite Rcompare_Gt... apply F2R_gt_0. -simpl. zify; omega. +simpl. zify; lia. intros Hz' (Vz, Rz). rewrite B2FF_FF2B, Rz. apply f_equal. @@ -1599,7 +1656,7 @@ now rewrite is_finite_FF2B. rewrite Bsign_FF2B, Rz''. rewrite Rcompare_Lt... apply F2R_lt_0. -simpl. zify; omega. +simpl. zify; lia. intros Hz' (Vz, Rz). rewrite B2FF_FF2B, Rz. apply f_equal. @@ -2150,7 +2207,7 @@ set (e' := Z.min _ _). assert (2 * e' <= ex)%Z as He. { assert (e' <= Z.div2 ex)%Z by apply Z.le_min_r. rewrite (Zdiv2_odd_eqn ex). - destruct Z.odd ; omega. } + destruct Z.odd ; lia. } generalize (Fsqrt_core_correct radix2 (Zpos mx) ex e' eq_refl He). unfold Fsqrt_core. set (mx' := match (ex - 2 * e')%Z with Z0 => _ | _ => _ end). @@ -2187,7 +2244,7 @@ apply Rlt_le_trans with (1 := Heps). fold (bpow radix2 0). apply bpow_le. generalize (prec_gt_0 prec). -clear ; omega. +clear ; lia. apply Rsqr_incrst_0. 3: apply bpow_ge_0. rewrite Rsqr_mult. @@ -2211,7 +2268,7 @@ now apply IZR_le. change 4%R with (bpow radix2 2). apply bpow_le. generalize (prec_gt_0 prec). -clear -Hmax ; omega. +clear -Hmax ; lia. apply Rmult_le_pos. apply sqrt_ge_0. rewrite <- (Rplus_opp_r 1). @@ -2230,7 +2287,7 @@ unfold Rsqr. rewrite <- bpow_plus. apply bpow_le. unfold emin. -clear -Hmax ; omega. +clear -Hmax ; lia. apply generic_format_ge_bpow with fexp. intros. apply Z.le_max_r. diff --git a/flocq/IEEE754/Bits.v b/flocq/IEEE754/Bits.v index 3a84edfe..68bc541a 100644 --- a/flocq/IEEE754/Bits.v +++ b/flocq/IEEE754/Bits.v @@ -18,6 +18,8 @@ COPYING file for more details. *) (** * IEEE-754 encoding of binary floating-point data *) + +From Coq Require Import Lia. Require Import Core Digits Binary. Section Binary_Bits. @@ -43,10 +45,10 @@ Proof. intros s m e Hm He. assert (0 <= mw)%Z as Hmw. destruct mw as [|mw'|mw'] ; try easy. - clear -Hm ; simpl in Hm ; omega. + clear -Hm ; simpl in Hm ; lia. assert (0 <= ew)%Z as Hew. destruct ew as [|ew'|ew'] ; try easy. - clear -He ; simpl in He ; omega. + clear -He ; simpl in He ; lia. unfold join_bits. rewrite Z.shiftl_mul_pow2 by easy. split. @@ -54,9 +56,9 @@ split. rewrite <- (Zmult_0_l (2^mw)). apply Zmult_le_compat_r. case s. - clear -He ; omega. + clear -He ; lia. now rewrite Zmult_0_l. - clear -Hm ; omega. + clear -Hm ; lia. - apply Z.lt_le_trans with (((if s then 2 ^ ew else 0) + e + 1) * 2 ^ mw)%Z. rewrite (Zmult_plus_distr_l _ 1). apply Zplus_lt_compat_l. @@ -65,9 +67,9 @@ split. apply Zmult_le_compat_r. rewrite Zpower_plus by easy. change (2^1)%Z with 2%Z. - case s ; clear -He ; omega. - clear -Hm ; omega. - clear -Hew ; omega. + case s ; clear -He ; lia. + clear -Hm ; lia. + clear -Hew ; lia. easy. Qed. @@ -85,10 +87,10 @@ Proof. intros s m e Hm He. assert (0 <= mw)%Z as Hmw. destruct mw as [|mw'|mw'] ; try easy. - clear -Hm ; simpl in Hm ; omega. + clear -Hm ; simpl in Hm ; lia. assert (0 <= ew)%Z as Hew. destruct ew as [|ew'|ew'] ; try easy. - clear -He ; simpl in He ; omega. + clear -He ; simpl in He ; lia. unfold split_bits, join_bits. rewrite Z.shiftl_mul_pow2 by easy. apply f_equal2 ; [apply f_equal2|]. @@ -99,7 +101,7 @@ apply f_equal2 ; [apply f_equal2|]. apply Zplus_le_0_compat. apply Zmult_le_0_compat. apply He. - clear -Hm ; omega. + clear -Hm ; lia. apply Hm. + apply Zle_bool_false. apply Zplus_lt_reg_l with (2^mw * (-e))%Z. @@ -108,12 +110,12 @@ apply f_equal2 ; [apply f_equal2|]. apply Z.lt_le_trans with (2^mw * 1)%Z. now apply Zmult_lt_compat_r. apply Zmult_le_compat_l. - clear -He ; omega. - clear -Hm ; omega. + clear -He ; lia. + clear -Hm ; lia. - rewrite Zplus_comm. rewrite Z_mod_plus_full. now apply Zmod_small. -- rewrite Z_div_plus_full_l by (clear -Hm ; omega). +- rewrite Z_div_plus_full_l by (clear -Hm ; lia). rewrite Zdiv_small with (1 := Hm). rewrite Zplus_0_r. case s. @@ -175,7 +177,7 @@ rewrite Zdiv_Zdiv. apply sym_eq. case Zle_bool_spec ; intros Hs. apply Zle_antisym. -cut (x / (2^mw * 2^ew) < 2)%Z. clear ; omega. +cut (x / (2^mw * 2^ew) < 2)%Z. clear ; lia. apply Zdiv_lt_upper_bound. now apply Zmult_lt_0_compat. rewrite <- Zpower_exp ; try ( apply Z.le_ge ; apply Zlt_le_weak ; assumption ). @@ -244,8 +246,8 @@ Theorem split_bits_of_binary_float_correct : split_bits (bits_of_binary_float x) = split_bits_of_binary_float x. Proof. intros [sx|sx|sx plx Hplx|sx mx ex Hx] ; - try ( simpl ; apply split_join_bits ; split ; try apply Z.le_refl ; try apply Zlt_pred ; trivial ; omega ). -simpl. apply split_join_bits; split; try (zify; omega). + try ( simpl ; apply split_join_bits ; split ; try apply Z.le_refl ; try apply Zlt_pred ; trivial ; lia ). +simpl. apply split_join_bits; split; try (zify; lia). destruct (digits2_Pnat_correct plx). unfold nan_pl in Hplx. rewrite Zpos_digits2_pos, <- Z_of_nat_S_digits2_Pnat in Hplx. @@ -253,7 +255,7 @@ rewrite Zpower_nat_Z in H0. eapply Z.lt_le_trans. apply H0. change 2%Z with (radix_val radix2). apply Zpower_le. rewrite Z.ltb_lt in Hplx. -unfold prec in *. zify; omega. +unfold prec in *. zify; lia. (* *) unfold bits_of_binary_float, split_bits_of_binary_float. assert (Hf: (emin <= ex /\ Zdigits radix2 (Zpos mx) <= prec)%Z). @@ -263,14 +265,14 @@ rewrite Zpos_digits2_pos in Hx'. generalize (Zeq_bool_eq _ _ Hx'). unfold FLT_exp. unfold emin. -clear ; zify ; omega. +clear ; zify ; lia. case Zle_bool_spec ; intros H ; [ apply -> Z.le_0_sub in H | apply -> Z.lt_sub_0 in H ] ; apply split_join_bits ; try now split. (* *) split. -clear -He_gt_0 H ; omega. -cut (Zpos mx < 2 * 2^mw)%Z. clear ; omega. +clear -He_gt_0 H ; lia. +cut (Zpos mx < 2 * 2^mw)%Z. clear ; lia. replace (2 * 2^mw)%Z with (2^prec)%Z. apply (Zpower_gt_Zdigits radix2 _ (Zpos mx)). apply Hf. @@ -282,12 +284,12 @@ now apply Zlt_le_weak. (* *) split. generalize (proj1 Hf). -clear ; omega. +clear ; lia. destruct (andb_prop _ _ Hx) as (_, Hx'). unfold emin. replace (2^ew)%Z with (2 * emax)%Z. generalize (Zle_bool_imp_le _ _ Hx'). -clear ; omega. +clear ; lia. apply sym_eq. rewrite (Zsucc_pred ew). unfold Z.succ. @@ -305,7 +307,7 @@ intros [sx|sx|sx pl pl_range|sx mx ex H]. - apply join_bits_range ; now split. - apply join_bits_range. now split. - clear -He_gt_0 ; omega. + clear -He_gt_0 ; lia. - apply Z.ltb_lt in pl_range. apply join_bits_range. split. @@ -313,7 +315,7 @@ intros [sx|sx|sx pl pl_range|sx mx ex H]. apply (Zpower_gt_Zdigits radix2 _ (Zpos pl)). apply Z.lt_succ_r. now rewrite <- Zdigits2_Zdigits. - clear -He_gt_0 ; omega. + clear -He_gt_0 ; lia. - unfold bounded in H. apply Bool.andb_true_iff in H ; destruct H as [A B]. apply Z.leb_le in B. @@ -321,22 +323,22 @@ intros [sx|sx|sx pl pl_range|sx mx ex H]. case Zle_bool_spec ; intros H. + apply join_bits_range. * split. - clear -H ; omega. + clear -H ; lia. rewrite Zpos_digits2_pos in A. cut (Zpos mx < 2 ^ prec)%Z. unfold prec. - rewrite Zpower_plus by (clear -Hmw ; omega). + rewrite Zpower_plus by (clear -Hmw ; lia). change (2^1)%Z with 2%Z. - clear ; omega. + clear ; lia. apply (Zpower_gt_Zdigits radix2 _ (Zpos mx)). - clear -A ; zify ; omega. + clear -A ; zify ; lia. * split. - unfold emin ; clear -A ; zify ; omega. + unfold emin ; clear -A ; zify ; lia. replace ew with ((ew - 1) + 1)%Z by ring. - rewrite Zpower_plus by (clear - Hew ; omega). + rewrite Zpower_plus by (clear - Hew ; lia). unfold emin, emax in *. change (2^1)%Z with 2%Z. - clear -B ; omega. + clear -B ; lia. + apply -> Z.lt_sub_0 in H. apply join_bits_range ; now split. Qed. @@ -370,7 +372,7 @@ unfold binary_float_of_bits_aux, split_bits. assert (Hnan: nan_pl prec 1 = true). apply Z.ltb_lt. simpl. unfold prec. - clear -Hmw ; omega. + clear -Hmw ; lia. case Zeq_bool_spec ; intros He1. case_eq (x mod 2^mw)%Z ; try easy. (* subnormal *) @@ -389,7 +391,7 @@ unfold Fexp, FLT_exp. apply sym_eq. apply Zmax_right. clear -H Hprec. -unfold prec ; omega. +unfold prec ; lia. apply Rnot_le_lt. intros H0. refine (_ (mag_le radix2 _ _ _ H0)). @@ -397,20 +399,20 @@ rewrite mag_bpow. rewrite mag_F2R_Zdigits. 2: discriminate. unfold emin, prec. apply Zlt_not_le. -cut (0 < emax)%Z. clear -H Hew ; omega. +cut (0 < emax)%Z. clear -H Hew ; lia. apply (Zpower_gt_0 radix2). -clear -Hew ; omega. +clear -Hew ; lia. apply bpow_gt_0. case Zeq_bool_spec ; intros He2. case_eq (x mod 2 ^ mw)%Z; try easy. (* nan *) intros plx Eqplx. apply Z.ltb_lt. rewrite Zpos_digits2_pos. -assert (forall a b, a <= b -> a < b+1)%Z by (intros; omega). apply H. clear H. +assert (forall a b, a <= b -> a < b+1)%Z by (intros; lia). apply H. clear H. apply Zdigits_le_Zpower. simpl. rewrite <- Eqplx. edestruct Z_mod_lt; eauto. change 2%Z with (radix_val radix2). -apply Z.lt_gt, Zpower_gt_0. omega. +apply Z.lt_gt, Zpower_gt_0. lia. case_eq (x mod 2^mw + 2^mw)%Z ; try easy. (* normal *) intros px Hm. @@ -452,7 +454,7 @@ revert He1. fold ex. cut (0 <= ex)%Z. unfold emin. -clear ; intros H1 H2 ; omega. +clear ; intros H1 H2 ; lia. eapply Z_mod_lt. apply Z.lt_gt. apply (Zpower_gt_0 radix2). @@ -471,12 +473,12 @@ revert He2. set (ex := ((x / 2^mw) mod 2^ew)%Z). cut (ex < 2^ew)%Z. replace (2^ew)%Z with (2 * emax)%Z. -clear ; intros H1 H2 ; omega. +clear ; intros H1 H2 ; lia. replace ew with (1 + (ew - 1))%Z by ring. rewrite Zpower_exp. apply refl_equal. discriminate. -clear -Hew ; omega. +clear -Hew ; lia. eapply Z_mod_lt. apply Z.lt_gt. apply (Zpower_gt_0 radix2). @@ -503,13 +505,13 @@ apply refl_equal. simpl. rewrite Zeq_bool_false. now rewrite Zeq_bool_true. -cut (1 < 2^ew)%Z. clear ; omega. +cut (1 < 2^ew)%Z. clear ; lia. now apply (Zpower_gt_1 radix2). (* *) simpl. rewrite Zeq_bool_false. rewrite Zeq_bool_true; auto. -cut (1 < 2^ew)%Z. clear ; omega. +cut (1 < 2^ew)%Z. clear ; lia. now apply (Zpower_gt_1 radix2). (* *) unfold split_bits_of_binary_float. @@ -522,19 +524,19 @@ destruct (andb_prop _ _ Bx) as (_, H1). generalize (Zle_bool_imp_le _ _ H1). unfold emin. replace (2^ew)%Z with (2 * emax)%Z. -clear ; omega. +clear ; lia. replace ew with (1 + (ew - 1))%Z by ring. rewrite Zpower_exp. apply refl_equal. discriminate. -clear -Hew ; omega. +clear -Hew ; lia. destruct (andb_prop _ _ Bx) as (H1, _). generalize (Zeq_bool_eq _ _ H1). rewrite Zpos_digits2_pos. unfold FLT_exp, emin. generalize (Zdigits radix2 (Zpos mx)). clear. -intros ; zify ; omega. +intros ; zify ; lia. (* . *) rewrite Zeq_bool_true. 2: apply refl_equal. simpl. @@ -547,7 +549,7 @@ apply -> Z.lt_sub_0 in Hm. generalize (Zdigits_le_Zpower radix2 _ (Zpos mx) Hm). generalize (Zdigits radix2 (Zpos mx)). clear. -intros ; zify ; omega. +intros ; zify ; lia. Qed. Theorem bits_of_binary_float_of_bits : @@ -588,12 +590,12 @@ case Zeq_bool_spec ; intros He2. case_eq mx; intros Hm. now rewrite He2. now rewrite He2. -intros. zify; omega. +intros. zify; lia. (* normal *) case_eq (mx + 2 ^ mw)%Z. intros Hm. apply False_ind. -clear -Bm Hm ; omega. +clear -Bm Hm ; lia. intros p Hm Jx Cx. rewrite <- Hm. rewrite Zle_bool_true. @@ -601,7 +603,7 @@ now ring_simplify (mx + 2^mw - 2^mw)%Z (ex + emin - 1 - emin + 1)%Z. now ring_simplify. intros p Hm. apply False_ind. -clear -Bm Hm ; zify ; omega. +clear -Bm Hm ; zify ; lia. Qed. End Binary_Bits. @@ -623,6 +625,12 @@ Proof. apply refl_equal. Qed. +Let Hemax : (3 <= 128)%Z. +Proof. +intros H. +discriminate H. +Qed. + Definition default_nan_pl32 : { nan : binary32 | is_nan 24 128 nan = true } := exist _ (@B754_nan 24 128 false (iter_nat xO 22 xH) (refl_equal true)) (refl_equal true). @@ -639,16 +647,28 @@ Definition binop_nan_pl32 (f1 f2 : binary32) : { nan : binary32 | is_nan 24 128 | _, _ => default_nan_pl32 end. +Definition ternop_nan_pl32 (f1 f2 f3 : binary32) : { nan : binary32 | is_nan 24 128 nan = true } := + match f1, f2, f3 with + | B754_nan s1 pl1 Hpl1, _, _ => exist _ (B754_nan s1 pl1 Hpl1) (refl_equal true) + | _, B754_nan s2 pl2 Hpl2, _ => exist _ (B754_nan s2 pl2 Hpl2) (refl_equal true) + | _, _, B754_nan s3 pl3 Hpl3 => exist _ (B754_nan s3 pl3 Hpl3) (refl_equal true) + | _, _, _ => default_nan_pl32 + end. + Definition b32_erase : binary32 -> binary32 := erase 24 128. Definition b32_opp : binary32 -> binary32 := Bopp 24 128 unop_nan_pl32. Definition b32_abs : binary32 -> binary32 := Babs 24 128 unop_nan_pl32. -Definition b32_sqrt : mode -> binary32 -> binary32 := Bsqrt _ _ Hprec Hprec_emax unop_nan_pl32. +Definition b32_pred : binary32 -> binary32 := Bpred _ _ Hprec Hprec_emax Hemax unop_nan_pl32. +Definition b32_succ : binary32 -> binary32 := Bsucc _ _ Hprec Hprec_emax Hemax unop_nan_pl32. +Definition b32_sqrt : mode -> binary32 -> binary32 := Bsqrt _ _ Hprec Hprec_emax unop_nan_pl32. Definition b32_plus : mode -> binary32 -> binary32 -> binary32 := Bplus _ _ Hprec Hprec_emax binop_nan_pl32. Definition b32_minus : mode -> binary32 -> binary32 -> binary32 := Bminus _ _ Hprec Hprec_emax binop_nan_pl32. Definition b32_mult : mode -> binary32 -> binary32 -> binary32 := Bmult _ _ Hprec Hprec_emax binop_nan_pl32. Definition b32_div : mode -> binary32 -> binary32 -> binary32 := Bdiv _ _ Hprec Hprec_emax binop_nan_pl32. +Definition b32_fma : mode -> binary32 -> binary32 -> binary32 -> binary32 := Bfma _ _ Hprec Hprec_emax ternop_nan_pl32. + Definition b32_compare : binary32 -> binary32 -> option comparison := Bcompare 24 128. Definition b32_of_bits : Z -> binary32 := binary_float_of_bits 23 8 (refl_equal _) (refl_equal _) (refl_equal _). Definition bits_of_b32 : binary32 -> Z := bits_of_binary_float 23 8. @@ -672,6 +692,12 @@ Proof. apply refl_equal. Qed. +Let Hemax : (3 <= 1024)%Z. +Proof. +intros H. +discriminate H. +Qed. + Definition default_nan_pl64 : { nan : binary64 | is_nan 53 1024 nan = true } := exist _ (@B754_nan 53 1024 false (iter_nat xO 51 xH) (refl_equal true)) (refl_equal true). @@ -688,9 +714,19 @@ Definition binop_nan_pl64 (f1 f2 : binary64) : { nan : binary64 | is_nan 53 1024 | _, _ => default_nan_pl64 end. +Definition ternop_nan_pl64 (f1 f2 f3 : binary64) : { nan : binary64 | is_nan 53 1024 nan = true } := + match f1, f2, f3 with + | B754_nan s1 pl1 Hpl1, _, _ => exist _ (B754_nan s1 pl1 Hpl1) (refl_equal true) + | _, B754_nan s2 pl2 Hpl2, _ => exist _ (B754_nan s2 pl2 Hpl2) (refl_equal true) + | _, _, B754_nan s3 pl3 Hpl3 => exist _ (B754_nan s3 pl3 Hpl3) (refl_equal true) + | _, _, _ => default_nan_pl64 + end. + Definition b64_erase : binary64 -> binary64 := erase 53 1024. Definition b64_opp : binary64 -> binary64 := Bopp 53 1024 unop_nan_pl64. Definition b64_abs : binary64 -> binary64 := Babs 53 1024 unop_nan_pl64. +Definition b64_pred : binary64 -> binary64 := Bpred _ _ Hprec Hprec_emax Hemax unop_nan_pl64. +Definition b64_succ : binary64 -> binary64 := Bsucc _ _ Hprec Hprec_emax Hemax unop_nan_pl64. Definition b64_sqrt : mode -> binary64 -> binary64 := Bsqrt _ _ Hprec Hprec_emax unop_nan_pl64. Definition b64_plus : mode -> binary64 -> binary64 -> binary64 := Bplus _ _ Hprec Hprec_emax binop_nan_pl64. @@ -698,6 +734,8 @@ Definition b64_minus : mode -> binary64 -> binary64 -> binary64 := Bminus _ _ Hp Definition b64_mult : mode -> binary64 -> binary64 -> binary64 := Bmult _ _ Hprec Hprec_emax binop_nan_pl64. Definition b64_div : mode -> binary64 -> binary64 -> binary64 := Bdiv _ _ Hprec Hprec_emax binop_nan_pl64. +Definition b64_fma : mode -> binary64 -> binary64 -> binary64 -> binary64 := Bfma _ _ Hprec Hprec_emax ternop_nan_pl64. + Definition b64_compare : binary64 -> binary64 -> option comparison := Bcompare 53 1024. Definition b64_of_bits : Z -> binary64 := binary_float_of_bits 52 11 (refl_equal _) (refl_equal _) (refl_equal _). Definition bits_of_b64 : binary64 -> Z := bits_of_binary_float 52 11. diff --git a/flocq/IEEE754/SpecFloatCompat.v b/flocq/IEEE754/SpecFloatCompat.v new file mode 100644 index 00000000..e2ace4d5 --- /dev/null +++ b/flocq/IEEE754/SpecFloatCompat.v @@ -0,0 +1,435 @@ +(** +This file is part of the Flocq formalization of floating-point +arithmetic in Coq: http://flocq.gforge.inria.fr/ + +Copyright (C) 2018-2019 Guillaume Bertholon +#<br /># +Copyright (C) 2018-2019 Érik Martin-Dorel +#<br /># +Copyright (C) 2018-2019 Pierre Roux + +This library is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +This library is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +COPYING file for more details. +*) + +Require Import ZArith. + +(** ** Inductive specification of floating-point numbers + +Similar to [IEEE754.Binary.full_float], but with no NaN payload. *) +Variant spec_float := + | S754_zero (s : bool) + | S754_infinity (s : bool) + | S754_nan + | S754_finite (s : bool) (m : positive) (e : Z). + +(** ** Parameterized definitions + +[prec] is the number of bits of the mantissa including the implicit one; +[emax] is the exponent of the infinities. + +For instance, Binary64 is defined by [prec = 53] and [emax = 1024]. *) +Section FloatOps. + Variable prec emax : Z. + + Definition emin := (3-emax-prec)%Z. + Definition fexp e := Z.max (e - prec) emin. + + Section Zdigits2. + Fixpoint digits2_pos (n : positive) : positive := + match n with + | xH => xH + | xO p => Pos.succ (digits2_pos p) + | xI p => Pos.succ (digits2_pos p) + end. + + Definition Zdigits2 n := + match n with + | Z0 => n + | Zpos p => Zpos (digits2_pos p) + | Zneg p => Zpos (digits2_pos p) + end. + End Zdigits2. + + Section ValidBinary. + Definition canonical_mantissa m e := + Zeq_bool (fexp (Zpos (digits2_pos m) + e)) e. + + Definition bounded m e := + andb (canonical_mantissa m e) (Zle_bool e (emax - prec)). + + Definition valid_binary x := + match x with + | S754_finite _ m e => bounded m e + | _ => true + end. + End ValidBinary. + + Section Iter. + Context {A : Type}. + Variable (f : A -> A). + + Fixpoint iter_pos (n : positive) (x : A) {struct n} : A := + match n with + | xI n' => iter_pos n' (iter_pos n' (f x)) + | xO n' => iter_pos n' (iter_pos n' x) + | xH => f x + end. + End Iter. + + Section Rounding. + Inductive location := loc_Exact | loc_Inexact : comparison -> location. + + Record shr_record := { shr_m : Z ; shr_r : bool ; shr_s : bool }. + + Definition shr_1 mrs := + let '(Build_shr_record m r s) := mrs in + let s := orb r s in + match m with + | Z0 => Build_shr_record Z0 false s + | Zpos xH => Build_shr_record Z0 true s + | Zpos (xO p) => Build_shr_record (Zpos p) false s + | Zpos (xI p) => Build_shr_record (Zpos p) true s + | Zneg xH => Build_shr_record Z0 true s + | Zneg (xO p) => Build_shr_record (Zneg p) false s + | Zneg (xI p) => Build_shr_record (Zneg p) true s + end. + + Definition loc_of_shr_record mrs := + match mrs with + | Build_shr_record _ false false => loc_Exact + | Build_shr_record _ false true => loc_Inexact Lt + | Build_shr_record _ true false => loc_Inexact Eq + | Build_shr_record _ true true => loc_Inexact Gt + end. + + Definition shr_record_of_loc m l := + match l with + | loc_Exact => Build_shr_record m false false + | loc_Inexact Lt => Build_shr_record m false true + | loc_Inexact Eq => Build_shr_record m true false + | loc_Inexact Gt => Build_shr_record m true true + end. + + Definition shr mrs e n := + match n with + | Zpos p => (iter_pos shr_1 p mrs, (e + n)%Z) + | _ => (mrs, e) + end. + + Definition shr_fexp m e l := + shr (shr_record_of_loc m l) e (fexp (Zdigits2 m + e) - e). + + Definition round_nearest_even mx lx := + match lx with + | loc_Exact => mx + | loc_Inexact Lt => mx + | loc_Inexact Eq => if Z.even mx then mx else (mx + 1)%Z + | loc_Inexact Gt => (mx + 1)%Z + end. + + Definition binary_round_aux sx mx ex lx := + let '(mrs', e') := shr_fexp mx ex lx in + let '(mrs'', e'') := shr_fexp (round_nearest_even (shr_m mrs') (loc_of_shr_record mrs')) e' loc_Exact in + match shr_m mrs'' with + | Z0 => S754_zero sx + | Zpos m => if Zle_bool e'' (emax - prec) then S754_finite sx m e'' else S754_infinity sx + | _ => S754_nan + end. + + Definition shl_align mx ex ex' := + match (ex' - ex)%Z with + | Zneg d => (shift_pos d mx, ex') + | _ => (mx, ex) + end. + + Definition binary_round sx mx ex := + let '(mz, ez) := shl_align mx ex (fexp (Zpos (digits2_pos mx) + ex))in + binary_round_aux sx (Zpos mz) ez loc_Exact. + + Definition binary_normalize m e szero := + match m with + | Z0 => S754_zero szero + | Zpos m => binary_round false m e + | Zneg m => binary_round true m e + end. + End Rounding. + + (** ** Define operations *) + + Definition SFopp x := + match x with + | S754_nan => S754_nan + | S754_infinity sx => S754_infinity (negb sx) + | S754_finite sx mx ex => S754_finite (negb sx) mx ex + | S754_zero sx => S754_zero (negb sx) + end. + + Definition SFabs x := + match x with + | S754_nan => S754_nan + | S754_infinity sx => S754_infinity false + | S754_finite sx mx ex => S754_finite false mx ex + | S754_zero sx => S754_zero false + end. + + Definition SFcompare f1 f2 := + match f1, f2 with + | S754_nan , _ | _, S754_nan => None + | S754_infinity s1, S754_infinity s2 => + Some match s1, s2 with + | true, true => Eq + | false, false => Eq + | true, false => Lt + | false, true => Gt + end + | S754_infinity s, _ => Some (if s then Lt else Gt) + | _, S754_infinity s => Some (if s then Gt else Lt) + | S754_finite s _ _, S754_zero _ => Some (if s then Lt else Gt) + | S754_zero _, S754_finite s _ _ => Some (if s then Gt else Lt) + | S754_zero _, S754_zero _ => Some Eq + | S754_finite s1 m1 e1, S754_finite s2 m2 e2 => + Some match s1, s2 with + | true, false => Lt + | false, true => Gt + | false, false => + match Z.compare e1 e2 with + | Lt => Lt + | Gt => Gt + | Eq => Pcompare m1 m2 Eq + end + | true, true => + match Z.compare e1 e2 with + | Lt => Gt + | Gt => Lt + | Eq => CompOpp (Pcompare m1 m2 Eq) + end + end + end. + + Definition SFeqb f1 f2 := + match SFcompare f1 f2 with + | Some Eq => true + | _ => false + end. + + Definition SFltb f1 f2 := + match SFcompare f1 f2 with + | Some Lt => true + | _ => false + end. + + Definition SFleb f1 f2 := + match SFcompare f1 f2 with + | Some (Lt | Eq) => true + | _ => false + end. + + Variant float_class : Set := + | PNormal | NNormal | PSubn | NSubn | PZero | NZero | PInf | NInf | NaN. + + Definition SFclassify f := + match f with + | S754_nan => NaN + | S754_infinity false => PInf + | S754_infinity true => NInf + | S754_zero false => NZero + | S754_zero true => PZero + | S754_finite false m _ => + if (digits2_pos m =? Z.to_pos prec)%positive then PNormal + else PSubn + | S754_finite true m _ => + if (digits2_pos m =? Z.to_pos prec)%positive then NNormal + else NSubn + end. + + Definition SFmul x y := + match x, y with + | S754_nan, _ | _, S754_nan => S754_nan + | S754_infinity sx, S754_infinity sy => S754_infinity (xorb sx sy) + | S754_infinity sx, S754_finite sy _ _ => S754_infinity (xorb sx sy) + | S754_finite sx _ _, S754_infinity sy => S754_infinity (xorb sx sy) + | S754_infinity _, S754_zero _ => S754_nan + | S754_zero _, S754_infinity _ => S754_nan + | S754_finite sx _ _, S754_zero sy => S754_zero (xorb sx sy) + | S754_zero sx, S754_finite sy _ _ => S754_zero (xorb sx sy) + | S754_zero sx, S754_zero sy => S754_zero (xorb sx sy) + | S754_finite sx mx ex, S754_finite sy my ey => + binary_round_aux (xorb sx sy) (Zpos (mx * my)) (ex + ey) loc_Exact + end. + + Definition cond_Zopp (b : bool) m := if b then Z.opp m else m. + + Definition SFadd x y := + match x, y with + | S754_nan, _ | _, S754_nan => S754_nan + | S754_infinity sx, S754_infinity sy => + if Bool.eqb sx sy then x else S754_nan + | S754_infinity _, _ => x + | _, S754_infinity _ => y + | S754_zero sx, S754_zero sy => + if Bool.eqb sx sy then x else + S754_zero false + | S754_zero _, _ => y + | _, S754_zero _ => x + | S754_finite sx mx ex, S754_finite sy my ey => + let ez := Z.min ex ey in + binary_normalize (Zplus (cond_Zopp sx (Zpos (fst (shl_align mx ex ez)))) (cond_Zopp sy (Zpos (fst (shl_align my ey ez))))) + ez false + end. + + Definition SFsub x y := + match x, y with + | S754_nan, _ | _, S754_nan => S754_nan + | S754_infinity sx, S754_infinity sy => + if Bool.eqb sx (negb sy) then x else S754_nan + | S754_infinity _, _ => x + | _, S754_infinity sy => S754_infinity (negb sy) + | S754_zero sx, S754_zero sy => + if Bool.eqb sx (negb sy) then x else + S754_zero false + | S754_zero _, S754_finite sy my ey => S754_finite (negb sy) my ey + | _, S754_zero _ => x + | S754_finite sx mx ex, S754_finite sy my ey => + let ez := Z.min ex ey in + binary_normalize (Zminus (cond_Zopp sx (Zpos (fst (shl_align mx ex ez)))) (cond_Zopp sy (Zpos (fst (shl_align my ey ez))))) + ez false + end. + + Definition new_location_even nb_steps k := + if Zeq_bool k 0 then loc_Exact + else loc_Inexact (Z.compare (2 * k) nb_steps). + + Definition new_location_odd nb_steps k := + if Zeq_bool k 0 then loc_Exact + else + loc_Inexact + match Z.compare (2 * k + 1) nb_steps with + | Lt => Lt + | Eq => Lt + | Gt => Gt + end. + + Definition new_location nb_steps := + if Z.even nb_steps then new_location_even nb_steps else new_location_odd nb_steps. + + Definition SFdiv_core_binary m1 e1 m2 e2 := + let d1 := Zdigits2 m1 in + let d2 := Zdigits2 m2 in + let e' := Z.min (fexp (d1 + e1 - (d2 + e2))) (e1 - e2) in + let s := (e1 - e2 - e')%Z in + let m' := + match s with + | Zpos _ => Z.shiftl m1 s + | Z0 => m1 + | Zneg _ => Z0 + end in + let '(q, r) := Z.div_eucl m' m2 in + (q, e', new_location m2 r). + + Definition SFdiv x y := + match x, y with + | S754_nan, _ | _, S754_nan => S754_nan + | S754_infinity sx, S754_infinity sy => S754_nan + | S754_infinity sx, S754_finite sy _ _ => S754_infinity (xorb sx sy) + | S754_finite sx _ _, S754_infinity sy => S754_zero (xorb sx sy) + | S754_infinity sx, S754_zero sy => S754_infinity (xorb sx sy) + | S754_zero sx, S754_infinity sy => S754_zero (xorb sx sy) + | S754_finite sx _ _, S754_zero sy => S754_infinity (xorb sx sy) + | S754_zero sx, S754_finite sy _ _ => S754_zero (xorb sx sy) + | S754_zero sx, S754_zero sy => S754_nan + | S754_finite sx mx ex, S754_finite sy my ey => + let '(mz, ez, lz) := SFdiv_core_binary (Zpos mx) ex (Zpos my) ey in + binary_round_aux (xorb sx sy) mz ez lz + end. + + Definition SFsqrt_core_binary m e := + let d := Zdigits2 m in + let e' := Z.min (fexp (Z.div2 (d + e + 1))) (Z.div2 e) in + let s := (e - 2 * e')%Z in + let m' := + match s with + | Zpos p => Z.shiftl m s + | Z0 => m + | Zneg _ => Z0 + end in + let (q, r) := Z.sqrtrem m' in + let l := + if Zeq_bool r 0 then loc_Exact + else loc_Inexact (if Zle_bool r q then Lt else Gt) in + (q, e', l). + + Definition SFsqrt x := + match x with + | S754_nan => S754_nan + | S754_infinity false => x + | S754_infinity true => S754_nan + | S754_finite true _ _ => S754_nan + | S754_zero _ => x + | S754_finite sx mx ex => + let '(mz, ez, lz) := SFsqrt_core_binary (Zpos mx) ex in + binary_round_aux false mz ez lz + end. + + Definition SFnormfr_mantissa f := + match f with + | S754_finite _ mx ex => + if Z.eqb ex (-prec) then Npos mx else 0%N + | _ => 0%N + end. + + Definition SFldexp f e := + match f with + | S754_finite sx mx ex => binary_round sx mx (ex+e) + | _ => f + end. + + Definition SFfrexp f := + match f with + | S754_finite sx mx ex => + if (Z.to_pos prec <=? digits2_pos mx)%positive then + (S754_finite sx mx (-prec), (ex+prec)%Z) + else + let d := (prec - Z.pos (digits2_pos mx))%Z in + (S754_finite sx (shift_pos (Z.to_pos d) mx) (-prec), (ex+prec-d)%Z) + | _ => (f, (-2*emax-prec)%Z) + end. + + Definition SFone := binary_round false 1 0. + + Definition SFulp x := SFldexp SFone (fexp (snd (SFfrexp x))). + + Definition SFpred_pos x := + match x with + | S754_finite _ mx _ => + let d := + if (mx~0 =? shift_pos (Z.to_pos prec) 1)%positive then + SFldexp SFone (fexp (snd (SFfrexp x) - 1)) + else + SFulp x in + SFsub x d + | _ => x + end. + + Definition SFmax_float := + S754_finite false (shift_pos (Z.to_pos prec) 1 - 1) (emax - prec). + + Definition SFsucc x := + match x with + | S754_zero _ => SFldexp SFone emin + | S754_infinity false => x + | S754_infinity true => SFopp SFmax_float + | S754_nan => x + | S754_finite false _ _ => SFadd x (SFulp x) + | S754_finite true _ _ => SFopp (SFpred_pos (SFopp x)) + end. + + Definition SFpred f := SFopp (SFsucc (SFopp f)). +End FloatOps. diff --git a/flocq/Prop/Div_sqrt_error.v b/flocq/Prop/Div_sqrt_error.v index 79220438..9aa9c508 100644 --- a/flocq/Prop/Div_sqrt_error.v +++ b/flocq/Prop/Div_sqrt_error.v @@ -42,9 +42,7 @@ rewrite H; apply generic_format_0. rewrite Hx, Hy, <- F2R_plus. apply generic_format_F2R. intros _. -case_eq (Fplus fx fy). -intros mz ez Hz. -rewrite <- Hz. +change (F2R _) with (F2R (Fplus fx fy)). apply Z.le_trans with (Z.min (Fexp fx) (Fexp fy)). rewrite F2R_plus, <- Hx, <- Hy. unfold cexp. @@ -52,7 +50,7 @@ apply Z.le_trans with (1:=Hfexp _). apply Zplus_le_reg_l with prec; ring_simplify. apply mag_le_bpow with (1 := H). now apply Z.min_case. -rewrite <- Fexp_Fplus, Hz. +rewrite <- Fexp_Fplus. apply Z.le_refl. Qed. @@ -100,7 +98,7 @@ apply Rlt_le_trans with (1 := Heps1). change 1%R with (bpow 0). apply bpow_le. generalize (prec_gt_0 prec). -clear ; omega. +clear ; lia. rewrite Rmult_1_r. rewrite Hx2, <- Hx1. unfold cexp. @@ -193,7 +191,7 @@ now apply IZR_lt. rewrite <- Rmult_assoc, Rinv_r, Rmult_1_l. apply Rle_trans with (bpow (-1)). apply bpow_le. -omega. +lia. replace (2 * (-1 + 5 / 4))%R with (/2)%R by field. apply Rinv_le. now apply IZR_lt. @@ -280,11 +278,11 @@ apply Rle_not_lt. rewrite <- Hr1. apply abs_round_ge_generic... apply generic_format_bpow. -unfold FLX_exp; omega. +unfold FLX_exp; lia. apply Es. apply Rlt_le_trans with (1:=H). apply bpow_le. -omega. +lia. now apply Rlt_le. Qed. @@ -319,7 +317,7 @@ rewrite <- bpow_plus; apply bpow_le; unfold e; set (mxm1 := (_ - 1)%Z). replace (_ * _)%Z with (2 * (mxm1 / 2) + mxm1 mod 2 - mxm1 mod 2)%Z by ring. rewrite <- Z.div_mod; [|now simpl]. apply (Zplus_le_reg_r _ _ (mxm1 mod 2 - mag beta x)%Z). -unfold mxm1; destruct (Z.mod_bound_or (mag beta x - 1) 2); omega. +unfold mxm1; destruct (Z.mod_bound_or (mag beta x - 1) 2); lia. Qed. Notation u_ro := (u_ro beta prec). @@ -346,7 +344,7 @@ assert (Hulp1p2eps : (ulp beta (FLX_exp prec) (1 + 2 * u_ro) = 2 * u_ro)%R). rewrite succ_FLX_1, mag_1, bpow_1, <- H2eps; simpl. apply (Rlt_le_trans _ 2); [apply Rplus_lt_compat_l|]. { unfold u_ro; rewrite <-Rmult_assoc, Rinv_r, Rmult_1_l; [|lra]. - change R1 with (bpow 0); apply bpow_lt; omega. } + change R1 with (bpow 0); apply bpow_lt; lia. } apply IZR_le, Zle_bool_imp_le, radix_prop. } assert (Hsucc1p2eps : (succ beta (FLX_exp prec) (1 + 2 * u_ro) = 1 + 4 * u_ro)%R). @@ -383,7 +381,7 @@ ring_simplify; apply Rsqr_incr_0_var. apply Rmult_le_pos; [|now apply pow_le]. assert (Heps_le_half : (u_ro <= 1 / 2)%R). { unfold u_ro, Rdiv; rewrite Rmult_comm; apply Rmult_le_compat_r; [lra|]. - change 1%R with (bpow 0); apply bpow_le; omega. } + change 1%R with (bpow 0); apply bpow_le; lia. } apply (Rle_trans _ (-8 * u_ro + 4)); [lra|]. apply Rplus_le_compat_r, Rmult_le_compat_r; [apply Pu_ro|]. now assert (H : (0 <= u_ro ^ 2)%R); [apply pow2_ge_0|lra]. } @@ -447,13 +445,13 @@ destruct (sqrt_error_N_FLX_aux2 _ Fmu HmuGe1) as [Hmu'|[Hmu'|Hmu']]. { rewrite Rminus_diag_eq, Rabs_R0; [|now simpl]. now apply Rmult_le_pos; [|apply Rabs_pos]. } apply generic_format_bpow'; [now apply FLX_exp_valid|]. - unfold FLX_exp; omega. } + unfold FLX_exp; lia. } { assert (Hsqrtmu : (1 <= sqrt mu < 1 + u_ro)%R); [rewrite Hmu'; split|]. { rewrite <- sqrt_1 at 1; apply sqrt_le_1_alt; lra. } { rewrite <- sqrt_square; [|lra]; apply sqrt_lt_1_alt; split; [lra|]. ring_simplify; assert (0 < u_ro ^ 2)%R; [apply pow_lt|]; lra. } assert (Fbpowe : generic_format beta (FLX_exp prec) (bpow e)). - { apply generic_format_bpow; unfold FLX_exp; omega. } + { apply generic_format_bpow; unfold FLX_exp; lia. } assert (Hrt : rt = bpow e :> R). { unfold rt; fold t; rewrite Ht; simpl; apply Rle_antisym. { apply round_N_le_midp; [now apply FLX_exp_valid|exact Fbpowe|]. @@ -495,7 +493,7 @@ assert (Hulpt : (ulp beta (FLX_exp prec) t = 2 * u_ro * bpow e)%R). { apply sqrt_lt_1_alt; split; [lra|]. apply (Rlt_le_trans _ _ _ HmuLtsqradix); right. now unfold bpow, Z.pow_pos; simpl; rewrite Zmult_1_r, mult_IZR. } - apply IZR_le, (Z.le_trans _ 2), Zle_bool_imp_le, radix_prop; omega. } + apply IZR_le, (Z.le_trans _ 2), Zle_bool_imp_le, radix_prop; lia. } rewrite Hmagt; ring. } rewrite Ht; apply Rmult_lt_0_compat; [|now apply bpow_gt_0]. now apply (Rlt_le_trans _ 1); [lra|rewrite <- sqrt_1; apply sqrt_le_1_alt]. } @@ -656,7 +654,7 @@ apply Fourier_util.Rle_mult_inv_pos; assumption. case (Zle_lt_or_eq 0 n); try exact H. clear H; intros H. case (Zle_lt_or_eq 1 n). -omega. +lia. clear H; intros H. set (ex := cexp beta fexp x). set (ey := cexp beta fexp y). @@ -715,7 +713,7 @@ rewrite Rinv_l, Rmult_1_r, Rmult_1_l. assert (mag beta x < mag beta y)%Z. case (Zle_or_lt (mag beta y) (mag beta x)); try easy. intros J; apply monotone_exp in J; clear -J Hexy. -unfold ex, ey, cexp in Hexy; omega. +unfold ex, ey, cexp in Hexy; lia. left; apply lt_mag with beta; easy. (* n = 1 -> Sterbenz + rnd_small *) intros Hn'; fold n; rewrite <- Hn'. diff --git a/flocq/Prop/Double_rounding.v b/flocq/Prop/Double_rounding.v index 055409bb..3e942fe0 100644 --- a/flocq/Prop/Double_rounding.v +++ b/flocq/Prop/Double_rounding.v @@ -122,7 +122,7 @@ destruct (Req_dec x'' 0) as [Zx''|Nzx'']. apply (Rle_lt_trans _ _ _ Hr1). apply Rmult_lt_compat_l; [lra|]. apply bpow_lt. - omega. + lia. - (* x'' <> 0 *) assert (Lx'' : mag x'' = mag x :> Z). { apply Zle_antisym. @@ -203,7 +203,7 @@ destruct (Req_dec x' 0) as [Zx'|Nzx']. replace (2 * (/ 2 * _)) with (bpow (fexp1 (mag x) - mag x)) by field. apply Rle_trans with 1; [|lra]. change 1 with (bpow 0); apply bpow_le. - omega. + lia. - (* x' <> 0 *) assert (Px' : 0 < x'). { assert (0 <= x'); [|lra]. @@ -314,10 +314,10 @@ Proof. intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 x Px Hf2f1 Hf1 Hx Hx'. destruct (Zle_or_lt (fexp1 (mag x)) (fexp2 (mag x))) as [Hf2'|Hf2']. - (* fexp1 (mag x) <= fexp2 (mag x) *) - assert (Hf2'' : (fexp2 (mag x) = fexp1 (mag x) :> Z)%Z); [omega|]. + assert (Hf2'' : (fexp2 (mag x) = fexp1 (mag x) :> Z)%Z) by lia. now apply round_round_lt_mid_same_place. - (* fexp2 (mag x) < fexp1 (mag x) *) - assert (Hf2'' : (fexp2 (mag x) <= fexp1 (mag x) - 1)%Z); [omega|]. + assert (Hf2'' : (fexp2 (mag x) <= fexp1 (mag x) - 1)%Z) by lia. generalize (Hx' Hf2''); intro Hx''. now apply round_round_lt_mid_further_place. Qed. @@ -380,7 +380,7 @@ destruct (Req_dec x'' 0) as [Zx''|Nzx'']. apply (Rle_lt_trans _ _ _ Hr1). apply Rmult_lt_compat_l; [lra|]. apply bpow_lt. - omega. + lia. - (* x'' <> 0 *) assert (Lx'' : mag x'' = mag x :> Z). { apply Zle_antisym. @@ -460,11 +460,11 @@ assert (Hx''pow : x'' = bpow (mag x)). unfold x'', round, F2R, scaled_mantissa, cexp; simpl. apply (Rmult_le_reg_r (bpow (- fexp2 (mag x)))); [now apply bpow_gt_0|]. bpow_simplify. - rewrite <- (IZR_Zpower _ (_ - _)); [|omega]. + rewrite <- (IZR_Zpower _ (_ - _)); [|lia]. apply IZR_le. apply Zlt_succ_le; unfold Z.succ. apply lt_IZR. - rewrite plus_IZR; rewrite IZR_Zpower; [|omega]. + rewrite plus_IZR; rewrite IZR_Zpower; [|lia]. apply (Rmult_lt_reg_r (bpow (fexp2 (mag x)))); [now apply bpow_gt_0|]. rewrite Rmult_plus_distr_r; rewrite Rmult_1_l. bpow_simplify. @@ -482,12 +482,12 @@ assert (Hr : Rabs (x - x'') < / 2 * ulp beta fexp1 x). - apply Rmult_lt_compat_l; [lra|]. rewrite 2!ulp_neq_0; try now apply Rgt_not_eq. unfold cexp; apply bpow_lt. - omega. } + lia. } unfold round, F2R, scaled_mantissa, cexp; simpl. assert (Hf : (0 <= mag x - fexp1 (mag x''))%Z). { rewrite Hx''pow. rewrite mag_bpow. - assert (fexp1 (mag x + 1) <= mag x)%Z; [|omega]. + assert (fexp1 (mag x + 1) <= mag x)%Z; [|lia]. destruct (Zle_or_lt (mag x) (fexp1 (mag x))) as [Hle|Hlt]; [|now apply Vfexp1]. assert (H : (mag x = fexp1 (mag x) :> Z)%Z); @@ -497,9 +497,9 @@ assert (Hf : (0 <= mag x - fexp1 (mag x''))%Z). rewrite (Znearest_imp _ _ (beta ^ (mag x - fexp1 (mag x'')))%Z). - rewrite (Znearest_imp _ _ (beta ^ (mag x - fexp1 (mag x)))%Z). + rewrite IZR_Zpower; [|exact Hf]. - rewrite IZR_Zpower; [|omega]. + rewrite IZR_Zpower; [|lia]. now bpow_simplify. - + rewrite IZR_Zpower; [|omega]. + + rewrite IZR_Zpower; [|lia]. apply (Rmult_lt_reg_r (bpow (fexp1 (mag x)))); [now apply bpow_gt_0|]. rewrite <- (Rabs_right (bpow (fexp1 _))) at 1; [|now apply Rle_ge; apply bpow_ge_0]. @@ -588,10 +588,10 @@ Proof. intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 x Px Hf2f1 Hf1 Hx Hx'. destruct (Zle_or_lt (fexp1 (mag x)) (fexp2 (mag x))) as [Hf2'|Hf2']. - (* fexp1 (mag x) <= fexp2 (mag x) *) - assert (Hf2'' : (fexp2 (mag x) = fexp1 (mag x) :> Z)%Z); [omega|]. + assert (Hf2'' : (fexp2 (mag x) = fexp1 (mag x) :> Z)%Z) by lia. now apply round_round_gt_mid_same_place. - (* fexp2 (mag x) < fexp1 (mag x) *) - assert (Hf2'' : (fexp2 (mag x) <= fexp1 (mag x) - 1)%Z); [omega|]. + assert (Hf2'' : (fexp2 (mag x) <= fexp1 (mag x) - 1)%Z) by lia. generalize (Hx' Hf2''); intro Hx''. now apply round_round_gt_mid_further_place. Qed. @@ -606,7 +606,7 @@ Lemma mag_mult_disj : Proof. intros x y Zx Zy. destruct (mag_mult beta x y Zx Zy). -omega. +lia. Qed. Definition round_round_mult_hyp fexp1 fexp2 := @@ -691,7 +691,7 @@ intros Hprec x y Fx Fy. apply round_round_mult; [|now apply generic_format_FLX|now apply generic_format_FLX]. unfold round_round_mult_hyp; split; intros ex ey; unfold FLX_exp; -omega. +lia. Qed. End Double_round_mult_FLX. @@ -721,7 +721,7 @@ generalize (Zmax_spec (ex + ey - prec') emin'); generalize (Zmax_spec (ex + ey - 1 - prec') emin'); generalize (Zmax_spec (ex - prec) emin); generalize (Zmax_spec (ey - prec) emin); -omega. +lia. Qed. End Double_round_mult_FLT. @@ -753,7 +753,7 @@ destruct (Z.ltb_spec (ex + ey - prec') emin'); destruct (Z.ltb_spec (ex - prec) emin); destruct (Z.ltb_spec (ey - prec) emin); destruct (Z.ltb_spec (ex + ey - 1 - prec') emin'); -omega. +lia. Qed. End Double_round_mult_FTZ. @@ -770,7 +770,7 @@ Lemma mag_plus_disj : Proof. intros x y Py Hxy. destruct (mag_plus beta x y Py Hxy). -omega. +lia. Qed. Lemma mag_plus_separated : @@ -798,10 +798,10 @@ Lemma mag_minus_disj : \/ (mag (x - y) = (mag x - 1)%Z :> Z)). Proof. intros x y Px Py Hln. -assert (Hxy : y < x); [now apply (lt_mag beta); [ |omega]|]. +assert (Hxy : y < x); [now apply (lt_mag beta); [ |lia]|]. generalize (mag_minus beta x y Py Hxy); intro Hln2. generalize (mag_minus_lb beta x y Px Py Hln); intro Hln3. -omega. +lia. Qed. Lemma mag_minus_separated : @@ -831,7 +831,7 @@ split. apply succ_le_lt; [apply Vfexp|idtac|exact Fx|assumption]. apply (generic_format_bpow beta fexp (mag x - 1)). replace (_ + _)%Z with (mag x : Z) by ring. - assert (fexp (mag x) < mag x)%Z; [|omega]. + assert (fexp (mag x) < mag x)%Z; [|lia]. now apply mag_generic_gt; [|now apply Rgt_not_eq|]. - rewrite Rabs_right. + apply Rlt_trans with x. @@ -884,7 +884,7 @@ destruct (Req_dec x 0) as [Zx|Nzx]. rewrite Rmult_plus_distr_r. rewrite <- Fx. rewrite mult_IZR. - rewrite IZR_Zpower; [|omega]. + rewrite IZR_Zpower; [|lia]. bpow_simplify. now rewrite <- Fy. } apply generic_format_F2R' with (f := fxy); [now rewrite Hxy|]. @@ -904,7 +904,7 @@ intros fexp1 fexp2 x y Hlnx Hlny Fx Fy. destruct (Z.le_gt_cases (fexp1 (mag x)) (fexp1 (mag y))) as [Hle|Hgt]. - now apply (round_round_plus_aux0_aux_aux fexp1). - rewrite Rplus_comm in Hlnx, Hlny |- *. - now apply (round_round_plus_aux0_aux_aux fexp1); [omega| | | |]. + now apply (round_round_plus_aux0_aux_aux fexp1); [lia| | | |]. Qed. (* fexp1 (mag x) - 1 <= mag y : @@ -927,20 +927,20 @@ destruct (Z.le_gt_cases (mag y) (fexp1 (mag x))) as [Hle|Hgt]. [now apply (mag_plus_separated fexp1)|]. apply (round_round_plus_aux0_aux fexp1); [| |assumption|assumption]; rewrite Lxy. - + now apply Hexp4; omega. - + now apply Hexp3; omega. + + now apply Hexp4; lia. + + now apply Hexp3; lia. - (* fexp1 (mag x) < mag y *) apply (round_round_plus_aux0_aux fexp1); [| |assumption|assumption]. destruct (mag_plus_disj x y Py Hyx) as [Lxy|Lxy]; rewrite Lxy. - + now apply Hexp4; omega. + + now apply Hexp4; lia. + apply Hexp2; apply (mag_le beta y x Py) in Hyx. replace (_ - _)%Z with (mag x : Z) by ring. - omega. + lia. + destruct (mag_plus_disj x y Py Hyx) as [Lxy|Lxy]; rewrite Lxy. - * now apply Hexp3; omega. + * now apply Hexp3; lia. * apply Hexp2. replace (_ - _)%Z with (mag x : Z) by ring. - omega. + lia. Qed. Lemma round_round_plus_aux1_aux : @@ -983,7 +983,7 @@ assert (UB : y * bpow (- fexp (mag x)) < / IZR (beta ^ k)). + bpow_simplify. rewrite bpow_opp. destruct k. - * omega. + * lia. * simpl; unfold Raux.bpow, Z.pow_pos. now apply Rle_refl. * casetype False; apply (Z.lt_irrefl 0). @@ -1003,7 +1003,7 @@ rewrite (Zfloor_imp mx). apply (Rlt_le_trans _ _ _ UB). rewrite bpow_opp. apply Rinv_le; [now apply bpow_gt_0|]. - now rewrite IZR_Zpower; [right|omega]. } + now rewrite IZR_Zpower; [right|lia]. } split. - rewrite <- Rplus_0_r at 1; apply Rplus_le_compat_l. now apply Rlt_le. @@ -1014,7 +1014,7 @@ split. apply Rlt_trans with (bpow (mag y)). + rewrite <- Rabs_right at 1; [|now apply Rle_ge; apply Rlt_le]. apply bpow_mag_gt. - + apply bpow_lt; omega. + + apply bpow_lt; lia. Qed. (* mag y <= fexp1 (mag x) - 2 : round_round_lt_mid applies. *) @@ -1034,18 +1034,18 @@ assert (Hbeta : (2 <= beta)%Z). now apply Zle_bool_imp_le. } intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Px Py Hly Fx. assert (Lxy : mag (x + y) = mag x :> Z); - [now apply (mag_plus_separated fexp1); [|apply Rlt_le| |omega]|]. + [now apply (mag_plus_separated fexp1); [|apply Rlt_le| |lia]|]. destruct Hexp as (_,(_,(_,Hexp4))). assert (Hf2 : (fexp2 (mag x) <= fexp1 (mag x))%Z); - [now apply Hexp4; omega|]. + [now apply Hexp4; lia|]. assert (Bpow2 : bpow (- 2) <= / 2 * / 2). { replace (/2 * /2) with (/4) by field. rewrite (bpow_opp _ 2). apply Rinv_le; [lra|]. apply (IZR_le (2 * 2) (beta * (beta * 1))). rewrite Zmult_1_r. - now apply Zmult_le_compat; omega. } -assert (P2 : (0 < 2)%Z) by omega. + now apply Zmult_le_compat; lia. } +assert (P2 : (0 < 2)%Z) by lia. unfold round_round_eq. apply round_round_lt_mid. - exact Vfexp1. @@ -1053,7 +1053,7 @@ apply round_round_lt_mid. - lra. - now rewrite Lxy. - rewrite Lxy. - assert (fexp1 (mag x) < mag x)%Z; [|omega]. + assert (fexp1 (mag x) < mag x)%Z; [|lia]. now apply mag_generic_gt; [|apply Rgt_not_eq|]. - unfold midp. apply (Rplus_lt_reg_r (- round beta fexp1 Zfloor (x + y))). @@ -1088,10 +1088,10 @@ apply round_round_lt_mid. replace (_ - _) with (- (/ 2)) by lra. apply Ropp_le_contravar. { apply Rle_trans with (bpow (- 1)). - - apply bpow_le; omega. + - apply bpow_le; lia. - unfold Raux.bpow, Z.pow_pos; simpl. apply Rinv_le; [lra|]. - apply IZR_le; omega. } + apply IZR_le; lia. } Qed. (* round_round_plus_aux{0,1} together *) @@ -1115,7 +1115,7 @@ destruct (Zle_or_lt (mag y) (fexp1 (mag x) - 2)) as [Hly|Hly]. rewrite (round_generic beta fexp2). + reflexivity. + now apply valid_rnd_N. - + assert (Hf1 : (fexp1 (mag x) - 1 <= mag y)%Z); [omega|]. + + assert (Hf1 : (fexp1 (mag x) - 1 <= mag y)%Z) by lia. now apply (round_round_plus_aux0 fexp1). Qed. @@ -1140,7 +1140,7 @@ destruct (Req_dec x 0) as [Zx|Nzx]. + reflexivity. + now apply valid_rnd_N. + apply (generic_inclusion_mag beta fexp1). - now intros _; apply Hexp4; omega. + now intros _; apply Hexp4; lia. exact Fy. - (* x <> 0 *) destruct (Req_dec y 0) as [Zy|Nzy]. @@ -1151,7 +1151,7 @@ destruct (Req_dec x 0) as [Zx|Nzx]. * reflexivity. * now apply valid_rnd_N. * apply (generic_inclusion_mag beta fexp1). - now intros _; apply Hexp4; omega. + now intros _; apply Hexp4; lia. exact Fx. + (* y <> 0 *) assert (Px : 0 < x); [lra|]. @@ -1199,21 +1199,21 @@ assert (Lyx : (mag y <= mag x)%Z); destruct (Z.lt_ge_cases (mag x - 2) (mag y)) as [Hlt|Hge]. - (* mag x - 2 < mag y *) assert (Hor : (mag y = mag x :> Z) - \/ (mag y = mag x - 1 :> Z)%Z); [omega|]. + \/ (mag y = mag x - 1 :> Z)%Z) by lia. destruct Hor as [Heq|Heqm1]. + (* mag y = mag x *) apply (round_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy]. * apply Hexp4. - apply Z.le_trans with (mag (x - y)); [omega|]. + apply Z.le_trans with (mag (x - y)); [lia|]. now apply mag_minus. * rewrite Heq. apply Hexp4. - apply Z.le_trans with (mag (x - y)); [omega|]. + apply Z.le_trans with (mag (x - y)); [lia|]. now apply mag_minus. + (* mag y = mag x - 1 *) apply (round_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy]. * apply Hexp4. - apply Z.le_trans with (mag (x - y)); [omega|]. + apply Z.le_trans with (mag (x - y)); [lia|]. now apply mag_minus. * rewrite Heqm1. apply Hexp4. @@ -1224,7 +1224,7 @@ destruct (Z.lt_ge_cases (mag x - 2) (mag y)) as [Hlt|Hge]. + (* mag (x - y) = mag x *) apply (round_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy]. * apply Hexp4. - omega. + lia. * now rewrite Lxmy; apply Hexp3. + (* mag (x - y) = mag x - 1 *) apply (round_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy]; @@ -1261,8 +1261,8 @@ assert (Hfy : (fexp1 (mag y) < mag y)%Z); [now apply mag_generic_gt; [|apply Rgt_not_eq|]|]. apply (round_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy]. - apply Z.le_trans with (fexp1 (mag (x - y))). - + apply Hexp4; omega. - + omega. + + apply Hexp4; lia. + + lia. - now apply Hexp3. Qed. @@ -1289,7 +1289,7 @@ assert (Hfy : (fexp (mag y) < mag y)%Z); destruct (Rlt_or_le (bpow (mag x - 1)) x) as [Hx|Hx]. - (* bpow (mag x - 1) < x *) assert (Lxy : mag (x - y) = mag x :> Z); - [now apply (mag_minus_separated fexp); [| | | | | |omega]|]. + [now apply (mag_minus_separated fexp); [| | | | | |lia]|]. assert (Rxy : round beta fexp Zceil (x - y) = x). { unfold round, F2R, scaled_mantissa, cexp; simpl. rewrite Lxy. @@ -1311,7 +1311,7 @@ destruct (Rlt_or_le (bpow (mag x - 1)) x) as [Hx|Hx]. + rewrite <- Rabs_right at 1; [|now apply Rle_ge; apply Rlt_le]. apply bpow_mag_gt. + apply bpow_le. - omega. + lia. - rewrite <- (Rplus_0_r (IZR _)) at 2. apply Rplus_le_compat_l. rewrite <- Ropp_0; apply Ropp_le_contravar. @@ -1334,9 +1334,9 @@ destruct (Rlt_or_le (bpow (mag x - 1)) x) as [Hx|Hx]. now intro Hx'; rewrite Hx' in Hxy; apply (Rlt_irrefl y). + rewrite Rabs_right; lra. - apply (mag_minus_lb beta x y Px Py). - omega. } + lia. } assert (Hfx1 : (fexp (mag x - 1) < mag x - 1)%Z); - [now apply (valid_exp_large fexp (mag y)); [|omega]|]. + [now apply (valid_exp_large fexp (mag y)); [|lia]|]. assert (Rxy : round beta fexp Zceil (x - y) <= x). { rewrite Xpow at 2. unfold round, F2R, scaled_mantissa, cexp; simpl. @@ -1344,10 +1344,10 @@ destruct (Rlt_or_le (bpow (mag x - 1)) x) as [Hx|Hx]. apply (Rmult_le_reg_r (bpow (- fexp (mag x - 1)%Z))); [now apply bpow_gt_0|]. bpow_simplify. - rewrite <- (IZR_Zpower beta (_ - _ - _)); [|omega]. + rewrite <- (IZR_Zpower beta (_ - _ - _)); [|lia]. apply IZR_le. apply Zceil_glb. - rewrite IZR_Zpower; [|omega]. + rewrite IZR_Zpower; [|lia]. rewrite Xpow at 1. rewrite Rmult_minus_distr_r. bpow_simplify. @@ -1383,7 +1383,7 @@ intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Py Hxy Hly Hly' Fx Fy. assert (Px := Rlt_trans 0 y x Py Hxy). destruct Hexp as (_,(_,(_,Hexp4))). assert (Hf2 : (fexp2 (mag x) <= fexp1 (mag x))%Z); - [now apply Hexp4; omega|]. + [now apply Hexp4; lia|]. assert (Hfx : (fexp1 (mag x) < mag x)%Z); [now apply mag_generic_gt; [|apply Rgt_not_eq|]|]. assert (Bpow2 : bpow (- 2) <= / 2 * / 2). @@ -1392,7 +1392,7 @@ assert (Bpow2 : bpow (- 2) <= / 2 * / 2). apply Rinv_le; [lra|]. apply (IZR_le (2 * 2) (beta * (beta * 1))). rewrite Zmult_1_r. - now apply Zmult_le_compat; omega. } + now apply Zmult_le_compat; lia. } assert (Ly : y < bpow (mag y)). { apply Rabs_lt_inv. apply bpow_mag_gt. } @@ -1401,19 +1401,19 @@ apply round_round_gt_mid. - exact Vfexp1. - exact Vfexp2. - lra. -- apply Hexp4; omega. -- assert (fexp1 (mag (x - y)) < mag (x - y))%Z; [|omega]. +- apply Hexp4; lia. +- assert (fexp1 (mag (x - y)) < mag (x - y))%Z; [|lia]. apply (valid_exp_large fexp1 (mag x - 1)). - + apply (valid_exp_large fexp1 (mag y)); [|omega]. + + apply (valid_exp_large fexp1 (mag y)); [|lia]. now apply mag_generic_gt; [|apply Rgt_not_eq|]. - + now apply mag_minus_lb; [| |omega]. + + now apply mag_minus_lb; [| |lia]. - unfold midp'. apply (Rplus_lt_reg_r (/ 2 * ulp beta fexp1 (x - y) - (x - y))). ring_simplify. replace (_ + _) with (round beta fexp1 Zceil (x - y) - (x - y)) by ring. apply Rlt_le_trans with (bpow (fexp1 (mag (x - y)) - 2)). + apply Rle_lt_trans with y; - [now apply round_round_minus_aux2_aux; try assumption; omega|]. + [now apply round_round_minus_aux2_aux; try assumption; lia|]. apply (Rlt_le_trans _ _ _ Ly). now apply bpow_le. + rewrite ulp_neq_0;[idtac|now apply sym_not_eq, Rlt_not_eq, Rgt_minus]. @@ -1428,7 +1428,7 @@ apply round_round_gt_mid. rewrite Zmult_1_r; apply Rinv_le. lra. now apply IZR_le. - * apply bpow_le; omega. + * apply bpow_le; lia. - intro Hf2'. unfold midp'. apply (Rplus_lt_reg_r (/ 2 * ulp beta fexp1 (x - y) - (x - y) @@ -1436,7 +1436,7 @@ apply round_round_gt_mid. ring_simplify. replace (_ + _) with (round beta fexp1 Zceil (x - y) - (x - y)) by ring. apply Rle_lt_trans with y; - [now apply round_round_minus_aux2_aux; try assumption; omega|]. + [now apply round_round_minus_aux2_aux; try assumption; lia|]. apply (Rlt_le_trans _ _ _ Ly). apply Rle_trans with (bpow (fexp1 (mag (x - y)) - 2)); [now apply bpow_le|]. @@ -1501,12 +1501,12 @@ destruct (Req_dec y x) as [Hy|Hy]. { rewrite (round_generic beta fexp2). - reflexivity. - now apply valid_rnd_N. - - assert (Hf1 : (fexp1 (mag (x - y)) - 1 <= mag y)%Z); [omega|]. + - assert (Hf1 : (fexp1 (mag (x - y)) - 1 <= mag y)%Z) by lia. now apply (round_round_minus_aux1 fexp1). } + rewrite (round_generic beta fexp2). * reflexivity. * now apply valid_rnd_N. - * assert (Hf1 : (fexp1 (mag x) - 1 <= mag y)%Z); [omega|]. + * assert (Hf1 : (fexp1 (mag x) - 1 <= mag y)%Z) by lia. now apply (round_round_minus_aux0 fexp1). Qed. @@ -1532,7 +1532,7 @@ destruct (Req_dec x 0) as [Zx|Nzx]. * now apply valid_rnd_N. * apply (generic_inclusion_mag beta fexp1). destruct Hexp as (_,(_,(_,Hexp4))). - now intros _; apply Hexp4; omega. + now intros _; apply Hexp4; lia. exact Fy. - (* x <> 0 *) destruct (Req_dec y 0) as [Zy|Nzy]. @@ -1543,7 +1543,7 @@ destruct (Req_dec x 0) as [Zx|Nzx]. * now apply valid_rnd_N. * apply (generic_inclusion_mag beta fexp1). destruct Hexp as (_,(_,(_,Hexp4))). - now intros _; apply Hexp4; omega. + now intros _; apply Hexp4; lia. exact Fx. + (* y <> 0 *) assert (Px : 0 < x); [lra|]. @@ -1626,9 +1626,9 @@ Proof. intros Hprec. unfold FLX_exp. unfold round_round_plus_hyp; split; [|split; [|split]]; -intros ex ey; try omega. +intros ex ey; try lia. unfold Prec_gt_0 in prec_gt_0_. -omega. +lia. Qed. Theorem round_round_plus_FLX : @@ -1683,19 +1683,19 @@ unfold round_round_plus_hyp; split; [|split; [|split]]; intros ex ey. - generalize (Zmax_spec (ex + 1 - prec) emin). generalize (Zmax_spec (ex - prec') emin'). generalize (Zmax_spec (ey - prec) emin). - omega. + lia. - generalize (Zmax_spec (ex - 1 - prec) emin). generalize (Zmax_spec (ex - prec') emin'). generalize (Zmax_spec (ey - prec) emin). - omega. + lia. - generalize (Zmax_spec (ex - prec) emin). generalize (Zmax_spec (ex - prec') emin'). generalize (Zmax_spec (ey - prec) emin). - omega. + lia. - unfold Prec_gt_0 in prec_gt_0_. generalize (Zmax_spec (ex - prec') emin'). generalize (Zmax_spec (ey - prec) emin). - omega. + lia. Qed. Theorem round_round_plus_FLT : @@ -1753,18 +1753,18 @@ unfold round_round_plus_hyp; split; [|split; [|split]]; intros ex ey. - destruct (Z.ltb_spec (ex + 1 - prec) emin); destruct (Z.ltb_spec (ex - prec') emin'); destruct (Z.ltb_spec (ey - prec) emin); - omega. + lia. - destruct (Z.ltb_spec (ex - 1 - prec) emin); destruct (Z.ltb_spec (ex - prec') emin'); destruct (Z.ltb_spec (ey - prec) emin); - omega. + lia. - destruct (Z.ltb_spec (ex - prec) emin); destruct (Z.ltb_spec (ex - prec') emin'); destruct (Z.ltb_spec (ey - prec) emin); - omega. + lia. - destruct (Z.ltb_spec (ex - prec') emin'); destruct (Z.ltb_spec (ey - prec) emin); - omega. + lia. Qed. Theorem round_round_plus_FTZ : @@ -1832,20 +1832,20 @@ destruct (Z.le_gt_cases (mag y) (fexp1 (mag x))) as [Hle|Hgt]. [now apply (mag_plus_separated fexp1)|]. apply (round_round_plus_aux0_aux fexp1); [| |assumption|assumption]; rewrite Lxy. - + now apply Hexp4; omega. - + now apply Hexp3; omega. + + now apply Hexp4; lia. + + now apply Hexp3; lia. - (* fexp1 (mag x) < mag y *) apply (round_round_plus_aux0_aux fexp1); [| |assumption|assumption]. destruct (mag_plus_disj x y Py Hyx) as [Lxy|Lxy]; rewrite Lxy. - + now apply Hexp4; omega. + + now apply Hexp4; lia. + apply Hexp2; apply (mag_le beta y x Py) in Hyx. replace (_ - _)%Z with (mag x : Z) by ring. - omega. + lia. + destruct (mag_plus_disj x y Py Hyx) as [Lxy|Lxy]; rewrite Lxy. - * now apply Hexp3; omega. + * now apply Hexp3; lia. * apply Hexp2. replace (_ - _)%Z with (mag x : Z) by ring. - omega. + lia. Qed. (* mag y <= fexp1 (mag x) - 1 : round_round_lt_mid applies. *) @@ -1863,16 +1863,16 @@ Lemma round_round_plus_radix_ge_3_aux1 : Proof. intros Hbeta fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Px Py Hly Fx. assert (Lxy : mag (x + y) = mag x :> Z); - [now apply (mag_plus_separated fexp1); [|apply Rlt_le| |omega]|]. + [now apply (mag_plus_separated fexp1); [|apply Rlt_le| |lia]|]. destruct Hexp as (_,(_,(_,Hexp4))). assert (Hf2 : (fexp2 (mag x) <= fexp1 (mag x))%Z); - [now apply Hexp4; omega|]. + [now apply Hexp4; lia|]. assert (Bpow3 : bpow (- 1) <= / 3). { unfold Raux.bpow, Z.pow_pos; simpl. rewrite Zmult_1_r. apply Rinv_le; [lra|]. now apply IZR_le. } -assert (P1 : (0 < 1)%Z) by omega. +assert (P1 : (0 < 1)%Z) by lia. unfold round_round_eq. apply round_round_lt_mid. - exact Vfexp1. @@ -1880,7 +1880,7 @@ apply round_round_lt_mid. - lra. - now rewrite Lxy. - rewrite Lxy. - assert (fexp1 (mag x) < mag x)%Z; [|omega]. + assert (fexp1 (mag x) < mag x)%Z; [|lia]. now apply mag_generic_gt; [|apply Rgt_not_eq|]. - unfold midp. apply (Rplus_lt_reg_r (- round beta fexp1 Zfloor (x + y))). @@ -1914,7 +1914,7 @@ apply round_round_lt_mid. apply (Rplus_le_reg_r (- 1)); ring_simplify. replace (_ - _) with (- (/ 3)) by lra. apply Ropp_le_contravar. - now apply Rle_trans with (bpow (- 1)); [apply bpow_le; omega|]. + now apply Rle_trans with (bpow (- 1)); [apply bpow_le; lia|]. Qed. (* round_round_plus_radix_ge_3_aux{0,1} together *) @@ -1940,7 +1940,7 @@ destruct (Zle_or_lt (mag y) (fexp1 (mag x) - 1)) as [Hly|Hly]. rewrite (round_generic beta fexp2). + reflexivity. + now apply valid_rnd_N. - + assert (Hf1 : (fexp1 (mag x) <= mag y)%Z); [omega|]. + + assert (Hf1 : (fexp1 (mag x) <= mag y)%Z) by lia. now apply (round_round_plus_radix_ge_3_aux0 fexp1). Qed. @@ -1966,7 +1966,7 @@ destruct (Req_dec x 0) as [Zx|Nzx]. + reflexivity. + now apply valid_rnd_N. + apply (generic_inclusion_mag beta fexp1). - now intros _; apply Hexp4; omega. + now intros _; apply Hexp4; lia. exact Fy. - (* x <> 0 *) destruct (Req_dec y 0) as [Zy|Nzy]. @@ -1977,7 +1977,7 @@ destruct (Req_dec x 0) as [Zx|Nzx]. * reflexivity. * now apply valid_rnd_N. * apply (generic_inclusion_mag beta fexp1). - now intros _; apply Hexp4; omega. + now intros _; apply Hexp4; lia. exact Fx. + (* y <> 0 *) assert (Px : 0 < x); [lra|]. @@ -2009,21 +2009,21 @@ assert (Lyx : (mag y <= mag x)%Z); destruct (Z.lt_ge_cases (mag x - 2) (mag y)) as [Hlt|Hge]. - (* mag x - 2 < mag y *) assert (Hor : (mag y = mag x :> Z) - \/ (mag y = mag x - 1 :> Z)%Z); [omega|]. + \/ (mag y = mag x - 1 :> Z)%Z) by lia. destruct Hor as [Heq|Heqm1]. + (* mag y = mag x *) apply (round_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy]. * apply Hexp4. - apply Z.le_trans with (mag (x - y)); [omega|]. + apply Z.le_trans with (mag (x - y)); [lia|]. now apply mag_minus. * rewrite Heq. apply Hexp4. - apply Z.le_trans with (mag (x - y)); [omega|]. + apply Z.le_trans with (mag (x - y)); [lia|]. now apply mag_minus. + (* mag y = mag x - 1 *) apply (round_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy]. * apply Hexp4. - apply Z.le_trans with (mag (x - y)); [omega|]. + apply Z.le_trans with (mag (x - y)); [lia|]. now apply mag_minus. * rewrite Heqm1. apply Hexp4. @@ -2034,7 +2034,7 @@ destruct (Z.lt_ge_cases (mag x - 2) (mag y)) as [Hlt|Hge]. + (* mag (x - y) = mag x *) apply (round_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy]. * apply Hexp4. - omega. + lia. * now rewrite Lxmy; apply Hexp3. + (* mag (x - y) = mag x - 1 *) apply (round_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy]; @@ -2071,8 +2071,8 @@ assert (Hfy : (fexp1 (mag y) < mag y)%Z); [now apply mag_generic_gt; [|apply Rgt_not_eq|]|]. apply (round_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy]. - apply Z.le_trans with (fexp1 (mag (x - y))). - + apply Hexp4; omega. - + omega. + + apply Hexp4; lia. + + lia. - now apply Hexp3. Qed. @@ -2097,7 +2097,7 @@ intros Hbeta fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Py Hxy Hly Hly' assert (Px := Rlt_trans 0 y x Py Hxy). destruct Hexp as (_,(_,(_,Hexp4))). assert (Hf2 : (fexp2 (mag x) <= fexp1 (mag x))%Z); - [now apply Hexp4; omega|]. + [now apply Hexp4; lia|]. assert (Hfx : (fexp1 (mag x) < mag x)%Z); [now apply mag_generic_gt; [|apply Rgt_not_eq|]|]. assert (Bpow3 : bpow (- 1) <= / 3). @@ -2113,12 +2113,12 @@ apply round_round_gt_mid. - exact Vfexp1. - exact Vfexp2. - lra. -- apply Hexp4; omega. -- assert (fexp1 (mag (x - y)) < mag (x - y))%Z; [|omega]. +- apply Hexp4; lia. +- assert (fexp1 (mag (x - y)) < mag (x - y))%Z; [|lia]. apply (valid_exp_large fexp1 (mag x - 1)). - + apply (valid_exp_large fexp1 (mag y)); [|omega]. + + apply (valid_exp_large fexp1 (mag y)); [|lia]. now apply mag_generic_gt; [|apply Rgt_not_eq|]. - + now apply mag_minus_lb; [| |omega]. + + now apply mag_minus_lb; [| |lia]. - unfold midp'. apply (Rplus_lt_reg_r (/ 2 * ulp beta fexp1 (x - y) - (x - y))). ring_simplify. @@ -2135,7 +2135,7 @@ apply round_round_gt_mid. apply Rmult_le_compat_r; [now apply bpow_ge_0|]. unfold Raux.bpow, Z.pow_pos; simpl. rewrite Zmult_1_r; apply Rinv_le; [lra|]. - now apply IZR_le; omega. + now apply IZR_le; lia. - intro Hf2'. unfold midp'. apply (Rplus_lt_reg_r (/ 2 * (ulp beta fexp1 (x - y) @@ -2164,7 +2164,7 @@ apply round_round_gt_mid. replace (_ - _) with (- / 3) by field. apply Ropp_le_contravar. apply Rle_trans with (bpow (- 1)). - * apply bpow_le; omega. + * apply bpow_le; lia. * unfold Raux.bpow, Z.pow_pos; simpl. rewrite Zmult_1_r; apply Rinv_le; [lra|]. now apply IZR_le. @@ -2204,12 +2204,12 @@ destruct (Req_dec y x) as [Hy|Hy]. { rewrite (round_generic beta fexp2). - reflexivity. - now apply valid_rnd_N. - - assert (Hf1 : (fexp1 (mag (x - y)) <= mag y)%Z); [omega|]. + - assert (Hf1 : (fexp1 (mag (x - y)) <= mag y)%Z) by lia. now apply (round_round_minus_radix_ge_3_aux1 fexp1). } + rewrite (round_generic beta fexp2). * reflexivity. * now apply valid_rnd_N. - * assert (Hf1 : (fexp1 (mag x) <= mag y)%Z); [omega|]. + * assert (Hf1 : (fexp1 (mag x) <= mag y)%Z) by lia. now apply (round_round_minus_radix_ge_3_aux0 fexp1). Qed. @@ -2236,7 +2236,7 @@ destruct (Req_dec x 0) as [Zx|Nzx]. * now apply valid_rnd_N. * apply (generic_inclusion_mag beta fexp1). destruct Hexp as (_,(_,(_,Hexp4))). - now intros _; apply Hexp4; omega. + now intros _; apply Hexp4; lia. exact Fy. - (* x <> 0 *) destruct (Req_dec y 0) as [Zy|Nzy]. @@ -2247,7 +2247,7 @@ destruct (Req_dec x 0) as [Zx|Nzx]. * now apply valid_rnd_N. * apply (generic_inclusion_mag beta fexp1). destruct Hexp as (_,(_,(_,Hexp4))). - now intros _; apply Hexp4; omega. + now intros _; apply Hexp4; lia. exact Fx. + (* y <> 0 *) assert (Px : 0 < x); [lra|]. @@ -2332,9 +2332,9 @@ Proof. intros Hprec. unfold FLX_exp. unfold round_round_plus_radix_ge_3_hyp; split; [|split; [|split]]; -intros ex ey; try omega. +intros ex ey; try lia. unfold Prec_gt_0 in prec_gt_0_. -omega. +lia. Qed. Theorem round_round_plus_radix_ge_3_FLX : @@ -2393,19 +2393,19 @@ unfold round_round_plus_radix_ge_3_hyp; split; [|split; [|split]]; intros ex ey. - generalize (Zmax_spec (ex + 1 - prec) emin). generalize (Zmax_spec (ex - prec') emin'). generalize (Zmax_spec (ey - prec) emin). - omega. + lia. - generalize (Zmax_spec (ex - 1 - prec) emin). generalize (Zmax_spec (ex - prec') emin'). generalize (Zmax_spec (ey - prec) emin). - omega. + lia. - generalize (Zmax_spec (ex - prec) emin). generalize (Zmax_spec (ex - prec') emin'). generalize (Zmax_spec (ey - prec) emin). - omega. + lia. - unfold Prec_gt_0 in prec_gt_0_. generalize (Zmax_spec (ex - prec') emin'). generalize (Zmax_spec (ey - prec) emin). - omega. + lia. Qed. Theorem round_round_plus_radix_ge_3_FLT : @@ -2467,18 +2467,18 @@ unfold round_round_plus_radix_ge_3_hyp; split; [|split; [|split]]; intros ex ey. - destruct (Z.ltb_spec (ex + 1 - prec) emin); destruct (Z.ltb_spec (ex - prec') emin'); destruct (Z.ltb_spec (ey - prec) emin); - omega. + lia. - destruct (Z.ltb_spec (ex - 1 - prec) emin); destruct (Z.ltb_spec (ex - prec') emin'); destruct (Z.ltb_spec (ey - prec) emin); - omega. + lia. - destruct (Z.ltb_spec (ex - prec) emin); destruct (Z.ltb_spec (ex - prec') emin'); destruct (Z.ltb_spec (ey - prec) emin); - omega. + lia. - destruct (Z.ltb_spec (ex - prec') emin'); destruct (Z.ltb_spec (ey - prec) emin); - omega. + lia. Qed. Theorem round_round_plus_radix_ge_3_FTZ : @@ -2546,11 +2546,11 @@ intros Cmid. destruct (generic_format_EM beta fexp1 x) as [Fx|Nfx]. - (* generic_format beta fexp1 x *) rewrite (round_generic beta fexp2); [reflexivity|now apply valid_rnd_N|]. - now apply (generic_inclusion_mag beta fexp1); [omega|]. + now apply (generic_inclusion_mag beta fexp1); [lia|]. - (* ~ generic_format beta fexp1 x *) assert (Hceil : round beta fexp1 Zceil x = rd + u1); [now apply round_UP_DN_ulp|]. - assert (Hf2' : (fexp2 (mag x) <= fexp1 (mag x) - 1)%Z); [omega|]. + assert (Hf2' : (fexp2 (mag x) <= fexp1 (mag x) - 1)%Z) by lia. destruct (Rlt_or_le (x - rd) (/ 2 * (u1 - u2))). + (* x - rd < / 2 * (u1 - u2) *) apply round_round_lt_mid_further_place; try assumption. @@ -2587,7 +2587,7 @@ Proof. intros x Px. rewrite (mag_sqrt beta x Px). generalize (Zdiv2_odd_eqn (mag x + 1)). -destruct Z.odd ; intros ; omega. +destruct Z.odd ; intros ; lia. Qed. Lemma round_round_sqrt_aux : @@ -2638,7 +2638,7 @@ assert (Pb : 0 < b). apply Rlt_Rminus. unfold u2, u1. apply bpow_lt. - omega. } + lia. } assert (Pb' : 0 < b'). { now unfold b'; rewrite Rmult_plus_distr_l; apply Rplus_lt_0_compat. } assert (Hr : sqrt x <= a + b'). @@ -2654,7 +2654,7 @@ assert (Hf1 : (2 * fexp1 (mag (sqrt x)) <= fexp1 (mag (x)))%Z); [destruct (mag_sqrt_disj x Px) as [H'|H']; rewrite H'; apply Hexp|]. assert (Hlx : (fexp1 (2 * mag (sqrt x)) < 2 * mag (sqrt x))%Z). { destruct (mag_sqrt_disj x Px) as [Hlx|Hlx]. - - apply (valid_exp_large fexp1 (mag x)); [|omega]. + - apply (valid_exp_large fexp1 (mag x)); [|lia]. now apply mag_generic_gt; [|apply Rgt_not_eq|]. - rewrite <- Hlx. now apply mag_generic_gt; [|apply Rgt_not_eq|]. } @@ -2698,7 +2698,7 @@ destruct (Req_dec a 0) as [Za|Nza]. unfold b'; change (bpow _) with u1. apply Rlt_le_trans with (/ 2 * (u1 + u1)); [|lra]. apply Rmult_lt_compat_l; [lra|]; apply Rplus_lt_compat_l. - unfold u2, u1, ulp, cexp; apply bpow_lt; omega. + unfold u2, u1, ulp, cexp; apply bpow_lt; lia. - (* a <> 0 *) assert (Pa : 0 < a); [lra|]. assert (Hla : (mag a = mag (sqrt x) :> Z)). @@ -2731,7 +2731,7 @@ destruct (Req_dec a 0) as [Za|Nza]. * apply pow2_ge_0. * unfold Raux.bpow, Z.pow_pos; simpl; rewrite Zmult_1_r. apply Rinv_le; [lra|]. - change 4%Z with (2 * 2)%Z; apply IZR_le, Zmult_le_compat; omega. + change 4%Z with (2 * 2)%Z; apply IZR_le, Zmult_le_compat; lia. * rewrite <- (Rplus_0_l (u1 ^ 2)) at 1; apply Rplus_le_compat_r. apply pow2_ge_0. } assert (Hr' : x <= a * a + u1 * a). @@ -2744,11 +2744,11 @@ destruct (Req_dec a 0) as [Za|Nza]. apply (Rmult_le_reg_r (bpow (- 2 * fexp1 (mag (sqrt x))))); [now apply bpow_gt_0|bpow_simplify]. rewrite Fx at 1; bpow_simplify. - rewrite <- IZR_Zpower; [|omega]. + rewrite <- IZR_Zpower; [|lia]. rewrite <- plus_IZR, <- 2!mult_IZR. apply IZR_le, Zlt_succ_le, lt_IZR. unfold Z.succ; rewrite plus_IZR; do 2 rewrite mult_IZR; rewrite plus_IZR. - rewrite IZR_Zpower; [|omega]. + rewrite IZR_Zpower; [|lia]. apply (Rmult_lt_reg_r (bpow (2 * fexp1 (mag (sqrt x))))); [now apply bpow_gt_0|bpow_simplify]. rewrite <- Fx. @@ -2787,12 +2787,12 @@ destruct (Req_dec a 0) as [Za|Nza]. apply Rinv_le; [lra|]. apply IZR_le. rewrite <- (Zmult_1_l 2). - apply Zmult_le_compat; omega. + apply Zmult_le_compat; lia. + assert (u2 ^ 2 < u1 ^ 2); [|unfold b'; lra]. unfold pow; do 2 rewrite Rmult_1_r. assert (H' : 0 <= u2); [unfold u2, ulp; apply bpow_ge_0|]. assert (u2 < u1); [|now apply Rmult_lt_compat]. - unfold u1, u2, ulp, cexp; apply bpow_lt; omega. } + unfold u1, u2, ulp, cexp; apply bpow_lt; lia. } apply (Rlt_irrefl (a * a + u1 * a)). apply Rlt_le_trans with (a * a + u1 * a - u2 * a + b * b). + rewrite <- (Rplus_0_r (a * a + _)) at 1. @@ -2835,7 +2835,8 @@ destruct (Rle_or_lt x 0) as [Npx|Px]. generalize ((proj1 (proj2 Hexp)) 1%Z). replace (_ - 1)%Z with 1%Z by ring. intro Hexp10. - assert (Hf0 : (fexp1 1 < 1)%Z); [omega|clear Hexp10]. + assert (Hf0 : (fexp1 1 < 1)%Z) by lia. + clear Hexp10. apply (valid_exp_large fexp1 1); [exact Hf0|]. apply mag_ge_bpow. rewrite Zeq_minus; [|reflexivity]. @@ -2847,18 +2848,18 @@ destruct (Rle_or_lt x 0) as [Npx|Px]. assert (Hf2 : (fexp2 (mag (sqrt x)) <= fexp1 (mag (sqrt x)) - 1)%Z). { assert (H : (fexp1 (2 * mag (sqrt x)) < 2 * mag (sqrt x))%Z). { destruct (mag_sqrt_disj x Px) as [Hlx|Hlx]. - - apply (valid_exp_large fexp1 (mag x)); [|omega]. + - apply (valid_exp_large fexp1 (mag x)); [|lia]. now apply mag_generic_gt; [|apply Rgt_not_eq|]. - rewrite <- Hlx. now apply mag_generic_gt; [|apply Rgt_not_eq|]. } generalize ((proj2 (proj2 Hexp)) (mag (sqrt x)) H). - omega. } + lia. } apply round_round_mid_cases. + exact Vfexp1. + exact Vfexp2. + now apply sqrt_lt_R0. - + omega. - + omega. + + lia. + + lia. + intros Hmid; casetype False; apply (Rle_not_lt _ _ Hmid). apply (round_round_sqrt_aux fexp1 fexp2 Vfexp1 Vfexp2 Hexp x Px Hf2 Fx). Qed. @@ -2878,7 +2879,7 @@ Proof. intros Hprec. unfold FLX_exp. unfold Prec_gt_0 in prec_gt_0_. -unfold round_round_sqrt_hyp; split; [|split]; intro ex; omega. +unfold round_round_sqrt_hyp; split; [|split]; intro ex; lia. Qed. Theorem round_round_sqrt_FLX : @@ -2919,14 +2920,14 @@ unfold Prec_gt_0 in prec_gt_0_. unfold round_round_sqrt_hyp; split; [|split]; intros ex. - generalize (Zmax_spec (ex - prec) emin). generalize (Zmax_spec (2 * ex - prec) emin). - omega. + lia. - generalize (Zmax_spec (ex - prec) emin). generalize (Zmax_spec (2 * ex - 1 - prec) emin). - omega. + lia. - generalize (Zmax_spec (2 * ex - prec) emin). generalize (Zmax_spec (ex - prec') emin'). generalize (Zmax_spec (ex - prec) emin). - omega. + lia. Qed. Theorem round_round_sqrt_FLT : @@ -2969,18 +2970,18 @@ unfold Prec_gt_0 in *. unfold round_round_sqrt_hyp; split; [|split]; intros ex. - destruct (Z.ltb_spec (ex - prec) emin); destruct (Z.ltb_spec (2 * ex - prec) emin); - omega. + lia. - destruct (Z.ltb_spec (ex - prec) emin); destruct (Z.ltb_spec (2 * ex - 1 - prec) emin); - omega. + lia. - intro H. destruct (Zle_or_lt emin (2 * ex - prec)) as [H'|H']. + destruct (Z.ltb_spec (ex - prec') emin'); destruct (Z.ltb_spec (ex - prec) emin); - omega. + lia. + casetype False. rewrite (Zlt_bool_true _ _ H') in H. - omega. + lia. Qed. Theorem round_round_sqrt_FTZ : @@ -3057,7 +3058,7 @@ assert (Pb : 0 < b). apply Rlt_Rminus. unfold u2, u1, ulp, cexp. apply bpow_lt. - omega. } + lia. } assert (Pb' : 0 < b'). { now unfold b'; rewrite Rmult_plus_distr_l; apply Rplus_lt_0_compat. } assert (Hr : sqrt x <= a + b'). @@ -3073,7 +3074,7 @@ assert (Hf1 : (2 * fexp1 (mag (sqrt x)) <= fexp1 (mag (x)))%Z); [destruct (mag_sqrt_disj x Px) as [H'|H']; rewrite H'; apply Hexp|]. assert (Hlx : (fexp1 (2 * mag (sqrt x)) < 2 * mag (sqrt x))%Z). { destruct (mag_sqrt_disj x Px) as [Hlx|Hlx]. - - apply (valid_exp_large fexp1 (mag x)); [|omega]. + - apply (valid_exp_large fexp1 (mag x)); [|lia]. now apply mag_generic_gt; [|apply Rgt_not_eq|]. - rewrite <- Hlx. now apply mag_generic_gt; [|apply Rgt_not_eq|]. } @@ -3117,7 +3118,7 @@ destruct (Req_dec a 0) as [Za|Nza]. unfold b'; change (bpow _) with u1. apply Rlt_le_trans with (/ 2 * (u1 + u1)); [|lra]. apply Rmult_lt_compat_l; [lra|]; apply Rplus_lt_compat_l. - unfold u2, u1, ulp, cexp; apply bpow_lt; omega. + unfold u2, u1, ulp, cexp; apply bpow_lt; lia. - (* a <> 0 *) assert (Pa : 0 < a); [lra|]. assert (Hla : (mag a = mag (sqrt x) :> Z)). @@ -3162,11 +3163,11 @@ destruct (Req_dec a 0) as [Za|Nza]. apply (Rmult_le_reg_r (bpow (- 2 * fexp1 (mag (sqrt x))))); [now apply bpow_gt_0|bpow_simplify]. rewrite Fx at 1; bpow_simplify. - rewrite <- IZR_Zpower; [|omega]. + rewrite <- IZR_Zpower; [|lia]. rewrite <- plus_IZR, <- 2!mult_IZR. apply IZR_le, Zlt_succ_le, lt_IZR. unfold Z.succ; rewrite plus_IZR; do 2 rewrite mult_IZR; rewrite plus_IZR. - rewrite IZR_Zpower; [|omega]. + rewrite IZR_Zpower; [|lia]. apply (Rmult_lt_reg_r (bpow (2 * fexp1 (mag (sqrt x))))); [now apply bpow_gt_0|bpow_simplify]. rewrite <- Fx. @@ -3203,12 +3204,12 @@ destruct (Req_dec a 0) as [Za|Nza]. unfold Raux.bpow; simpl; unfold Z.pow_pos; simpl. rewrite Zmult_1_r. apply Rinv_le; [lra|]. - apply IZR_le; omega. + apply IZR_le; lia. + assert (u2 ^ 2 < u1 ^ 2); [|unfold b'; lra]. unfold pow; do 2 rewrite Rmult_1_r. assert (H' : 0 <= u2); [unfold u2, ulp; apply bpow_ge_0|]. assert (u2 < u1); [|now apply Rmult_lt_compat]. - unfold u1, u2, ulp, cexp; apply bpow_lt; omega. } + unfold u1, u2, ulp, cexp; apply bpow_lt; lia. } apply (Rlt_irrefl (a * a + u1 * a)). apply Rlt_le_trans with (a * a + u1 * a - u2 * a + b * b). + rewrite <- (Rplus_0_r (a * a + _)) at 1. @@ -3263,7 +3264,8 @@ destruct (Rle_or_lt x 0) as [Npx|Px]. generalize ((proj1 (proj2 Hexp)) 1%Z). replace (_ - 1)%Z with 1%Z by ring. intro Hexp10. - assert (Hf0 : (fexp1 1 < 1)%Z); [omega|clear Hexp10]. + assert (Hf0 : (fexp1 1 < 1)%Z) by lia. + clear Hexp10. apply (valid_exp_large fexp1 1); [exact Hf0|]. apply mag_ge_bpow. rewrite Zeq_minus; [|reflexivity]. @@ -3275,18 +3277,18 @@ destruct (Rle_or_lt x 0) as [Npx|Px]. assert (Hf2 : (fexp2 (mag (sqrt x)) <= fexp1 (mag (sqrt x)) - 1)%Z). { assert (H : (fexp1 (2 * mag (sqrt x)) < 2 * mag (sqrt x))%Z). { destruct (mag_sqrt_disj x Px) as [Hlx|Hlx]. - - apply (valid_exp_large fexp1 (mag x)); [|omega]. + - apply (valid_exp_large fexp1 (mag x)); [|lia]. now apply mag_generic_gt; [|apply Rgt_not_eq|]. - rewrite <- Hlx. now apply mag_generic_gt; [|apply Rgt_not_eq|]. } generalize ((proj2 (proj2 Hexp)) (mag (sqrt x)) H). - omega. } + lia. } apply round_round_mid_cases. + exact Vfexp1. + exact Vfexp2. + now apply sqrt_lt_R0. - + omega. - + omega. + + lia. + + lia. + intros Hmid; casetype False; apply (Rle_not_lt _ _ Hmid). apply (round_round_sqrt_radix_ge_4_aux Hbeta fexp1 fexp2 Vfexp1 Vfexp2 Hexp x Px Hf2 Fx). @@ -3307,7 +3309,7 @@ Proof. intros Hprec. unfold FLX_exp. unfold Prec_gt_0 in prec_gt_0_. -unfold round_round_sqrt_radix_ge_4_hyp; split; [|split]; intro ex; omega. +unfold round_round_sqrt_radix_ge_4_hyp; split; [|split]; intro ex; lia. Qed. Theorem round_round_sqrt_radix_ge_4_FLX : @@ -3350,14 +3352,14 @@ unfold Prec_gt_0 in prec_gt_0_. unfold round_round_sqrt_radix_ge_4_hyp; split; [|split]; intros ex. - generalize (Zmax_spec (ex - prec) emin). generalize (Zmax_spec (2 * ex - prec) emin). - omega. + lia. - generalize (Zmax_spec (ex - prec) emin). generalize (Zmax_spec (2 * ex - 1 - prec) emin). - omega. + lia. - generalize (Zmax_spec (2 * ex - prec) emin). generalize (Zmax_spec (ex - prec') emin'). generalize (Zmax_spec (ex - prec) emin). - omega. + lia. Qed. Theorem round_round_sqrt_radix_ge_4_FLT : @@ -3402,18 +3404,18 @@ unfold Prec_gt_0 in *. unfold round_round_sqrt_radix_ge_4_hyp; split; [|split]; intros ex. - destruct (Z.ltb_spec (ex - prec) emin); destruct (Z.ltb_spec (2 * ex - prec) emin); - omega. + lia. - destruct (Z.ltb_spec (ex - prec) emin); destruct (Z.ltb_spec (2 * ex - 1 - prec) emin); - omega. + lia. - intro H. destruct (Zle_or_lt emin (2 * ex - prec)) as [H'|H']. + destruct (Z.ltb_spec (ex - prec') emin'); destruct (Z.ltb_spec (ex - prec) emin); - omega. + lia. + casetype False. rewrite (Zlt_bool_true _ _ H') in H. - omega. + lia. Qed. Theorem round_round_sqrt_radix_ge_4_FTZ : @@ -3479,7 +3481,7 @@ assert (Hf : F2R f = x). rewrite plus_IZR. rewrite Rmult_plus_distr_r. rewrite mult_IZR. - rewrite IZR_Zpower; [|omega]. + rewrite IZR_Zpower; [|lia]. unfold cexp at 2; bpow_simplify. unfold Zminus; rewrite bpow_plus. rewrite (Rmult_comm _ (bpow (- 1))). @@ -3489,11 +3491,11 @@ assert (Hf : F2R f = x). rewrite Ebeta. rewrite (mult_IZR 2). rewrite Rinv_mult_distr; - [|simpl; lra | apply IZR_neq; omega]. + [|simpl; lra | apply IZR_neq; lia]. rewrite <- Rmult_assoc; rewrite (Rmult_comm (IZR n)); rewrite (Rmult_assoc _ (IZR n)). rewrite Rinv_r; - [rewrite Rmult_1_r | apply IZR_neq; omega]. + [rewrite Rmult_1_r | apply IZR_neq; lia]. simpl; fold (cexp beta fexp1 x). rewrite <- 2!ulp_neq_0; try now apply Rgt_not_eq. fold u; rewrite Xmid at 2. @@ -3525,12 +3527,12 @@ assert (Hf : F2R f = x). unfold round, F2R, scaled_mantissa, cexp; simpl. bpow_simplify. rewrite Lrd. - rewrite <- (IZR_Zpower _ (_ - _)); [|omega]. + rewrite <- (IZR_Zpower _ (_ - _)); [|lia]. rewrite <- mult_IZR. rewrite (Zfloor_imp (Zfloor (x * bpow (- fexp1 (mag x))) * beta ^ (fexp1 (mag x) - fexp2 (mag x)))). + rewrite mult_IZR. - rewrite IZR_Zpower; [|omega]. + rewrite IZR_Zpower; [|lia]. bpow_simplify. now unfold rd. + split; [now apply Rle_refl|]. @@ -3557,7 +3559,7 @@ assert (Hlx : bpow (mag x - 1) <= x < bpow (mag x)). apply Hex. now apply Rgt_not_eq. } unfold round_round_eq. -rewrite (round_N_small_pos beta fexp1 _ x (mag x)); [|exact Hlx|omega]. +rewrite (round_N_small_pos beta fexp1 _ x (mag x)); [|exact Hlx|lia]. set (x'' := round beta fexp2 (Znearest choice2) x). destruct (Req_dec x'' 0) as [Zx''|Nzx'']; [now rewrite Zx''; rewrite round_0; [|apply valid_rnd_N]|]. @@ -3566,7 +3568,7 @@ destruct (Zle_or_lt (fexp2 (mag x)) (mag x)). destruct (Rlt_or_le x'' (bpow (mag x))). + (* x'' < bpow (mag x) *) rewrite (round_N_small_pos beta fexp1 _ _ (mag x)); - [reflexivity|split; [|exact H0]|omega]. + [reflexivity|split; [|exact H0]|lia]. apply round_large_pos_ge_bpow; [now apply valid_rnd_N| |now apply Hlx]. fold x''; assert (0 <= x''); [|lra]; unfold x''. rewrite <- (round_0 beta fexp2 (Znearest choice2)). @@ -3581,7 +3583,7 @@ destruct (Zle_or_lt (fexp2 (mag x)) (mag x)). unfold round, F2R, scaled_mantissa, cexp; simpl. rewrite mag_bpow. assert (Hf11 : (fexp1 (mag x + 1) = fexp1 (mag x) :> Z)%Z); - [apply Vfexp1; omega|]. + [apply Vfexp1; lia|]. rewrite Hf11. apply (Rmult_eq_reg_r (bpow (- fexp1 (mag x)))); [|now apply Rgt_not_eq; apply bpow_gt_0]. @@ -3590,7 +3592,7 @@ destruct (Zle_or_lt (fexp2 (mag x)) (mag x)). apply Znearest_imp. simpl; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r. rewrite Rabs_right; [|now apply Rle_ge; apply bpow_ge_0]. - apply Rle_lt_trans with (bpow (- 2)); [now apply bpow_le; omega|]. + apply Rle_lt_trans with (bpow (- 2)); [now apply bpow_le; lia|]. unfold Raux.bpow, Z.pow_pos; simpl; rewrite Zmult_1_r. assert (Hbeta : (2 <= beta)%Z). { destruct beta as (beta_val,beta_prop); simpl. @@ -3598,11 +3600,11 @@ destruct (Zle_or_lt (fexp2 (mag x)) (mag x)). apply Rinv_lt_contravar. * apply Rmult_lt_0_compat; [lra|]. rewrite mult_IZR; apply Rmult_lt_0_compat; - apply IZR_lt; omega. + apply IZR_lt; lia. * apply IZR_lt. apply (Z.le_lt_trans _ _ _ Hbeta). rewrite <- (Zmult_1_r beta) at 1. - apply Zmult_lt_compat_l; omega. + apply Zmult_lt_compat_l; lia. - (* mag x < fexp2 (mag x) *) casetype False; apply Nzx''. now apply (round_N_small_pos beta _ _ _ (mag x)). @@ -3630,11 +3632,11 @@ assert (Hlx : bpow (mag x - 1) <= x < bpow (mag x)). apply Hex. now apply Rgt_not_eq. } rewrite (round_N_small_pos beta fexp1 choice1 x (mag x)); - [|exact Hlx|omega]. + [|exact Hlx|lia]. destruct (Req_dec x'' 0) as [Zx''|Nzx'']; [now rewrite Zx''; rewrite round_0; [reflexivity|apply valid_rnd_N]|]. rewrite (round_N_small_pos beta _ _ x'' (mag x)); - [reflexivity| |omega]. + [reflexivity| |lia]. split. - apply round_large_pos_ge_bpow. + now apply valid_rnd_N. @@ -3680,19 +3682,19 @@ set (u2 := ulp beta fexp2 x). intros Cz Clt Ceq Cgt. destruct (Ztrichotomy (mag x) (fexp1 (mag x) - 1)) as [Hlt|[Heq|Hgt]]. - (* mag x < fexp1 (mag x) - 1 *) - assert (H : (mag x <= fexp1 (mag x) - 2)%Z) by omega. + assert (H : (mag x <= fexp1 (mag x) - 2)%Z) by lia. now apply round_round_really_zero. - (* mag x = fexp1 (mag x) - 1 *) - assert (H : (fexp1 (mag x) = (mag x + 1))%Z) by omega. + assert (H : (fexp1 (mag x) = (mag x + 1))%Z) by lia. destruct (Rlt_or_le x (bpow (mag x) - / 2 * u2)) as [Hlt'|Hge']. + now apply round_round_zero. + now apply Cz. - (* mag x > fexp1 (mag x) - 1 *) - assert (H : (fexp1 (mag x) <= mag x)%Z) by omega. + assert (H : (fexp1 (mag x) <= mag x)%Z) by lia. destruct (Rtotal_order x (midp fexp1 x)) as [Hlt'|[Heq'|Hgt']]. + (* x < midp fexp1 x *) destruct (Rlt_or_le x (midp fexp1 x - / 2 * u2)) as [Hlt''|Hle'']. - * now apply round_round_lt_mid_further_place; [| | |omega| |]. + * now apply round_round_lt_mid_further_place; [| | |lia| |]. * now apply Clt; [|split]. + (* x = midp fexp1 x *) now apply Ceq. @@ -3703,12 +3705,11 @@ destruct (Ztrichotomy (mag x) (fexp1 (mag x) - 1)) as [Hlt|[Heq|Hgt]]. - (* generic_format beta fexp1 x *) unfold round_round_eq; rewrite (round_generic beta fexp2); [reflexivity|now apply valid_rnd_N|]. - now apply (generic_inclusion_mag beta fexp1); [omega|]. + now apply (generic_inclusion_mag beta fexp1); [lia|]. - (* ~ generic_format beta fexp1 x *) assert (Hceil : round beta fexp1 Zceil x = x' + u1); [now apply round_UP_DN_ulp|]. - assert (Hf2' : (fexp2 (mag x) <= fexp1 (mag x) - 1)%Z); - [omega|]. + assert (Hf2' : (fexp2 (mag x) <= fexp1 (mag x) - 1)%Z) by lia. assert (midp' fexp1 x + / 2 * ulp beta fexp2 x < x); [|now apply round_round_gt_mid_further_place]. revert Hle''; unfold midp, midp'; fold x'. @@ -3724,7 +3725,7 @@ Lemma mag_div_disj : Proof. intros x y Px Py. generalize (mag_div beta x y (Rgt_not_eq _ _ Px) (Rgt_not_eq _ _ Py)). -omega. +lia. Qed. Definition round_round_div_hyp fexp1 fexp2 := @@ -3829,7 +3830,7 @@ destruct (Zle_or_lt Z0 (fexp1 (mag x) - mag (x / y) replace (_ - _ + 1)%Z with ((mag x + 1) - mag y)%Z by ring. apply Hexp. { now assert (fexp1 (mag x + 1) <= mag x)%Z; - [apply valid_exp|omega]. } + [apply valid_exp|lia]. } { assumption. } replace (_ + 1 - _)%Z with (mag x - mag y + 1)%Z by ring. now rewrite <- Hxy. @@ -3842,7 +3843,7 @@ destruct (Zle_or_lt Z0 (fexp1 (mag x) - mag (x / y) bpow_simplify. rewrite (Rmult_comm p). unfold p; bpow_simplify. - rewrite <- IZR_Zpower; [|omega]. + rewrite <- IZR_Zpower; [|lia]. rewrite <- mult_IZR. rewrite <- minus_IZR. apply IZR_le. @@ -3850,7 +3851,7 @@ destruct (Zle_or_lt Z0 (fexp1 (mag x) - mag (x / y) apply Zlt_le_succ. apply lt_IZR. rewrite mult_IZR. - rewrite IZR_Zpower; [|omega]. + rewrite IZR_Zpower; [|lia]. apply (Rmult_lt_reg_r (bpow (fexp1 (mag x)))); [now apply bpow_gt_0|bpow_simplify]. rewrite <- Fx. @@ -4000,7 +4001,7 @@ destruct (Zle_or_lt Z0 (fexp1 (mag x) - fexp1 (mag (x / y)) replace (_ - _ + 1)%Z with ((mag x + 1) - mag y)%Z by ring. apply Hexp. { now assert (fexp1 (mag x + 1) <= mag x)%Z; - [apply valid_exp|omega]. } + [apply valid_exp|lia]. } { assumption. } replace (_ + 1 - _)%Z with (mag x - mag y + 1)%Z by ring. now rewrite <- Hxy. @@ -4016,7 +4017,7 @@ destruct (Zle_or_lt Z0 (fexp1 (mag x) - fexp1 (mag (x / y)) rewrite (Rmult_comm u1). unfold x', u1, round, F2R, ulp, scaled_mantissa, cexp; simpl. bpow_simplify. - rewrite <- (IZR_Zpower _ (_ - _)%Z); [|omega]. + rewrite <- (IZR_Zpower _ (_ - _)%Z); [|lia]. do 5 rewrite <- mult_IZR. rewrite <- plus_IZR. rewrite <- minus_IZR. @@ -4026,7 +4027,7 @@ destruct (Zle_or_lt Z0 (fexp1 (mag x) - fexp1 (mag (x / y)) apply lt_IZR. rewrite plus_IZR. do 5 rewrite mult_IZR; simpl. - rewrite IZR_Zpower; [|omega]. + rewrite IZR_Zpower; [|lia]. apply (Rmult_lt_reg_r (bpow (fexp1 (mag x)))); [now apply bpow_gt_0|]. rewrite Rmult_assoc. @@ -4063,7 +4064,7 @@ destruct (Zle_or_lt Z0 (fexp1 (mag x) - fexp1 (mag (x / y)) apply (Zplus_le_reg_r _ _ (- mag y)); ring_simplify. rewrite (Zplus_comm (- _)). destruct (mag_div_disj x y Px Py) as [Hxy|Hxy]; rewrite Hxy; - apply Hexp; try assumption; rewrite <- Hxy; omega. + apply Hexp; try assumption; rewrite <- Hxy; lia. Qed. Lemma round_round_div_aux2 : @@ -4139,7 +4140,7 @@ destruct (Zle_or_lt Z0 (fexp1 (mag x) - fexp1 (mag (x / y)) replace (_ - _ + 1)%Z with ((mag x + 1) - mag y)%Z by ring. apply Hexp. { now assert (fexp1 (mag x + 1) <= mag x)%Z; - [apply valid_exp|omega]. } + [apply valid_exp|lia]. } { assumption. } replace (_ + 1 - _)%Z with (mag x - mag y + 1)%Z by ring. now rewrite <- Hxy. @@ -4213,7 +4214,7 @@ destruct (Zle_or_lt Z0 (fexp1 (mag x) - fexp1 (mag (x / y)) apply (Zplus_le_reg_r _ _ (- mag y)); ring_simplify. rewrite (Zplus_comm (- _)). destruct (mag_div_disj x y Px Py) as [Hxy|Hxy]; rewrite Hxy; - apply Hexp; try assumption; rewrite <- Hxy; omega. + apply Hexp; try assumption; rewrite <- Hxy; lia. + apply Rge_le; rewrite Fx at 1; apply Rle_ge. rewrite Fy at 1 2. apply (Rmult_le_reg_r (bpow (- fexp1 (mag x)))); @@ -4225,7 +4226,7 @@ destruct (Zle_or_lt Z0 (fexp1 (mag x) - fexp1 (mag (x / y)) rewrite (Rmult_comm u1). unfold x', u1, round, F2R, ulp, scaled_mantissa, cexp; simpl. bpow_simplify. - rewrite <- (IZR_Zpower _ (_ - _)%Z); [|omega]. + rewrite <- (IZR_Zpower _ (_ - _)%Z); [|lia]. do 5 rewrite <- mult_IZR. do 2 rewrite <- plus_IZR. apply IZR_le. @@ -4233,7 +4234,7 @@ destruct (Zle_or_lt Z0 (fexp1 (mag x) - fexp1 (mag (x / y)) apply lt_IZR. rewrite plus_IZR. do 5 rewrite mult_IZR; simpl. - rewrite IZR_Zpower; [|omega]. + rewrite IZR_Zpower; [|lia]. apply (Rmult_lt_reg_r (bpow (fexp1 (mag x)))); [now apply bpow_gt_0|]. rewrite (Rmult_assoc _ (IZR mx)). @@ -4379,8 +4380,8 @@ intros Hprec. unfold Prec_gt_0 in prec_gt_0_. unfold FLX_exp. unfold round_round_div_hyp. -split; [now intro ex; omega|]. -split; [|split; [|split]]; intros ex ey; omega. +split; [now intro ex; lia|]. +split; [|split; [|split]]; intros ex ey; lia. Qed. Theorem round_round_div_FLX : @@ -4425,27 +4426,27 @@ unfold round_round_div_hyp. split; [intro ex|split; [|split; [|split]]; intros ex ey]. - generalize (Zmax_spec (ex - prec') emin'). generalize (Zmax_spec (ex - prec) emin). - omega. + lia. - generalize (Zmax_spec (ex - prec) emin). generalize (Zmax_spec (ey - prec) emin). generalize (Zmax_spec (ex - ey - prec) emin). generalize (Zmax_spec (ex - ey - prec') emin'). - omega. + lia. - generalize (Zmax_spec (ex - prec) emin). generalize (Zmax_spec (ey - prec) emin). generalize (Zmax_spec (ex - ey + 1 - prec) emin). generalize (Zmax_spec (ex - ey + 1 - prec') emin'). - omega. + lia. - generalize (Zmax_spec (ex - prec) emin). generalize (Zmax_spec (ey - prec) emin). generalize (Zmax_spec (ex - ey - prec) emin). generalize (Zmax_spec (ex - ey - prec') emin'). - omega. + lia. - generalize (Zmax_spec (ex - prec) emin). generalize (Zmax_spec (ey - prec) emin). generalize (Zmax_spec (ex - ey - prec) emin). generalize (Zmax_spec (ex - ey - prec') emin'). - omega. + lia. Qed. Theorem round_round_div_FLT : @@ -4493,27 +4494,27 @@ unfold round_round_div_hyp. split; [intro ex|split; [|split; [|split]]; intros ex ey]. - destruct (Z.ltb_spec (ex - prec') emin'); destruct (Z.ltb_spec (ex - prec) emin); - omega. + lia. - destruct (Z.ltb_spec (ex - prec) emin); destruct (Z.ltb_spec (ey - prec) emin); destruct (Z.ltb_spec (ex - ey - prec) emin); destruct (Z.ltb_spec (ex - ey - prec') emin'); - omega. + lia. - destruct (Z.ltb_spec (ex - prec) emin); destruct (Z.ltb_spec (ey - prec) emin); destruct (Z.ltb_spec (ex - ey + 1 - prec) emin); destruct (Z.ltb_spec (ex - ey + 1 - prec') emin'); - omega. + lia. - destruct (Z.ltb_spec (ex - prec) emin); destruct (Z.ltb_spec (ey - prec) emin); destruct (Z.ltb_spec (ex - ey - prec) emin); destruct (Z.ltb_spec (ex - ey - prec') emin'); - omega. + lia. - destruct (Z.ltb_spec (ex - prec) emin); destruct (Z.ltb_spec (ey - prec) emin); destruct (Z.ltb_spec (ex - ey - prec) emin); destruct (Z.ltb_spec (ex - ey - prec') emin'); - omega. + lia. Qed. Theorem round_round_div_FTZ : diff --git a/flocq/Prop/Mult_error.v b/flocq/Prop/Mult_error.v index 57a3856f..f4467025 100644 --- a/flocq/Prop/Mult_error.v +++ b/flocq/Prop/Mult_error.v @@ -18,6 +18,8 @@ COPYING file for more details. *) (** * Error of the multiplication is in the FLX/FLT format *) + +From Coq Require Import Lia. Require Import Core Operations Plus_error. Section Fprop_mult_error. @@ -71,7 +73,7 @@ unfold cexp, FLX_exp. rewrite mag_unique with (1 := Hex). rewrite mag_unique with (1 := Hey). rewrite mag_unique with (1 := Hexy). -cut (exy - 1 < ex + ey)%Z. omega. +cut (exy - 1 < ex + ey)%Z. lia. apply (lt_bpow beta). apply Rle_lt_trans with (1 := proj1 Hexy). rewrite Rabs_mult. @@ -89,7 +91,7 @@ rewrite mag_unique with (1 := Hey). rewrite mag_unique with (1 := Hexy). cut ((ex - 1) + (ey - 1) < exy)%Z. generalize (prec_gt_0 prec). -clear ; omega. +clear ; lia. apply (lt_bpow beta). apply Rle_lt_trans with (2 := proj2 Hexy). rewrite Rabs_mult. @@ -163,7 +165,7 @@ apply (generic_format_F2R' _ _ _ f). { now unfold F2R; simpl; rewrite bpow_plus, Rmult_assoc. } intro Nzmx; unfold mx, ex; rewrite <- Fx. unfold f, ex; simpl; unfold cexp; rewrite (mag_mult_bpow _ _ _ Nzx). -unfold FLX_exp; omega. +unfold FLX_exp; lia. Qed. End Fprop_mult_error. @@ -209,10 +211,10 @@ assumption. apply Rle_trans with (2:=Hxy). apply bpow_le. generalize (prec_gt_0 prec). -clear ; omega. +clear ; lia. rewrite <- (round_FLT_FLX beta emin) in H1. 2:apply Rle_trans with (2:=Hxy). -2:apply bpow_le ; generalize (prec_gt_0 prec) ; clear ; omega. +2:apply bpow_le ; generalize (prec_gt_0 prec) ; clear ; lia. unfold f; rewrite <- H1. apply generic_format_F2R. intros _. @@ -242,7 +244,7 @@ specialize (Ex Hx0). destruct (mag beta y) as (ey,Ey) ; simpl. specialize (Ey Hy0). assert (emin + 2 * prec -1 < ex + ey)%Z. -2: omega. +2: lia. apply (lt_bpow beta). apply Rle_lt_trans with (1:=Hxy). rewrite Rabs_mult, bpow_plus. @@ -262,7 +264,7 @@ intros Hy _. rewrite <- (Rmult_1_l (bpow _)) at 1. apply Rmult_le_compat_r. apply bpow_ge_0. -apply IZR_le; omega. +apply IZR_le; lia. intros H1 H2; contradict H2. replace ny with 0%Z. simpl; ring. @@ -296,7 +298,7 @@ destruct (mag beta x) as (ex,Hx). destruct (mag beta y) as (ey,Hy). simpl; apply Z.le_trans with ((ex-prec)+(ey-prec))%Z. 2: apply Zplus_le_compat; apply Z.le_max_l. -assert (e + 2*prec -1< ex+ey)%Z;[idtac|omega]. +assert (e + 2*prec -1< ex+ey)%Z;[idtac|lia]. apply lt_bpow with beta. apply Rle_lt_trans with (1:=H1). rewrite Rabs_mult, bpow_plus. @@ -327,9 +329,30 @@ apply (generic_format_F2R' _ _ _ f). { now unfold F2R; simpl; rewrite bpow_plus, Rmult_assoc. } intro Nzmx; unfold mx, ex; rewrite <- Fx. unfold f, ex; simpl; unfold cexp; rewrite (mag_mult_bpow _ _ _ Nzx). -unfold FLT_exp; rewrite Z.max_l; [|omega]; rewrite <- Z.add_max_distr_r. -set (n := (_ - _ + _)%Z); apply (Z.le_trans _ n); [unfold n; omega|]. +unfold FLT_exp; rewrite Z.max_l; [|lia]; rewrite <- Z.add_max_distr_r. +set (n := (_ - _ + _)%Z); apply (Z.le_trans _ n); [unfold n; lia|]. apply Z.le_max_l. Qed. +Lemma mult_bpow_pos_exact_FLT : + forall x e, + format x -> + (0 <= e)%Z -> + format (x * bpow e)%R. +Proof. +intros x e Fx He. +destruct (Req_dec x 0) as [Zx|Nzx]. +{ rewrite Zx, Rmult_0_l; apply generic_format_0. } +rewrite Fx. +set (mx := Ztrunc _); set (ex := cexp _). +pose (f := {| Fnum := mx; Fexp := ex + e |} : float beta). +apply (generic_format_F2R' _ _ _ f). +{ now unfold F2R; simpl; rewrite bpow_plus, Rmult_assoc. } +intro Nzmx; unfold mx, ex; rewrite <- Fx. +unfold f, ex; simpl; unfold cexp; rewrite (mag_mult_bpow _ _ _ Nzx). +unfold FLT_exp; rewrite <-Z.add_max_distr_r. +replace (_ - _ + e)%Z with (mag beta x + e - prec)%Z; [ |ring]. +apply Z.max_le_compat_l; lia. +Qed. + End Fprop_mult_error_FLT. diff --git a/flocq/Prop/Plus_error.v b/flocq/Prop/Plus_error.v index 42f80093..514d3aab 100644 --- a/flocq/Prop/Plus_error.v +++ b/flocq/Prop/Plus_error.v @@ -50,19 +50,19 @@ destruct (Zle_or_lt e' e) as [He|He]. exists m. unfold F2R at 2. simpl. rewrite Rmult_assoc, <- bpow_plus. -rewrite <- IZR_Zpower. 2: omega. +rewrite <- IZR_Zpower by lia. rewrite <- mult_IZR, Zrnd_IZR... unfold F2R. simpl. rewrite mult_IZR. rewrite Rmult_assoc. -rewrite IZR_Zpower. 2: omega. +rewrite IZR_Zpower by lia. rewrite <- bpow_plus. apply (f_equal (fun v => IZR m * bpow v)%R). ring. exists ((rnd (IZR m * bpow (e - e'))) * Zpower beta (e' - e))%Z. unfold F2R. simpl. rewrite mult_IZR. -rewrite IZR_Zpower. 2: omega. +rewrite IZR_Zpower by lia. rewrite 2!Rmult_assoc. rewrite <- 2!bpow_plus. apply (f_equal (fun v => _ * bpow v)%R). @@ -326,8 +326,7 @@ exists (Ztrunc (scaled_mantissa beta fexp x)*Zpower beta (cexp x -e))%Z. rewrite Fx at 1; unfold F2R; simpl. rewrite mult_IZR, Rmult_assoc. f_equal. -rewrite IZR_Zpower. -2: omega. +rewrite IZR_Zpower by lia. rewrite <- bpow_plus; f_equal; ring. Qed. @@ -351,7 +350,7 @@ case (Zle_or_lt (mag beta (x/IZR beta)) (mag beta y)); intros H1. pose (e:=cexp (x / IZR beta)). destruct (ex_shift x e) as (nx, Hnx); try exact Fx. apply monotone_exp. -rewrite <- (mag_minus1 x Zx); omega. +rewrite <- (mag_minus1 x Zx); lia. destruct (ex_shift y e) as (ny, Hny); try assumption. apply monotone_exp... destruct (round_repr_same_exp beta fexp rnd (nx+ny) e) as (n,Hn). @@ -406,11 +405,11 @@ apply V; left. apply lt_mag with beta. now apply Rabs_pos_lt. rewrite <- mag_minus1 in H1; try assumption. -rewrite 2!mag_abs; omega. +rewrite 2!mag_abs; lia. (* . *) destruct U as [U|U]. rewrite U; apply Z.le_trans with (mag beta x). -omega. +lia. rewrite <- mag_abs. apply mag_le. now apply Rabs_pos_lt. @@ -424,13 +423,13 @@ now apply Rabs_pos_lt. rewrite 2!mag_abs. assert (mag beta y < mag beta x - 1)%Z. now rewrite (mag_minus1 x Zx). -omega. +lia. apply cexp_round_ge... apply round_plus_neq_0... contradict H1; apply Zle_not_lt. rewrite <- (mag_minus1 x Zx). replace y with (-x)%R. -rewrite mag_opp; omega. +rewrite mag_opp; lia. lra. now exists n. Qed. @@ -520,7 +519,7 @@ rewrite <- mag_minus1; try assumption. unfold FLT_exp; apply bpow_le. apply Z.le_trans with (2:=Z.le_max_l _ _). destruct (mag beta x) as (n,Hn); simpl. -assert (e + prec < n)%Z; try omega. +assert (e + prec < n)%Z; try lia. apply lt_bpow with beta. apply Rle_lt_trans with (1:=He). now apply Hn. @@ -568,7 +567,7 @@ unfold cexp. rewrite <- mag_minus1 by easy. unfold FLX_exp; apply bpow_le. destruct (mag beta x) as (n,Hn); simpl. -assert (e + prec < n)%Z; try omega. +assert (e + prec < n)%Z; try lia. apply lt_bpow with beta. apply Rle_lt_trans with (1:=He). now apply Hn. diff --git a/flocq/Prop/Relative.v b/flocq/Prop/Relative.v index 5f87bd84..6b8e8f77 100644 --- a/flocq/Prop/Relative.v +++ b/flocq/Prop/Relative.v @@ -147,7 +147,7 @@ apply (lt_bpow beta). apply Rle_lt_trans with (2 := proj2 He). exact Hx. generalize (Hmin ex). -omega. +lia. apply Rmult_le_compat_l. apply bpow_ge_0. apply He. @@ -218,7 +218,7 @@ apply Rle_trans with (bpow (-p + 1) * bpow (ex - 1))%R. rewrite <- bpow_plus. apply bpow_le. generalize (Hmin ex). -omega. +lia. apply Rmult_le_compat_l. apply bpow_ge_0. generalize He. @@ -230,7 +230,7 @@ now apply round_le. apply generic_format_bpow. ring_simplify (ex - 1 + 1)%Z. generalize (Hmin ex). -omega. +lia. Qed. Theorem relative_error_round_F2R_emin : @@ -283,7 +283,7 @@ apply (lt_bpow beta). apply Rle_lt_trans with (2 := proj2 He). exact Hx. generalize (Hmin ex). -omega. +lia. apply Rmult_le_compat_l. apply bpow_ge_0. apply He. @@ -375,7 +375,7 @@ apply Rle_trans with (bpow (-p + 1) * bpow (ex - 1))%R. rewrite <- bpow_plus. apply bpow_le. generalize (Hmin ex). -omega. +lia. apply Rmult_le_compat_l. apply bpow_ge_0. generalize He. @@ -387,7 +387,7 @@ now apply round_le. apply generic_format_bpow. ring_simplify (ex - 1 + 1)%Z. generalize (Hmin ex). -omega. +lia. Qed. Theorem relative_error_N_round_F2R_emin : @@ -425,7 +425,7 @@ Lemma relative_error_FLX_aux : Proof. intros k. unfold FLX_exp. -omega. +lia. Qed. Variable rnd : R -> Z. @@ -505,7 +505,7 @@ Proof. unfold u_ro; apply (Rmult_lt_reg_l 2); [lra|]. rewrite <-Rmult_assoc, Rinv_r, Rmult_1_l, Rmult_1_r; [|lra]. apply (Rle_lt_trans _ (bpow 0)); - [apply bpow_le; omega|simpl; lra]. + [apply bpow_le; lia|simpl; lra]. Qed. Lemma u_rod1pu_ro_pos : (0 <= u_ro / (1 + u_ro))%R. @@ -659,7 +659,7 @@ Proof. intros k Hk. unfold FLT_exp. generalize (Zmax_spec (k - prec) emin). -omega. +lia. Qed. Variable rnd : R -> Z. @@ -843,7 +843,7 @@ destruct relative_error_N_ex with (FLT_exp emin prec) (emin+prec)%Z prec choice as (eps,(Heps1,Heps2)). now apply FLT_exp_valid. intros; unfold FLT_exp. -rewrite Zmax_left; omega. +lia. rewrite Rabs_right;[assumption|apply Rle_ge; now left]. exists eps; exists 0%R. split;[assumption|split]. @@ -869,14 +869,14 @@ rewrite ulp_neq_0. apply bpow_le. unfold FLT_exp, cexp. rewrite Zmax_right. -omega. +lia. destruct (mag beta x) as (e,He); simpl. assert (e-1 < emin+prec)%Z. apply (lt_bpow beta). apply Rle_lt_trans with (2:=Hx). rewrite <- (Rabs_pos_eq x) by now apply Rlt_le. now apply He, Rgt_not_eq. -omega. +lia. split ; ring. Qed. diff --git a/flocq/Prop/Round_odd.v b/flocq/Prop/Round_odd.v index df2952cc..a433c381 100644 --- a/flocq/Prop/Round_odd.v +++ b/flocq/Prop/Round_odd.v @@ -68,7 +68,7 @@ assert (H0:(Zfloor x <= Zfloor y)%Z) by now apply Zfloor_le. case (Zle_lt_or_eq _ _ H0); intros H1. apply Rle_trans with (1:=Zceil_ub _). rewrite Zceil_floor_neq. -apply IZR_le; omega. +apply IZR_le; lia. now apply sym_not_eq. contradict Hy2. rewrite <- H1, Hx2; discriminate. @@ -503,7 +503,7 @@ Proof. intros x Hx. apply generic_inclusion_mag with fexp; trivial; intros Hx2. generalize (fexpe_fexp (mag beta x)). -omega. +lia. Qed. @@ -525,7 +525,7 @@ rewrite Rmult_assoc, <- bpow_plus. rewrite <- Hg1; unfold F2R. apply f_equal, f_equal. ring. -omega. +lia. split; trivial. split. unfold canonical, cexp. @@ -536,7 +536,7 @@ rewrite Z.even_pow. rewrite Even_beta. apply Bool.orb_true_intro. now right. -omega. +lia. Qed. @@ -713,7 +713,7 @@ rewrite Zmult_1_r; apply Rinv_le. exact Rlt_0_2. apply IZR_le. specialize (radix_gt_1 beta). -omega. +lia. apply Rlt_le_trans with (bpow (fexp e)*1)%R. 2: right; ring. unfold Rdiv; apply Rmult_lt_compat_l. @@ -766,7 +766,7 @@ rewrite Zplus_comm; unfold Zminus; apply f_equal2. rewrite Fexp_Fplus. rewrite Z.min_l. now rewrite Fexp_d. -rewrite Hu'2; omega. +rewrite Hu'2; lia. Qed. Lemma m_eq_0: (0 = F2R d)%R -> exists f:float beta, @@ -797,7 +797,7 @@ Lemma fexp_m_eq_0: (0 = F2R d)%R -> Proof with auto with typeclass_instances. intros Y. assert ((fexp (mag beta (F2R u) - 1) <= fexp (mag beta (F2R u))))%Z. -2: omega. +2: lia. destruct (mag beta x) as (e,He). rewrite Rabs_right in He. 2: now left. @@ -812,8 +812,8 @@ ring_simplify (fexp e + 1 - 1)%Z. replace (fexp (fexp e)) with (fexp e). case exists_NE_; intros V. contradict V; rewrite Even_beta; discriminate. -rewrite (proj2 (V e)); omega. -apply sym_eq, valid_exp; omega. +rewrite (proj2 (V e)); lia. +apply sym_eq, valid_exp; lia. Qed. Lemma Fm: generic_format beta fexpe m. @@ -829,7 +829,7 @@ rewrite <- Fexp_d; trivial. rewrite Cd. unfold cexp. generalize (fexpe_fexp (mag beta (F2R d))). -omega. +lia. (* *) destruct m_eq_0 as (g,(Hg1,Hg2)); trivial. apply generic_format_F2R' with g. @@ -838,7 +838,7 @@ intros H; unfold cexp; rewrite Hg2. rewrite mag_m_0; try assumption. apply Z.le_trans with (1:=fexpe_fexp _). generalize (fexp_m_eq_0 Y). -omega. +lia. Qed. @@ -857,7 +857,7 @@ rewrite <- Fexp_d; trivial. rewrite Cd. unfold cexp. generalize (fexpe_fexp (mag beta (F2R d))). -omega. +lia. (* *) destruct m_eq_0 as (g,(Hg1,Hg2)); trivial. apply exists_even_fexp_lt. @@ -866,7 +866,7 @@ rewrite Hg2. rewrite mag_m_0; trivial. apply Z.le_lt_trans with (1:=fexpe_fexp _). generalize (fexp_m_eq_0 Y). -omega. +lia. Qed. @@ -952,7 +952,7 @@ eexists; split. apply sym_eq, Y. simpl; unfold cexp. apply Z.le_lt_trans with (1:=fexpe_fexp _). -omega. +lia. absurd (true=false). discriminate. rewrite <- Hk3, <- Hk'3. @@ -1105,14 +1105,14 @@ intros _; rewrite Zx, round_0... destruct (mag beta x) as (e,He); simpl; intros H. apply mag_unique; split. apply abs_round_ge_generic... -apply FLT_format_bpow... -auto with zarith. +apply generic_format_FLT_bpow... +now apply Z.lt_le_pred. now apply He. assert (V: (Rabs (round beta (FLT_exp emin prec) Zrnd_odd x) <= bpow beta e)%R). apply abs_round_le_generic... -apply FLT_format_bpow... -auto with zarith. +apply generic_format_FLT_bpow... +now apply Zlt_le_weak. left; now apply He. case V; try easy; intros K. assert (H0:Rnd_odd_pt beta (FLT_exp emin prec) x (round beta (FLT_exp emin prec) Zrnd_odd x)). diff --git a/flocq/Prop/Sterbenz.v b/flocq/Prop/Sterbenz.v index 746b7026..9594ac5d 100644 --- a/flocq/Prop/Sterbenz.v +++ b/flocq/Prop/Sterbenz.v @@ -67,7 +67,7 @@ rewrite <- F2R_plus. apply generic_format_F2R. intros _. case_eq (Fplus fx fy). -intros mxy exy Pxy. +intros mxy exy Pxy; simpl. rewrite <- Pxy, F2R_plus, <- Hx, <- Hy. unfold cexp. replace exy with (fexp (Z.min ex ey)). diff --git a/flocq/Version.v b/flocq/Version.v index d0e36a57..aebb0d76 100644 --- a/flocq/Version.v +++ b/flocq/Version.v @@ -29,4 +29,4 @@ Definition Flocq_version := Eval vm_compute in parse t major (minor * 10 + N_of_ascii h - N_of_ascii "0"%char)%N | Empty_string => (major * 100 + minor)%N end in - parse "3.1.0"%string N0 N0. + parse "3.4.0"%string N0 N0. diff --git a/kvx/Asmexpand.ml b/kvx/Asmexpand.ml index 1e76a355..35c980bb 100644 --- a/kvx/Asmexpand.ml +++ b/kvx/Asmexpand.ml @@ -103,7 +103,7 @@ let fixup_variadic_call pos tyl = assert false *) let fixup_call sg = - if sg.sig_cc.cc_vararg then fixup_variadic_call 0 sg.sig_args + if sg.sig_cc.cc_vararg <> None then fixup_variadic_call 0 sg.sig_args (* Handling of annotations *) @@ -501,7 +501,7 @@ let expand_instruction instr = | Pallocframe (sz, ofs) -> let sg = get_current_function_sig() in emit (Pmv (Asmvliw.GPR17, stack_pointer)); - if sg.sig_cc.cc_vararg then begin + if sg.sig_cc.cc_vararg <> None then begin let n = arguments_size sg in let extra_sz = if n >= _nbregargs_ then 0 else (* align _alignment_ *) ((_nbregargs_ - n) * wordsize) in let full_sz = Z.add sz (Z.of_uint extra_sz) in @@ -524,7 +524,7 @@ let expand_instruction instr = | Pfreeframe (sz, ofs) -> let sg = get_current_function_sig() in let extra_sz = - if sg.sig_cc.cc_vararg then begin + if sg.sig_cc.cc_vararg <> None then begin let n = arguments_size sg in if n >= _nbregargs_ then 0 else (* align _alignment_ *) ((_nbregargs_ - n) * wordsize) end else 0 in diff --git a/kvx/Conventions1.v b/kvx/Conventions1.v index 0b2cf406..d8eff34e 100644 --- a/kvx/Conventions1.v +++ b/kvx/Conventions1.v @@ -240,11 +240,18 @@ Fixpoint loc_arguments_rec (va: bool) *) end. +(* FIX Sylvain: not sure to understand what I have done... *) +Definition has_va (s: signature) : bool := + match s.(sig_cc).(cc_vararg) with + | Some n => true + | None => false + end. + (** [loc_arguments s] returns the list of locations where to store arguments when calling a function with signature [s]. *) Definition loc_arguments (s: signature) : list (rpair loc) := - loc_arguments_rec s.(sig_cc).(cc_vararg) s.(sig_args) 0 0. + loc_arguments_rec (has_va s) s.(sig_args) 0 0. (** [size_arguments s] returns the number of [Outgoing] slots used to call a function with signature [s]. *) @@ -287,11 +294,11 @@ Proof. assert (AL: forall ofs ty, ofs >= 0 -> align ofs (typealign ty) >= 0). { intros. assert (ofs <= align ofs (typealign ty)) by (apply align_le; apply typealign_pos). - omega. } + lia. } assert (SK: (if Archi.ptr64 then 2 else 1) > 0). - { destruct Archi.ptr64; omega. } + { destruct Archi.ptr64; lia. } assert (SKK: forall ty, (if Archi.ptr64 then 2 else typesize ty) > 0). - { intros. destruct Archi.ptr64. omega. apply typesize_pos. } + { intros. destruct Archi.ptr64. lia. apply typesize_pos. } assert (A: forall regs rn ofs ty f, OKREGS regs -> OKF f -> ofs >= 0 -> OK (one_arg regs rn ofs ty f)). { intros until f; intros OR OF OO; red; unfold one_arg; intros. @@ -300,7 +307,7 @@ Proof. - eapply OF; eauto. - subst p; cbn. auto using align_divides, typealign_pos. - eapply OF; [idtac|eauto]. - generalize (AL ofs ty OO) (SKK ty); omega. + generalize (AL ofs ty OO) (SKK ty); lia. } assert (B: forall regs rn ofs f, OKREGS regs -> OKF f -> ofs >= 0 -> OK (two_args regs rn ofs f)). @@ -312,8 +319,8 @@ Proof. :: f rn' (ofs' + 2))). { red; cbn; intros. destruct H. - subst p; cbn. - repeat split; auto using Z.divide_1_l. omega. - - eapply OF; [idtac|eauto]. omega. + repeat split; auto using Z.divide_1_l. lia. + - eapply OF; [idtac|eauto]. lia. } destruct (list_nth_z regs rn') as [r1|] eqn:NTH1; destruct (list_nth_z regs (rn' + 1)) as [r2|] eqn:NTH2; @@ -330,7 +337,7 @@ Proof. - subst p; cbn. apply OR. eapply list_nth_z_in; eauto. - eapply OF; eauto. - subst p; cbn. rewrite OTY. split. apply (AL ofs Tlong OO). apply Z.divide_1_l. - - eapply OF; [idtac|eauto]. generalize (AL ofs Tlong OO); cbn; omega. + - eapply OF; [idtac|eauto]. generalize (AL ofs Tlong OO); cbn; lia. } assert (D: OKREGS param_regs). { red. decide_goal. } @@ -359,7 +366,7 @@ Lemma loc_arguments_acceptable: forall (s: signature) (p: rpair loc), In p (loc_arguments s) -> forall_rpair loc_argument_acceptable p. Proof. - unfold loc_arguments; intros. eapply loc_arguments_rec_charact; eauto. omega. + unfold loc_arguments; intros. eapply loc_arguments_rec_charact; eauto. lia. Qed. (** The offsets of [Outgoing] arguments are below [size_arguments s]. *) @@ -368,9 +375,9 @@ Remark fold_max_outgoing_above: forall l n, fold_left max_outgoing_2 l n >= n. Proof. assert (A: forall n l, max_outgoing_1 n l >= n). - { intros; unfold max_outgoing_1. destruct l as [_ | []]; xomega. } + { intros; unfold max_outgoing_1. destruct l as [_ | []]; lia. } induction l; cbn; intros. - - omega. + - lia. - eapply Zge_trans. eauto. destruct a; cbn. apply A. eapply Zge_trans; eauto. Qed. @@ -388,14 +395,14 @@ Lemma loc_arguments_bounded: Proof. intros until ty. assert (A: forall n l, n <= max_outgoing_1 n l). - { intros; unfold max_outgoing_1. destruct l as [_ | []]; xomega. } + { intros; unfold max_outgoing_1. destruct l as [_ | []]; lia. } assert (B: forall p n, In (S Outgoing ofs ty) (regs_of_rpair p) -> ofs + typesize ty <= max_outgoing_2 n p). { intros. destruct p; cbn in H; intuition; subst; cbn. - - xomega. - - eapply Z.le_trans. 2: apply A. xomega. - - xomega. } + - lia. + - eapply Z.le_trans. 2: apply A. lia. + - lia. } assert (C: forall l n, In (S Outgoing ofs ty) (regs_of_rpairs l) -> ofs + typesize ty <= fold_left max_outgoing_2 l n). @@ -415,4 +422,10 @@ Proof. Qed. -Definition return_value_needs_normalization (t: rettype) : bool := false. +(** ** Normalization of function results and parameters *) + +(** No normalization needed. *) + +Definition return_value_needs_normalization (t: rettype): bool := false. +Definition parameter_needs_normalization (t: rettype): bool := false. + diff --git a/kvx/TargetPrinter.ml b/kvx/TargetPrinter.ml index 5b6230ca..9e2e3776 100644 --- a/kvx/TargetPrinter.ml +++ b/kvx/TargetPrinter.ml @@ -201,14 +201,16 @@ module Target (*: TARGET*) = let name_of_section = function | Section_text -> ".text" - | Section_data(true, true) -> + | Section_data(Init, true) -> ".section .tdata,\"awT\",@progbits" - | Section_data(false, true) -> + | Section_data(Uninit, true) -> ".section .tbss,\"awT\",@nobits" + | Section_data(Init_reloc, true) -> + failwith "Sylvain does not how to fix this" | Section_data(i, false) | Section_small_data(i) -> - (if i then ".data" else "COMM") + variable_section ~sec:".data" ~bss:".bss" i | Section_const i | Section_small_const i -> - if i then ".section .rodata" else "COMM" + variable_section ~sec:".section .rodata" i | Section_string -> ".section .rodata" | Section_literal -> ".section .rodata" | Section_jumptable -> ".section .rodata" diff --git a/lib/Coqlib.v b/lib/Coqlib.v index 7a7261a3..cdfbcdce 100644 --- a/lib/Coqlib.v +++ b/lib/Coqlib.v @@ -22,6 +22,7 @@ Require Export ZArith. Require Export Znumtheory. Require Export List. Require Export Bool. +Require Export Lia. Global Set Asymmetric Patterns. @@ -45,11 +46,7 @@ Ltac decEq := cut (A <> B); [intro; congruence | try discriminate] end. -Ltac byContradiction := - cut False; [contradiction|idtac]. - -Ltac omegaContradiction := - cut False; [contradiction|omega]. +Ltac byContradiction := exfalso. Lemma modusponens: forall (P Q: Prop), P -> (P -> Q) -> Q. Proof. auto. Qed. @@ -119,7 +116,7 @@ Lemma Plt_ne: Proof. unfold Plt; intros. red; intro. subst y. eelim Pos.lt_irrefl; eauto. Qed. -Hint Resolve Plt_ne: coqlib. +Global Hint Resolve Plt_ne: coqlib. Lemma Plt_trans: forall (x y z: positive), Plt x y -> Plt y z -> Plt x z. @@ -130,14 +127,14 @@ Lemma Plt_succ: Proof. unfold Plt; intros. apply Pos.lt_succ_r. apply Pos.le_refl. Qed. -Hint Resolve Plt_succ: coqlib. +Global Hint Resolve Plt_succ: coqlib. Lemma Plt_trans_succ: forall (x y: positive), Plt x y -> Plt x (Pos.succ y). Proof. intros. apply Plt_trans with y. assumption. apply Plt_succ. Qed. -Hint Resolve Plt_succ: coqlib. +Global Hint Resolve Plt_succ: coqlib. Lemma Plt_succ_inv: forall (x y: positive), Plt x (Pos.succ y) -> Plt x y \/ x = y. @@ -178,10 +175,9 @@ Proof (Pos.lt_le_trans). Lemma Plt_strict: forall p, ~ Plt p p. Proof (Pos.lt_irrefl). -Hint Resolve Ple_refl Plt_Ple Ple_succ Plt_strict: coqlib. +Global Hint Resolve Ple_refl Plt_Ple Ple_succ Plt_strict: coqlib. -Ltac xomega := unfold Plt, Ple in *; zify; omega. -Ltac xomegaContradiction := exfalso; xomega. +Ltac extlia := unfold Plt, Ple in *; lia. (** Peano recursion over positive numbers. *) @@ -284,7 +280,7 @@ Lemma zlt_true: Proof. intros. case (zlt x y); intros. auto. - omegaContradiction. + extlia. Qed. Lemma zlt_false: @@ -292,7 +288,7 @@ Lemma zlt_false: x >= y -> (if zlt x y then a else b) = b. Proof. intros. case (zlt x y); intros. - omegaContradiction. + extlia. auto. Qed. @@ -304,7 +300,7 @@ Lemma zle_true: Proof. intros. case (zle x y); intros. auto. - omegaContradiction. + extlia. Qed. Lemma zle_false: @@ -312,7 +308,7 @@ Lemma zle_false: x > y -> (if zle x y then a else b) = b. Proof. intros. case (zle x y); intros. - omegaContradiction. + extlia. auto. Qed. @@ -323,54 +319,54 @@ Proof. reflexivity. Qed. Lemma two_power_nat_pos : forall n : nat, two_power_nat n > 0. Proof. - induction n. rewrite two_power_nat_O. omega. - rewrite two_power_nat_S. omega. + induction n. rewrite two_power_nat_O. lia. + rewrite two_power_nat_S. lia. Qed. Lemma two_power_nat_two_p: forall x, two_power_nat x = two_p (Z.of_nat x). Proof. induction x. auto. - rewrite two_power_nat_S. rewrite Nat2Z.inj_succ. rewrite two_p_S. omega. omega. + rewrite two_power_nat_S. rewrite Nat2Z.inj_succ. rewrite two_p_S. lia. lia. Qed. Lemma two_p_monotone: forall x y, 0 <= x <= y -> two_p x <= two_p y. Proof. intros. - replace (two_p x) with (two_p x * 1) by omega. - replace y with (x + (y - x)) by omega. - rewrite two_p_is_exp; try omega. + replace (two_p x) with (two_p x * 1) by lia. + replace y with (x + (y - x)) by lia. + rewrite two_p_is_exp; try lia. apply Zmult_le_compat_l. - assert (two_p (y - x) > 0). apply two_p_gt_ZERO. omega. omega. - assert (two_p x > 0). apply two_p_gt_ZERO. omega. omega. + assert (two_p (y - x) > 0). apply two_p_gt_ZERO. lia. lia. + assert (two_p x > 0). apply two_p_gt_ZERO. lia. lia. Qed. Lemma two_p_monotone_strict: forall x y, 0 <= x < y -> two_p x < two_p y. Proof. - intros. assert (two_p x <= two_p (y - 1)). apply two_p_monotone; omega. - assert (two_p (y - 1) > 0). apply two_p_gt_ZERO. omega. - replace y with (Z.succ (y - 1)) by omega. rewrite two_p_S. omega. omega. + intros. assert (two_p x <= two_p (y - 1)). apply two_p_monotone; lia. + assert (two_p (y - 1) > 0). apply two_p_gt_ZERO. lia. + replace y with (Z.succ (y - 1)) by lia. rewrite two_p_S. lia. lia. Qed. Lemma two_p_strict: forall x, x >= 0 -> x < two_p x. Proof. intros x0 GT. pattern x0. apply natlike_ind. - simpl. omega. - intros. rewrite two_p_S; auto. generalize (two_p_gt_ZERO x H). omega. - omega. + simpl. lia. + intros. rewrite two_p_S; auto. generalize (two_p_gt_ZERO x H). lia. + lia. Qed. Lemma two_p_strict_2: forall x, x >= 0 -> 2 * x - 1 < two_p x. Proof. - intros. assert (x = 0 \/ x - 1 >= 0) by omega. destruct H0. + intros. assert (x = 0 \/ x - 1 >= 0) by lia. destruct H0. subst. vm_compute. auto. replace (two_p x) with (2 * two_p (x - 1)). - generalize (two_p_strict _ H0). omega. - rewrite <- two_p_S. decEq. omega. omega. + generalize (two_p_strict _ H0). lia. + rewrite <- two_p_S. decEq. lia. lia. Qed. (** Properties of [Zmin] and [Zmax] *) @@ -401,12 +397,12 @@ Qed. Lemma Zmax_bound_l: forall x y z, x <= y -> x <= Z.max y z. Proof. - intros. generalize (Z.le_max_l y z). omega. + intros. generalize (Z.le_max_l y z). lia. Qed. Lemma Zmax_bound_r: forall x y z, x <= z -> x <= Z.max y z. Proof. - intros. generalize (Z.le_max_r y z). omega. + intros. generalize (Z.le_max_r y z). lia. Qed. (** Properties of Euclidean division and modulus. *) @@ -416,7 +412,7 @@ Lemma Zmod_unique: x = a * y + b -> 0 <= b < y -> x mod y = b. Proof. intros. subst x. rewrite Z.add_comm. - rewrite Z_mod_plus. apply Z.mod_small. auto. omega. + rewrite Z_mod_plus. apply Z.mod_small. auto. lia. Qed. Lemma Zdiv_unique: @@ -424,14 +420,14 @@ Lemma Zdiv_unique: x = a * y + b -> 0 <= b < y -> x / y = a. Proof. intros. subst x. rewrite Z.add_comm. - rewrite Z_div_plus. rewrite (Zdiv_small b y H0). omega. omega. + rewrite Z_div_plus. rewrite (Zdiv_small b y H0). lia. lia. Qed. Lemma Zdiv_Zdiv: forall a b c, b > 0 -> c > 0 -> (a / b) / c = a / (b * c). Proof. - intros. apply Z.div_div; omega. + intros. apply Z.div_div; lia. Qed. Lemma Zdiv_interval_1: @@ -445,14 +441,14 @@ Proof. set (q := a/b) in *. set (r := a mod b) in *. split. assert (lo < (q + 1)). - apply Zmult_lt_reg_r with b. omega. - apply Z.le_lt_trans with a. omega. + apply Zmult_lt_reg_r with b. lia. + apply Z.le_lt_trans with a. lia. replace ((q + 1) * b) with (b * q + b) by ring. - omega. - omega. - apply Zmult_lt_reg_r with b. omega. + lia. + lia. + apply Zmult_lt_reg_r with b. lia. replace (q * b) with (b * q) by ring. - omega. + lia. Qed. Lemma Zdiv_interval_2: @@ -462,13 +458,13 @@ Lemma Zdiv_interval_2: Proof. intros. assert (lo <= a / b < hi+1). - apply Zdiv_interval_1. omega. omega. auto. - assert (lo * b <= lo * 1) by (apply Z.mul_le_mono_nonpos_l; omega). + apply Zdiv_interval_1. lia. lia. auto. + assert (lo * b <= lo * 1) by (apply Z.mul_le_mono_nonpos_l; lia). replace (lo * 1) with lo in H3 by ring. - assert ((hi + 1) * 1 <= (hi + 1) * b) by (apply Z.mul_le_mono_nonneg_l; omega). + assert ((hi + 1) * 1 <= (hi + 1) * b) by (apply Z.mul_le_mono_nonneg_l; lia). replace ((hi + 1) * 1) with (hi + 1) in H4 by ring. - omega. - omega. + lia. + lia. Qed. Lemma Zmod_recombine: @@ -476,7 +472,7 @@ Lemma Zmod_recombine: a > 0 -> b > 0 -> x mod (a * b) = ((x/b) mod a) * b + (x mod b). Proof. - intros. rewrite (Z.mul_comm a b). rewrite Z.rem_mul_r by omega. ring. + intros. rewrite (Z.mul_comm a b). rewrite Z.rem_mul_r by lia. ring. Qed. (** Properties of divisibility. *) @@ -486,9 +482,9 @@ Lemma Zdivide_interval: 0 < c -> 0 <= a < b -> (c | a) -> (c | b) -> 0 <= a <= b - c. Proof. intros. destruct H1 as [x EQ1]. destruct H2 as [y EQ2]. subst. destruct H0. - split. omega. exploit Zmult_lt_reg_r; eauto. intros. + split. lia. exploit Zmult_lt_reg_r; eauto. intros. replace (y * c - c) with ((y - 1) * c) by ring. - apply Zmult_le_compat_r; omega. + apply Zmult_le_compat_r; lia. Qed. (** Conversion from [Z] to [nat]. *) @@ -503,8 +499,8 @@ Lemma Z_to_nat_max: forall z, Z.of_nat (Z.to_nat z) = Z.max z 0. Proof. intros. destruct (zle 0 z). -- rewrite Z2Nat.id by auto. xomega. -- rewrite Z_to_nat_neg by omega. xomega. +- rewrite Z2Nat.id by auto. extlia. +- rewrite Z_to_nat_neg by lia. extlia. Qed. (** Alignment: [align n amount] returns the smallest multiple of [amount] @@ -519,8 +515,8 @@ Proof. generalize (Z_div_mod_eq (x + y - 1) y H). intro. replace ((x + y - 1) / y * y) with ((x + y - 1) - (x + y - 1) mod y). - generalize (Z_mod_lt (x + y - 1) y H). omega. - rewrite Z.mul_comm. omega. + generalize (Z_mod_lt (x + y - 1) y H). lia. + rewrite Z.mul_comm. lia. Qed. Lemma align_divides: forall x y, y > 0 -> (y | align x y). @@ -563,7 +559,7 @@ Definition sum_left_map (A B C: Type) (f: A -> B) (x: A + C) : B + C := (** Properties of [List.nth] (n-th element of a list). *) -Hint Resolve in_eq in_cons: coqlib. +Global Hint Resolve in_eq in_cons: coqlib. Lemma nth_error_in: forall (A: Type) (n: nat) (l: list A) (x: A), @@ -577,14 +573,14 @@ Proof. discriminate. apply in_cons. auto. Qed. -Hint Resolve nth_error_in: coqlib. +Global Hint Resolve nth_error_in: coqlib. Lemma nth_error_nil: forall (A: Type) (idx: nat), nth_error (@nil A) idx = None. Proof. induction idx; simpl; intros; reflexivity. Qed. -Hint Resolve nth_error_nil: coqlib. +Global Hint Resolve nth_error_nil: coqlib. (** Compute the length of a list, with result in [Z]. *) @@ -599,8 +595,8 @@ Remark list_length_z_aux_shift: list_length_z_aux l n = list_length_z_aux l m + (n - m). Proof. induction l; intros; simpl. - omega. - replace (n - m) with (Z.succ n - Z.succ m) by omega. auto. + lia. + replace (n - m) with (Z.succ n - Z.succ m) by lia. auto. Qed. Definition list_length_z (A: Type) (l: list A) : Z := @@ -611,15 +607,15 @@ Lemma list_length_z_cons: list_length_z (hd :: tl) = list_length_z tl + 1. Proof. intros. unfold list_length_z. simpl. - rewrite (list_length_z_aux_shift tl 1 0). omega. + rewrite (list_length_z_aux_shift tl 1 0). lia. Qed. Lemma list_length_z_pos: forall (A: Type) (l: list A), list_length_z l >= 0. Proof. - induction l; simpl. unfold list_length_z; simpl. omega. - rewrite list_length_z_cons. omega. + induction l; simpl. unfold list_length_z; simpl. lia. + rewrite list_length_z_cons. lia. Qed. Lemma list_length_z_map: @@ -663,8 +659,8 @@ Proof. induction l; simpl; intros. discriminate. rewrite list_length_z_cons. destruct (zeq n 0). - generalize (list_length_z_pos l); omega. - exploit IHl; eauto. omega. + generalize (list_length_z_pos l); lia. + exploit IHl; eauto. lia. Qed. (** Properties of [List.incl] (list inclusion). *) @@ -675,7 +671,7 @@ Lemma incl_cons_inv: Proof. unfold incl; intros. apply H. apply in_cons. auto. Qed. -Hint Resolve incl_cons_inv: coqlib. +Global Hint Resolve incl_cons_inv: coqlib. Lemma incl_app_inv_l: forall (A: Type) (l1 l2 m: list A), @@ -691,7 +687,7 @@ Proof. unfold incl; intros. apply H. apply in_or_app. right; assumption. Qed. -Hint Resolve incl_tl incl_refl incl_app_inv_l incl_app_inv_r: coqlib. +Global Hint Resolve incl_tl incl_refl incl_app_inv_l incl_app_inv_r: coqlib. Lemma incl_same_head: forall (A: Type) (x: A) (l1 l2: list A), @@ -1015,6 +1011,14 @@ Proof. generalize list_norepet_app; firstorder. Qed. +Lemma list_norepet_rev: + forall (A: Type) (l: list A), list_norepet l -> list_norepet (List.rev l). +Proof. + induction 1; simpl. +- constructor. +- apply list_norepet_append_commut. simpl. constructor; auto. rewrite <- List.in_rev; auto. +Qed. + (** [is_tail l1 l2] holds iff [l2] is of the form [l ++ l1] for some [l]. *) Inductive is_tail (A: Type): list A -> list A -> Prop := @@ -1038,7 +1042,7 @@ Proof. constructor. constructor. constructor. auto. Qed. -Hint Resolve is_tail_refl is_tail_cons is_tail_in is_tail_cons_left: coqlib. +Global Hint Resolve is_tail_refl is_tail_cons is_tail_in is_tail_cons_left: coqlib. Lemma is_tail_incl: forall (A: Type) (l1 l2: list A), is_tail l1 l2 -> incl l1 l2. @@ -1064,7 +1068,7 @@ Proof. induction l1; cbn; auto with coqlib. intros l2 l3 H; inversion H; eauto with coqlib. Qed. -Hint Resolve is_tail_app_inv: coqlib. +Global Hint Resolve is_tail_app_inv: coqlib. Lemma is_tail_app_right A (l2 l1: list A): is_tail l1 (l2++l1). Proof. @@ -1085,7 +1089,7 @@ Lemma is_tail_bound A (l1 l2: list A): Proof. intros H; destruct (is_tail_app_def H) as (l3 & EQ). subst; rewrite app_length. - omega. + lia. Qed. (** [list_forall2 P [x1 ... xN] [y1 ... yM]] holds iff [N = M] and diff --git a/lib/Decidableplus.v b/lib/Decidableplus.v index 66dffb3a..73f080b6 100644 --- a/lib/Decidableplus.v +++ b/lib/Decidableplus.v @@ -126,14 +126,14 @@ Program Instance Decidable_ge_Z : forall (x y: Z), Decidable (x >= y) := { Decidable_witness := Z.geb x y }. Next Obligation. - rewrite Z.geb_le. intuition omega. + rewrite Z.geb_le. intuition lia. Qed. Program Instance Decidable_gt_Z : forall (x y: Z), Decidable (x > y) := { Decidable_witness := Z.gtb x y }. Next Obligation. - rewrite Z.gtb_lt. intuition omega. + rewrite Z.gtb_lt. intuition lia. Qed. Program Instance Decidable_divides : forall (x y: Z), Decidable (x | y) := { @@ -146,7 +146,7 @@ Next Obligation. destruct (Z.eq_dec x 0). subst x. rewrite Z.mul_0_r in EQ. subst y. reflexivity. assert (k = y / x). - { apply Zdiv_unique_full with 0. red; omega. rewrite EQ; ring. } + { apply Zdiv_unique_full with 0. red; lia. rewrite EQ; ring. } congruence. Qed. diff --git a/lib/Floats.v b/lib/Floats.v index ac67b88c..7be322b6 100644 --- a/lib/Floats.v +++ b/lib/Floats.v @@ -169,7 +169,7 @@ Proof. { apply Digits.Zdigits_le_Zpower. rewrite <- H. rewrite Z.abs_eq; tauto. } destruct (zeq p' 0). - rewrite e. simpl; auto. -- rewrite Z2Pos.id by omega. omega. +- rewrite Z2Pos.id by lia. lia. Qed. (** Transform a Nan payload to a quiet Nan payload. *) @@ -178,7 +178,7 @@ Definition quiet_nan_64_payload (p: positive) := Z.to_pos (P_mod_two_p (Pos.lor p ((iter_nat xO 51 1%positive))) 52%nat). Lemma quiet_nan_64_proof: forall p, nan_pl 53 (quiet_nan_64_payload p) = true. -Proof. intros; apply normalized_nan; auto; omega. Qed. +Proof. intros; apply normalized_nan; auto; lia. Qed. Definition quiet_nan_64 (sp: bool * positive) : {x :float | is_nan _ _ x = true} := let (s, p) := sp in @@ -190,7 +190,7 @@ Definition quiet_nan_32_payload (p: positive) := Z.to_pos (P_mod_two_p (Pos.lor p ((iter_nat xO 22 1%positive))) 23%nat). Lemma quiet_nan_32_proof: forall p, nan_pl 24 (quiet_nan_32_payload p) = true. -Proof. intros; apply normalized_nan; auto; omega. Qed. +Proof. intros; apply normalized_nan; auto; lia. Qed. Definition quiet_nan_32 (sp: bool * positive) : {x :float32 | is_nan _ _ x = true} := let (s, p) := sp in @@ -224,7 +224,7 @@ Proof. rewrite Z.ltb_lt in *. unfold Pos.shiftl_nat, nat_rect, Digits.digits2_pos. fold (Digits.digits2_pos p). - zify; omega. + zify; lia. Qed. Definition expand_nan s p H : {x | is_nan _ _ x = true} := @@ -397,7 +397,7 @@ Ltac smart_omega := compute_this Int64.modulus; compute_this Int64.half_modulus; compute_this Int64.max_unsigned; compute_this (Z.pow_pos 2 1024); compute_this (Z.pow_pos 2 53); compute_this (Z.pow_pos 2 52); compute_this (Z.pow_pos 2 32); - zify; omega. + zify; lia. (** Commutativity properties of addition and multiplication. *) @@ -493,7 +493,7 @@ Proof. intros; unfold of_bits, to_bits, bits_of_b64, b64_of_bits. rewrite Int64.unsigned_repr, binary_float_of_bits_of_binary_float; [reflexivity|]. generalize (bits_of_binary_float_range 52 11 __ __ f). - change (2^(52+11+1)) with (Int64.max_unsigned + 1). omega. + change (2^(52+11+1)) with (Int64.max_unsigned + 1). lia. Qed. Theorem to_of_bits: @@ -537,7 +537,7 @@ Proof. rewrite BofZ_plus by auto. f_equal. unfold Int.ltu in H. destruct zlt in H; try discriminate. - unfold y, Int.sub. rewrite Int.signed_repr. omega. + unfold y, Int.sub. rewrite Int.signed_repr. lia. compute_this (Int.unsigned ox8000_0000); smart_omega. Qed. @@ -559,8 +559,8 @@ Proof. change (Int.and ox7FFF_FFFF ox8000_0000) with Int.zero. rewrite ! Int.and_zero; auto. } assert (RNG: 0 <= Int.unsigned lo < two_p 31). - { unfold lo. change ox7FFF_FFFF with (Int.repr (two_p 31 - 1)). rewrite <- Int.zero_ext_and by omega. - apply Int.zero_ext_range. compute_this Int.zwordsize. omega. } + { unfold lo. change ox7FFF_FFFF with (Int.repr (two_p 31 - 1)). rewrite <- Int.zero_ext_and by lia. + apply Int.zero_ext_range. compute_this Int.zwordsize. lia. } assert (B: forall i, 0 <= i < Int.zwordsize -> Int.testbit ox8000_0000 i = if zeq i 31 then true else false). { intros; unfold Int.testbit. change (Int.unsigned ox8000_0000) with (2^31). destruct (zeq i 31). subst i; auto. apply Z.pow2_bits_false; auto. } @@ -573,12 +573,12 @@ Proof. assert (SU: - Int.signed hi = Int.unsigned hi). { destruct EITHER as [EQ|EQ]; rewrite EQ; reflexivity. } unfold Z.sub; rewrite SU, <- E. - unfold Int.add; rewrite Int.unsigned_repr, Int.signed_eq_unsigned. omega. - - assert (Int.max_signed = two_p 31 - 1) by reflexivity. omega. + unfold Int.add; rewrite Int.unsigned_repr, Int.signed_eq_unsigned. lia. + - assert (Int.max_signed = two_p 31 - 1) by reflexivity. lia. - assert (Int.unsigned hi = 0 \/ Int.unsigned hi = two_p 31) by (destruct EITHER as [EQ|EQ]; rewrite EQ; [left|right]; reflexivity). assert (Int.max_unsigned = two_p 31 + two_p 31 - 1) by reflexivity. - omega. + lia. Qed. Theorem to_intu_to_int_1: @@ -601,14 +601,14 @@ Proof. { rewrite ZofB_correct in C. destruct (is_finite _ _ x) eqn:FINx; congruence. } destruct (zeq p 0). subst p; smart_omega. - destruct (ZofB_range_pos 53 1024 __ __ x p C) as [P Q]. omega. + destruct (ZofB_range_pos 53 1024 __ __ x p C) as [P Q]. lia. assert (CMP: Bcompare _ _ x y = Some Lt). { unfold cmp, cmp_of_comparison, compare in H. destruct (Bcompare _ _ x y) as [[]|]; auto; discriminate. } rewrite Bcompare_correct in CMP by auto. inv CMP. apply Rcompare_Lt_inv in H1. rewrite EQy in H1. assert (p < Int.unsigned ox8000_0000). { apply lt_IZR. apply Rle_lt_trans with (1 := P) (2 := H1). } - change Int.max_signed with (Int.unsigned ox8000_0000 - 1). omega. + change Int.max_signed with (Int.unsigned ox8000_0000 - 1). lia. Qed. Theorem to_intu_to_int_2: @@ -640,7 +640,7 @@ Proof. compute_this (Int.unsigned ox8000_0000). smart_omega. apply Rge_le; auto. } - unfold to_int; rewrite EQ. simpl. unfold Int.sub. rewrite Int.unsigned_repr by omega. auto. + unfold to_int; rewrite EQ. simpl. unfold Int.sub. rewrite Int.unsigned_repr by lia. auto. Qed. (** Conversions from ints to floats can be defined as bitwise manipulations @@ -659,8 +659,8 @@ Proof. - f_equal. rewrite Int64.ofwords_add'. reflexivity. - apply split_join_bits. generalize (Int.unsigned_range x). - compute_this Int.modulus; compute_this (2^52); omega. - compute_this (2^11); omega. + compute_this Int.modulus; compute_this (2^52); lia. + compute_this (2^11); lia. Qed. Lemma from_words_value: @@ -698,7 +698,7 @@ Theorem of_intu_from_words: Proof. intros. pose proof (Int.unsigned_range x). rewrite ! from_words_eq. unfold sub. rewrite BofZ_minus. - unfold of_intu. apply (f_equal (BofZ 53 1024 __ __)). rewrite Int.unsigned_zero. omega. + unfold of_intu. apply (f_equal (BofZ 53 1024 __ __)). rewrite Int.unsigned_zero. lia. apply integer_representable_n; auto; smart_omega. apply integer_representable_n; auto; rewrite Int.unsigned_zero; smart_omega. Qed. @@ -725,7 +725,7 @@ Proof. rewrite ! from_words_eq. rewrite ox8000_0000_signed_unsigned. change (Int.unsigned ox8000_0000) with Int.half_modulus. unfold sub. rewrite BofZ_minus. - unfold of_int. apply f_equal. omega. + unfold of_int. apply f_equal. lia. apply integer_representable_n; auto; smart_omega. apply integer_representable_n; auto; smart_omega. Qed. @@ -741,8 +741,8 @@ Proof. - f_equal. rewrite Int64.ofwords_add'. reflexivity. - apply split_join_bits. generalize (Int.unsigned_range x). - compute_this Int.modulus; compute_this (2^52); omega. - compute_this (2^11); omega. + compute_this Int.modulus; compute_this (2^52); lia. + compute_this (2^11); lia. Qed. Lemma from_words_value': @@ -772,11 +772,11 @@ Proof. destruct (BofZ_representable 53 1024 __ __ (2^84 + Int.unsigned x * 2^32)) as (D & E & F). replace (2^84 + Int.unsigned x * 2^32) with ((2^52 + Int.unsigned x) * 2^32) by ring. - apply integer_representable_n2p; auto. smart_omega. omega. omega. + apply integer_representable_n2p; auto. smart_omega. lia. lia. apply B2R_Bsign_inj; auto. - rewrite A, D. rewrite <- IZR_Zpower by omega. rewrite <- plus_IZR. auto. + rewrite A, D. rewrite <- IZR_Zpower by lia. rewrite <- plus_IZR. auto. rewrite C, F. symmetry. apply Zlt_bool_false. - compute_this (2^84); compute_this (2^32); omega. + compute_this (2^84); compute_this (2^32); lia. Qed. Theorem of_longu_from_words: @@ -803,12 +803,12 @@ Proof. rewrite <- (Int64.ofwords_recompose l) at 1. rewrite Int64.ofwords_add'. fold xh; fold xl. compute_this (two_p 32); compute_this p20; ring. apply integer_representable_n2p; auto. - compute_this p20; smart_omega. omega. omega. + compute_this p20; smart_omega. lia. lia. apply integer_representable_n; auto; smart_omega. replace (2^84 + xh * 2^32) with ((2^52 + xh) * 2^32) by ring. - apply integer_representable_n2p; auto. smart_omega. omega. omega. + apply integer_representable_n2p; auto. smart_omega. lia. lia. change (2^84 + p20 * 2^32) with ((2^52 + 1048576) * 2^32). - apply integer_representable_n2p; auto. omega. omega. + apply integer_representable_n2p; auto. lia. lia. Qed. Theorem of_long_from_words: @@ -837,15 +837,15 @@ Proof. rewrite <- (Int64.ofwords_recompose l) at 1. rewrite Int64.ofwords_add''. fold xh; fold xl. compute_this (two_p 32); ring. apply integer_representable_n2p; auto. - compute_this (2^20); smart_omega. omega. omega. + compute_this (2^20); smart_omega. lia. lia. apply integer_representable_n; auto; smart_omega. replace (2^84 + (xh + Int.half_modulus) * 2^32) with ((2^52 + xh + Int.half_modulus) * 2^32) by (compute_this Int.half_modulus; ring). - apply integer_representable_n2p; auto. smart_omega. omega. omega. + apply integer_representable_n2p; auto. smart_omega. lia. lia. change (2^84 + p * 2^32) with ((2^52 + p) * 2^32). apply integer_representable_n2p; auto. - compute_this p; smart_omega. omega. + compute_this p; smart_omega. lia. Qed. (** Conversions from 64-bit integers can be expressed in terms of @@ -867,7 +867,7 @@ Proof. assert (DECOMP: x = yh * 2^32 + yl). { unfold x. rewrite <- (Int64.ofwords_recompose l). apply Int64.ofwords_add'. } rewrite BofZ_mult. rewrite BofZ_plus. rewrite DECOMP; auto. - apply integer_representable_n2p; auto. smart_omega. omega. omega. + apply integer_representable_n2p; auto. smart_omega. lia. lia. apply integer_representable_n; auto; smart_omega. apply integer_representable_n; auto; smart_omega. apply integer_representable_n; auto; smart_omega. @@ -890,7 +890,7 @@ Proof. assert (DECOMP: x = yh * 2^32 + yl). { unfold x. rewrite <- (Int64.ofwords_recompose l), Int64.ofwords_add''. auto. } rewrite BofZ_mult. rewrite BofZ_plus. rewrite DECOMP; auto. - apply integer_representable_n2p; auto. smart_omega. omega. omega. + apply integer_representable_n2p; auto. smart_omega. lia. lia. apply integer_representable_n; auto; smart_omega. apply integer_representable_n; auto; smart_omega. apply integer_representable_n; auto. compute; intuition congruence. @@ -932,53 +932,53 @@ Proof. { intros; unfold n; autorewrite with ints; auto. rewrite Int64.unsigned_one. rewrite Int64.bits_one. compute_this Int64.zwordsize. destruct (zeq i 0); simpl proj_sumbool. - rewrite zlt_true by omega. rewrite andb_true_r. subst i; auto. + rewrite zlt_true by lia. rewrite andb_true_r. subst i; auto. rewrite andb_false_r, orb_false_r. - destruct (zeq i 63). subst i. apply zlt_false; omega. - apply zlt_true; omega. } + destruct (zeq i 63). subst i. apply zlt_false; lia. + apply zlt_true; lia. } assert (NB2: forall i, 0 <= i -> Z.testbit (Int64.signed n * 2^1) i = if zeq i 0 then false else if zeq i 1 then Int64.testbit x 1 || Int64.testbit x 0 else Int64.testbit x i). - { intros. rewrite Z.mul_pow2_bits by omega. destruct (zeq i 0). - apply Z.testbit_neg_r; omega. - rewrite Int64.bits_signed by omega. compute_this Int64.zwordsize. + { intros. rewrite Z.mul_pow2_bits by lia. destruct (zeq i 0). + apply Z.testbit_neg_r; lia. + rewrite Int64.bits_signed by lia. compute_this Int64.zwordsize. destruct (zlt (i-1) 64). - rewrite NB by omega. destruct (zeq i 1). + rewrite NB by lia. destruct (zeq i 1). subst. rewrite dec_eq_true by auto. auto. - rewrite dec_eq_false by omega. destruct (zeq (i - 1) 63). - symmetry. apply Int64.bits_above. compute_this Int64.zwordsize; omega. - f_equal; omega. - rewrite NB by omega. rewrite dec_eq_false by omega. rewrite dec_eq_true by auto. - rewrite dec_eq_false by omega. symmetry. apply Int64.bits_above. compute_this Int64.zwordsize; omega. + rewrite dec_eq_false by lia. destruct (zeq (i - 1) 63). + symmetry. apply Int64.bits_above. compute_this Int64.zwordsize; lia. + f_equal; lia. + rewrite NB by lia. rewrite dec_eq_false by lia. rewrite dec_eq_true by auto. + rewrite dec_eq_false by lia. symmetry. apply Int64.bits_above. compute_this Int64.zwordsize; lia. } assert (EQ: Int64.signed n * 2 = int_round_odd (Int64.unsigned x) 1). { - symmetry. apply (int_round_odd_bits 53 1024). omega. - intros. rewrite NB2 by omega. replace i with 0 by omega. auto. - rewrite NB2 by omega. rewrite dec_eq_false by omega. rewrite dec_eq_true. + symmetry. apply int_round_odd_bits. lia. + intros. rewrite NB2 by lia. replace i with 0 by lia. auto. + rewrite NB2 by lia. rewrite dec_eq_false by lia. rewrite dec_eq_true. rewrite orb_comm. unfold Int64.testbit. change (2^1) with 2. destruct (Z.testbit (Int64.unsigned x) 0) eqn:B0; - [rewrite Z.testbit_true in B0 by omega|rewrite Z.testbit_false in B0 by omega]; + [rewrite Z.testbit_true in B0 by lia|rewrite Z.testbit_false in B0 by lia]; change (2^0) with 1 in B0; rewrite Zdiv_1_r in B0; rewrite B0; auto. - intros. rewrite NB2 by omega. rewrite ! dec_eq_false by omega. auto. + intros. rewrite NB2 by lia. rewrite ! dec_eq_false by lia. auto. } unfold mul, of_long, of_longu. rewrite BofZ_mult_2p. - change (2^1) with 2. rewrite EQ. apply BofZ_round_odd with (p := 1). -+ omega. ++ lia. + apply Z.le_trans with Int64.modulus; trivial. smart_omega. -+ omega. -+ apply Z.le_trans with (2^63). compute; intuition congruence. xomega. ++ lia. ++ apply Z.le_trans with (2^63). compute; intuition congruence. extlia. - apply Z.le_trans with Int64.modulus; trivial. pose proof (Int64.signed_range n). compute_this Int64.min_signed; compute_this Int64.max_signed; - compute_this Int64.modulus; xomega. + compute_this Int64.modulus; extlia. - assert (2^63 <= int_round_odd (Int64.unsigned x) 1). - { change (2^63) with (int_round_odd (2^63) 1). apply (int_round_odd_le 0 0); omega. } - rewrite <- EQ in H1. compute_this (2^63). compute_this (2^53). xomega. -- omega. + { change (2^63) with (int_round_odd (2^63) 1). apply int_round_odd_le; lia. } + rewrite <- EQ in H1. compute_this (2^63). compute_this (2^53). extlia. +- lia. Qed. (** Conversions to/from 32-bit integers can be implemented by going through 64-bit integers. *) @@ -992,8 +992,8 @@ Proof. intros. exploit ZofB_range_inversion; eauto. intros (A & B & C). unfold ZofB_range; rewrite C. replace (min2 <=? n) with true. replace (n <=? max2) with true. auto. - symmetry; apply Z.leb_le; omega. - symmetry; apply Z.leb_le; omega. + symmetry; apply Z.leb_le; lia. + symmetry; apply Z.leb_le; lia. Qed. Theorem to_int_to_long: @@ -1015,7 +1015,7 @@ Proof. exploit ZofB_range_inversion; eauto. intros (A & B & C). replace (ZofB_range 53 1024 f 0 Int64.max_unsigned) with (Some z). simpl. rewrite Int.unsigned_repr; auto. - symmetry; eapply ZofB_range_widen; eauto. omega. compute; congruence. + symmetry; eapply ZofB_range_widen; eauto. lia. compute; congruence. Qed. Theorem to_intu_to_long: @@ -1244,7 +1244,7 @@ Theorem cmp_double: forall f1 f2 c, cmp c f1 f2 = Float.cmp c (to_double f1) (to_double f2). Proof. unfold cmp, Float.cmp; intros. f_equal. symmetry. apply Bcompare_Bconv_widen. - red; omega. omega. omega. + red; lia. lia. lia. Qed. (** Properties of conversions to/from in-memory representation. @@ -1256,7 +1256,7 @@ Proof. intros; unfold of_bits, to_bits, bits_of_b32, b32_of_bits. rewrite Int.unsigned_repr, binary_float_of_bits_of_binary_float; [reflexivity|]. generalize (bits_of_binary_float_range 23 8 __ __ f). - change (2^(23+8+1)) with (Int.max_unsigned + 1). omega. + change (2^(23+8+1)) with (Int.max_unsigned + 1). lia. Qed. Theorem to_of_bits: @@ -1296,7 +1296,7 @@ Proof. unfold to_int in H. destruct (ZofB_range _ _ f Int.min_signed Int.max_signed) as [n'|] eqn:E; inv H. unfold Float.to_int, to_double, Float.of_single. - erewrite ZofB_range_Bconv; eauto. auto. omega. omega. omega. omega. + erewrite ZofB_range_Bconv; eauto. auto. lia. lia. lia. lia. Qed. Theorem to_intu_double: @@ -1306,7 +1306,7 @@ Proof. unfold to_intu in H. destruct (ZofB_range _ _ f 0 Int.max_unsigned) as [n'|] eqn:E; inv H. unfold Float.to_intu, to_double, Float.of_single. - erewrite ZofB_range_Bconv; eauto. auto. omega. omega. omega. omega. + erewrite ZofB_range_Bconv; eauto. auto. lia. lia. lia. lia. Qed. Theorem to_long_double: @@ -1316,7 +1316,7 @@ Proof. unfold to_long in H. destruct (ZofB_range _ _ f Int64.min_signed Int64.max_signed) as [n'|] eqn:E; inv H. unfold Float.to_long, to_double, Float.of_single. - erewrite ZofB_range_Bconv; eauto. auto. omega. omega. omega. omega. + erewrite ZofB_range_Bconv; eauto. auto. lia. lia. lia. lia. Qed. Theorem to_longu_double: @@ -1326,7 +1326,7 @@ Proof. unfold to_longu in H. destruct (ZofB_range _ _ f 0 Int64.max_unsigned) as [n'|] eqn:E; inv H. unfold Float.to_longu, to_double, Float.of_single. - erewrite ZofB_range_Bconv; eauto. auto. omega. omega. omega. omega. + erewrite ZofB_range_Bconv; eauto. auto. lia. lia. lia. lia. Qed. (** Conversions from 64-bit integers to single-precision floats can be expressed @@ -1341,37 +1341,37 @@ Proof. intros. assert (POS: 0 < 2^p) by (apply (Zpower_gt_0 radix2); auto). assert (A: Z.land n (2^p-1) = n mod 2^p). - { rewrite <- Z.land_ones by auto. f_equal. rewrite Z.ones_equiv. omega. } + { rewrite <- Z.land_ones by auto. f_equal. rewrite Z.ones_equiv. lia. } rewrite A. assert (B: 0 <= n mod 2^p < 2^p). - { apply Z_mod_lt. omega. } + { apply Z_mod_lt. lia. } set (m := n mod 2^p + (2^p-1)) in *. assert (C: m / 2^p = if zeq (n mod 2^p) 0 then 0 else 1). { unfold m. destruct (zeq (n mod 2^p) 0). - rewrite e. apply Z.div_small. omega. - eapply Coqlib.Zdiv_unique with (n mod 2^p - 1). ring. omega. } + rewrite e. apply Z.div_small. lia. + eapply Coqlib.Zdiv_unique with (n mod 2^p - 1). ring. lia. } assert (D: Z.testbit m p = if zeq (n mod 2^p) 0 then false else true). { destruct (zeq (n mod 2^p) 0). apply Z.testbit_false; auto. rewrite C; auto. apply Z.testbit_true; auto. rewrite C; auto. } assert (E: forall i, p < i -> Z.testbit m i = false). - { intros. apply Z.testbit_false. omega. + { intros. apply Z.testbit_false. lia. replace (m / 2^i) with 0. auto. symmetry. apply Z.div_small. - unfold m. split. omega. apply Z.lt_le_trans with (2 * 2^p). omega. - change 2 with (2^1) at 1. rewrite <- (Zpower_plus radix2) by omega. - apply Zpower_le. omega. } + unfold m. split. lia. apply Z.lt_le_trans with (2 * 2^p). lia. + change 2 with (2^1) at 1. rewrite <- (Zpower_plus radix2) by lia. + apply Zpower_le. lia. } assert (F: forall i, 0 <= i -> Z.testbit (-2^p) i = if zlt i p then false else true). { intros. rewrite Z.bits_opp by auto. rewrite <- Z.ones_equiv. destruct (zlt i p). - rewrite Z.ones_spec_low by omega. auto. - rewrite Z.ones_spec_high by omega. auto. } + rewrite Z.ones_spec_low by lia. auto. + rewrite Z.ones_spec_high by lia. auto. } apply int_round_odd_bits; auto. - - intros. rewrite Z.land_spec, F, zlt_true by omega. apply andb_false_r. - - rewrite Z.land_spec, Z.lor_spec, D, F, zlt_false, andb_true_r by omega. + - intros. rewrite Z.land_spec, F, zlt_true by lia. apply andb_false_r. + - rewrite Z.land_spec, Z.lor_spec, D, F, zlt_false, andb_true_r by lia. destruct (Z.eqb (n mod 2^p) 0) eqn:Z. rewrite Z.eqb_eq in Z. rewrite Z, zeq_true. apply orb_false_r. rewrite Z.eqb_neq in Z. rewrite zeq_false by auto. apply orb_true_r. - - intros. rewrite Z.land_spec, Z.lor_spec, E, F, zlt_false, andb_true_r by omega. + - intros. rewrite Z.land_spec, Z.lor_spec, E, F, zlt_false, andb_true_r by lia. apply orb_false_r. Qed. @@ -1380,22 +1380,22 @@ Lemma of_long_round_odd: 2^36 <= Z.abs n < 2^64 -> BofZ 24 128 __ __ n = Bconv _ _ 24 128 __ __ conv_nan mode_NE (BofZ 53 1024 __ __ (Z.land (Z.lor n ((Z.land n 2047) + 2047)) (-2048))). Proof. - intros. rewrite <- (int_round_odd_plus 11) by omega. + intros. rewrite <- (int_round_odd_plus 11) by lia. assert (-2^64 <= int_round_odd n 11). - { change (-2^64) with (int_round_odd (-2^64) 11). apply (int_round_odd_le 0 0); xomega. } + { change (-2^64) with (int_round_odd (-2^64) 11). apply int_round_odd_le; extlia. } assert (int_round_odd n 11 <= 2^64). - { change (2^64) with (int_round_odd (2^64) 11). apply (int_round_odd_le 0 0); xomega. } + { change (2^64) with (int_round_odd (2^64) 11). apply int_round_odd_le; extlia. } rewrite Bconv_BofZ. apply BofZ_round_odd with (p := 11). - omega. - apply Z.le_trans with (2^64). omega. compute; intuition congruence. - omega. + lia. + apply Z.le_trans with (2^64). lia. compute; intuition congruence. + lia. exact (proj1 H). - unfold int_round_odd. apply integer_representable_n2p_wide. auto. omega. + unfold int_round_odd. apply integer_representable_n2p_wide. auto. lia. unfold int_round_odd in H0, H1. split; (apply Zmult_le_reg_r with (2^11); [compute; auto | assumption]). - omega. - omega. + lia. + lia. Qed. Theorem of_longu_double_1: @@ -1404,7 +1404,7 @@ Theorem of_longu_double_1: of_longu n = of_double (Float.of_longu n). Proof. intros. symmetry; apply Bconv_BofZ. apply integer_representable_n; auto. - pose proof (Int64.unsigned_range n); omega. + pose proof (Int64.unsigned_range n); lia. Qed. Theorem of_longu_double_2: @@ -1422,14 +1422,14 @@ Proof. unfold of_double, Float.to_single. instantiate (1 := Float.to_single_nan). f_equal. unfold Float.of_longu. f_equal. set (n' := Z.land (Z.lor (Int64.unsigned n) (Z.land (Int64.unsigned n) 2047 + 2047)) (-2048)). - assert (int_round_odd (Int64.unsigned n) 11 = n') by (apply int_round_odd_plus; omega). + assert (int_round_odd (Int64.unsigned n) 11 = n') by (apply int_round_odd_plus; lia). assert (0 <= n'). - { rewrite <- H1. change 0 with (int_round_odd 0 11). apply (int_round_odd_le 0 0); omega. } + { rewrite <- H1. change 0 with (int_round_odd 0 11). apply int_round_odd_le; lia. } assert (n' < Int64.modulus). { apply Z.le_lt_trans with (int_round_odd (Int64.modulus - 1) 11). - rewrite <- H1. apply (int_round_odd_le 0 0); omega. + rewrite <- H1. apply int_round_odd_le; lia. compute; auto. } - rewrite <- (Int64.unsigned_repr n') by (unfold Int64.max_unsigned; omega). + rewrite <- (Int64.unsigned_repr n') by (unfold Int64.max_unsigned; lia). f_equal. Int64.bit_solve. rewrite Int64.testbit_repr by auto. unfold n'. rewrite Z.land_spec, Z.lor_spec. f_equal. f_equal. unfold Int64.testbit. rewrite Int64.add_unsigned. @@ -1438,11 +1438,11 @@ Proof. Int64.unsigned (Int64.repr 2047))) i). rewrite Int64.testbit_repr by auto. f_equal. f_equal. unfold Int64.and. symmetry. apply Int64.unsigned_repr. change 2047 with (Z.ones 11). - rewrite Z.land_ones by omega. + rewrite Z.land_ones by lia. exploit (Z_mod_lt (Int64.unsigned n) (2^11)). compute; auto. - assert (2^11 < Int64.max_unsigned) by (compute; auto). omega. + assert (2^11 < Int64.max_unsigned) by (compute; auto). lia. apply Int64.same_bits_eqm; auto. exists (-1); auto. - split. xomega. change (2^64) with Int64.modulus. xomega. + split. extlia. change (2^64) with Int64.modulus. extlia. Qed. Theorem of_long_double_1: @@ -1450,7 +1450,7 @@ Theorem of_long_double_1: Z.abs (Int64.signed n) <= 2^53 -> of_long n = of_double (Float.of_long n). Proof. - intros. symmetry; apply Bconv_BofZ. apply integer_representable_n; auto. xomega. + intros. symmetry; apply Bconv_BofZ. apply integer_representable_n; auto. extlia. Qed. Theorem of_long_double_2: @@ -1468,34 +1468,34 @@ Proof. unfold of_double, Float.to_single. instantiate (1 := Float.to_single_nan). f_equal. unfold Float.of_long. f_equal. set (n' := Z.land (Z.lor (Int64.signed n) (Z.land (Int64.signed n) 2047 + 2047)) (-2048)). - assert (int_round_odd (Int64.signed n) 11 = n') by (apply int_round_odd_plus; omega). + assert (int_round_odd (Int64.signed n) 11 = n') by (apply int_round_odd_plus; lia). assert (Int64.min_signed <= n'). - { rewrite <- H1. change Int64.min_signed with (int_round_odd Int64.min_signed 11). apply (int_round_odd_le 0 0); omega. } + { rewrite <- H1. change Int64.min_signed with (int_round_odd Int64.min_signed 11). apply int_round_odd_le; lia. } assert (n' <= Int64.max_signed). { apply Z.le_trans with (int_round_odd Int64.max_signed 11). - rewrite <- H1. apply (int_round_odd_le 0 0); omega. + rewrite <- H1. apply int_round_odd_le; lia. compute; intuition congruence. } - rewrite <- (Int64.signed_repr n') by omega. + rewrite <- (Int64.signed_repr n') by lia. f_equal. Int64.bit_solve. rewrite Int64.testbit_repr by auto. unfold n'. rewrite Z.land_spec, Z.lor_spec. f_equal. f_equal. - rewrite Int64.bits_signed by omega. rewrite zlt_true by omega. auto. + rewrite Int64.bits_signed by lia. rewrite zlt_true by lia. auto. unfold Int64.testbit. rewrite Int64.add_unsigned. fold (Int64.testbit (Int64.repr (Int64.unsigned (Int64.and n (Int64.repr 2047)) + Int64.unsigned (Int64.repr 2047))) i). rewrite Int64.testbit_repr by auto. f_equal. f_equal. unfold Int64.and. change (Int64.unsigned (Int64.repr 2047)) with 2047. - change 2047 with (Z.ones 11). rewrite ! Z.land_ones by omega. + change 2047 with (Z.ones 11). rewrite ! Z.land_ones by lia. rewrite Int64.unsigned_repr. apply eqmod_mod_eq. - apply Z.lt_gt. apply (Zpower_gt_0 radix2); omega. + apply Z.lt_gt. apply (Zpower_gt_0 radix2); lia. apply eqmod_divides with (2^64). apply Int64.eqm_signed_unsigned. exists (2^(64-11)); auto. exploit (Z_mod_lt (Int64.unsigned n) (2^11)). compute; auto. - assert (2^11 < Int64.max_unsigned) by (compute; auto). omega. + assert (2^11 < Int64.max_unsigned) by (compute; auto). lia. apply Int64.same_bits_eqm; auto. exists (-1); auto. split. auto. assert (-2^64 < Int64.min_signed) by (compute; auto). assert (Int64.max_signed < 2^64) by (compute; auto). - xomega. + extlia. Qed. End Float32. diff --git a/lib/HashedSet.v b/lib/HashedSet.v index cb2ee1b2..48798a1b 100644 --- a/lib/HashedSet.v +++ b/lib/HashedSet.v @@ -118,7 +118,7 @@ Proof. destruct i; simpl; reflexivity. Qed. -Hint Resolve gempty : pset. +Global Hint Resolve gempty : pset. Hint Rewrite gempty : pset. Definition node (b0 : pset) (f : bool) (b1 : pset) : pset := @@ -139,7 +139,7 @@ Proof. all: reflexivity. Qed. -Hint Resolve wf_node: pset. +Global Hint Resolve wf_node: pset. Lemma gnode : forall b0 f b1 i, @@ -180,7 +180,7 @@ Proof. Qed. Hint Rewrite add_nonempty : pset. -Hint Resolve add_nonempty : pset. +Global Hint Resolve add_nonempty : pset. Lemma wf_add: forall i s, (iswf s) -> (iswf (add i s)). @@ -194,7 +194,7 @@ Proof. all: intuition. Qed. -Hint Resolve wf_add : pset. +Global Hint Resolve wf_add : pset. Theorem gadds : forall i : positive, @@ -204,7 +204,7 @@ Proof. induction i; destruct s; simpl; auto. Qed. -Hint Resolve gadds : pset. +Global Hint Resolve gadds : pset. Hint Rewrite gadds : pset. Theorem gaddo : @@ -220,7 +220,7 @@ Proof. all: apply gempty. Qed. -Hint Resolve gaddo : pset. +Global Hint Resolve gaddo : pset. Fixpoint remove (i : positive) (s : pset) { struct i } : pset := match i with @@ -290,7 +290,7 @@ Proof. Qed. Hint Rewrite remove_empty : pset. -Hint Resolve remove_empty : pset. +Global Hint Resolve remove_empty : pset. Lemma gremove_noncanon_s : forall i : positive, @@ -310,7 +310,7 @@ Proof. apply gremove_noncanon_s. Qed. -Hint Resolve gremoves : pset. +Global Hint Resolve gremoves : pset. Hint Rewrite gremoves : pset. Lemma gremove_noncanon_o : @@ -337,7 +337,7 @@ Proof. assumption. Qed. -Hint Resolve gremoveo : pset. +Global Hint Resolve gremoveo : pset. Fixpoint union_nonopt (s s' : pset) : pset := match s, s' with @@ -382,7 +382,7 @@ Proof. all: destruct pset_eq; simpl; trivial; discriminate. Qed. -Hint Resolve union_nonempty1 union_nonempty2 : pset. +Global Hint Resolve union_nonempty1 union_nonempty2 : pset. Lemma wf_union : forall s s', (iswf s) -> (iswf s') -> (iswf (union s s')). @@ -403,7 +403,7 @@ Proof. intuition auto with pset. Qed. -Hint Resolve wf_union : pset. +Global Hint Resolve wf_union : pset. Theorem gunion: forall s s' : pset, @@ -463,7 +463,7 @@ Proof. intuition. Qed. -Hint Resolve wf_inter : pset. +Global Hint Resolve wf_inter : pset. Lemma inter_noncanon_same: forall s s' j, (contains (inter s s') j) = (contains (inter_noncanon s s') j). @@ -483,7 +483,7 @@ Proof. apply ginter_noncanon. Qed. -Hint Resolve ginter gunion : pset. +Global Hint Resolve ginter gunion : pset. Hint Rewrite ginter gunion : pset. Fixpoint subtract_noncanon (s s' : pset) : pset := @@ -535,7 +535,7 @@ Proof. intuition. Qed. -Hint Resolve wf_subtract : pset. +Global Hint Resolve wf_subtract : pset. Lemma subtract_noncanon_same: forall s s' j, (contains (subtract s s') j) = (contains (subtract_noncanon s s') j). @@ -555,7 +555,7 @@ Proof. apply gsubtract_noncanon. Qed. -Hint Resolve gsubtract : pset. +Global Hint Resolve gsubtract : pset. Hint Rewrite gsubtract : pset. Lemma wf_is_nonempty : @@ -585,7 +585,7 @@ Proof. assumption. Qed. -Hint Resolve wf_is_nonempty : pset. +Global Hint Resolve wf_is_nonempty : pset. Lemma wf_is_empty1 : forall s, iswf s -> (forall i, (contains s i) = false) -> is_empty s = true. @@ -618,7 +618,7 @@ Proof. assumption. Qed. -Hint Resolve wf_is_empty1 : pset. +Global Hint Resolve wf_is_empty1 : pset. Lemma wf_eq : forall s s', iswf s -> iswf s' -> s <> s' -> @@ -1376,7 +1376,7 @@ Proof. all: assumption. Qed. -Hint Resolve is_subset_spec1 is_subset_spec2 : pset. +Global Hint Resolve is_subset_spec1 is_subset_spec2 : pset. Theorem is_subset_spec: forall s s', @@ -1409,6 +1409,6 @@ Proof. Qed. End PSet. -Hint Resolve PSet.gaddo PSet.gadds PSet.gremoveo PSet.gremoves PSet.gunion PSet.ginter PSet.gsubtract PSet.gfilter PSet.is_subset_spec1 PSet.is_subset_spec2 : pset. +Global Hint Resolve PSet.gaddo PSet.gadds PSet.gremoveo PSet.gremoves PSet.gunion PSet.ginter PSet.gsubtract PSet.gfilter PSet.is_subset_spec1 PSet.is_subset_spec2 : pset. Hint Rewrite PSet.gadds PSet.gremoves PSet.gunion PSet.ginter PSet.gsubtract PSet.gfilter : pset. diff --git a/lib/IEEE754_extra.v b/lib/IEEE754_extra.v index 18313ec1..580d4f90 100644 --- a/lib/IEEE754_extra.v +++ b/lib/IEEE754_extra.v @@ -119,7 +119,7 @@ Definition integer_representable (n: Z): Prop := Let int_upper_bound_eq: 2^emax - 2^(emax - prec) = (2^prec - 1) * 2^(emax - prec). Proof. red in prec_gt_0_. - ring_simplify. rewrite <- (Zpower_plus radix2) by omega. f_equal. f_equal. omega. + ring_simplify. rewrite <- (Zpower_plus radix2) by lia. f_equal. f_equal. lia. Qed. Lemma integer_representable_n2p: @@ -130,14 +130,14 @@ Proof. intros; split. - red in prec_gt_0_. replace (Z.abs (n * 2^p)) with (Z.abs n * 2^p). rewrite int_upper_bound_eq. - apply Zmult_le_compat. zify; omega. apply (Zpower_le radix2); omega. - zify; omega. apply (Zpower_ge_0 radix2). + apply Zmult_le_compat. zify; lia. apply (Zpower_le radix2); lia. + zify; lia. apply (Zpower_ge_0 radix2). rewrite Z.abs_mul. f_equal. rewrite Z.abs_eq. auto. apply (Zpower_ge_0 radix2). - apply generic_format_FLT. exists (Float radix2 n p). unfold F2R; simpl. rewrite <- IZR_Zpower by auto. apply mult_IZR. - simpl; zify; omega. - unfold emin, Fexp; red in prec_gt_0_; omega. + simpl; zify; lia. + unfold emin, Fexp; red in prec_gt_0_; lia. Qed. Lemma integer_representable_2p: @@ -149,19 +149,19 @@ Proof. - red in prec_gt_0_. rewrite Z.abs_eq by (apply (Zpower_ge_0 radix2)). apply Z.le_trans with (2^(emax-1)). - apply (Zpower_le radix2); omega. + apply (Zpower_le radix2); lia. assert (2^emax = 2^(emax-1)*2). - { change 2 with (2^1) at 3. rewrite <- (Zpower_plus radix2) by omega. - f_equal. omega. } + { change 2 with (2^1) at 3. rewrite <- (Zpower_plus radix2) by lia. + f_equal. lia. } assert (2^(emax - prec) <= 2^(emax - 1)). - { apply (Zpower_le radix2). omega. } - omega. + { apply (Zpower_le radix2). lia. } + lia. - red in prec_gt_0_. apply generic_format_FLT. exists (Float radix2 1 p). unfold F2R; simpl. - rewrite Rmult_1_l. rewrite <- IZR_Zpower. auto. omega. - simpl Z.abs. change 1 with (2^0). apply (Zpower_lt radix2). omega. auto. - unfold emin, Fexp; omega. + rewrite Rmult_1_l. rewrite <- IZR_Zpower. auto. lia. + simpl Z.abs. change 1 with (2^0). apply (Zpower_lt radix2). lia. auto. + unfold emin, Fexp; lia. Qed. Lemma integer_representable_opp: @@ -178,12 +178,12 @@ Lemma integer_representable_n2p_wide: Proof. intros. red in prec_gt_0_. destruct (Z.eq_dec n (2^prec)); [idtac | destruct (Z.eq_dec n (-2^prec))]. -- rewrite e. rewrite <- (Zpower_plus radix2) by omega. - apply integer_representable_2p. omega. +- rewrite e. rewrite <- (Zpower_plus radix2) by lia. + apply integer_representable_2p. lia. - rewrite e. rewrite <- Zopp_mult_distr_l. apply integer_representable_opp. - rewrite <- (Zpower_plus radix2) by omega. - apply integer_representable_2p. omega. -- apply integer_representable_n2p; omega. + rewrite <- (Zpower_plus radix2) by lia. + apply integer_representable_2p. lia. +- apply integer_representable_n2p; lia. Qed. Lemma integer_representable_n: @@ -191,7 +191,7 @@ Lemma integer_representable_n: Proof. red in prec_gt_0_. intros. replace n with (n * 2^0) by (change (2^0) with 1; ring). - apply integer_representable_n2p_wide. auto. omega. omega. + apply integer_representable_n2p_wide. auto. lia. lia. Qed. Lemma round_int_no_overflow: @@ -205,14 +205,14 @@ Proof. apply round_le_generic. apply fexp_correct; auto. apply valid_rnd_N. apply generic_format_FLT. exists (Float radix2 (2^prec-1) (emax-prec)). rewrite int_upper_bound_eq. unfold F2R; simpl. - rewrite <- IZR_Zpower by omega. rewrite <- mult_IZR. auto. - assert (0 < 2^prec) by (apply (Zpower_gt_0 radix2); omega). - unfold Fnum; simpl; zify; omega. - unfold emin, Fexp; omega. + rewrite <- IZR_Zpower by lia. rewrite <- mult_IZR. auto. + assert (0 < 2^prec) by (apply (Zpower_gt_0 radix2); lia). + unfold Fnum; simpl; zify; lia. + unfold emin, Fexp; lia. rewrite <- abs_IZR. apply IZR_le. auto. - rewrite <- IZR_Zpower by omega. apply IZR_lt. simpl. - assert (0 < 2^(emax-prec)) by (apply (Zpower_gt_0 radix2); omega). - omega. + rewrite <- IZR_Zpower by lia. apply IZR_lt. simpl. + assert (0 < 2^(emax-prec)) by (apply (Zpower_gt_0 radix2); lia). + lia. apply fexp_correct. auto. Qed. @@ -299,8 +299,8 @@ Proof. { apply round_le_generic. apply fexp_correct. auto. apply valid_rnd_N. apply (integer_representable_opp 1). apply (integer_representable_2p 0). - red in prec_gt_0_; omega. - apply IZR_le; omega. + red in prec_gt_0_; lia. + apply IZR_le; lia. } lra. Qed. @@ -335,7 +335,7 @@ Proof. rewrite R, W, C, F. rewrite Rcompare_IZR. unfold Z.ltb at 3. generalize (Zcompare_spec (p + q) 0); intros SPEC; inversion SPEC; auto. - assert (EITHER: 0 <= p \/ 0 <= q) by omega. + assert (EITHER: 0 <= p \/ 0 <= q) by lia. destruct EITHER; [apply andb_false_intro1 | apply andb_false_intro2]; apply Zlt_bool_false; auto. - intros P (U & V). @@ -343,8 +343,8 @@ Proof. rewrite P, U, C. f_equal. rewrite C, F in V. generalize (Zlt_bool_spec p 0) (Zlt_bool_spec q 0). rewrite <- V. intros SPEC1 SPEC2; inversion SPEC1; inversion SPEC2; try congruence; symmetry. - apply Zlt_bool_true; omega. - apply Zlt_bool_false; omega. + apply Zlt_bool_true; lia. + apply Zlt_bool_false; lia. Qed. Theorem BofZ_minus: @@ -365,7 +365,7 @@ Proof. rewrite R, W, C, F. rewrite Rcompare_IZR. unfold Z.ltb at 3. generalize (Zcompare_spec (p - q) 0); intros SPEC; inversion SPEC; auto. - assert (EITHER: 0 <= p \/ q < 0) by omega. + assert (EITHER: 0 <= p \/ q < 0) by lia. destruct EITHER; [apply andb_false_intro1 | apply andb_false_intro2]. rewrite Zlt_bool_false; auto. rewrite Zlt_bool_true; auto. @@ -375,8 +375,8 @@ Proof. generalize (Zlt_bool_spec p 0) (Zlt_bool_spec q 0). rewrite V. intros SPEC1 SPEC2; inversion SPEC1; inversion SPEC2; symmetry. rewrite <- H3 in H1; discriminate. - apply Zlt_bool_true; omega. - apply Zlt_bool_false; omega. + apply Zlt_bool_true; lia. + apply Zlt_bool_false; lia. rewrite <- H3 in H1; discriminate. Qed. @@ -389,10 +389,10 @@ Proof. intros. assert (SIGN: xorb (p <? 0) (q <? 0) = (p * q <? 0)). { - rewrite (Zlt_bool_false q) by omega. + rewrite (Zlt_bool_false q) by lia. generalize (Zlt_bool_spec p 0); intros SPEC; inversion SPEC; simpl; symmetry. - apply Zlt_bool_true. rewrite Z.mul_comm. apply Z.mul_pos_neg; omega. - apply Zlt_bool_false. apply Zsame_sign_imp; omega. + apply Zlt_bool_true. rewrite Z.mul_comm. apply Z.mul_pos_neg; lia. + apply Zlt_bool_false. apply Zsame_sign_imp; lia. } destruct (BofZ_representable p) as (A & B & C); auto. destruct (BofZ_representable q) as (D & E & F); auto. @@ -420,10 +420,10 @@ Proof. destruct (Z.eq_dec x 0). - subst x. apply BofZ_mult. apply integer_representable_n. - generalize (Zpower_ge_0 radix2 prec). simpl; omega. + generalize (Zpower_ge_0 radix2 prec). simpl; lia. apply integer_representable_2p. auto. apply (Zpower_gt_0 radix2). - omega. + lia. - assert (IZR x <> 0%R) by (apply (IZR_neq _ _ n)). destruct (BofZ_finite x H) as (A & B & C). destruct (BofZ_representable (2^p)) as (D & E & F). @@ -432,16 +432,16 @@ Proof. cexp radix2 fexp (IZR x) + p). { unfold cexp, fexp. rewrite mult_IZR. - change (2^p) with (radix2^p). rewrite IZR_Zpower by omega. + change (2^p) with (radix2^p). rewrite IZR_Zpower by lia. rewrite mag_mult_bpow by auto. assert (prec + 1 <= mag radix2 (IZR x)). { rewrite <- (mag_abs radix2 (IZR x)). rewrite <- (mag_bpow radix2 prec). apply mag_le. - apply bpow_gt_0. rewrite <- IZR_Zpower by (red in prec_gt_0_;omega). + apply bpow_gt_0. rewrite <- IZR_Zpower by (red in prec_gt_0_;lia). rewrite <- abs_IZR. apply IZR_le; auto. } unfold FLT_exp. - unfold emin; red in prec_gt_0_; zify; omega. + unfold emin; red in prec_gt_0_; zify; lia. } assert (forall m, round radix2 fexp m (IZR x) * IZR (2^p) = round radix2 fexp m (IZR (x * 2^p)))%R. @@ -451,11 +451,11 @@ Proof. set (a := IZR x); set (b := bpow radix2 (- cexp radix2 fexp a)). replace (a * IZR (2^p) * (b * bpow radix2 (-p)))%R with (a * b)%R. unfold F2R; simpl. rewrite Rmult_assoc. f_equal. - rewrite bpow_plus. f_equal. apply (IZR_Zpower radix2). omega. + rewrite bpow_plus. f_equal. apply (IZR_Zpower radix2). lia. transitivity ((a * b) * (IZR (2^p) * bpow radix2 (-p)))%R. rewrite (IZR_Zpower radix2). rewrite <- bpow_plus. - replace (p + -p) with 0 by omega. change (bpow radix2 0) with 1%R. ring. - omega. + replace (p + -p) with 0 by lia. change (bpow radix2 0) with 1%R. ring. + lia. ring. } assert (forall m x, @@ -468,11 +468,11 @@ Proof. } assert (xorb (x <? 0) (2^p <? 0) = (x * 2^p <? 0)). { - assert (0 < 2^p) by (apply (Zpower_gt_0 radix2); omega). - rewrite (Zlt_bool_false (2^p)) by omega. rewrite xorb_false_r. + assert (0 < 2^p) by (apply (Zpower_gt_0 radix2); lia). + rewrite (Zlt_bool_false (2^p)) by lia. rewrite xorb_false_r. symmetry. generalize (Zlt_bool_spec x 0); intros SPEC; inversion SPEC. apply Zlt_bool_true. apply Z.mul_neg_pos; auto. - apply Zlt_bool_false. apply Z.mul_nonneg_nonneg; omega. + apply Zlt_bool_false. apply Z.mul_nonneg_nonneg; lia. } generalize (Bmult_correct _ _ _ Hmax nan mode_NE (BofZ x) (BofZ (2^p))) (BofZ_correct (x * 2^p)). @@ -496,10 +496,10 @@ Lemma round_odd_flt: round radix2 fexp (Znearest choice) x. Proof. intros. apply round_N_odd. auto. apply fexp_correct; auto. - apply exists_NE_FLT. right; omega. - apply FLT_exp_valid. red; omega. - apply exists_NE_FLT. right; omega. - unfold fexp, FLT_exp; intros. zify; omega. + apply exists_NE_FLT. right; lia. + apply FLT_exp_valid. red; lia. + apply exists_NE_FLT. right; lia. + unfold fexp, FLT_exp; intros. zify; lia. Qed. Corollary round_odd_fix: @@ -522,8 +522,8 @@ Proof. cexp radix2 (FIX_exp p) x). { unfold cexp, FLT_exp, FIX_exp. - replace (mag radix2 x - prec') with p by (unfold prec'; omega). - apply Z.max_l. unfold emin', emin. red in prec_gt_0_; omega. + replace (mag radix2 x - prec') with p by (unfold prec'; lia). + apply Z.max_l. unfold emin', emin. red in prec_gt_0_; lia. } assert (RND: round radix2 (FIX_exp p) Zrnd_odd x = round radix2 (FLT_exp emin' prec') Zrnd_odd x). @@ -532,9 +532,9 @@ Proof. } rewrite RND. apply round_odd_flt. auto. - unfold prec'. red in prec_gt_0_; omega. - unfold prec'. omega. - unfold emin'. omega. + unfold prec'. red in prec_gt_0_; lia. + unfold prec'. lia. + unfold emin'. lia. Qed. Definition int_round_odd (x: Z) (p: Z) := @@ -545,23 +545,23 @@ Lemma Zrnd_odd_int: Zrnd_odd (IZR n * bpow radix2 (-p)) * 2^p = int_round_odd n p. Proof. - intros. - assert (0 < 2^p) by (apply (Zpower_gt_0 radix2); omega). - assert (n = (n / 2^p) * 2^p + n mod 2^p) by (rewrite Z.mul_comm; apply Z.div_mod; omega). - assert (0 <= n mod 2^p < 2^p) by (apply Z_mod_lt; omega). + clear. intros. + assert (0 < 2^p) by (apply (Zpower_gt_0 radix2); lia). + assert (n = (n / 2^p) * 2^p + n mod 2^p) by (rewrite Z.mul_comm; apply Z.div_mod; lia). + assert (0 <= n mod 2^p < 2^p) by (apply Z_mod_lt; lia). unfold int_round_odd. set (q := n / 2^p) in *; set (r := n mod 2^p) in *. f_equal. pose proof (bpow_gt_0 radix2 (-p)). assert (bpow radix2 p * bpow radix2 (-p) = 1)%R. - { rewrite <- bpow_plus. replace (p + -p) with 0 by omega. auto. } + { rewrite <- bpow_plus. replace (p + -p) with 0 by lia. auto. } assert (IZR n * bpow radix2 (-p) = IZR q + IZR r * bpow radix2 (-p))%R. { rewrite H1. rewrite plus_IZR, mult_IZR. change (IZR (2^p)) with (IZR (radix2^p)). - rewrite IZR_Zpower by omega. ring_simplify. + rewrite IZR_Zpower by lia. ring_simplify. rewrite Rmult_assoc. rewrite H4. ring. } assert (0 <= IZR r < bpow radix2 p)%R. - { split. apply IZR_le; omega. - rewrite <- IZR_Zpower by omega. apply IZR_lt; tauto. } + { split. apply IZR_le; lia. + rewrite <- IZR_Zpower by lia. apply IZR_lt; tauto. } assert (0 <= IZR r * bpow radix2 (-p) < 1)%R. { generalize (bpow_gt_0 radix2 (-p)). intros. split. apply Rmult_le_pos; lra. @@ -586,7 +586,7 @@ Lemma int_round_odd_le: forall p x y, 0 <= p -> x <= y -> int_round_odd x p <= int_round_odd y p. Proof. - intros. + clear. intros. assert (Zrnd_odd (IZR x * bpow radix2 (-p)) <= Zrnd_odd (IZR y * bpow radix2 (-p))). { apply Zrnd_le. apply valid_rnd_odd. apply Rmult_le_compat_r. apply bpow_ge_0. apply IZR_le; auto. } @@ -598,7 +598,7 @@ Lemma int_round_odd_exact: forall p x, 0 <= p -> (2^p | x) -> int_round_odd x p = x. Proof. - intros. unfold int_round_odd. apply Znumtheory.Zdivide_mod in H0. + clear. intros. unfold int_round_odd. apply Znumtheory.Zdivide_mod in H0. rewrite H0. simpl. rewrite Z.mul_comm. symmetry. apply Z_div_exact_2. apply Z.lt_gt. apply (Zpower_gt_0 radix2). auto. auto. Qed. @@ -615,15 +615,15 @@ Proof. assert (DIV: (2^p | 2^emax - 2^(emax - prec))). { rewrite int_upper_bound_eq. apply Z.divide_mul_r. exists (2^(emax - prec - p)). red in prec_gt_0_. - rewrite <- (Zpower_plus radix2) by omega. f_equal; omega. } + rewrite <- (Zpower_plus radix2) by lia. f_equal; lia. } assert (YRANGE: Z.abs (int_round_odd x p) <= 2^emax - 2^(emax-prec)). { apply Z.abs_le. split. replace (-(2^emax - 2^(emax-prec))) with (int_round_odd (-(2^emax - 2^(emax-prec))) p). - apply int_round_odd_le; zify; omega. - apply int_round_odd_exact. omega. apply Z.divide_opp_r. auto. + apply int_round_odd_le; zify; lia. + apply int_round_odd_exact. lia. apply Z.divide_opp_r. auto. replace (2^emax - 2^(emax-prec)) with (int_round_odd (2^emax - 2^(emax-prec)) p). - apply int_round_odd_le; zify; omega. - apply int_round_odd_exact. omega. auto. } + apply int_round_odd_le; zify; lia. + apply int_round_odd_exact. lia. auto. } destruct (BofZ_finite x XRANGE) as (X1 & X2 & X3). destruct (BofZ_finite (int_round_odd x p) YRANGE) as (Y1 & Y2 & Y3). apply BofZ_finite_equal; auto. @@ -631,12 +631,12 @@ Proof. assert (IZR (int_round_odd x p) = round radix2 (FIX_exp p) Zrnd_odd (IZR x)). { unfold round, scaled_mantissa, cexp, FIX_exp. - rewrite <- Zrnd_odd_int by omega. - unfold F2R; simpl. rewrite mult_IZR. f_equal. apply (IZR_Zpower radix2). omega. + rewrite <- Zrnd_odd_int by lia. + unfold F2R; simpl. rewrite mult_IZR. f_equal. apply (IZR_Zpower radix2). lia. } - rewrite H. symmetry. apply round_odd_fix. auto. omega. + rewrite H. symmetry. apply round_odd_fix. auto. lia. rewrite <- IZR_Zpower. rewrite <- abs_IZR. apply IZR_le; auto. - red in prec_gt_0_; omega. + red in prec_gt_0_; lia. Qed. Lemma int_round_odd_shifts: @@ -644,7 +644,7 @@ Lemma int_round_odd_shifts: int_round_odd x p = Z.shiftl (if Z.eqb (x mod 2^p) 0 then Z.shiftr x p else Z.lor (Z.shiftr x p) 1) p. Proof. - intros. + clear. intros. unfold int_round_odd. rewrite Z.shiftl_mul_pow2 by auto. f_equal. rewrite Z.shiftr_div_pow2 by auto. destruct (x mod 2^p =? 0) eqn:E. auto. @@ -662,22 +662,22 @@ Lemma int_round_odd_bits: (forall i, p < i -> Z.testbit y i = Z.testbit x i) -> int_round_odd x p = y. Proof. - intros until p; intros PPOS BELOW AT ABOVE. + clear. intros until p; intros PPOS BELOW AT ABOVE. rewrite int_round_odd_shifts by auto. apply Z.bits_inj'. intros. generalize (Zcompare_spec n p); intros SPEC; inversion SPEC. - rewrite BELOW by auto. apply Z.shiftl_spec_low; auto. -- subst n. rewrite AT. rewrite Z.shiftl_spec_high by omega. - replace (p - p) with 0 by omega. +- subst n. rewrite AT. rewrite Z.shiftl_spec_high by lia. + replace (p - p) with 0 by lia. destruct (x mod 2^p =? 0). - + rewrite Z.shiftr_spec by omega. f_equal; omega. + + rewrite Z.shiftr_spec by lia. f_equal; lia. + rewrite Z.lor_spec. apply orb_true_r. -- rewrite ABOVE by auto. rewrite Z.shiftl_spec_high by omega. +- rewrite ABOVE by auto. rewrite Z.shiftl_spec_high by lia. destruct (x mod 2^p =? 0). - rewrite Z.shiftr_spec by omega. f_equal; omega. - rewrite Z.lor_spec, Z.shiftr_spec by omega. - change 1 with (Z.ones 1). rewrite Z.ones_spec_high by omega. rewrite orb_false_r. - f_equal; omega. + rewrite Z.shiftr_spec by lia. f_equal; lia. + rewrite Z.lor_spec, Z.shiftr_spec by lia. + change 1 with (Z.ones 1). rewrite Z.ones_spec_high by lia. rewrite orb_false_r. + f_equal; lia. Qed. (** ** Conversion from a FP number to an integer *) @@ -709,7 +709,7 @@ Proof. } rewrite EQ. f_equal. generalize (Zpower_pos_gt_0 2 p (eq_refl _)); intros. - rewrite Ztrunc_floor. symmetry. apply Zfloor_div. omega. + rewrite Ztrunc_floor. symmetry. apply Zfloor_div. lia. apply Rmult_le_pos. apply IZR_le. compute; congruence. apply Rlt_le. apply Rinv_0_lt_compat. apply IZR_lt. auto. Qed. @@ -727,7 +727,7 @@ Proof. assert (-x < 0)%R. { apply Rlt_le_trans with (IZR (Zfloor (-x)) + 1)%R. apply Zfloor_ub. rewrite <- plus_IZR. - apply IZR_le. omega. } + apply IZR_le. lia. } lra. Qed. @@ -741,7 +741,7 @@ Proof. - rewrite Ztrunc_ceil in H by (apply Rlt_le; auto). split. + apply (Ropp_lt_cancel (-(1))). rewrite Ropp_involutive. replace 1%R with (IZR (Zfloor (-x)) + 1)%R. apply Zfloor_ub. - unfold Zceil in H. replace (Zfloor (-x)) with 0 by omega. simpl. apply Rplus_0_l. + unfold Zceil in H. replace (Zfloor (-x)) with 0 by lia. simpl. apply Rplus_0_l. + apply Rlt_le_trans with 0%R; auto. apply Rle_0_1. Qed. @@ -758,10 +758,10 @@ Proof. intros. rewrite ZofB_correct in H. destruct (is_finite prec emax f) eqn:FIN; inversion H. set (x := B2R prec emax f) in *. set (y := (-x)%R). assert (A: (IZR (Ztrunc y) <= y < IZR (Ztrunc y + 1)%Z)%R). - { apply Ztrunc_range_pos. unfold y. rewrite Ztrunc_opp. omega. } + { apply Ztrunc_range_pos. unfold y. rewrite Ztrunc_opp. lia. } destruct A as [B C]. unfold y in B, C. rewrite Ztrunc_opp in B, C. - replace (- Ztrunc x + 1) with (- (Ztrunc x - 1)) in C by omega. + replace (- Ztrunc x + 1) with (- (Ztrunc x - 1)) in C by lia. rewrite opp_IZR in B, C. lra. Qed. @@ -777,7 +777,7 @@ Theorem ZofB_range_nonneg: Proof. intros. destruct (Z.eq_dec n 0). - subst n. apply ZofB_range_zero. auto. -- destruct (ZofB_range_pos f n) as (A & B). auto. omega. +- destruct (ZofB_range_pos f n) as (A & B). auto. lia. split; auto. apply Rlt_le_trans with 0%R. simpl; lra. apply Rle_trans with (IZR n); auto. apply IZR_le; auto. Qed. @@ -796,7 +796,7 @@ Qed. Remark Zfloor_minus: forall x n, Zfloor (x - IZR n) = Zfloor x - n. Proof. - intros. apply Zfloor_imp. replace (Zfloor x - n + 1) with ((Zfloor x + 1) - n) by omega. + intros. apply Zfloor_imp. replace (Zfloor x - n + 1) with ((Zfloor x + 1) - n) by lia. rewrite ! minus_IZR. unfold Rminus. split. apply Rplus_le_compat_r. apply Zfloor_lb. apply Rplus_lt_compat_r. rewrite plus_IZR. apply Zfloor_ub. @@ -809,11 +809,11 @@ Theorem ZofB_minus: Proof. intros. assert (Q: -2^prec <= q <= 2^prec). - { split; auto. generalize (Zpower_ge_0 radix2 prec); simpl; omega. } - assert (RANGE: (-1 < B2R _ _ f < IZR (p + 1)%Z)%R) by (apply ZofB_range_nonneg; auto; omega). + { split; auto. generalize (Zpower_ge_0 radix2 prec); simpl; lia. } + assert (RANGE: (-1 < B2R _ _ f < IZR (p + 1)%Z)%R) by (apply ZofB_range_nonneg; auto; lia). rewrite ZofB_correct in H. destruct (is_finite prec emax f) eqn:FIN; try discriminate. assert (PQ2: (IZR (p + 1) <= IZR q * 2)%R). - { rewrite <- mult_IZR. apply IZR_le. omega. } + { rewrite <- mult_IZR. apply IZR_le. lia. } assert (EXACT: round radix2 fexp (round_mode m) (B2R _ _ f - IZR q)%R = (B2R _ _ f - IZR q)%R). { apply round_generic. apply valid_rnd_round_mode. apply sterbenz_aux. now apply FLT_exp_valid. apply FLT_exp_monotone. apply generic_format_B2R. @@ -828,7 +828,7 @@ Proof. - rewrite A. fold emin; fold fexp. rewrite EXACT. apply Rle_lt_trans with (bpow radix2 prec). apply Rle_trans with (IZR q). apply Rabs_le. lra. - rewrite <- IZR_Zpower. apply IZR_le; auto. red in prec_gt_0_; omega. + rewrite <- IZR_Zpower. apply IZR_le; auto. red in prec_gt_0_; lia. apply bpow_lt. auto. Qed. @@ -874,8 +874,8 @@ Proof. intros. destruct (ZofB_range_inversion _ _ _ _ H) as (A & B & C). set (f' := Bminus prec emax prec_gt_0_ Hmax minus_nan m f (BofZ q)). assert (D: ZofB f' = Some (p - q)). - { apply ZofB_minus. auto. omega. auto. auto. } - unfold ZofB_range. rewrite D. rewrite Zle_bool_true by omega. rewrite Zle_bool_true by omega. auto. + { apply ZofB_minus. auto. lia. auto. auto. } + unfold ZofB_range. rewrite D. rewrite Zle_bool_true by lia. rewrite Zle_bool_true by lia. auto. Qed. (** ** Algebraic identities *) @@ -961,7 +961,7 @@ Theorem Bmult2_Bplus: Proof. intros until f; intros NAN. destruct (BofZ_representable 2) as (A & B & C). - apply (integer_representable_2p 1). red in prec_gt_0_; omega. + apply (integer_representable_2p 1). red in prec_gt_0_; lia. pose proof (Bmult_correct _ _ _ Hmax mult_nan mode f (BofZ 2%Z)). fold emin in H. rewrite A, B, C in H. rewrite xorb_false_r in H. destruct (is_finite _ _ f) eqn:FIN. @@ -979,7 +979,7 @@ Proof. replace 0%R with (@F2R radix2 {| Fnum := 0%Z; Fexp := e |}). rewrite Rcompare_F2R. destruct s; auto. unfold F2R. simpl. ring. - apply IZR_lt. omega. + apply IZR_lt. lia. destruct (Bmult prec emax prec_gt_0_ Hmax mult_nan mode f (BofZ 2)); reflexivity || discriminate. + destruct H0 as (P & Q). apply B2FF_inj. rewrite P, H. auto. - destruct f as [sf|sf|sf pf Hf|sf mf ef Hf]; try discriminate. @@ -1000,11 +1000,11 @@ Proof. assert (REC: forall n, Z.pos (nat_rect _ xH (fun _ => xO) n) = 2 ^ (Z.of_nat n)). { induction n. reflexivity. simpl nat_rect. transitivity (2 * Z.pos (nat_rect _ xH (fun _ => xO) n)). reflexivity. - rewrite Nat2Z.inj_succ. rewrite IHn. unfold Z.succ. rewrite Zpower_plus by omega. + rewrite Nat2Z.inj_succ. rewrite IHn. unfold Z.succ. rewrite Zpower_plus by lia. change (2 ^ 1) with 2. ring. } red in prec_gt_0_. - unfold Bexact_inverse_mantissa. rewrite iter_nat_of_Z by omega. rewrite REC. - rewrite Zabs2Nat.id_abs. rewrite Z.abs_eq by omega. auto. + unfold Bexact_inverse_mantissa. rewrite iter_nat_of_Z by lia. rewrite REC. + rewrite Zabs2Nat.id_abs. rewrite Z.abs_eq by lia. auto. Qed. Remark Bexact_inverse_mantissa_digits2_pos: @@ -1013,11 +1013,11 @@ Proof. assert (DIGITS: forall n, digits2_pos (nat_rect _ xH (fun _ => xO) n) = Pos.of_nat (n+1)). { induction n; simpl. auto. rewrite IHn. destruct n; auto. } red in prec_gt_0_. - unfold Bexact_inverse_mantissa. rewrite iter_nat_of_Z by omega. rewrite DIGITS. - rewrite Zabs2Nat.abs_nat_nonneg, Z2Nat.inj_sub by omega. + unfold Bexact_inverse_mantissa. rewrite iter_nat_of_Z by lia. rewrite DIGITS. + rewrite Zabs2Nat.abs_nat_nonneg, Z2Nat.inj_sub by lia. destruct prec; try discriminate. rewrite Nat.sub_add. simpl. rewrite Pos2Nat.id. auto. - simpl. zify; omega. + simpl. zify; lia. Qed. Remark bounded_Bexact_inverse: @@ -1028,8 +1028,8 @@ Proof. rewrite <- Zeq_is_eq_bool. rewrite <- Zle_is_le_bool. rewrite Bexact_inverse_mantissa_digits2_pos. split. -- intros; split. unfold FLT_exp. unfold emin in H. zify; omega. omega. -- intros [A B]. unfold FLT_exp in A. unfold emin. zify; omega. +- intros; split. unfold FLT_exp. unfold emin in H. zify; lia. lia. +- intros [A B]. unfold FLT_exp in A. unfold emin. zify; lia. Qed. Program Definition Bexact_inverse (f: binary_float) : option binary_float := @@ -1045,7 +1045,7 @@ Program Definition Bexact_inverse (f: binary_float) : option binary_float := end. Next Obligation. rewrite <- bounded_Bexact_inverse in B. rewrite <- bounded_Bexact_inverse. - unfold emin in *. omega. + unfold emin in *. lia. Qed. Lemma Bexact_inverse_correct: @@ -1067,9 +1067,9 @@ Proof with (try discriminate). rewrite <- ! cond_Ropp_mult_l. red in prec_gt_0_. replace (IZR (2 ^ (prec - 1))) with (bpow radix2 (prec - 1)) - by (symmetry; apply (IZR_Zpower radix2); omega). + by (symmetry; apply (IZR_Zpower radix2); lia). rewrite <- ! bpow_plus. - replace (prec - 1 + e') with (- (prec - 1 + e)) by (unfold e'; omega). + replace (prec - 1 + e') with (- (prec - 1 + e)) by (unfold e'; lia). rewrite bpow_opp. unfold cond_Ropp; destruct s; auto. rewrite Ropp_inv_permute. auto. apply Rgt_not_eq. apply bpow_gt_0. split. simpl. apply F2R_neq_0. destruct s; simpl in H; discriminate. @@ -1163,9 +1163,9 @@ Proof. assert (C: 0 <= Z.log2_up base) by apply Z.log2_up_nonneg. destruct (Z.log2_spec base) as [D E]; auto. destruct (Z.log2_up_spec base) as [F G]. apply radix_gt_1. - assert (K: 0 <= 2 ^ Z.log2 base) by (apply Z.pow_nonneg; omega). - rewrite ! (Z.mul_comm n). rewrite ! Z.pow_mul_r by omega. - split; apply Z.pow_le_mono_l; omega. + assert (K: 0 <= 2 ^ Z.log2 base) by (apply Z.pow_nonneg; lia). + rewrite ! (Z.mul_comm n). rewrite ! Z.pow_mul_r by lia. + split; apply Z.pow_le_mono_l; lia. Qed. Lemma bpow_log_pos: @@ -1174,8 +1174,8 @@ Lemma bpow_log_pos: (bpow radix2 (n * Z.log2 base)%Z <= bpow base n)%R. Proof. intros. rewrite <- ! IZR_Zpower. apply IZR_le; apply Zpower_log; auto. - omega. - rewrite Z.mul_comm; apply Zmult_gt_0_le_0_compat. omega. apply Z.log2_nonneg. + lia. + rewrite Z.mul_comm; apply Zmult_gt_0_le_0_compat. lia. apply Z.log2_nonneg. Qed. Lemma bpow_log_neg: @@ -1183,10 +1183,10 @@ Lemma bpow_log_neg: n < 0 -> (bpow base n <= bpow radix2 (n * Z.log2 base)%Z)%R. Proof. - intros. set (m := -n). replace n with (-m) by (unfold m; omega). + intros. set (m := -n). replace n with (-m) by (unfold m; lia). rewrite ! Z.mul_opp_l, ! bpow_opp. apply Rinv_le. apply bpow_gt_0. - apply bpow_log_pos. unfold m; omega. + apply bpow_log_pos. unfold m; lia. Qed. (** Overflow and underflow conditions. *) @@ -1203,12 +1203,12 @@ Proof. rewrite <- (Rmult_1_l (bpow radix2 emax)). apply Rmult_le_compat. apply Rle_0_1. apply bpow_ge_0. - apply IZR_le. zify; omega. + apply IZR_le. zify; lia. eapply Rle_trans. eapply bpow_le. eassumption. apply bpow_log_pos; auto. apply generic_format_FLT. exists (Float radix2 1 emax). unfold F2R; simpl. ring. simpl. apply (Zpower_gt_1 radix2); auto. - simpl. unfold emin; red in prec_gt_0_; omega. + simpl. unfold emin; red in prec_gt_0_; lia. Qed. Lemma round_NE_underflows: @@ -1221,10 +1221,10 @@ Proof. assert (A: round radix2 fexp (round_mode mode_NE) eps = 0%R). { unfold round. simpl. assert (E: cexp radix2 fexp eps = emin). - { unfold cexp, eps. rewrite mag_bpow. unfold fexp, FLT_exp. zify; red in prec_gt_0_; omega. } + { unfold cexp, eps. rewrite mag_bpow. unfold fexp, FLT_exp. zify; red in prec_gt_0_; lia. } unfold scaled_mantissa; rewrite E. assert (P: (eps * bpow radix2 (-emin) = / 2)%R). - { unfold eps. rewrite <- bpow_plus. replace (emin - 1 + -emin) with (-1) by omega. auto. } + { unfold eps. rewrite <- bpow_plus. replace (emin - 1 + -emin) with (-1) by lia. auto. } rewrite P. unfold Znearest. assert (F: Zfloor (/ 2)%R = 0). { apply Zfloor_imp. simpl. lra. } @@ -1244,18 +1244,18 @@ Lemma round_integer_underflow: round radix2 fexp (round_mode mode_NE) (IZR (Zpos m) * bpow base e) = 0%R. Proof. intros. apply round_NE_underflows. split. -- apply Rmult_le_pos. apply IZR_le. zify; omega. apply bpow_ge_0. +- apply Rmult_le_pos. apply IZR_le. zify; lia. apply bpow_ge_0. - apply Rle_trans with (bpow radix2 (Z.log2_up (Z.pos m) + e * Z.log2 base)). + rewrite bpow_plus. apply Rmult_le_compat. - apply IZR_le; zify; omega. + apply IZR_le; zify; lia. apply bpow_ge_0. rewrite <- IZR_Zpower. apply IZR_le. destruct (Z.eq_dec (Z.pos m) 1). - rewrite e0. simpl. omega. - apply Z.log2_up_spec. zify; omega. + rewrite e0. simpl. lia. + apply Z.log2_up_spec. zify; lia. apply Z.log2_up_nonneg. apply bpow_log_neg. auto. -+ apply bpow_le. omega. ++ apply bpow_le. lia. Qed. (** Correctness of Bparse *) @@ -1281,20 +1281,20 @@ Proof. - (* e = Zpos e *) destruct (Z.ltb_spec (Z.pos e * Z.log2 (Z.pos b)) emax). + (* no overflow *) - rewrite pos_pow_spec. rewrite <- IZR_Zpower by (zify; omega). rewrite <- mult_IZR. + rewrite pos_pow_spec. rewrite <- IZR_Zpower by (zify; lia). rewrite <- mult_IZR. replace false with (Z.pos m * Z.pos b ^ Z.pos e <? 0). exact (BofZ_correct (Z.pos m * Z.pos b ^ Z.pos e)). - rewrite Z.ltb_ge. rewrite Z.mul_comm. apply Zmult_gt_0_le_0_compat. zify; omega. apply (Zpower_ge_0 base). + rewrite Z.ltb_ge. rewrite Z.mul_comm. apply Zmult_gt_0_le_0_compat. zify; lia. apply (Zpower_ge_0 base). + (* overflow *) rewrite Rlt_bool_false. auto. eapply Rle_trans; [idtac|apply Rle_abs]. - apply (round_integer_overflow base). zify; omega. auto. + apply (round_integer_overflow base). zify; lia. auto. - (* e = Zneg e *) destruct (Z.ltb_spec (Z.neg e * Z.log2 (Z.pos b) + Z.log2_up (Z.pos m)) emin). + (* undeflow *) rewrite round_integer_underflow; auto. rewrite Rlt_bool_true. auto. replace (Rabs 0)%R with 0%R. apply bpow_gt_0. apply (abs_IZR 0). - zify; omega. + zify; lia. + (* no underflow *) generalize (Bdiv_correct_aux prec emax prec_gt_0_ Hmax mode_NE false m 0 false (pos_pow b e) 0). set (f := let '(mz, ez, lz) := Fdiv_core_binary prec emax (Z.pos m) 0 (Z.pos (pos_pow b e)) 0 @@ -1384,13 +1384,13 @@ Proof. apply Rlt_le_trans with (bpow radix2 emax1). rewrite F2R_cond_Zopp. rewrite abs_cond_Ropp. rewrite <- F2R_Zabs. simpl Z.abs. eapply bounded_lt_emax; eauto. - apply bpow_le. omega. + apply bpow_le. lia. } assert (EQ: round radix2 fexp2 (round_mode m) (B2R prec1 emax1 f) = B2R prec1 emax1 f). { apply round_generic. apply valid_rnd_round_mode. eapply generic_inclusion_le. 5: apply generic_format_B2R. apply fexp_correct; auto. apply fexp_correct; auto. - instantiate (1 := emax2). intros. unfold fexp2, FLT_exp. unfold emin2. zify; omega. + instantiate (1 := emax2). intros. unfold fexp2, FLT_exp. unfold emin2. zify; lia. apply Rlt_le; auto. } rewrite EQ. rewrite Rlt_bool_true by auto. auto. @@ -1444,7 +1444,7 @@ Proof. intros. destruct (ZofB_range_inversion _ _ _ _ _ _ H3) as (A & B & C). unfold ZofB_range. erewrite ZofB_Bconv by eauto. - rewrite ! Zle_bool_true by omega. auto. + rewrite ! Zle_bool_true by lia. auto. Qed. (** Change of format (to higher precision) and comparison. *) diff --git a/lib/Integers.v b/lib/Integers.v index 246c708c..c48af2fc 100644 --- a/lib/Integers.v +++ b/lib/Integers.v @@ -77,7 +77,7 @@ Definition min_signed : Z := - half_modulus. Remark wordsize_pos: zwordsize > 0. Proof. - unfold zwordsize, wordsize. generalize WS.wordsize_not_zero. omega. + unfold zwordsize, wordsize. generalize WS.wordsize_not_zero. lia. Qed. Remark modulus_power: modulus = two_p zwordsize. @@ -88,15 +88,15 @@ Qed. Remark modulus_gt_one: modulus > 1. Proof. rewrite modulus_power. apply Z.lt_gt. apply (two_p_monotone_strict 0). - generalize wordsize_pos; omega. + generalize wordsize_pos; lia. Qed. Remark modulus_pos: modulus > 0. Proof. - generalize modulus_gt_one; omega. + generalize modulus_gt_one; lia. Qed. -Hint Resolve modulus_pos: ints. +Global Hint Resolve modulus_pos: ints. (** * Representation of machine integers *) @@ -326,16 +326,16 @@ Proof. unfold half_modulus. rewrite modulus_power. set (ws1 := zwordsize - 1). replace (zwordsize) with (Z.succ ws1). - rewrite two_p_S. rewrite Z.mul_comm. apply Z_div_mult. omega. - unfold ws1. generalize wordsize_pos; omega. - unfold ws1. omega. + rewrite two_p_S. rewrite Z.mul_comm. apply Z_div_mult. lia. + unfold ws1. generalize wordsize_pos; lia. + unfold ws1. lia. Qed. Remark half_modulus_modulus: modulus = 2 * half_modulus. Proof. rewrite half_modulus_power. rewrite modulus_power. - rewrite <- two_p_S. apply f_equal. omega. - generalize wordsize_pos; omega. + rewrite <- two_p_S. apply f_equal. lia. + generalize wordsize_pos; lia. Qed. (** Relative positions, from greatest to smallest: @@ -351,38 +351,38 @@ Qed. Remark half_modulus_pos: half_modulus > 0. Proof. - rewrite half_modulus_power. apply two_p_gt_ZERO. generalize wordsize_pos; omega. + rewrite half_modulus_power. apply two_p_gt_ZERO. generalize wordsize_pos; lia. Qed. Remark min_signed_neg: min_signed < 0. Proof. - unfold min_signed. generalize half_modulus_pos. omega. + unfold min_signed. generalize half_modulus_pos. lia. Qed. Remark max_signed_pos: max_signed >= 0. Proof. - unfold max_signed. generalize half_modulus_pos. omega. + unfold max_signed. generalize half_modulus_pos. lia. Qed. Remark wordsize_max_unsigned: zwordsize <= max_unsigned. Proof. assert (zwordsize < modulus). rewrite modulus_power. apply two_p_strict. - generalize wordsize_pos. omega. - unfold max_unsigned. omega. + generalize wordsize_pos. lia. + unfold max_unsigned. lia. Qed. Remark two_wordsize_max_unsigned: 2 * zwordsize - 1 <= max_unsigned. Proof. assert (2 * zwordsize - 1 < modulus). - rewrite modulus_power. apply two_p_strict_2. generalize wordsize_pos; omega. - unfold max_unsigned; omega. + rewrite modulus_power. apply two_p_strict_2. generalize wordsize_pos; lia. + unfold max_unsigned; lia. Qed. Remark max_signed_unsigned: max_signed < max_unsigned. Proof. unfold max_signed, max_unsigned. rewrite half_modulus_modulus. - generalize half_modulus_pos. omega. + generalize half_modulus_pos. lia. Qed. Lemma unsigned_repr_eq: @@ -405,45 +405,45 @@ Definition eqm := eqmod modulus. Lemma eqm_refl: forall x, eqm x x. Proof (eqmod_refl modulus). -Hint Resolve eqm_refl: ints. +Global Hint Resolve eqm_refl: ints. Lemma eqm_refl2: forall x y, x = y -> eqm x y. Proof (eqmod_refl2 modulus). -Hint Resolve eqm_refl2: ints. +Global Hint Resolve eqm_refl2: ints. Lemma eqm_sym: forall x y, eqm x y -> eqm y x. Proof (eqmod_sym modulus). -Hint Resolve eqm_sym: ints. +Global Hint Resolve eqm_sym: ints. Lemma eqm_trans: forall x y z, eqm x y -> eqm y z -> eqm x z. Proof (eqmod_trans modulus). -Hint Resolve eqm_trans: ints. +Global Hint Resolve eqm_trans: ints. Lemma eqm_small_eq: forall x y, eqm x y -> 0 <= x < modulus -> 0 <= y < modulus -> x = y. Proof (eqmod_small_eq modulus). -Hint Resolve eqm_small_eq: ints. +Global Hint Resolve eqm_small_eq: ints. Lemma eqm_add: forall a b c d, eqm a b -> eqm c d -> eqm (a + c) (b + d). Proof (eqmod_add modulus). -Hint Resolve eqm_add: ints. +Global Hint Resolve eqm_add: ints. Lemma eqm_neg: forall x y, eqm x y -> eqm (-x) (-y). Proof (eqmod_neg modulus). -Hint Resolve eqm_neg: ints. +Global Hint Resolve eqm_neg: ints. Lemma eqm_sub: forall a b c d, eqm a b -> eqm c d -> eqm (a - c) (b - d). Proof (eqmod_sub modulus). -Hint Resolve eqm_sub: ints. +Global Hint Resolve eqm_sub: ints. Lemma eqm_mult: forall a b c d, eqm a c -> eqm b d -> eqm (a * b) (c * d). Proof (eqmod_mult modulus). -Hint Resolve eqm_mult: ints. +Global Hint Resolve eqm_mult: ints. Lemma eqm_same_bits: forall x y, @@ -471,7 +471,7 @@ Lemma eqm_unsigned_repr: Proof. unfold eqm; intros. rewrite unsigned_repr_eq. apply eqmod_mod. auto with ints. Qed. -Hint Resolve eqm_unsigned_repr: ints. +Global Hint Resolve eqm_unsigned_repr: ints. Lemma eqm_unsigned_repr_l: forall a b, eqm a b -> eqm (unsigned (repr a)) b. @@ -479,7 +479,7 @@ Proof. intros. apply eqm_trans with a. apply eqm_sym. apply eqm_unsigned_repr. auto. Qed. -Hint Resolve eqm_unsigned_repr_l: ints. +Global Hint Resolve eqm_unsigned_repr_l: ints. Lemma eqm_unsigned_repr_r: forall a b, eqm a b -> eqm a (unsigned (repr b)). @@ -487,7 +487,7 @@ Proof. intros. apply eqm_trans with b. auto. apply eqm_unsigned_repr. Qed. -Hint Resolve eqm_unsigned_repr_r: ints. +Global Hint Resolve eqm_unsigned_repr_r: ints. Lemma eqm_signed_unsigned: forall x, eqm (signed x) (unsigned x). @@ -500,17 +500,17 @@ Qed. Theorem unsigned_range: forall i, 0 <= unsigned i < modulus. Proof. - destruct i. simpl. omega. + destruct i. simpl. lia. Qed. -Hint Resolve unsigned_range: ints. +Global Hint Resolve unsigned_range: ints. Theorem unsigned_range_2: forall i, 0 <= unsigned i <= max_unsigned. Proof. intro; unfold max_unsigned. - generalize (unsigned_range i). omega. + generalize (unsigned_range i). lia. Qed. -Hint Resolve unsigned_range_2: ints. +Global Hint Resolve unsigned_range_2: ints. Theorem signed_range: forall i, min_signed <= signed i <= max_signed. @@ -518,18 +518,18 @@ Proof. intros. unfold signed. generalize (unsigned_range i). set (n := unsigned i). intros. case (zlt n half_modulus); intro. - unfold max_signed. generalize min_signed_neg. omega. + unfold max_signed. generalize min_signed_neg. lia. unfold min_signed, max_signed. - rewrite half_modulus_modulus in *. omega. + rewrite half_modulus_modulus in *. lia. Qed. Theorem repr_unsigned: forall i, repr (unsigned i) = i. Proof. destruct i; simpl. unfold repr. apply mkint_eq. - rewrite Z_mod_modulus_eq. apply Z.mod_small; omega. + rewrite Z_mod_modulus_eq. apply Z.mod_small; lia. Qed. -Hint Resolve repr_unsigned: ints. +Global Hint Resolve repr_unsigned: ints. Lemma repr_signed: forall i, repr (signed i) = i. @@ -537,7 +537,7 @@ Proof. intros. transitivity (repr (unsigned i)). apply eqm_samerepr. apply eqm_signed_unsigned. auto with ints. Qed. -Hint Resolve repr_signed: ints. +Global Hint Resolve repr_signed: ints. Opaque repr. @@ -550,34 +550,34 @@ Theorem unsigned_repr: forall z, 0 <= z <= max_unsigned -> unsigned (repr z) = z. Proof. intros. rewrite unsigned_repr_eq. - apply Z.mod_small. unfold max_unsigned in H. omega. + apply Z.mod_small. unfold max_unsigned in H. lia. Qed. -Hint Resolve unsigned_repr: ints. +Global Hint Resolve unsigned_repr: ints. Theorem signed_repr: forall z, min_signed <= z <= max_signed -> signed (repr z) = z. Proof. intros. unfold signed. destruct (zle 0 z). replace (unsigned (repr z)) with z. - rewrite zlt_true. auto. unfold max_signed in H. omega. - symmetry. apply unsigned_repr. generalize max_signed_unsigned. omega. + rewrite zlt_true. auto. unfold max_signed in H. lia. + symmetry. apply unsigned_repr. generalize max_signed_unsigned. lia. pose (z' := z + modulus). replace (repr z) with (repr z'). replace (unsigned (repr z')) with z'. - rewrite zlt_false. unfold z'. omega. + rewrite zlt_false. unfold z'. lia. unfold z'. unfold min_signed in H. - rewrite half_modulus_modulus. omega. + rewrite half_modulus_modulus. lia. symmetry. apply unsigned_repr. unfold z', max_unsigned. unfold min_signed, max_signed in H. - rewrite half_modulus_modulus. omega. - apply eqm_samerepr. unfold z'; red. exists 1. omega. + rewrite half_modulus_modulus. lia. + apply eqm_samerepr. unfold z'; red. exists 1. lia. Qed. Theorem signed_eq_unsigned: forall x, unsigned x <= max_signed -> signed x = unsigned x. Proof. intros. unfold signed. destruct (zlt (unsigned x) half_modulus). - auto. unfold max_signed in H. omegaContradiction. + auto. unfold max_signed in H. extlia. Qed. Theorem signed_positive: @@ -585,7 +585,7 @@ Theorem signed_positive: Proof. intros. unfold signed, max_signed. generalize (unsigned_range x) half_modulus_modulus half_modulus_pos; intros. - destruct (zlt (unsigned x) half_modulus); omega. + destruct (zlt (unsigned x) half_modulus); lia. Qed. (** ** Properties of zero, one, minus one *) @@ -597,11 +597,11 @@ Qed. Theorem unsigned_one: unsigned one = 1. Proof. - unfold one; rewrite unsigned_repr_eq. apply Z.mod_small. split. omega. + unfold one; rewrite unsigned_repr_eq. apply Z.mod_small. split. lia. unfold modulus. replace wordsize with (S(Init.Nat.pred wordsize)). rewrite two_power_nat_S. generalize (two_power_nat_pos (Init.Nat.pred wordsize)). - omega. - generalize wordsize_pos. unfold zwordsize. omega. + lia. + generalize wordsize_pos. unfold zwordsize. lia. Qed. Theorem unsigned_mone: unsigned mone = modulus - 1. @@ -609,25 +609,25 @@ Proof. unfold mone; rewrite unsigned_repr_eq. replace (-1) with ((modulus - 1) + (-1) * modulus). rewrite Z_mod_plus_full. apply Z.mod_small. - generalize modulus_pos. omega. omega. + generalize modulus_pos. lia. lia. Qed. Theorem signed_zero: signed zero = 0. Proof. - unfold signed. rewrite unsigned_zero. apply zlt_true. generalize half_modulus_pos; omega. + unfold signed. rewrite unsigned_zero. apply zlt_true. generalize half_modulus_pos; lia. Qed. Theorem signed_one: zwordsize > 1 -> signed one = 1. Proof. intros. unfold signed. rewrite unsigned_one. apply zlt_true. - change 1 with (two_p 0). rewrite half_modulus_power. apply two_p_monotone_strict. omega. + change 1 with (two_p 0). rewrite half_modulus_power. apply two_p_monotone_strict. lia. Qed. Theorem signed_mone: signed mone = -1. Proof. unfold signed. rewrite unsigned_mone. - rewrite zlt_false. omega. - rewrite half_modulus_modulus. generalize half_modulus_pos. omega. + rewrite zlt_false. lia. + rewrite half_modulus_modulus. generalize half_modulus_pos. lia. Qed. Theorem one_not_zero: one <> zero. @@ -641,7 +641,7 @@ Theorem unsigned_repr_wordsize: unsigned iwordsize = zwordsize. Proof. unfold iwordsize; rewrite unsigned_repr_eq. apply Z.mod_small. - generalize wordsize_pos wordsize_max_unsigned; unfold max_unsigned; omega. + generalize wordsize_pos wordsize_max_unsigned; unfold max_unsigned; lia. Qed. (** ** Properties of equality *) @@ -700,7 +700,7 @@ Proof. Qed. Theorem add_commut: forall x y, add x y = add y x. -Proof. intros; unfold add. decEq. omega. Qed. +Proof. intros; unfold add. decEq. lia. Qed. Theorem add_zero: forall x, add x zero = x. Proof. @@ -734,7 +734,7 @@ Theorem add_neg_zero: forall x, add x (neg x) = zero. Proof. intros; unfold add, neg, zero. apply eqm_samerepr. replace 0 with (unsigned x + (- (unsigned x))). - auto with ints. omega. + auto with ints. lia. Qed. Theorem unsigned_add_carry: @@ -746,8 +746,8 @@ Proof. rewrite unsigned_repr_eq. generalize (unsigned_range x) (unsigned_range y). intros. destruct (zlt (unsigned x + unsigned y) modulus). - rewrite unsigned_zero. apply Zmod_unique with 0. omega. omega. - rewrite unsigned_one. apply Zmod_unique with 1. omega. omega. + rewrite unsigned_zero. apply Zmod_unique with 0. lia. lia. + rewrite unsigned_one. apply Zmod_unique with 1. lia. lia. Qed. Corollary unsigned_add_either: @@ -758,8 +758,8 @@ Proof. intros. rewrite unsigned_add_carry. unfold add_carry. rewrite unsigned_zero. rewrite Z.add_0_r. destruct (zlt (unsigned x + unsigned y) modulus). - rewrite unsigned_zero. left; omega. - rewrite unsigned_one. right; omega. + rewrite unsigned_zero. left; lia. + rewrite unsigned_one. right; lia. Qed. (** ** Properties of negation *) @@ -778,7 +778,7 @@ Theorem neg_involutive: forall x, neg (neg x) = x. Proof. intros; unfold neg. apply eqm_repr_eq. eapply eqm_trans. apply eqm_neg. - apply eqm_unsigned_repr_l. apply eqm_refl. apply eqm_refl2. omega. + apply eqm_unsigned_repr_l. apply eqm_refl. apply eqm_refl2. lia. Qed. Theorem neg_add_distr: forall x y, neg(add x y) = add (neg x) (neg y). @@ -788,7 +788,7 @@ Proof. auto with ints. replace (- (unsigned x + unsigned y)) with ((- unsigned x) + (- unsigned y)). - auto with ints. omega. + auto with ints. lia. Qed. (** ** Properties of subtraction *) @@ -796,7 +796,7 @@ Qed. Theorem sub_zero_l: forall x, sub x zero = x. Proof. intros; unfold sub. rewrite unsigned_zero. - replace (unsigned x - 0) with (unsigned x) by omega. apply repr_unsigned. + replace (unsigned x - 0) with (unsigned x) by lia. apply repr_unsigned. Qed. Theorem sub_zero_r: forall x, sub zero x = neg x. @@ -812,7 +812,7 @@ Qed. Theorem sub_idem: forall x, sub x x = zero. Proof. - intros; unfold sub. unfold zero. decEq. omega. + intros; unfold sub. unfold zero. decEq. lia. Qed. Theorem sub_add_l: forall x y z, sub (add x y) z = add (sub x z) y. @@ -855,8 +855,8 @@ Proof. rewrite unsigned_repr_eq. generalize (unsigned_range x) (unsigned_range y). intros. destruct (zlt (unsigned x - unsigned y) 0). - rewrite unsigned_one. apply Zmod_unique with (-1). omega. omega. - rewrite unsigned_zero. apply Zmod_unique with 0. omega. omega. + rewrite unsigned_one. apply Zmod_unique with (-1). lia. lia. + rewrite unsigned_zero. apply Zmod_unique with 0. lia. lia. Qed. (** ** Properties of multiplication *) @@ -883,9 +883,9 @@ Theorem mul_mone: forall x, mul x mone = neg x. Proof. intros; unfold mul, neg. rewrite unsigned_mone. apply eqm_samerepr. - replace (-unsigned x) with (0 - unsigned x) by omega. + replace (-unsigned x) with (0 - unsigned x) by lia. replace (unsigned x * (modulus - 1)) with (unsigned x * modulus - unsigned x) by ring. - apply eqm_sub. exists (unsigned x). omega. apply eqm_refl. + apply eqm_sub. exists (unsigned x). lia. apply eqm_refl. Qed. Theorem mul_assoc: forall x y z, mul (mul x y) z = mul x (mul y z). @@ -960,7 +960,7 @@ Proof. generalize (unsigned_range y); intro. assert (unsigned y <> 0). red; intro. elim H. rewrite <- (repr_unsigned y). unfold zero. congruence. - unfold y'. omega. + unfold y'. lia. auto with ints. Qed. @@ -1030,7 +1030,7 @@ Proof. assert (Z.quot x' one = x'). symmetry. apply Zquot_unique_full with 0. red. change (Z.abs one) with 1. - destruct (zle 0 x'). left. omega. right. omega. + destruct (zle 0 x'). left. lia. right. lia. unfold one; ring. congruence. Qed. @@ -1058,12 +1058,12 @@ Proof. assert (unsigned d <> 0). { red; intros. elim H. rewrite <- (repr_unsigned d). rewrite H0; auto. } assert (0 < D). - { unfold D. generalize (unsigned_range d); intros. omega. } + { unfold D. generalize (unsigned_range d); intros. lia. } assert (0 <= Q <= max_unsigned). { unfold Q. apply Zdiv_interval_2. rewrite <- E1; apply unsigned_range_2. - omega. unfold max_unsigned; generalize modulus_pos; omega. omega. } - omega. + lia. unfold max_unsigned; generalize modulus_pos; lia. lia. } + lia. Qed. Lemma unsigned_signed: @@ -1072,8 +1072,8 @@ Proof. intros. unfold lt. rewrite signed_zero. unfold signed. generalize (unsigned_range n). rewrite half_modulus_modulus. intros. destruct (zlt (unsigned n) half_modulus). -- rewrite zlt_false by omega. auto. -- rewrite zlt_true by omega. ring. +- rewrite zlt_false by lia. auto. +- rewrite zlt_true by lia. ring. Qed. Theorem divmods2_divs_mods: @@ -1101,24 +1101,24 @@ Proof. - (* D = 1 *) rewrite e. rewrite Z.quot_1_r; auto. - (* D = -1 *) - rewrite e. change (-1) with (Z.opp 1). rewrite Z.quot_opp_r by omega. + rewrite e. change (-1) with (Z.opp 1). rewrite Z.quot_opp_r by lia. rewrite Z.quot_1_r. assert (N <> min_signed). { red; intros; destruct H0. + elim H0. rewrite <- (repr_signed n). rewrite <- H2. rewrite H4. auto. + elim H0. rewrite <- (repr_signed d). unfold D in e; rewrite e; auto. } - unfold min_signed, max_signed in *. omega. + unfold min_signed, max_signed in *. lia. - (* |D| > 1 *) assert (Z.abs (Z.quot N D) < half_modulus). - { rewrite <- Z.quot_abs by omega. apply Zquot_lt_upper_bound. - xomega. xomega. + { rewrite <- Z.quot_abs by lia. apply Zquot_lt_upper_bound. + extlia. extlia. apply Z.le_lt_trans with (half_modulus * 1). - rewrite Z.mul_1_r. unfold min_signed, max_signed in H3; xomega. - apply Zmult_lt_compat_l. generalize half_modulus_pos; omega. xomega. } + rewrite Z.mul_1_r. unfold min_signed, max_signed in H3; extlia. + apply Zmult_lt_compat_l. generalize half_modulus_pos; lia. extlia. } rewrite Z.abs_lt in H4. - unfold min_signed, max_signed; omega. + unfold min_signed, max_signed; lia. } - unfold proj_sumbool; rewrite ! zle_true by omega; simpl. + unfold proj_sumbool; rewrite ! zle_true by lia; simpl. unfold Q, R; rewrite H2; auto. Qed. @@ -1169,7 +1169,7 @@ Qed. Lemma bits_mone: forall i, 0 <= i < zwordsize -> testbit mone i = true. Proof. - intros. unfold mone. rewrite testbit_repr; auto. apply Ztestbit_m1. omega. + intros. unfold mone. rewrite testbit_repr; auto. apply Ztestbit_m1. lia. Qed. Hint Rewrite bits_zero bits_mone : ints. @@ -1186,7 +1186,7 @@ Proof. unfold zwordsize, ws1, wordsize. destruct WS.wordsize as [] eqn:E. elim WS.wordsize_not_zero; auto. - rewrite Nat2Z.inj_succ. simpl. omega. + rewrite Nat2Z.inj_succ. simpl. lia. assert (half_modulus = two_power_nat ws1). rewrite two_power_nat_two_p. rewrite <- H. apply half_modulus_power. rewrite H; rewrite H0. @@ -1228,11 +1228,11 @@ Lemma bits_signed: Proof. intros. destruct (zlt i zwordsize). - - apply same_bits_eqm. apply eqm_signed_unsigned. omega. + - apply same_bits_eqm. apply eqm_signed_unsigned. lia. - unfold signed. rewrite sign_bit_of_unsigned. destruct (zlt (unsigned x) half_modulus). + apply Ztestbit_above with wordsize. apply unsigned_range. auto. + apply Ztestbit_above_neg with wordsize. - fold modulus. generalize (unsigned_range x). omega. auto. + fold modulus. generalize (unsigned_range x). lia. auto. Qed. Lemma bits_le: @@ -1240,9 +1240,9 @@ Lemma bits_le: (forall i, 0 <= i < zwordsize -> testbit x i = true -> testbit y i = true) -> unsigned x <= unsigned y. Proof. - intros. apply Ztestbit_le. generalize (unsigned_range y); omega. + intros. apply Ztestbit_le. generalize (unsigned_range y); lia. intros. fold (testbit y i). destruct (zlt i zwordsize). - apply H. omega. auto. + apply H. lia. auto. fold (testbit x i) in H1. rewrite bits_above in H1; auto. congruence. Qed. @@ -1510,10 +1510,10 @@ Lemma unsigned_not: forall x, unsigned (not x) = max_unsigned - unsigned x. Proof. intros. transitivity (unsigned (repr(-unsigned x - 1))). - f_equal. bit_solve. rewrite testbit_repr; auto. symmetry. apply Z_one_complement. omega. + f_equal. bit_solve. rewrite testbit_repr; auto. symmetry. apply Z_one_complement. lia. rewrite unsigned_repr_eq. apply Zmod_unique with (-1). - unfold max_unsigned. omega. - generalize (unsigned_range x). unfold max_unsigned. omega. + unfold max_unsigned. lia. + generalize (unsigned_range x). unfold max_unsigned. lia. Qed. Theorem not_neg: @@ -1523,9 +1523,9 @@ Proof. rewrite <- (repr_unsigned x) at 1. unfold add. rewrite !testbit_repr; auto. transitivity (Z.testbit (-unsigned x - 1) i). - symmetry. apply Z_one_complement. omega. + symmetry. apply Z_one_complement. lia. apply same_bits_eqm; auto. - replace (-unsigned x - 1) with (-unsigned x + (-1)) by omega. + replace (-unsigned x - 1) with (-unsigned x + (-1)) by lia. apply eqm_add. unfold neg. apply eqm_unsigned_repr. rewrite unsigned_mone. exists (-1). ring. @@ -1567,9 +1567,9 @@ Proof. replace (unsigned (xor b one)) with (1 - unsigned b). destruct (zlt (unsigned x - unsigned y - unsigned b)). rewrite zlt_true. rewrite xor_zero_l; auto. - unfold max_unsigned; omega. + unfold max_unsigned; lia. rewrite zlt_false. rewrite xor_idem; auto. - unfold max_unsigned; omega. + unfold max_unsigned; lia. destruct H; subst b. rewrite xor_zero_l. rewrite unsigned_one, unsigned_zero; auto. rewrite xor_idem. rewrite unsigned_one, unsigned_zero; auto. @@ -1588,16 +1588,16 @@ Proof. rewrite (Zdecomp x) in *. rewrite (Zdecomp y) in *. transitivity (Z.testbit (Zshiftin (Z.odd x || Z.odd y) (Z.div2 x + Z.div2 y)) i). - f_equal. rewrite !Zshiftin_spec. - exploit (EXCL 0). omega. rewrite !Ztestbit_shiftin_base. intros. + exploit (EXCL 0). lia. rewrite !Ztestbit_shiftin_base. intros. Opaque Z.mul. destruct (Z.odd x); destruct (Z.odd y); simpl in *; discriminate || ring. - rewrite !Ztestbit_shiftin; auto. destruct (zeq i 0). + auto. - + apply IND. omega. intros. - exploit (EXCL (Z.succ j)). omega. + + apply IND. lia. intros. + exploit (EXCL (Z.succ j)). lia. rewrite !Ztestbit_shiftin_succ. auto. - omega. omega. + lia. lia. Qed. Theorem add_is_or: @@ -1606,10 +1606,10 @@ Theorem add_is_or: add x y = or x y. Proof. bit_solve. unfold add. rewrite testbit_repr; auto. - apply Z_add_is_or. omega. + apply Z_add_is_or. lia. intros. assert (testbit (and x y) j = testbit zero j) by congruence. - autorewrite with ints in H2. assumption. omega. + autorewrite with ints in H2. assumption. lia. Qed. Theorem xor_is_or: @@ -1655,7 +1655,7 @@ Proof. intros. unfold shl. rewrite testbit_repr; auto. destruct (zlt i (unsigned y)). apply Z.shiftl_spec_low. auto. - apply Z.shiftl_spec_high. omega. omega. + apply Z.shiftl_spec_high. lia. lia. Qed. Lemma bits_shru: @@ -1669,7 +1669,7 @@ Proof. destruct (zlt (i + unsigned y) zwordsize). auto. apply bits_above; auto. - omega. + lia. Qed. Lemma bits_shr: @@ -1680,15 +1680,15 @@ Lemma bits_shr: Proof. intros. unfold shr. rewrite testbit_repr; auto. rewrite Z.shiftr_spec. apply bits_signed. - generalize (unsigned_range y); omega. - omega. + generalize (unsigned_range y); lia. + lia. Qed. Hint Rewrite bits_shl bits_shru bits_shr: ints. Theorem shl_zero: forall x, shl x zero = x. Proof. - bit_solve. rewrite unsigned_zero. rewrite zlt_false. f_equal; omega. omega. + bit_solve. rewrite unsigned_zero. rewrite zlt_false. f_equal; lia. lia. Qed. Lemma bitwise_binop_shl: @@ -1700,7 +1700,7 @@ Proof. intros. apply same_bits_eq; intros. rewrite H; auto. rewrite !bits_shl; auto. destruct (zlt i (unsigned n)); auto. - rewrite H; auto. generalize (unsigned_range n); omega. + rewrite H; auto. generalize (unsigned_range n); lia. Qed. Theorem and_shl: @@ -1728,7 +1728,7 @@ Lemma ltu_inv: forall x y, ltu x y = true -> 0 <= unsigned x < unsigned y. Proof. unfold ltu; intros. destruct (zlt (unsigned x) (unsigned y)). - split; auto. generalize (unsigned_range x); omega. + split; auto. generalize (unsigned_range x); lia. discriminate. Qed. @@ -1749,15 +1749,15 @@ Proof. generalize (ltu_iwordsize_inv _ H) (ltu_iwordsize_inv _ H0); intros. assert (unsigned (add y z) = unsigned y + unsigned z). unfold add. apply unsigned_repr. - generalize two_wordsize_max_unsigned; omega. + generalize two_wordsize_max_unsigned; lia. apply same_bits_eq; intros. rewrite bits_shl; auto. destruct (zlt i (unsigned z)). - - rewrite bits_shl; auto. rewrite zlt_true. auto. omega. + - rewrite bits_shl; auto. rewrite zlt_true. auto. lia. - rewrite bits_shl. destruct (zlt (i - unsigned z) (unsigned y)). - + rewrite bits_shl; auto. rewrite zlt_true. auto. omega. - + rewrite bits_shl; auto. rewrite zlt_false. f_equal. omega. omega. - + omega. + + rewrite bits_shl; auto. rewrite zlt_true. auto. lia. + + rewrite bits_shl; auto. rewrite zlt_false. f_equal. lia. lia. + + lia. Qed. Theorem sub_ltu: @@ -1767,12 +1767,12 @@ Theorem sub_ltu: Proof. intros. generalize (ltu_inv x y H). intros . - split. omega. omega. + split. lia. lia. Qed. Theorem shru_zero: forall x, shru x zero = x. Proof. - bit_solve. rewrite unsigned_zero. rewrite zlt_true. f_equal; omega. omega. + bit_solve. rewrite unsigned_zero. rewrite zlt_true. f_equal; lia. lia. Qed. Lemma bitwise_binop_shru: @@ -1784,7 +1784,7 @@ Proof. intros. apply same_bits_eq; intros. rewrite H; auto. rewrite !bits_shru; auto. destruct (zlt (i + unsigned n) zwordsize); auto. - rewrite H; auto. generalize (unsigned_range n); omega. + rewrite H; auto. generalize (unsigned_range n); lia. Qed. Theorem and_shru: @@ -1819,20 +1819,20 @@ Proof. generalize (ltu_iwordsize_inv _ H) (ltu_iwordsize_inv _ H0); intros. assert (unsigned (add y z) = unsigned y + unsigned z). unfold add. apply unsigned_repr. - generalize two_wordsize_max_unsigned; omega. + generalize two_wordsize_max_unsigned; lia. apply same_bits_eq; intros. rewrite bits_shru; auto. destruct (zlt (i + unsigned z) zwordsize). - rewrite bits_shru. destruct (zlt (i + unsigned z + unsigned y) zwordsize). - + rewrite bits_shru; auto. rewrite zlt_true. f_equal. omega. omega. - + rewrite bits_shru; auto. rewrite zlt_false. auto. omega. - + omega. - - rewrite bits_shru; auto. rewrite zlt_false. auto. omega. + + rewrite bits_shru; auto. rewrite zlt_true. f_equal. lia. lia. + + rewrite bits_shru; auto. rewrite zlt_false. auto. lia. + + lia. + - rewrite bits_shru; auto. rewrite zlt_false. auto. lia. Qed. Theorem shr_zero: forall x, shr x zero = x. Proof. - bit_solve. rewrite unsigned_zero. rewrite zlt_true. f_equal; omega. omega. + bit_solve. rewrite unsigned_zero. rewrite zlt_true. f_equal; lia. lia. Qed. Lemma bitwise_binop_shr: @@ -1844,8 +1844,8 @@ Proof. rewrite H; auto. rewrite !bits_shr; auto. rewrite H; auto. destruct (zlt (i + unsigned n) zwordsize). - generalize (unsigned_range n); omega. - omega. + generalize (unsigned_range n); lia. + lia. Qed. Theorem and_shr: @@ -1880,15 +1880,15 @@ Proof. generalize (ltu_iwordsize_inv _ H) (ltu_iwordsize_inv _ H0); intros. assert (unsigned (add y z) = unsigned y + unsigned z). unfold add. apply unsigned_repr. - generalize two_wordsize_max_unsigned; omega. + generalize two_wordsize_max_unsigned; lia. apply same_bits_eq; intros. rewrite !bits_shr; auto. f_equal. destruct (zlt (i + unsigned z) zwordsize). - rewrite H4. replace (i + (unsigned y + unsigned z)) with (i + unsigned z + unsigned y) by omega. auto. + rewrite H4. replace (i + (unsigned y + unsigned z)) with (i + unsigned z + unsigned y) by lia. auto. rewrite (zlt_false _ (i + unsigned (add y z))). - destruct (zlt (zwordsize - 1 + unsigned y) zwordsize); omega. - omega. - destruct (zlt (i + unsigned z) zwordsize); omega. + destruct (zlt (zwordsize - 1 + unsigned y) zwordsize); lia. + lia. + destruct (zlt (i + unsigned z) zwordsize); lia. Qed. Theorem and_shr_shru: @@ -1898,7 +1898,7 @@ Proof. intros. apply same_bits_eq; intros. rewrite bits_and; auto. rewrite bits_shr; auto. rewrite !bits_shru; auto. destruct (zlt (i + unsigned z) zwordsize). - - rewrite bits_and; auto. generalize (unsigned_range z); omega. + - rewrite bits_and; auto. generalize (unsigned_range z); lia. - apply andb_false_r. Qed. @@ -1924,17 +1924,17 @@ Proof. rewrite sign_bit_of_unsigned. unfold lt. rewrite signed_zero. unfold signed. destruct (zlt (unsigned x) half_modulus). - rewrite zlt_false. auto. generalize (unsigned_range x); omega. + rewrite zlt_false. auto. generalize (unsigned_range x); lia. rewrite zlt_true. unfold one; rewrite testbit_repr; auto. - generalize (unsigned_range x); omega. - omega. + generalize (unsigned_range x); lia. + lia. rewrite zlt_false. unfold testbit. rewrite Ztestbit_eq. rewrite zeq_false. destruct (lt x zero). rewrite unsigned_one. simpl Z.div2. rewrite Z.testbit_0_l; auto. rewrite unsigned_zero. simpl Z.div2. rewrite Z.testbit_0_l; auto. - auto. omega. omega. - generalize wordsize_max_unsigned; omega. + auto. lia. lia. + generalize wordsize_max_unsigned; lia. Qed. Theorem shr_lt_zero: @@ -1945,13 +1945,13 @@ Proof. rewrite bits_shr; auto. rewrite unsigned_repr. transitivity (testbit x (zwordsize - 1)). - f_equal. destruct (zlt (i + (zwordsize - 1)) zwordsize); omega. + f_equal. destruct (zlt (i + (zwordsize - 1)) zwordsize); lia. rewrite sign_bit_of_unsigned. unfold lt. rewrite signed_zero. unfold signed. destruct (zlt (unsigned x) half_modulus). - rewrite zlt_false. rewrite bits_zero; auto. generalize (unsigned_range x); omega. - rewrite zlt_true. rewrite bits_mone; auto. generalize (unsigned_range x); omega. - generalize wordsize_max_unsigned; omega. + rewrite zlt_false. rewrite bits_zero; auto. generalize (unsigned_range x); lia. + rewrite zlt_true. rewrite bits_mone; auto. generalize (unsigned_range x); lia. + generalize wordsize_max_unsigned; lia. Qed. (** ** Properties of rotations *) @@ -1968,20 +1968,20 @@ Proof. exploit (Z_mod_lt (unsigned y) zwordsize). apply wordsize_pos. fold j. intros RANGE. rewrite testbit_repr; auto. - rewrite Z.lor_spec. rewrite Z.shiftr_spec. 2: omega. + rewrite Z.lor_spec. rewrite Z.shiftr_spec. 2: lia. destruct (zlt i j). - rewrite Z.shiftl_spec_low; auto. simpl. unfold testbit. f_equal. symmetry. apply Zmod_unique with (-k - 1). rewrite EQ. ring. - omega. + lia. - rewrite Z.shiftl_spec_high. fold (testbit x (i + (zwordsize - j))). rewrite bits_above. rewrite orb_false_r. fold (testbit x (i - j)). f_equal. symmetry. apply Zmod_unique with (-k). rewrite EQ. ring. - omega. omega. omega. omega. + lia. lia. lia. lia. Qed. Lemma bits_ror: @@ -1996,20 +1996,20 @@ Proof. exploit (Z_mod_lt (unsigned y) zwordsize). apply wordsize_pos. fold j. intros RANGE. rewrite testbit_repr; auto. - rewrite Z.lor_spec. rewrite Z.shiftr_spec. 2: omega. + rewrite Z.lor_spec. rewrite Z.shiftr_spec. 2: lia. destruct (zlt (i + j) zwordsize). - rewrite Z.shiftl_spec_low; auto. rewrite orb_false_r. unfold testbit. f_equal. symmetry. apply Zmod_unique with k. rewrite EQ. ring. - omega. omega. + lia. lia. - rewrite Z.shiftl_spec_high. fold (testbit x (i + j)). rewrite bits_above. simpl. unfold testbit. f_equal. symmetry. apply Zmod_unique with (k + 1). rewrite EQ. ring. - omega. omega. omega. omega. + lia. lia. lia. lia. Qed. Hint Rewrite bits_rol bits_ror: ints. @@ -2026,8 +2026,8 @@ Proof. - rewrite andb_false_r; auto. - generalize (unsigned_range n); intros. rewrite bits_mone. rewrite andb_true_r. f_equal. - symmetry. apply Z.mod_small. omega. - omega. + symmetry. apply Z.mod_small. lia. + lia. Qed. Theorem shru_rolm: @@ -2042,9 +2042,9 @@ Proof. - generalize (unsigned_range n); intros. rewrite bits_mone. rewrite andb_true_r. f_equal. unfold sub. rewrite unsigned_repr. rewrite unsigned_repr_wordsize. - symmetry. apply Zmod_unique with (-1). ring. omega. - rewrite unsigned_repr_wordsize. generalize wordsize_max_unsigned. omega. - omega. + symmetry. apply Zmod_unique with (-1). ring. lia. + rewrite unsigned_repr_wordsize. generalize wordsize_max_unsigned. lia. + lia. - rewrite andb_false_r; auto. Qed. @@ -2098,11 +2098,11 @@ Proof. apply eqmod_sub. apply eqmod_sym. apply eqmod_mod. apply wordsize_pos. apply eqmod_refl. - replace (i - M - N) with (i - (M + N)) by omega. + replace (i - M - N) with (i - (M + N)) by lia. apply eqmod_sub. apply eqmod_refl. apply eqmod_trans with (Z.modulo (unsigned n + unsigned m) zwordsize). - replace (M + N) with (N + M) by omega. apply eqmod_mod. apply wordsize_pos. + replace (M + N) with (N + M) by lia. apply eqmod_mod. apply wordsize_pos. unfold modu, add. fold M; fold N. rewrite unsigned_repr_wordsize. assert (forall a, eqmod zwordsize a (unsigned (repr a))). intros. eapply eqmod_divides. apply eqm_unsigned_repr. assumption. @@ -2149,7 +2149,7 @@ Proof. unfold sub. rewrite unsigned_repr. rewrite unsigned_repr_wordsize. apply eqmod_mod_eq. apply wordsize_pos. exists 1. ring. rewrite unsigned_repr_wordsize. - generalize wordsize_pos; generalize wordsize_max_unsigned; omega. + generalize wordsize_pos; generalize wordsize_max_unsigned; lia. Qed. Theorem ror_rol_neg: @@ -2157,9 +2157,9 @@ Theorem ror_rol_neg: Proof. intros. apply same_bits_eq; intros. rewrite bits_ror by auto. rewrite bits_rol by auto. - f_equal. apply eqmod_mod_eq. omega. + f_equal. apply eqmod_mod_eq. lia. apply eqmod_trans with (i - (- unsigned y)). - apply eqmod_refl2; omega. + apply eqmod_refl2; lia. apply eqmod_sub. apply eqmod_refl. apply eqmod_divides with modulus. apply eqm_unsigned_repr. auto. @@ -2182,8 +2182,8 @@ Proof. assert (unsigned (add y z) = zwordsize). rewrite H1. apply unsigned_repr_wordsize. unfold add in H5. rewrite unsigned_repr in H5. - omega. - generalize two_wordsize_max_unsigned; omega. + lia. + generalize two_wordsize_max_unsigned; lia. - apply eqm_unsigned_repr_r. apply eqm_refl2. f_equal. apply Z.mod_small; auto. Qed. @@ -2199,10 +2199,10 @@ Proof. destruct (Z_is_power2 (unsigned n)) as [i|] eqn:E; inv H. assert (0 <= i < zwordsize). { apply Z_is_power2_range with (unsigned n). - generalize wordsize_pos; omega. + generalize wordsize_pos; lia. rewrite <- modulus_power. apply unsigned_range. auto. } - rewrite unsigned_repr; auto. generalize wordsize_max_unsigned; omega. + rewrite unsigned_repr; auto. generalize wordsize_max_unsigned; lia. Qed. Lemma is_power2_rng: @@ -2236,10 +2236,10 @@ Remark two_p_range: 0 <= two_p n <= max_unsigned. Proof. intros. split. - assert (two_p n > 0). apply two_p_gt_ZERO. omega. omega. + assert (two_p n > 0). apply two_p_gt_ZERO. lia. lia. generalize (two_p_monotone_strict _ _ H). unfold zwordsize; rewrite <- two_power_nat_two_p. - unfold max_unsigned, modulus. omega. + unfold max_unsigned, modulus. lia. Qed. Lemma is_power2_two_p: @@ -2247,7 +2247,7 @@ Lemma is_power2_two_p: is_power2 (repr (two_p n)) = Some (repr n). Proof. intros. unfold is_power2. rewrite unsigned_repr. - rewrite Z_is_power2_complete by omega; auto. + rewrite Z_is_power2_complete by lia; auto. apply two_p_range. auto. Qed. @@ -2261,7 +2261,7 @@ Lemma shl_mul_two_p: Proof. intros. unfold shl, mul. apply eqm_samerepr. rewrite Zshiftl_mul_two_p. auto with ints. - generalize (unsigned_range y); omega. + generalize (unsigned_range y); lia. Qed. Theorem shl_mul: @@ -2297,19 +2297,19 @@ Proof. rewrite shl_mul_two_p. unfold mul. apply eqm_unsigned_repr_l. apply eqm_mult; auto with ints. apply eqm_unsigned_repr_l. apply eqm_refl2. rewrite unsigned_repr. auto. - generalize wordsize_max_unsigned; omega. + generalize wordsize_max_unsigned; lia. - bit_solve. rewrite unsigned_repr. destruct (zlt i n). + auto. + replace (testbit y i) with false. apply andb_false_r. symmetry. unfold testbit. - assert (EQ: Z.of_nat (Z.to_nat n) = n) by (apply Z2Nat.id; omega). + assert (EQ: Z.of_nat (Z.to_nat n) = n) by (apply Z2Nat.id; lia). apply Ztestbit_above with (Z.to_nat n). rewrite <- EQ in H0. rewrite <- two_power_nat_two_p in H0. - generalize (unsigned_range y); omega. + generalize (unsigned_range y); lia. rewrite EQ; auto. - + generalize wordsize_max_unsigned; omega. + + generalize wordsize_max_unsigned; lia. Qed. (** Unsigned right shifts and unsigned divisions by powers of 2. *) @@ -2320,7 +2320,7 @@ Lemma shru_div_two_p: Proof. intros. unfold shru. rewrite Zshiftr_div_two_p. auto. - generalize (unsigned_range y); omega. + generalize (unsigned_range y); lia. Qed. Theorem divu_pow2: @@ -2340,7 +2340,7 @@ Lemma shr_div_two_p: Proof. intros. unfold shr. rewrite Zshiftr_div_two_p. auto. - generalize (unsigned_range y); omega. + generalize (unsigned_range y); lia. Qed. Theorem divs_pow2: @@ -2393,24 +2393,24 @@ Proof. set (uy := unsigned y). assert (0 <= uy < zwordsize - 1). generalize (ltu_inv _ _ H). rewrite unsigned_repr. auto. - generalize wordsize_pos wordsize_max_unsigned; omega. + generalize wordsize_pos wordsize_max_unsigned; lia. rewrite shr_div_two_p. unfold shrx. unfold divs. assert (shl one y = repr (two_p uy)). transitivity (mul one (repr (two_p uy))). symmetry. apply mul_pow2. replace y with (repr uy). - apply is_power2_two_p. omega. apply repr_unsigned. + apply is_power2_two_p. lia. apply repr_unsigned. rewrite mul_commut. apply mul_one. - assert (two_p uy > 0). apply two_p_gt_ZERO. omega. + assert (two_p uy > 0). apply two_p_gt_ZERO. lia. assert (two_p uy < half_modulus). rewrite half_modulus_power. apply two_p_monotone_strict. auto. assert (two_p uy < modulus). - rewrite modulus_power. apply two_p_monotone_strict. omega. + rewrite modulus_power. apply two_p_monotone_strict. lia. assert (unsigned (shl one y) = two_p uy). - rewrite H1. apply unsigned_repr. unfold max_unsigned. omega. + rewrite H1. apply unsigned_repr. unfold max_unsigned. lia. assert (signed (shl one y) = two_p uy). rewrite H1. apply signed_repr. - unfold max_signed. generalize min_signed_neg. omega. + unfold max_signed. generalize min_signed_neg. lia. rewrite H6. rewrite Zquot_Zdiv; auto. unfold lt. rewrite signed_zero. @@ -2419,10 +2419,10 @@ Proof. assert (signed (sub (shl one y) one) = two_p uy - 1). unfold sub. rewrite H5. rewrite unsigned_one. apply signed_repr. - generalize min_signed_neg. unfold max_signed. omega. - rewrite H7. rewrite signed_repr. f_equal. f_equal. omega. + generalize min_signed_neg. unfold max_signed. lia. + rewrite H7. rewrite signed_repr. f_equal. f_equal. lia. generalize (signed_range x). intros. - assert (two_p uy - 1 <= max_signed). unfold max_signed. omega. omega. + assert (two_p uy - 1 <= max_signed). unfold max_signed. lia. lia. Qed. Theorem shrx_shr_2: @@ -2437,19 +2437,19 @@ Proof. generalize (unsigned_range y); fold uy; intros. assert (0 <= uy < zwordsize - 1). generalize (ltu_inv _ _ H). rewrite unsigned_repr. auto. - generalize wordsize_pos wordsize_max_unsigned; omega. + generalize wordsize_pos wordsize_max_unsigned; lia. assert (two_p uy < modulus). - rewrite modulus_power. apply two_p_monotone_strict. omega. + rewrite modulus_power. apply two_p_monotone_strict. lia. f_equal. rewrite shl_mul_two_p. fold uy. rewrite mul_commut. rewrite mul_one. unfold sub. rewrite unsigned_one. rewrite unsigned_repr. rewrite unsigned_repr_wordsize. fold uy. apply same_bits_eq; intros. rewrite bits_shru by auto. - rewrite testbit_repr by auto. rewrite Ztestbit_two_p_m1 by omega. - rewrite unsigned_repr by (generalize wordsize_max_unsigned; omega). + rewrite testbit_repr by auto. rewrite Ztestbit_two_p_m1 by lia. + rewrite unsigned_repr by (generalize wordsize_max_unsigned; lia). destruct (zlt i uy). - rewrite zlt_true by omega. rewrite bits_mone by omega. auto. - rewrite zlt_false by omega. auto. - assert (two_p uy > 0) by (apply two_p_gt_ZERO; omega). unfold max_unsigned; omega. + rewrite zlt_true by lia. rewrite bits_mone by lia. auto. + rewrite zlt_false by lia. auto. + assert (two_p uy > 0) by (apply two_p_gt_ZERO; lia). unfold max_unsigned; lia. - replace (shru zero (sub iwordsize y)) with zero. rewrite add_zero; auto. bit_solve. destruct (zlt (i + unsigned (sub iwordsize y)) zwordsize); auto. @@ -2518,23 +2518,23 @@ Proof. set (uy := unsigned y). assert (0 <= uy < zwordsize - 1). generalize (ltu_inv _ _ H). rewrite unsigned_repr. auto. - generalize wordsize_pos wordsize_max_unsigned; omega. + generalize wordsize_pos wordsize_max_unsigned; lia. assert (shl one y = repr (two_p uy)). rewrite shl_mul_two_p. rewrite mul_commut. apply mul_one. assert (and x (sub (shl one y) one) = modu x (repr (two_p uy))). symmetry. rewrite H1. apply modu_and with (logn := y). rewrite is_power2_two_p. unfold uy. rewrite repr_unsigned. auto. - omega. + lia. rewrite H2. rewrite H1. repeat rewrite shr_div_two_p. fold sx. fold uy. - assert (two_p uy > 0). apply two_p_gt_ZERO. omega. + assert (two_p uy > 0). apply two_p_gt_ZERO. lia. assert (two_p uy < modulus). - rewrite modulus_power. apply two_p_monotone_strict. omega. + rewrite modulus_power. apply two_p_monotone_strict. lia. assert (two_p uy < half_modulus). rewrite half_modulus_power. apply two_p_monotone_strict. auto. assert (two_p uy < modulus). - rewrite modulus_power. apply two_p_monotone_strict. omega. + rewrite modulus_power. apply two_p_monotone_strict. lia. assert (sub (repr (two_p uy)) one = repr (two_p uy - 1)). unfold sub. apply eqm_samerepr. apply eqm_sub. apply eqm_sym; apply eqm_unsigned_repr. rewrite unsigned_one. apply eqm_refl. @@ -2547,17 +2547,17 @@ Proof. fold eqm. unfold sx. apply eqm_sym. apply eqm_signed_unsigned. unfold modulus. rewrite two_power_nat_two_p. exists (two_p (zwordsize - uy)). rewrite <- two_p_is_exp. - f_equal. fold zwordsize; omega. omega. omega. + f_equal. fold zwordsize; lia. lia. lia. rewrite H8. rewrite Zdiv_shift; auto. unfold add. apply eqm_samerepr. apply eqm_add. apply eqm_unsigned_repr. destruct (zeq (sx mod two_p uy) 0); simpl. rewrite unsigned_zero. apply eqm_refl. rewrite unsigned_one. apply eqm_refl. - generalize (Z_mod_lt (unsigned x) (two_p uy) H3). unfold max_unsigned. omega. - unfold max_unsigned; omega. - generalize (signed_range x). fold sx. intros. split. omega. unfold max_signed. omega. - generalize min_signed_neg. unfold max_signed. omega. + generalize (Z_mod_lt (unsigned x) (two_p uy) H3). unfold max_unsigned. lia. + unfold max_unsigned; lia. + generalize (signed_range x). fold sx. intros. split. lia. unfold max_signed. lia. + generalize min_signed_neg. unfold max_signed. lia. Qed. (** Connections between [shr] and [shru]. *) @@ -2576,14 +2576,14 @@ Lemma and_positive: forall x y, signed y >= 0 -> signed (and x y) >= 0. Proof. intros. - assert (unsigned y < half_modulus). rewrite signed_positive in H. unfold max_signed in H; omega. + assert (unsigned y < half_modulus). rewrite signed_positive in H. unfold max_signed in H; lia. generalize (sign_bit_of_unsigned y). rewrite zlt_true; auto. intros A. generalize (sign_bit_of_unsigned (and x y)). rewrite bits_and. rewrite A. rewrite andb_false_r. unfold signed. destruct (zlt (unsigned (and x y)) half_modulus). - intros. generalize (unsigned_range (and x y)); omega. + intros. generalize (unsigned_range (and x y)); lia. congruence. - generalize wordsize_pos; omega. + generalize wordsize_pos; lia. Qed. Theorem shr_and_is_shru_and: @@ -2610,7 +2610,7 @@ Lemma bits_sign_ext: testbit (sign_ext n x) i = testbit x (if zlt i n then i else n - 1). Proof. intros. unfold sign_ext. - rewrite testbit_repr; auto. apply Zsign_ext_spec. omega. + rewrite testbit_repr; auto. apply Zsign_ext_spec. lia. Qed. Hint Rewrite bits_zero_ext bits_sign_ext: ints. @@ -2619,13 +2619,13 @@ Theorem zero_ext_above: forall n x, n >= zwordsize -> zero_ext n x = x. Proof. intros. apply same_bits_eq; intros. - rewrite bits_zero_ext. apply zlt_true. omega. omega. + rewrite bits_zero_ext. apply zlt_true. lia. lia. Qed. Theorem zero_ext_below: forall n x, n <= 0 -> zero_ext n x = zero. Proof. - intros. bit_solve. destruct (zlt i n); auto. apply bits_below; omega. omega. + intros. bit_solve. destruct (zlt i n); auto. apply bits_below; lia. lia. Qed. Theorem sign_ext_above: @@ -2633,13 +2633,13 @@ Theorem sign_ext_above: Proof. intros. apply same_bits_eq; intros. unfold sign_ext; rewrite testbit_repr; auto. - rewrite Zsign_ext_spec. rewrite zlt_true. auto. omega. omega. + rewrite Zsign_ext_spec. rewrite zlt_true. auto. lia. lia. Qed. Theorem sign_ext_below: forall n x, n <= 0 -> sign_ext n x = zero. Proof. - intros. bit_solve. apply bits_below. destruct (zlt i n); omega. + intros. bit_solve. apply bits_below. destruct (zlt i n); lia. Qed. Theorem zero_ext_and: @@ -2661,8 +2661,8 @@ Proof. fold (testbit (zero_ext n x) i). destruct (zlt i zwordsize). rewrite bits_zero_ext; auto. - rewrite bits_above. rewrite zlt_false; auto. omega. omega. - omega. + rewrite bits_above. rewrite zlt_false; auto. lia. lia. + lia. Qed. Theorem zero_ext_widen: @@ -2670,7 +2670,7 @@ Theorem zero_ext_widen: zero_ext n' (zero_ext n x) = zero_ext n x. Proof. bit_solve. destruct (zlt i n). - apply zlt_true. omega. + apply zlt_true. lia. destruct (zlt i n'); auto. tauto. tauto. Qed. @@ -2683,9 +2683,9 @@ Proof. bit_solve. destruct (zlt i n'). auto. rewrite (zlt_false _ i n). - destruct (zlt (n' - 1) n); f_equal; omega. - omega. - destruct (zlt i n'); omega. + destruct (zlt (n' - 1) n); f_equal; lia. + lia. + destruct (zlt i n'); lia. apply sign_ext_above; auto. Qed. @@ -2697,8 +2697,8 @@ Proof. bit_solve. destruct (zlt i n'). auto. - rewrite !zlt_false. auto. omega. omega. omega. - destruct (zlt i n'); omega. + rewrite !zlt_false. auto. lia. lia. lia. + destruct (zlt i n'); lia. apply sign_ext_above; auto. Qed. @@ -2707,9 +2707,9 @@ Theorem zero_ext_narrow: zero_ext n (zero_ext n' x) = zero_ext n x. Proof. bit_solve. destruct (zlt i n). - apply zlt_true. omega. + apply zlt_true. lia. auto. - omega. omega. omega. + lia. lia. lia. Qed. Theorem sign_ext_narrow: @@ -2717,9 +2717,9 @@ Theorem sign_ext_narrow: sign_ext n (sign_ext n' x) = sign_ext n x. Proof. intros. destruct (zlt n zwordsize). - bit_solve. destruct (zlt i n); f_equal; apply zlt_true; omega. - destruct (zlt i n); omega. - rewrite (sign_ext_above n'). auto. omega. + bit_solve. destruct (zlt i n); f_equal; apply zlt_true; lia. + destruct (zlt i n); lia. + rewrite (sign_ext_above n'). auto. lia. Qed. Theorem zero_sign_ext_narrow: @@ -2729,21 +2729,21 @@ Proof. intros. destruct (zlt n' zwordsize). bit_solve. destruct (zlt i n); auto. - rewrite zlt_true; auto. omega. - omega. omega. + rewrite zlt_true; auto. lia. + lia. lia. rewrite sign_ext_above; auto. Qed. Theorem zero_ext_idem: forall n x, 0 <= n -> zero_ext n (zero_ext n x) = zero_ext n x. Proof. - intros. apply zero_ext_widen. omega. + intros. apply zero_ext_widen. lia. Qed. Theorem sign_ext_idem: forall n x, 0 < n -> sign_ext n (sign_ext n x) = sign_ext n x. Proof. - intros. apply sign_ext_widen. omega. + intros. apply sign_ext_widen. lia. Qed. Theorem sign_ext_zero_ext: @@ -2753,15 +2753,15 @@ Proof. bit_solve. destruct (zlt i n). rewrite zlt_true; auto. - rewrite zlt_true; auto. omega. - destruct (zlt i n); omega. + rewrite zlt_true; auto. lia. + destruct (zlt i n); lia. rewrite zero_ext_above; auto. Qed. Theorem zero_ext_sign_ext: forall n x, 0 < n -> zero_ext n (sign_ext n x) = zero_ext n x. Proof. - intros. apply zero_sign_ext_narrow. omega. + intros. apply zero_sign_ext_narrow. lia. Qed. Theorem sign_ext_equal_if_zero_equal: @@ -2784,21 +2784,21 @@ Proof. apply same_bits_eq; intros. rewrite bits_shru by auto. fold Z. destruct (zlt Z Y). - assert (A: unsigned (sub y z) = Y - Z). - { apply unsigned_repr. generalize wordsize_max_unsigned; omega. } - symmetry; rewrite bits_shl, A by omega. + { apply unsigned_repr. generalize wordsize_max_unsigned; lia. } + symmetry; rewrite bits_shl, A by lia. destruct (zlt (i + Z) zwordsize). -+ rewrite bits_shl by omega. fold Y. - destruct (zlt i (Y - Z)); [rewrite zlt_true by omega|rewrite zlt_false by omega]; auto. - rewrite bits_zero_ext by omega. rewrite zlt_true by omega. f_equal; omega. -+ rewrite bits_zero_ext by omega. rewrite ! zlt_false by omega. auto. ++ rewrite bits_shl by lia. fold Y. + destruct (zlt i (Y - Z)); [rewrite zlt_true by lia|rewrite zlt_false by lia]; auto. + rewrite bits_zero_ext by lia. rewrite zlt_true by lia. f_equal; lia. ++ rewrite bits_zero_ext by lia. rewrite ! zlt_false by lia. auto. - assert (A: unsigned (sub z y) = Z - Y). - { apply unsigned_repr. generalize wordsize_max_unsigned; omega. } - rewrite bits_zero_ext, bits_shru, A by omega. - destruct (zlt (i + Z) zwordsize); [rewrite zlt_true by omega|rewrite zlt_false by omega]; auto. - rewrite bits_shl by omega. fold Y. + { apply unsigned_repr. generalize wordsize_max_unsigned; lia. } + rewrite bits_zero_ext, bits_shru, A by lia. + destruct (zlt (i + Z) zwordsize); [rewrite zlt_true by lia|rewrite zlt_false by lia]; auto. + rewrite bits_shl by lia. fold Y. destruct (zlt (i + Z) Y). -+ rewrite zlt_false by omega. auto. -+ rewrite zlt_true by omega. f_equal; omega. ++ rewrite zlt_false by lia. auto. ++ rewrite zlt_true by lia. f_equal; lia. Qed. Corollary zero_ext_shru_shl: @@ -2809,11 +2809,11 @@ Corollary zero_ext_shru_shl: Proof. intros. assert (A: unsigned y = zwordsize - n). - { unfold y. apply unsigned_repr. generalize wordsize_max_unsigned. omega. } + { unfold y. apply unsigned_repr. generalize wordsize_max_unsigned. lia. } assert (B: ltu y iwordsize = true). - { unfold ltu; rewrite A, unsigned_repr_wordsize. apply zlt_true; omega. } - rewrite shru_shl by auto. unfold ltu; rewrite zlt_false by omega. - rewrite sub_idem, shru_zero. f_equal. rewrite A; omega. + { unfold ltu; rewrite A, unsigned_repr_wordsize. apply zlt_true; lia. } + rewrite shru_shl by auto. unfold ltu; rewrite zlt_false by lia. + rewrite sub_idem, shru_zero. f_equal. rewrite A; lia. Qed. Theorem shr_shl: @@ -2825,26 +2825,26 @@ Proof. intros. apply ltu_iwordsize_inv in H; apply ltu_iwordsize_inv in H0. unfold ltu. set (Y := unsigned y) in *; set (Z := unsigned z) in *. apply same_bits_eq; intros. rewrite bits_shr by auto. fold Z. - rewrite bits_shl by (destruct (zlt (i + Z) zwordsize); omega). fold Y. + rewrite bits_shl by (destruct (zlt (i + Z) zwordsize); lia). fold Y. destruct (zlt Z Y). - assert (A: unsigned (sub y z) = Y - Z). - { apply unsigned_repr. generalize wordsize_max_unsigned; omega. } - rewrite bits_shl, A by omega. + { apply unsigned_repr. generalize wordsize_max_unsigned; lia. } + rewrite bits_shl, A by lia. destruct (zlt i (Y - Z)). -+ apply zlt_true. destruct (zlt (i + Z) zwordsize); omega. -+ rewrite zlt_false by (destruct (zlt (i + Z) zwordsize); omega). - rewrite bits_sign_ext by omega. f_equal. ++ apply zlt_true. destruct (zlt (i + Z) zwordsize); lia. ++ rewrite zlt_false by (destruct (zlt (i + Z) zwordsize); lia). + rewrite bits_sign_ext by lia. f_equal. destruct (zlt (i + Z) zwordsize). - rewrite zlt_true by omega. omega. - rewrite zlt_false by omega. omega. + rewrite zlt_true by lia. lia. + rewrite zlt_false by lia. lia. - assert (A: unsigned (sub z y) = Z - Y). - { apply unsigned_repr. generalize wordsize_max_unsigned; omega. } - rewrite bits_sign_ext by omega. - rewrite bits_shr by (destruct (zlt i (zwordsize - Z)); omega). - rewrite A. rewrite zlt_false by (destruct (zlt (i + Z) zwordsize); omega). + { apply unsigned_repr. generalize wordsize_max_unsigned; lia. } + rewrite bits_sign_ext by lia. + rewrite bits_shr by (destruct (zlt i (zwordsize - Z)); lia). + rewrite A. rewrite zlt_false by (destruct (zlt (i + Z) zwordsize); lia). f_equal. destruct (zlt i (zwordsize - Z)). -+ rewrite ! zlt_true by omega. omega. -+ rewrite ! zlt_false by omega. rewrite zlt_true by omega. omega. ++ rewrite ! zlt_true by lia. lia. ++ rewrite ! zlt_false by lia. rewrite zlt_true by lia. lia. Qed. Corollary sign_ext_shr_shl: @@ -2855,11 +2855,11 @@ Corollary sign_ext_shr_shl: Proof. intros. assert (A: unsigned y = zwordsize - n). - { unfold y. apply unsigned_repr. generalize wordsize_max_unsigned. omega. } + { unfold y. apply unsigned_repr. generalize wordsize_max_unsigned. lia. } assert (B: ltu y iwordsize = true). - { unfold ltu; rewrite A, unsigned_repr_wordsize. apply zlt_true; omega. } - rewrite shr_shl by auto. unfold ltu; rewrite zlt_false by omega. - rewrite sub_idem, shr_zero. f_equal. rewrite A; omega. + { unfold ltu; rewrite A, unsigned_repr_wordsize. apply zlt_true; lia. } + rewrite shr_shl by auto. unfold ltu; rewrite zlt_false by lia. + rewrite sub_idem, shr_zero. f_equal. rewrite A; lia. Qed. (** [zero_ext n x] is the unique integer congruent to [x] modulo [2^n] @@ -2868,14 +2868,14 @@ Qed. Lemma zero_ext_range: forall n x, 0 <= n < zwordsize -> 0 <= unsigned (zero_ext n x) < two_p n. Proof. - intros. rewrite zero_ext_mod; auto. apply Z_mod_lt. apply two_p_gt_ZERO. omega. + intros. rewrite zero_ext_mod; auto. apply Z_mod_lt. apply two_p_gt_ZERO. lia. Qed. Lemma eqmod_zero_ext: forall n x, 0 <= n < zwordsize -> eqmod (two_p n) (unsigned (zero_ext n x)) (unsigned x). Proof. intros. rewrite zero_ext_mod; auto. apply eqmod_sym. apply eqmod_mod. - apply two_p_gt_ZERO. omega. + apply two_p_gt_ZERO. lia. Qed. (** [sign_ext n x] is the unique integer congruent to [x] modulo [2^n] @@ -2886,26 +2886,26 @@ Lemma sign_ext_range: Proof. intros. rewrite sign_ext_shr_shl; auto. set (X := shl x (repr (zwordsize - n))). - assert (two_p (n - 1) > 0) by (apply two_p_gt_ZERO; omega). + assert (two_p (n - 1) > 0) by (apply two_p_gt_ZERO; lia). assert (unsigned (repr (zwordsize - n)) = zwordsize - n). apply unsigned_repr. - split. omega. generalize wordsize_max_unsigned; omega. + split. lia. generalize wordsize_max_unsigned; lia. rewrite shr_div_two_p. rewrite signed_repr. rewrite H1. apply Zdiv_interval_1. - omega. omega. apply two_p_gt_ZERO; omega. + lia. lia. apply two_p_gt_ZERO; lia. replace (- two_p (n - 1) * two_p (zwordsize - n)) with (- (two_p (n - 1) * two_p (zwordsize - n))) by ring. rewrite <- two_p_is_exp. - replace (n - 1 + (zwordsize - n)) with (zwordsize - 1) by omega. + replace (n - 1 + (zwordsize - n)) with (zwordsize - 1) by lia. rewrite <- half_modulus_power. - generalize (signed_range X). unfold min_signed, max_signed. omega. - omega. omega. + generalize (signed_range X). unfold min_signed, max_signed. lia. + lia. lia. apply Zdiv_interval_2. apply signed_range. - generalize min_signed_neg; omega. - generalize max_signed_pos; omega. - rewrite H1. apply two_p_gt_ZERO. omega. + generalize min_signed_neg; lia. + generalize max_signed_pos; lia. + rewrite H1. apply two_p_gt_ZERO. lia. Qed. Lemma eqmod_sign_ext': @@ -2914,12 +2914,12 @@ Lemma eqmod_sign_ext': Proof. intros. set (N := Z.to_nat n). - assert (Z.of_nat N = n) by (apply Z2Nat.id; omega). + assert (Z.of_nat N = n) by (apply Z2Nat.id; lia). rewrite <- H0. rewrite <- two_power_nat_two_p. apply eqmod_same_bits; intros. rewrite H0 in H1. rewrite H0. fold (testbit (sign_ext n x) i). rewrite bits_sign_ext. - rewrite zlt_true. auto. omega. omega. + rewrite zlt_true. auto. lia. lia. Qed. Lemma eqmod_sign_ext: @@ -2930,7 +2930,7 @@ Proof. apply eqmod_divides with modulus. apply eqm_signed_unsigned. exists (two_p (zwordsize - n)). unfold modulus. rewrite two_power_nat_two_p. fold zwordsize. - rewrite <- two_p_is_exp. f_equal. omega. omega. omega. + rewrite <- two_p_is_exp. f_equal. lia. lia. lia. apply eqmod_sign_ext'; auto. Qed. @@ -2941,11 +2941,11 @@ Lemma shl_zero_ext: shl (zero_ext n x) m = zero_ext (n + unsigned m) (shl x m). Proof. intros. apply same_bits_eq; intros. - rewrite bits_zero_ext, ! bits_shl by omega. + rewrite bits_zero_ext, ! bits_shl by lia. destruct (zlt i (unsigned m)). -- rewrite zlt_true by omega; auto. -- rewrite bits_zero_ext by omega. - destruct (zlt (i - unsigned m) n); [rewrite zlt_true by omega|rewrite zlt_false by omega]; auto. +- rewrite zlt_true by lia; auto. +- rewrite bits_zero_ext by lia. + destruct (zlt (i - unsigned m) n); [rewrite zlt_true by lia|rewrite zlt_false by lia]; auto. Qed. Lemma shl_sign_ext: @@ -2954,12 +2954,12 @@ Lemma shl_sign_ext: Proof. intros. generalize (unsigned_range m); intros. apply same_bits_eq; intros. - rewrite bits_sign_ext, ! bits_shl by omega. + rewrite bits_sign_ext, ! bits_shl by lia. destruct (zlt i (n + unsigned m)). - rewrite bits_shl by auto. destruct (zlt i (unsigned m)); auto. - rewrite bits_sign_ext by omega. f_equal. apply zlt_true. omega. -- rewrite zlt_false by omega. rewrite bits_shl by omega. rewrite zlt_false by omega. - rewrite bits_sign_ext by omega. f_equal. rewrite zlt_false by omega. omega. + rewrite bits_sign_ext by lia. f_equal. apply zlt_true. lia. +- rewrite zlt_false by lia. rewrite bits_shl by lia. rewrite zlt_false by lia. + rewrite bits_sign_ext by lia. f_equal. rewrite zlt_false by lia. lia. Qed. Lemma shru_zero_ext: @@ -2968,10 +2968,10 @@ Lemma shru_zero_ext: Proof. intros. bit_solve. - destruct (zlt (i + unsigned m) zwordsize). -* destruct (zlt i n); [rewrite zlt_true by omega|rewrite zlt_false by omega]; auto. +* destruct (zlt i n); [rewrite zlt_true by lia|rewrite zlt_false by lia]; auto. * destruct (zlt i n); auto. -- generalize (unsigned_range m); omega. -- omega. +- generalize (unsigned_range m); lia. +- lia. Qed. Lemma shru_zero_ext_0: @@ -2980,8 +2980,8 @@ Lemma shru_zero_ext_0: Proof. intros. bit_solve. - destruct (zlt (i + unsigned m) zwordsize); auto. - apply zlt_false. omega. -- generalize (unsigned_range m); omega. + apply zlt_false. lia. +- generalize (unsigned_range m); lia. Qed. Lemma shr_sign_ext: @@ -2994,12 +2994,12 @@ Proof. rewrite bits_sign_ext, bits_shr. - f_equal. destruct (zlt i n), (zlt (i + unsigned m) zwordsize). -+ apply zlt_true; omega. -+ apply zlt_true; omega. -+ rewrite zlt_false by omega. rewrite zlt_true by omega. omega. -+ rewrite zlt_false by omega. rewrite zlt_true by omega. omega. -- destruct (zlt i n); omega. -- destruct (zlt (i + unsigned m) zwordsize); omega. ++ apply zlt_true; lia. ++ apply zlt_true; lia. ++ rewrite zlt_false by lia. rewrite zlt_true by lia. lia. ++ rewrite zlt_false by lia. rewrite zlt_true by lia. lia. +- destruct (zlt i n); lia. +- destruct (zlt (i + unsigned m) zwordsize); lia. Qed. Lemma zero_ext_shru_min: @@ -3008,10 +3008,10 @@ Lemma zero_ext_shru_min: Proof. intros. apply ltu_iwordsize_inv in H. apply Z.min_case_strong; intros; auto. - bit_solve; try omega. + bit_solve; try lia. destruct (zlt i (zwordsize - unsigned n)). - rewrite zlt_true by omega. auto. - destruct (zlt i s); auto. rewrite zlt_false by omega; auto. + rewrite zlt_true by lia. auto. + destruct (zlt i s); auto. rewrite zlt_false by lia; auto. Qed. Lemma sign_ext_shr_min: @@ -3023,12 +3023,12 @@ Proof. destruct (Z.min_spec (zwordsize - unsigned n) s) as [[A B] | [A B]]; rewrite B; auto. apply same_bits_eq; intros. rewrite ! bits_sign_ext by auto. destruct (zlt i (zwordsize - unsigned n)). - rewrite zlt_true by omega. auto. + rewrite zlt_true by lia. auto. assert (C: testbit (shr x n) (zwordsize - unsigned n - 1) = testbit x (zwordsize - 1)). - { rewrite bits_shr by omega. rewrite zlt_true by omega. f_equal; omega. } - rewrite C. destruct (zlt i s); rewrite bits_shr by omega. - rewrite zlt_false by omega. auto. - rewrite zlt_false by omega. auto. + { rewrite bits_shr by lia. rewrite zlt_true by lia. f_equal; lia. } + rewrite C. destruct (zlt i s); rewrite bits_shr by lia. + rewrite zlt_false by lia. auto. + rewrite zlt_false by lia. auto. Qed. Lemma shl_zero_ext_min: @@ -3039,10 +3039,10 @@ Proof. apply Z.min_case_strong; intros; auto. apply same_bits_eq; intros. rewrite ! bits_shl by auto. destruct (zlt i (unsigned n)); auto. - rewrite ! bits_zero_ext by omega. + rewrite ! bits_zero_ext by lia. destruct (zlt (i - unsigned n) s). - rewrite zlt_true by omega; auto. - rewrite zlt_false by omega; auto. + rewrite zlt_true by lia; auto. + rewrite zlt_false by lia; auto. Qed. Lemma shl_sign_ext_min: @@ -3054,10 +3054,10 @@ Proof. destruct (Z.min_spec (zwordsize - unsigned n) s) as [[A B] | [A B]]; rewrite B; auto. apply same_bits_eq; intros. rewrite ! bits_shl by auto. destruct (zlt i (unsigned n)); auto. - rewrite ! bits_sign_ext by omega. f_equal. + rewrite ! bits_sign_ext by lia. f_equal. destruct (zlt (i - unsigned n) s). - rewrite zlt_true by omega; auto. - omegaContradiction. + rewrite zlt_true by lia; auto. + extlia. Qed. (** ** Properties of [one_bits] (decomposition in sum of powers of two) *) @@ -3068,8 +3068,8 @@ Proof. assert (A: forall p, 0 <= p < zwordsize -> ltu (repr p) iwordsize = true). intros. unfold ltu, iwordsize. apply zlt_true. repeat rewrite unsigned_repr. tauto. - generalize wordsize_max_unsigned; omega. - generalize wordsize_max_unsigned; omega. + generalize wordsize_max_unsigned; lia. + generalize wordsize_max_unsigned; lia. unfold one_bits. intros. destruct (list_in_map_inv _ _ _ H) as [i0 [EQ IN]]. subst i. apply A. apply Z_one_bits_range with (unsigned x); auto. @@ -3099,7 +3099,7 @@ Proof. rewrite mul_one. apply eqm_unsigned_repr_r. rewrite unsigned_repr. auto with ints. generalize (H a (in_eq _ _)). change (Z.of_nat wordsize) with zwordsize. - generalize wordsize_max_unsigned. omega. + generalize wordsize_max_unsigned. lia. auto with ints. intros; apply H; auto with coqlib. Qed. @@ -3143,7 +3143,7 @@ Proof. apply eqm_sub. apply eqm_trans with (unsigned (repr (unsigned x + unsigned d))). eauto with ints. apply eqm_trans with (unsigned (repr (unsigned y + unsigned d))). eauto with ints. eauto with ints. eauto with ints. - omega. omega. + lia. lia. Qed. Lemma translate_ltu: @@ -3154,8 +3154,8 @@ Lemma translate_ltu: Proof. intros. unfold add. unfold ltu. repeat rewrite unsigned_repr; auto. case (zlt (unsigned x) (unsigned y)); intro. - apply zlt_true. omega. - apply zlt_false. omega. + apply zlt_true. lia. + apply zlt_false. lia. Qed. Theorem translate_cmpu: @@ -3176,8 +3176,8 @@ Lemma translate_lt: Proof. intros. repeat rewrite add_signed. unfold lt. repeat rewrite signed_repr; auto. case (zlt (signed x) (signed y)); intro. - apply zlt_true. omega. - apply zlt_false. omega. + apply zlt_true. lia. + apply zlt_false. lia. Qed. Theorem translate_cmp: @@ -3213,7 +3213,7 @@ Proof. intros. unfold ltu in H. destruct (zlt (unsigned x) (unsigned y)); try discriminate. rewrite signed_eq_unsigned. - generalize (unsigned_range x). omega. omega. + generalize (unsigned_range x). lia. lia. Qed. Theorem lt_sub_overflow: @@ -3227,30 +3227,30 @@ Proof. unfold min_signed, max_signed in *. generalize half_modulus_pos half_modulus_modulus; intros HM MM. destruct (zle 0 (X - Y)). -- unfold proj_sumbool at 1; rewrite zle_true at 1 by omega. simpl. - rewrite (zlt_false _ X) by omega. +- unfold proj_sumbool at 1; rewrite zle_true at 1 by lia. simpl. + rewrite (zlt_false _ X) by lia. destruct (zlt (X - Y) half_modulus). - + unfold proj_sumbool; rewrite zle_true by omega. - rewrite signed_repr. rewrite zlt_false by omega. apply xor_idem. - unfold min_signed, max_signed; omega. - + unfold proj_sumbool; rewrite zle_false by omega. + + unfold proj_sumbool; rewrite zle_true by lia. + rewrite signed_repr. rewrite zlt_false by lia. apply xor_idem. + unfold min_signed, max_signed; lia. + + unfold proj_sumbool; rewrite zle_false by lia. replace (signed (repr (X - Y))) with (X - Y - modulus). - rewrite zlt_true by omega. apply xor_idem. + rewrite zlt_true by lia. apply xor_idem. rewrite signed_repr_eq. replace ((X - Y) mod modulus) with (X - Y). rewrite zlt_false; auto. - symmetry. apply Zmod_unique with 0; omega. -- unfold proj_sumbool at 2. rewrite zle_true at 1 by omega. rewrite andb_true_r. - rewrite (zlt_true _ X) by omega. + symmetry. apply Zmod_unique with 0; lia. +- unfold proj_sumbool at 2. rewrite zle_true at 1 by lia. rewrite andb_true_r. + rewrite (zlt_true _ X) by lia. destruct (zlt (X - Y) (-half_modulus)). - + unfold proj_sumbool; rewrite zle_false by omega. + + unfold proj_sumbool; rewrite zle_false by lia. replace (signed (repr (X - Y))) with (X - Y + modulus). - rewrite zlt_false by omega. apply xor_zero. + rewrite zlt_false by lia. apply xor_zero. rewrite signed_repr_eq. replace ((X - Y) mod modulus) with (X - Y + modulus). - rewrite zlt_true by omega; auto. - symmetry. apply Zmod_unique with (-1); omega. - + unfold proj_sumbool; rewrite zle_true by omega. - rewrite signed_repr. rewrite zlt_true by omega. apply xor_zero_l. - unfold min_signed, max_signed; omega. + rewrite zlt_true by lia; auto. + symmetry. apply Zmod_unique with (-1); lia. + + unfold proj_sumbool; rewrite zle_true by lia. + rewrite signed_repr. rewrite zlt_true by lia. apply xor_zero_l. + unfold min_signed, max_signed; lia. Qed. Lemma signed_eq: @@ -3270,10 +3270,10 @@ Lemma not_lt: Proof. intros. unfold lt. rewrite signed_eq. unfold proj_sumbool. destruct (zlt (signed y) (signed x)). - rewrite zlt_false. rewrite zeq_false. auto. omega. omega. + rewrite zlt_false. rewrite zeq_false. auto. lia. lia. destruct (zeq (signed x) (signed y)). - rewrite zlt_false. auto. omega. - rewrite zlt_true. auto. omega. + rewrite zlt_false. auto. lia. + rewrite zlt_true. auto. lia. Qed. Lemma lt_not: @@ -3287,10 +3287,10 @@ Lemma not_ltu: Proof. intros. unfold ltu, eq. destruct (zlt (unsigned y) (unsigned x)). - rewrite zlt_false. rewrite zeq_false. auto. omega. omega. + rewrite zlt_false. rewrite zeq_false. auto. lia. lia. destruct (zeq (unsigned x) (unsigned y)). - rewrite zlt_false. auto. omega. - rewrite zlt_true. auto. omega. + rewrite zlt_false. auto. lia. + rewrite zlt_true. auto. lia. Qed. Lemma ltu_not: @@ -3322,7 +3322,7 @@ Proof. clear H3. generalize (unsigned_range ofs1) (unsigned_range ofs2). intros P Q. generalize (unsigned_add_either base ofs1) (unsigned_add_either base ofs2). - intros [C|C] [D|D]; omega. + intros [C|C] [D|D]; lia. Qed. (** ** Size of integers, in bits. *) @@ -3339,14 +3339,14 @@ Theorem bits_size_1: Proof. intros. destruct (zeq (unsigned x) 0). left. rewrite <- (repr_unsigned x). rewrite e; auto. - right. apply Ztestbit_size_1. generalize (unsigned_range x); omega. + right. apply Ztestbit_size_1. generalize (unsigned_range x); lia. Qed. Theorem bits_size_2: forall x i, size x <= i -> testbit x i = false. Proof. - intros. apply Ztestbit_size_2. generalize (unsigned_range x); omega. - fold (size x); omega. + intros. apply Ztestbit_size_2. generalize (unsigned_range x); lia. + fold (size x); lia. Qed. Theorem size_range: @@ -3354,9 +3354,9 @@ Theorem size_range: Proof. intros; split. apply Zsize_pos. destruct (bits_size_1 x). - subst x; unfold size; rewrite unsigned_zero; simpl. generalize wordsize_pos; omega. + subst x; unfold size; rewrite unsigned_zero; simpl. generalize wordsize_pos; lia. destruct (zle (size x) zwordsize); auto. - rewrite bits_above in H. congruence. omega. + rewrite bits_above in H. congruence. lia. Qed. Theorem bits_size_3: @@ -3369,7 +3369,7 @@ Proof. destruct (bits_size_1 x). subst x. unfold size; rewrite unsigned_zero; assumption. rewrite (H0 (Z.pred (size x))) in H1. congruence. - generalize (size_range x); omega. + generalize (size_range x); lia. Qed. Theorem bits_size_4: @@ -3383,14 +3383,14 @@ Proof. assert (size x <= n). apply bits_size_3; auto. destruct (zlt (size x) n). - rewrite bits_size_2 in H0. congruence. omega. - omega. + rewrite bits_size_2 in H0. congruence. lia. + lia. Qed. Theorem size_interval_1: forall x, 0 <= unsigned x < two_p (size x). Proof. - intros; apply Zsize_interval_1. generalize (unsigned_range x); omega. + intros; apply Zsize_interval_1. generalize (unsigned_range x); lia. Qed. Theorem size_interval_2: @@ -3404,9 +3404,9 @@ Theorem size_and: Proof. intros. assert (0 <= Z.min (size a) (size b)). - generalize (size_range a) (size_range b). zify; omega. + generalize (size_range a) (size_range b). zify; lia. apply bits_size_3. auto. intros. - rewrite bits_and by omega. + rewrite bits_and by lia. rewrite andb_false_iff. generalize (bits_size_2 a i). generalize (bits_size_2 b i). @@ -3419,9 +3419,9 @@ Proof. intros. generalize (size_interval_1 (and a b)); intros. assert (two_p (size (and a b)) <= two_p (Z.min (size a) (size b))). - apply two_p_monotone. split. generalize (size_range (and a b)); omega. + apply two_p_monotone. split. generalize (size_range (and a b)); lia. apply size_and. - omega. + lia. Qed. Theorem size_or: @@ -3429,17 +3429,17 @@ Theorem size_or: Proof. intros. generalize (size_range a) (size_range b); intros. destruct (bits_size_1 a). - subst a. rewrite size_zero. rewrite or_zero_l. zify; omega. + subst a. rewrite size_zero. rewrite or_zero_l. zify; lia. destruct (bits_size_1 b). - subst b. rewrite size_zero. rewrite or_zero. zify; omega. + subst b. rewrite size_zero. rewrite or_zero. zify; lia. zify. destruct H3 as [[P Q] | [P Q]]; subst. apply bits_size_4. tauto. rewrite bits_or. rewrite H2. apply orb_true_r. - omega. - intros. rewrite bits_or. rewrite !bits_size_2. auto. omega. omega. omega. + lia. + intros. rewrite bits_or. rewrite !bits_size_2. auto. lia. lia. lia. apply bits_size_4. tauto. rewrite bits_or. rewrite H1. apply orb_true_l. destruct (zeq (size a) 0). unfold testbit in H1. rewrite Z.testbit_neg_r in H1. - congruence. omega. omega. - intros. rewrite bits_or. rewrite !bits_size_2. auto. omega. omega. omega. + congruence. lia. lia. + intros. rewrite bits_or. rewrite !bits_size_2. auto. lia. lia. lia. Qed. Corollary or_interval: @@ -3453,12 +3453,12 @@ Theorem size_xor: Proof. intros. assert (0 <= Z.max (size a) (size b)). - generalize (size_range a) (size_range b). zify; omega. + generalize (size_range a) (size_range b). zify; lia. apply bits_size_3. auto. intros. rewrite bits_xor. rewrite !bits_size_2. auto. - zify; omega. - zify; omega. - omega. + zify; lia. + zify; lia. + lia. Qed. Corollary xor_interval: @@ -3467,9 +3467,9 @@ Proof. intros. generalize (size_interval_1 (xor a b)); intros. assert (two_p (size (xor a b)) <= two_p (Z.max (size a) (size b))). - apply two_p_monotone. split. generalize (size_range (xor a b)); omega. + apply two_p_monotone. split. generalize (size_range (xor a b)); lia. apply size_xor. - omega. + lia. Qed. End Make. @@ -3549,7 +3549,7 @@ Proof. intros. unfold shl'. rewrite testbit_repr; auto. destruct (zlt i (Int.unsigned y)). apply Z.shiftl_spec_low. auto. - apply Z.shiftl_spec_high. omega. omega. + apply Z.shiftl_spec_high. lia. lia. Qed. Lemma bits_shru': @@ -3563,7 +3563,7 @@ Proof. destruct (zlt (i + Int.unsigned y) zwordsize). auto. apply bits_above; auto. - omega. + lia. Qed. Lemma bits_shr': @@ -3574,8 +3574,8 @@ Lemma bits_shr': Proof. intros. unfold shr'. rewrite testbit_repr; auto. rewrite Z.shiftr_spec. apply bits_signed. - generalize (Int.unsigned_range y); omega. - omega. + generalize (Int.unsigned_range y); lia. + lia. Qed. Lemma shl'_mul_two_p: @@ -3584,7 +3584,7 @@ Lemma shl'_mul_two_p: Proof. intros. unfold shl', mul. apply eqm_samerepr. rewrite Zshiftl_mul_two_p. apply eqm_mult. apply eqm_refl. apply eqm_unsigned_repr. - generalize (Int.unsigned_range y); omega. + generalize (Int.unsigned_range y); lia. Qed. Lemma shl'_one_two_p: @@ -3635,7 +3635,7 @@ Proof. intros. apply Int.ltu_inv in H. change (Int.unsigned (Int.repr 63)) with 63 in H. set (y1 := Int64.repr (Int.unsigned y)). assert (U: unsigned y1 = Int.unsigned y). - { apply unsigned_repr. assert (63 < max_unsigned) by reflexivity. omega. } + { apply unsigned_repr. assert (63 < max_unsigned) by reflexivity. lia. } transitivity (shrx x y1). - unfold shrx', shrx, shl', shl. rewrite U; auto. - rewrite shrx_carry. @@ -3656,20 +3656,20 @@ Proof. assert (N1: 63 < max_unsigned) by reflexivity. assert (N2: 63 < Int.max_unsigned) by reflexivity. assert (A: unsigned z = Int.unsigned y). - { unfold z; apply unsigned_repr; omega. } + { unfold z; apply unsigned_repr; lia. } assert (B: unsigned (sub (repr 64) z) = Int.unsigned (Int.sub (Int.repr 64) y)). { unfold z. unfold sub, Int.sub. change (unsigned (repr 64)) with 64. change (Int.unsigned (Int.repr 64)) with 64. - rewrite (unsigned_repr (Int.unsigned y)) by omega. - rewrite unsigned_repr, Int.unsigned_repr by omega. + rewrite (unsigned_repr (Int.unsigned y)) by lia. + rewrite unsigned_repr, Int.unsigned_repr by lia. auto. } unfold shrx', shr', shru', shl'. rewrite <- A. change (Int.unsigned (Int.repr 63)) with (unsigned (repr 63)). rewrite <- B. apply shrx_shr_2. - unfold ltu. apply zlt_true. change (unsigned z < 63). rewrite A; omega. + unfold ltu. apply zlt_true. change (unsigned z < 63). rewrite A; lia. Qed. Lemma shr'63: @@ -3788,11 +3788,11 @@ Proof. change (Int.unsigned iwordsize') with 64 in *. assert (128 < max_unsigned) by reflexivity. assert (128 < Int.max_unsigned) by reflexivity. - assert (Y: unsigned y' = Int.unsigned y) by (apply unsigned_repr; omega). - assert (Z: unsigned z' = Int.unsigned z) by (apply unsigned_repr; omega). + assert (Y: unsigned y' = Int.unsigned y) by (apply unsigned_repr; lia). + assert (Z: unsigned z' = Int.unsigned z) by (apply unsigned_repr; lia). assert (P: Int.unsigned (Int.add y z) = unsigned (add y' z')). - { unfold Int.add. rewrite Int.unsigned_repr by omega. - unfold add. rewrite unsigned_repr by omega. congruence. } + { unfold Int.add. rewrite Int.unsigned_repr by lia. + unfold add. rewrite unsigned_repr by lia. congruence. } intuition auto. apply zlt_true. rewrite Y; auto. apply zlt_true. rewrite Z; auto. @@ -3806,7 +3806,7 @@ Theorem or_ror': Int.add y z = iwordsize' -> ror x (repr (Int.unsigned z)) = or (shl' x y) (shru' x z). Proof. - intros. destruct (int_ltu_2_inv y z) as (A & B & C & D & E & F); auto. rewrite H1; omega. + intros. destruct (int_ltu_2_inv y z) as (A & B & C & D & E & F); auto. rewrite H1; lia. replace (shl' x y) with (shl x (repr (Int.unsigned y))). replace (shru' x z) with (shru x (repr (Int.unsigned z))). apply or_ror; auto. rewrite F, H1. reflexivity. @@ -3822,7 +3822,7 @@ Theorem shl'_shl': shl' (shl' x y) z = shl' x (Int.add y z). Proof. intros. apply Int.ltu_inv in H1. - destruct (int_ltu_2_inv y z) as (A & B & C & D & E & F); auto. omega. + destruct (int_ltu_2_inv y z) as (A & B & C & D & E & F); auto. lia. set (y' := repr (Int.unsigned y)) in *. set (z' := repr (Int.unsigned z)) in *. replace (shl' x y) with (shl x y'). @@ -3843,7 +3843,7 @@ Theorem shru'_shru': shru' (shru' x y) z = shru' x (Int.add y z). Proof. intros. apply Int.ltu_inv in H1. - destruct (int_ltu_2_inv y z) as (A & B & C & D & E & F); auto. omega. + destruct (int_ltu_2_inv y z) as (A & B & C & D & E & F); auto. lia. set (y' := repr (Int.unsigned y)) in *. set (z' := repr (Int.unsigned z)) in *. replace (shru' x y) with (shru x y'). @@ -3864,7 +3864,7 @@ Theorem shr'_shr': shr' (shr' x y) z = shr' x (Int.add y z). Proof. intros. apply Int.ltu_inv in H1. - destruct (int_ltu_2_inv y z) as (A & B & C & D & E & F); auto. omega. + destruct (int_ltu_2_inv y z) as (A & B & C & D & E & F); auto. lia. set (y' := repr (Int.unsigned y)) in *. set (z' := repr (Int.unsigned z)) in *. replace (shr' x y) with (shr x y'). @@ -3889,21 +3889,21 @@ Proof. apply same_bits_eq; intros. rewrite bits_shru' by auto. fold Z. destruct (zlt Z Y). - assert (A: Int.unsigned (Int.sub y z) = Y - Z). - { apply Int.unsigned_repr. assert (zwordsize < Int.max_unsigned) by reflexivity. omega. } - symmetry; rewrite bits_shl', A by omega. + { apply Int.unsigned_repr. assert (zwordsize < Int.max_unsigned) by reflexivity. lia. } + symmetry; rewrite bits_shl', A by lia. destruct (zlt (i + Z) zwordsize). -+ rewrite bits_shl' by omega. fold Y. - destruct (zlt i (Y - Z)); [rewrite zlt_true by omega|rewrite zlt_false by omega]; auto. - rewrite bits_zero_ext by omega. rewrite zlt_true by omega. f_equal; omega. -+ rewrite bits_zero_ext by omega. rewrite ! zlt_false by omega. auto. ++ rewrite bits_shl' by lia. fold Y. + destruct (zlt i (Y - Z)); [rewrite zlt_true by lia|rewrite zlt_false by lia]; auto. + rewrite bits_zero_ext by lia. rewrite zlt_true by lia. f_equal; lia. ++ rewrite bits_zero_ext by lia. rewrite ! zlt_false by lia. auto. - assert (A: Int.unsigned (Int.sub z y) = Z - Y). - { apply Int.unsigned_repr. assert (zwordsize < Int.max_unsigned) by reflexivity. omega. } - rewrite bits_zero_ext, bits_shru', A by omega. - destruct (zlt (i + Z) zwordsize); [rewrite zlt_true by omega|rewrite zlt_false by omega]; auto. - rewrite bits_shl' by omega. fold Y. + { apply Int.unsigned_repr. assert (zwordsize < Int.max_unsigned) by reflexivity. lia. } + rewrite bits_zero_ext, bits_shru', A by lia. + destruct (zlt (i + Z) zwordsize); [rewrite zlt_true by lia|rewrite zlt_false by lia]; auto. + rewrite bits_shl' by lia. fold Y. destruct (zlt (i + Z) Y). -+ rewrite zlt_false by omega. auto. -+ rewrite zlt_true by omega. f_equal; omega. ++ rewrite zlt_false by lia. auto. ++ rewrite zlt_true by lia. f_equal; lia. Qed. Theorem shr'_shl': @@ -3916,26 +3916,26 @@ Proof. change (Int.unsigned iwordsize') with zwordsize in *. unfold Int.ltu. set (Y := Int.unsigned y) in *; set (Z := Int.unsigned z) in *. apply same_bits_eq; intros. rewrite bits_shr' by auto. fold Z. - rewrite bits_shl' by (destruct (zlt (i + Z) zwordsize); omega). fold Y. + rewrite bits_shl' by (destruct (zlt (i + Z) zwordsize); lia). fold Y. destruct (zlt Z Y). - assert (A: Int.unsigned (Int.sub y z) = Y - Z). - { apply Int.unsigned_repr. assert (zwordsize < Int.max_unsigned) by reflexivity. omega. } - rewrite bits_shl', A by omega. + { apply Int.unsigned_repr. assert (zwordsize < Int.max_unsigned) by reflexivity. lia. } + rewrite bits_shl', A by lia. destruct (zlt i (Y - Z)). -+ apply zlt_true. destruct (zlt (i + Z) zwordsize); omega. -+ rewrite zlt_false by (destruct (zlt (i + Z) zwordsize); omega). - rewrite bits_sign_ext by omega. f_equal. ++ apply zlt_true. destruct (zlt (i + Z) zwordsize); lia. ++ rewrite zlt_false by (destruct (zlt (i + Z) zwordsize); lia). + rewrite bits_sign_ext by lia. f_equal. destruct (zlt (i + Z) zwordsize). - rewrite zlt_true by omega. omega. - rewrite zlt_false by omega. omega. + rewrite zlt_true by lia. lia. + rewrite zlt_false by lia. lia. - assert (A: Int.unsigned (Int.sub z y) = Z - Y). - { apply Int.unsigned_repr. assert (zwordsize < Int.max_unsigned) by reflexivity. omega. } - rewrite bits_sign_ext by omega. - rewrite bits_shr' by (destruct (zlt i (zwordsize - Z)); omega). - rewrite A. rewrite zlt_false by (destruct (zlt (i + Z) zwordsize); omega). + { apply Int.unsigned_repr. assert (zwordsize < Int.max_unsigned) by reflexivity. lia. } + rewrite bits_sign_ext by lia. + rewrite bits_shr' by (destruct (zlt i (zwordsize - Z)); lia). + rewrite A. rewrite zlt_false by (destruct (zlt (i + Z) zwordsize); lia). f_equal. destruct (zlt i (zwordsize - Z)). -+ rewrite ! zlt_true by omega. omega. -+ rewrite ! zlt_false by omega. rewrite zlt_true by omega. omega. ++ rewrite ! zlt_true by lia. lia. ++ rewrite ! zlt_false by lia. rewrite zlt_true by lia. lia. Qed. Lemma shl'_zero_ext: @@ -3943,11 +3943,11 @@ Lemma shl'_zero_ext: shl' (zero_ext n x) m = zero_ext (n + Int.unsigned m) (shl' x m). Proof. intros. apply same_bits_eq; intros. - rewrite bits_zero_ext, ! bits_shl' by omega. + rewrite bits_zero_ext, ! bits_shl' by lia. destruct (zlt i (Int.unsigned m)). -- rewrite zlt_true by omega; auto. -- rewrite bits_zero_ext by omega. - destruct (zlt (i - Int.unsigned m) n); [rewrite zlt_true by omega|rewrite zlt_false by omega]; auto. +- rewrite zlt_true by lia; auto. +- rewrite bits_zero_ext by lia. + destruct (zlt (i - Int.unsigned m) n); [rewrite zlt_true by lia|rewrite zlt_false by lia]; auto. Qed. Lemma shl'_sign_ext: @@ -3956,12 +3956,12 @@ Lemma shl'_sign_ext: Proof. intros. generalize (Int.unsigned_range m); intros. apply same_bits_eq; intros. - rewrite bits_sign_ext, ! bits_shl' by omega. + rewrite bits_sign_ext, ! bits_shl' by lia. destruct (zlt i (n + Int.unsigned m)). - rewrite bits_shl' by auto. destruct (zlt i (Int.unsigned m)); auto. - rewrite bits_sign_ext by omega. f_equal. apply zlt_true. omega. -- rewrite zlt_false by omega. rewrite bits_shl' by omega. rewrite zlt_false by omega. - rewrite bits_sign_ext by omega. f_equal. rewrite zlt_false by omega. omega. + rewrite bits_sign_ext by lia. f_equal. apply zlt_true. lia. +- rewrite zlt_false by lia. rewrite bits_shl' by lia. rewrite zlt_false by lia. + rewrite bits_sign_ext by lia. f_equal. rewrite zlt_false by lia. lia. Qed. Lemma shru'_zero_ext: @@ -3969,9 +3969,9 @@ Lemma shru'_zero_ext: shru' (zero_ext (n + Int.unsigned m) x) m = zero_ext n (shru' x m). Proof. intros. generalize (Int.unsigned_range m); intros. - bit_solve; [|omega]. rewrite bits_shru', bits_zero_ext, bits_shru' by omega. + bit_solve; [|lia]. rewrite bits_shru', bits_zero_ext, bits_shru' by lia. destruct (zlt (i + Int.unsigned m) zwordsize). -* destruct (zlt i n); [rewrite zlt_true by omega|rewrite zlt_false by omega]; auto. +* destruct (zlt i n); [rewrite zlt_true by lia|rewrite zlt_false by lia]; auto. * destruct (zlt i n); auto. Qed. @@ -3980,9 +3980,9 @@ Lemma shru'_zero_ext_0: shru' (zero_ext n x) m = zero. Proof. intros. generalize (Int.unsigned_range m); intros. - bit_solve. rewrite bits_shru', bits_zero_ext by omega. + bit_solve. rewrite bits_shru', bits_zero_ext by lia. destruct (zlt (i + Int.unsigned m) zwordsize); auto. - apply zlt_false. omega. + apply zlt_false. lia. Qed. Lemma shr'_sign_ext: @@ -3995,12 +3995,12 @@ Proof. rewrite bits_sign_ext, bits_shr'. - f_equal. destruct (zlt i n), (zlt (i + Int.unsigned m) zwordsize). -+ apply zlt_true; omega. -+ apply zlt_true; omega. -+ rewrite zlt_false by omega. rewrite zlt_true by omega. omega. -+ rewrite zlt_false by omega. rewrite zlt_true by omega. omega. -- destruct (zlt i n); omega. -- destruct (zlt (i + Int.unsigned m) zwordsize); omega. ++ apply zlt_true; lia. ++ apply zlt_true; lia. ++ rewrite zlt_false by lia. rewrite zlt_true by lia. lia. ++ rewrite zlt_false by lia. rewrite zlt_true by lia. lia. +- destruct (zlt i n); lia. +- destruct (zlt (i + Int.unsigned m) zwordsize); lia. Qed. Lemma zero_ext_shru'_min: @@ -4009,10 +4009,10 @@ Lemma zero_ext_shru'_min: Proof. intros. apply Int.ltu_inv in H. change (Int.unsigned iwordsize') with zwordsize in H. apply Z.min_case_strong; intros; auto. - bit_solve; try omega. rewrite ! bits_shru' by omega. + bit_solve; try lia. rewrite ! bits_shru' by lia. destruct (zlt i (zwordsize - Int.unsigned n)). - rewrite zlt_true by omega. auto. - destruct (zlt i s); auto. rewrite zlt_false by omega; auto. + rewrite zlt_true by lia. auto. + destruct (zlt i s); auto. rewrite zlt_false by lia; auto. Qed. Lemma sign_ext_shr'_min: @@ -4024,12 +4024,12 @@ Proof. destruct (Z.min_spec (zwordsize - Int.unsigned n) s) as [[A B] | [A B]]; rewrite B; auto. apply same_bits_eq; intros. rewrite ! bits_sign_ext by auto. destruct (zlt i (zwordsize - Int.unsigned n)). - rewrite zlt_true by omega. auto. + rewrite zlt_true by lia. auto. assert (C: testbit (shr' x n) (zwordsize - Int.unsigned n - 1) = testbit x (zwordsize - 1)). - { rewrite bits_shr' by omega. rewrite zlt_true by omega. f_equal; omega. } - rewrite C. destruct (zlt i s); rewrite bits_shr' by omega. - rewrite zlt_false by omega. auto. - rewrite zlt_false by omega. auto. + { rewrite bits_shr' by lia. rewrite zlt_true by lia. f_equal; lia. } + rewrite C. destruct (zlt i s); rewrite bits_shr' by lia. + rewrite zlt_false by lia. auto. + rewrite zlt_false by lia. auto. Qed. Lemma shl'_zero_ext_min: @@ -4040,10 +4040,10 @@ Proof. apply Z.min_case_strong; intros; auto. apply same_bits_eq; intros. rewrite ! bits_shl' by auto. destruct (zlt i (Int.unsigned n)); auto. - rewrite ! bits_zero_ext by omega. + rewrite ! bits_zero_ext by lia. destruct (zlt (i - Int.unsigned n) s). - rewrite zlt_true by omega; auto. - rewrite zlt_false by omega; auto. + rewrite zlt_true by lia; auto. + rewrite zlt_false by lia; auto. Qed. Lemma shl'_sign_ext_min: @@ -4055,10 +4055,10 @@ Proof. destruct (Z.min_spec (zwordsize - Int.unsigned n) s) as [[A B] | [A B]]; rewrite B; auto. apply same_bits_eq; intros. rewrite ! bits_shl' by auto. destruct (zlt i (Int.unsigned n)); auto. - rewrite ! bits_sign_ext by omega. f_equal. + rewrite ! bits_sign_ext by lia. f_equal. destruct (zlt (i - Int.unsigned n) s). - rewrite zlt_true by omega; auto. - omegaContradiction. + rewrite zlt_true by lia; auto. + extlia. Qed. (** Powers of two with exponents given as 32-bit ints *) @@ -4079,8 +4079,8 @@ Proof. destruct (list_in_map_inv _ _ _ H) as [i0 [EQ IN]]. exploit Z_one_bits_range; eauto. fold zwordsize. intros R. unfold Int.ltu. rewrite EQ. rewrite Int.unsigned_repr. - change (Int.unsigned iwordsize') with zwordsize. apply zlt_true. omega. - assert (zwordsize < Int.max_unsigned) by reflexivity. omega. + change (Int.unsigned iwordsize') with zwordsize. apply zlt_true. lia. + assert (zwordsize < Int.max_unsigned) by reflexivity. lia. Qed. Fixpoint int_of_one_bits' (l: list Int.int) : int := @@ -4099,7 +4099,7 @@ Proof. - auto. - rewrite IHl by eauto. apply eqm_samerepr; apply eqm_add. + rewrite shl'_one_two_p. rewrite Int.unsigned_repr. apply eqm_sym; apply eqm_unsigned_repr. - exploit (H a). auto. assert (zwordsize < Int.max_unsigned) by reflexivity. omega. + exploit (H a). auto. assert (zwordsize < Int.max_unsigned) by reflexivity. lia. + apply eqm_sym; apply eqm_unsigned_repr. } intros. rewrite <- (repr_unsigned x) at 1. unfold one_bits'. rewrite REC. @@ -4118,7 +4118,7 @@ Proof. { apply Z_one_bits_range with (unsigned n). rewrite B; auto with coqlib. } rewrite Int.unsigned_repr. auto. assert (zwordsize < Int.max_unsigned) by reflexivity. - omega. + lia. Qed. Theorem is_power2'_range: @@ -4137,11 +4137,11 @@ Proof. unfold is_power2'; intros. destruct (Z_one_bits wordsize (unsigned n) 0) as [ | i [ | ? ?]] eqn:B; inv H. rewrite (Z_one_bits_powerserie wordsize (unsigned n)) by (apply unsigned_range). - rewrite Int.unsigned_repr. rewrite B; simpl. omega. + rewrite Int.unsigned_repr. rewrite B; simpl. lia. assert (0 <= i < zwordsize). { apply Z_one_bits_range with (unsigned n). rewrite B; auto with coqlib. } assert (zwordsize < Int.max_unsigned) by reflexivity. - omega. + lia. Qed. Theorem mul_pow2': @@ -4185,7 +4185,7 @@ Proof. assert (zwordsize = 2 * Int.zwordsize) by reflexivity. fold (testbit (shru n (repr Int.zwordsize)) i). rewrite bits_shru. change (unsigned (repr Int.zwordsize)) with Int.zwordsize. - apply zlt_true. omega. omega. + apply zlt_true. lia. lia. Qed. Lemma bits_ofwords: @@ -4200,15 +4200,15 @@ Proof. rewrite testbit_repr; auto. rewrite !testbit_repr; auto. fold (Int.testbit lo i). rewrite Int.bits_above. apply orb_false_r. auto. - omega. + lia. Qed. Lemma lo_ofwords: forall hi lo, loword (ofwords hi lo) = lo. Proof. intros. apply Int.same_bits_eq; intros. - rewrite bits_loword; auto. rewrite bits_ofwords. apply zlt_true. omega. - assert (zwordsize = 2 * Int.zwordsize) by reflexivity. omega. + rewrite bits_loword; auto. rewrite bits_ofwords. apply zlt_true. lia. + assert (zwordsize = 2 * Int.zwordsize) by reflexivity. lia. Qed. Lemma hi_ofwords: @@ -4216,8 +4216,8 @@ Lemma hi_ofwords: Proof. intros. apply Int.same_bits_eq; intros. rewrite bits_hiword; auto. rewrite bits_ofwords. - rewrite zlt_false. f_equal. omega. omega. - assert (zwordsize = 2 * Int.zwordsize) by reflexivity. omega. + rewrite zlt_false. f_equal. lia. lia. + assert (zwordsize = 2 * Int.zwordsize) by reflexivity. lia. Qed. Lemma ofwords_recompose: @@ -4225,9 +4225,9 @@ Lemma ofwords_recompose: Proof. intros. apply same_bits_eq; intros. rewrite bits_ofwords; auto. destruct (zlt i Int.zwordsize). - apply bits_loword. omega. - rewrite bits_hiword. f_equal. omega. - assert (zwordsize = 2 * Int.zwordsize) by reflexivity. omega. + apply bits_loword. lia. + rewrite bits_hiword. f_equal. lia. + assert (zwordsize = 2 * Int.zwordsize) by reflexivity. lia. Qed. Lemma ofwords_add: @@ -4238,10 +4238,10 @@ Proof. apply eqm_sym; apply eqm_unsigned_repr. apply eqm_refl. apply eqm_sym; apply eqm_unsigned_repr. - change Int.zwordsize with 32; change zwordsize with 64; omega. + change Int.zwordsize with 32; change zwordsize with 64; lia. rewrite unsigned_repr. generalize (Int.unsigned_range lo). intros [A B]. exact B. assert (Int.max_unsigned < max_unsigned) by (compute; auto). - generalize (Int.unsigned_range_2 lo); omega. + generalize (Int.unsigned_range_2 lo); lia. Qed. Lemma ofwords_add': @@ -4252,7 +4252,7 @@ Proof. change (two_p 32) with Int.modulus. change Int.modulus with 4294967296. change max_unsigned with 18446744073709551615. - omega. + lia. Qed. Remark eqm_mul_2p32: @@ -4276,7 +4276,7 @@ Proof. change min_signed with (Int.min_signed * Int.modulus). change max_signed with (Int.max_signed * Int.modulus + Int.modulus - 1). change Int.modulus with 4294967296. - omega. + lia. apply eqm_samerepr. apply eqm_add. apply eqm_mul_2p32. apply Int.eqm_signed_unsigned. apply eqm_refl. Qed. @@ -4291,7 +4291,7 @@ Proof. intros. apply Int64.same_bits_eq; intros. rewrite H by auto. rewrite ! bits_ofwords by auto. assert (zwordsize = 2 * Int.zwordsize) by reflexivity. - destruct (zlt i Int.zwordsize); rewrite H0 by omega; auto. + destruct (zlt i Int.zwordsize); rewrite H0 by lia; auto. Qed. Lemma decompose_and: @@ -4336,21 +4336,21 @@ Proof. intros. assert (Int.unsigned (Int.sub Int.iwordsize y) = Int.zwordsize - Int.unsigned y). { unfold Int.sub. rewrite Int.unsigned_repr. auto. - rewrite Int.unsigned_repr_wordsize. generalize Int.wordsize_max_unsigned; omega. } + rewrite Int.unsigned_repr_wordsize. generalize Int.wordsize_max_unsigned; lia. } assert (zwordsize = 2 * Int.zwordsize) by reflexivity. apply Int64.same_bits_eq; intros. rewrite bits_shl' by auto. symmetry. rewrite bits_ofwords by auto. - destruct (zlt i Int.zwordsize). rewrite Int.bits_shl by omega. + destruct (zlt i Int.zwordsize). rewrite Int.bits_shl by lia. destruct (zlt i (Int.unsigned y)). auto. - rewrite bits_ofwords by omega. rewrite zlt_true by omega. auto. - rewrite zlt_false by omega. rewrite bits_ofwords by omega. - rewrite Int.bits_or by omega. rewrite Int.bits_shl by omega. - rewrite Int.bits_shru by omega. rewrite H0. + rewrite bits_ofwords by lia. rewrite zlt_true by lia. auto. + rewrite zlt_false by lia. rewrite bits_ofwords by lia. + rewrite Int.bits_or by lia. rewrite Int.bits_shl by lia. + rewrite Int.bits_shru by lia. rewrite H0. destruct (zlt (i - Int.unsigned y) (Int.zwordsize)). - rewrite zlt_true by omega. rewrite zlt_true by omega. - rewrite orb_false_l. f_equal. omega. - rewrite zlt_false by omega. rewrite zlt_false by omega. - rewrite orb_false_r. f_equal. omega. + rewrite zlt_true by lia. rewrite zlt_true by lia. + rewrite orb_false_l. f_equal. lia. + rewrite zlt_false by lia. rewrite zlt_false by lia. + rewrite orb_false_r. f_equal. lia. Qed. Lemma decompose_shl_2: @@ -4363,15 +4363,15 @@ Proof. assert (zwordsize = 2 * Int.zwordsize) by reflexivity. assert (Int.unsigned (Int.sub y Int.iwordsize) = Int.unsigned y - Int.zwordsize). { unfold Int.sub. rewrite Int.unsigned_repr. auto. - rewrite Int.unsigned_repr_wordsize. generalize (Int.unsigned_range_2 y). omega. } + rewrite Int.unsigned_repr_wordsize. generalize (Int.unsigned_range_2 y). lia. } apply Int64.same_bits_eq; intros. rewrite bits_shl' by auto. symmetry. rewrite bits_ofwords by auto. - destruct (zlt i Int.zwordsize). rewrite zlt_true by omega. apply Int.bits_zero. - rewrite Int.bits_shl by omega. + destruct (zlt i Int.zwordsize). rewrite zlt_true by lia. apply Int.bits_zero. + rewrite Int.bits_shl by lia. destruct (zlt i (Int.unsigned y)). - rewrite zlt_true by omega. auto. - rewrite zlt_false by omega. - rewrite bits_ofwords by omega. rewrite zlt_true by omega. f_equal. omega. + rewrite zlt_true by lia. auto. + rewrite zlt_false by lia. + rewrite bits_ofwords by lia. rewrite zlt_true by lia. f_equal. lia. Qed. Lemma decompose_shru_1: @@ -4384,25 +4384,25 @@ Proof. intros. assert (Int.unsigned (Int.sub Int.iwordsize y) = Int.zwordsize - Int.unsigned y). { unfold Int.sub. rewrite Int.unsigned_repr. auto. - rewrite Int.unsigned_repr_wordsize. generalize Int.wordsize_max_unsigned; omega. } + rewrite Int.unsigned_repr_wordsize. generalize Int.wordsize_max_unsigned; lia. } assert (zwordsize = 2 * Int.zwordsize) by reflexivity. apply Int64.same_bits_eq; intros. rewrite bits_shru' by auto. symmetry. rewrite bits_ofwords by auto. destruct (zlt i Int.zwordsize). - rewrite zlt_true by omega. - rewrite bits_ofwords by omega. - rewrite Int.bits_or by omega. rewrite Int.bits_shl by omega. - rewrite Int.bits_shru by omega. rewrite H0. + rewrite zlt_true by lia. + rewrite bits_ofwords by lia. + rewrite Int.bits_or by lia. rewrite Int.bits_shl by lia. + rewrite Int.bits_shru by lia. rewrite H0. destruct (zlt (i + Int.unsigned y) (Int.zwordsize)). - rewrite zlt_true by omega. + rewrite zlt_true by lia. rewrite orb_false_r. auto. - rewrite zlt_false by omega. - rewrite orb_false_l. f_equal. omega. - rewrite Int.bits_shru by omega. + rewrite zlt_false by lia. + rewrite orb_false_l. f_equal. lia. + rewrite Int.bits_shru by lia. destruct (zlt (i + Int.unsigned y) zwordsize). - rewrite bits_ofwords by omega. - rewrite zlt_true by omega. rewrite zlt_false by omega. f_equal. omega. - rewrite zlt_false by omega. auto. + rewrite bits_ofwords by lia. + rewrite zlt_true by lia. rewrite zlt_false by lia. f_equal. lia. + rewrite zlt_false by lia. auto. Qed. Lemma decompose_shru_2: @@ -4415,16 +4415,16 @@ Proof. assert (zwordsize = 2 * Int.zwordsize) by reflexivity. assert (Int.unsigned (Int.sub y Int.iwordsize) = Int.unsigned y - Int.zwordsize). { unfold Int.sub. rewrite Int.unsigned_repr. auto. - rewrite Int.unsigned_repr_wordsize. generalize (Int.unsigned_range_2 y). omega. } + rewrite Int.unsigned_repr_wordsize. generalize (Int.unsigned_range_2 y). lia. } apply Int64.same_bits_eq; intros. rewrite bits_shru' by auto. symmetry. rewrite bits_ofwords by auto. destruct (zlt i Int.zwordsize). - rewrite Int.bits_shru by omega. rewrite H1. + rewrite Int.bits_shru by lia. rewrite H1. destruct (zlt (i + Int.unsigned y) zwordsize). - rewrite zlt_true by omega. rewrite bits_ofwords by omega. - rewrite zlt_false by omega. f_equal; omega. - rewrite zlt_false by omega. auto. - rewrite zlt_false by omega. apply Int.bits_zero. + rewrite zlt_true by lia. rewrite bits_ofwords by lia. + rewrite zlt_false by lia. f_equal; lia. + rewrite zlt_false by lia. auto. + rewrite zlt_false by lia. apply Int.bits_zero. Qed. Lemma decompose_shr_1: @@ -4437,26 +4437,26 @@ Proof. intros. assert (Int.unsigned (Int.sub Int.iwordsize y) = Int.zwordsize - Int.unsigned y). { unfold Int.sub. rewrite Int.unsigned_repr. auto. - rewrite Int.unsigned_repr_wordsize. generalize Int.wordsize_max_unsigned; omega. } + rewrite Int.unsigned_repr_wordsize. generalize Int.wordsize_max_unsigned; lia. } assert (zwordsize = 2 * Int.zwordsize) by reflexivity. apply Int64.same_bits_eq; intros. rewrite bits_shr' by auto. symmetry. rewrite bits_ofwords by auto. destruct (zlt i Int.zwordsize). - rewrite zlt_true by omega. - rewrite bits_ofwords by omega. - rewrite Int.bits_or by omega. rewrite Int.bits_shl by omega. - rewrite Int.bits_shru by omega. rewrite H0. + rewrite zlt_true by lia. + rewrite bits_ofwords by lia. + rewrite Int.bits_or by lia. rewrite Int.bits_shl by lia. + rewrite Int.bits_shru by lia. rewrite H0. destruct (zlt (i + Int.unsigned y) (Int.zwordsize)). - rewrite zlt_true by omega. + rewrite zlt_true by lia. rewrite orb_false_r. auto. - rewrite zlt_false by omega. - rewrite orb_false_l. f_equal. omega. - rewrite Int.bits_shr by omega. + rewrite zlt_false by lia. + rewrite orb_false_l. f_equal. lia. + rewrite Int.bits_shr by lia. destruct (zlt (i + Int.unsigned y) zwordsize). - rewrite bits_ofwords by omega. - rewrite zlt_true by omega. rewrite zlt_false by omega. f_equal. omega. - rewrite zlt_false by omega. rewrite bits_ofwords by omega. - rewrite zlt_false by omega. f_equal. + rewrite bits_ofwords by lia. + rewrite zlt_true by lia. rewrite zlt_false by lia. f_equal. lia. + rewrite zlt_false by lia. rewrite bits_ofwords by lia. + rewrite zlt_false by lia. f_equal. Qed. Lemma decompose_shr_2: @@ -4470,24 +4470,24 @@ Proof. assert (zwordsize = 2 * Int.zwordsize) by reflexivity. assert (Int.unsigned (Int.sub y Int.iwordsize) = Int.unsigned y - Int.zwordsize). { unfold Int.sub. rewrite Int.unsigned_repr. auto. - rewrite Int.unsigned_repr_wordsize. generalize (Int.unsigned_range_2 y). omega. } + rewrite Int.unsigned_repr_wordsize. generalize (Int.unsigned_range_2 y). lia. } apply Int64.same_bits_eq; intros. rewrite bits_shr' by auto. symmetry. rewrite bits_ofwords by auto. destruct (zlt i Int.zwordsize). - rewrite Int.bits_shr by omega. rewrite H1. + rewrite Int.bits_shr by lia. rewrite H1. destruct (zlt (i + Int.unsigned y) zwordsize). - rewrite zlt_true by omega. rewrite bits_ofwords by omega. - rewrite zlt_false by omega. f_equal; omega. - rewrite zlt_false by omega. rewrite bits_ofwords by omega. - rewrite zlt_false by omega. auto. - rewrite Int.bits_shr by omega. + rewrite zlt_true by lia. rewrite bits_ofwords by lia. + rewrite zlt_false by lia. f_equal; lia. + rewrite zlt_false by lia. rewrite bits_ofwords by lia. + rewrite zlt_false by lia. auto. + rewrite Int.bits_shr by lia. change (Int.unsigned (Int.sub Int.iwordsize Int.one)) with (Int.zwordsize - 1). destruct (zlt (i + Int.unsigned y) zwordsize); - rewrite bits_ofwords by omega. - symmetry. rewrite zlt_false by omega. f_equal. - destruct (zlt (i - Int.zwordsize + (Int.zwordsize - 1)) Int.zwordsize); omega. - symmetry. rewrite zlt_false by omega. f_equal. - destruct (zlt (i - Int.zwordsize + (Int.zwordsize - 1)) Int.zwordsize); omega. + rewrite bits_ofwords by lia. + symmetry. rewrite zlt_false by lia. f_equal. + destruct (zlt (i - Int.zwordsize + (Int.zwordsize - 1)) Int.zwordsize); lia. + symmetry. rewrite zlt_false by lia. f_equal. + destruct (zlt (i - Int.zwordsize + (Int.zwordsize - 1)) Int.zwordsize); lia. Qed. Lemma decompose_add: @@ -4624,14 +4624,14 @@ Proof. intros. unfold ltu. rewrite ! ofwords_add'. unfold Int.ltu, Int.eq. destruct (zeq (Int.unsigned xh) (Int.unsigned yh)). rewrite e. destruct (zlt (Int.unsigned xl) (Int.unsigned yl)). - apply zlt_true; omega. - apply zlt_false; omega. + apply zlt_true; lia. + apply zlt_false; lia. change (two_p 32) with Int.modulus. generalize (Int.unsigned_range xl) (Int.unsigned_range yl). change Int.modulus with 4294967296. intros. destruct (zlt (Int.unsigned xh) (Int.unsigned yh)). - apply zlt_true; omega. - apply zlt_false; omega. + apply zlt_true; lia. + apply zlt_false; lia. Qed. Lemma decompose_leu: @@ -4643,8 +4643,8 @@ Proof. unfold Int.eq. destruct (zeq (Int.unsigned xh) (Int.unsigned yh)). auto. unfold Int.ltu. destruct (zlt (Int.unsigned xh) (Int.unsigned yh)). - rewrite zlt_false by omega; auto. - rewrite zlt_true by omega; auto. + rewrite zlt_false by lia; auto. + rewrite zlt_true by lia; auto. Qed. Lemma decompose_lt: @@ -4654,14 +4654,14 @@ Proof. intros. unfold lt. rewrite ! ofwords_add''. rewrite Int.eq_signed. destruct (zeq (Int.signed xh) (Int.signed yh)). rewrite e. unfold Int.ltu. destruct (zlt (Int.unsigned xl) (Int.unsigned yl)). - apply zlt_true; omega. - apply zlt_false; omega. + apply zlt_true; lia. + apply zlt_false; lia. change (two_p 32) with Int.modulus. generalize (Int.unsigned_range xl) (Int.unsigned_range yl). change Int.modulus with 4294967296. intros. unfold Int.lt. destruct (zlt (Int.signed xh) (Int.signed yh)). - apply zlt_true; omega. - apply zlt_false; omega. + apply zlt_true; lia. + apply zlt_false; lia. Qed. Lemma decompose_le: @@ -4673,8 +4673,8 @@ Proof. rewrite Int.eq_signed. destruct (zeq (Int.signed xh) (Int.signed yh)). auto. unfold Int.lt. destruct (zlt (Int.signed xh) (Int.signed yh)). - rewrite zlt_false by omega; auto. - rewrite zlt_true by omega; auto. + rewrite zlt_false by lia; auto. + rewrite zlt_true by lia; auto. Qed. (** Utility proofs for mixed 32bit and 64bit arithmetic *) @@ -4689,7 +4689,7 @@ Proof. change (wordsize) with 64%nat in *. change (Int.wordsize) with 32%nat in *. unfold two_power_nat. simpl. - omega. + lia. Qed. Remark int_unsigned_repr: @@ -4709,9 +4709,9 @@ Proof. rewrite unsigned_repr by apply int_unsigned_range. rewrite int_unsigned_repr. reflexivity. rewrite unsigned_repr by apply int_unsigned_range. rewrite int_unsigned_repr. generalize (int_unsigned_range y). - omega. + lia. generalize (Int.sub_ltu x y H). intros. - generalize (Int.unsigned_range_2 y). intros. omega. + generalize (Int.unsigned_range_2 y). intros. lia. Qed. End Int64. @@ -4887,7 +4887,7 @@ Lemma to_int_of_int: forall n, to_int (of_int n) = n. Proof. intros; unfold of_int, to_int. rewrite unsigned_repr. apply Int.repr_unsigned. - unfold max_unsigned. rewrite modulus_eq32. destruct (Int.unsigned_range n); omega. + unfold max_unsigned. rewrite modulus_eq32. destruct (Int.unsigned_range n); lia. Qed. End AGREE32. @@ -4997,12 +4997,12 @@ Lemma to_int64_of_int64: forall n, to_int64 (of_int64 n) = n. Proof. intros; unfold of_int64, to_int64. rewrite unsigned_repr. apply Int64.repr_unsigned. - unfold max_unsigned. rewrite modulus_eq64. destruct (Int64.unsigned_range n); omega. + unfold max_unsigned. rewrite modulus_eq64. destruct (Int64.unsigned_range n); lia. Qed. End AGREE64. -Hint Resolve +Global Hint Resolve agree32_repr agree32_of_int agree32_of_ints agree32_of_int_eq agree32_of_ints_eq agree32_to_int agree32_to_int_eq agree32_neg agree32_add agree32_sub agree32_mul agree32_divs agree64_repr agree64_of_int agree64_of_int_eq @@ -5025,19 +5025,22 @@ Qed. Global Opaque Ptrofs.repr. -Hint Resolve Int.modulus_pos Int.eqm_refl Int.eqm_refl2 Int.eqm_sym Int.eqm_trans +Global Hint Resolve + Int.modulus_pos Int.eqm_refl Int.eqm_refl2 Int.eqm_sym Int.eqm_trans Int.eqm_small_eq Int.eqm_add Int.eqm_neg Int.eqm_sub Int.eqm_mult Int.eqm_unsigned_repr Int.eqm_unsigned_repr_l Int.eqm_unsigned_repr_r Int.unsigned_range Int.unsigned_range_2 Int.repr_unsigned Int.repr_signed Int.unsigned_repr : ints. -Hint Resolve Int64.modulus_pos Int64.eqm_refl Int64.eqm_refl2 Int64.eqm_sym Int64.eqm_trans +Global Hint Resolve + Int64.modulus_pos Int64.eqm_refl Int64.eqm_refl2 Int64.eqm_sym Int64.eqm_trans Int64.eqm_small_eq Int64.eqm_add Int64.eqm_neg Int64.eqm_sub Int64.eqm_mult Int64.eqm_unsigned_repr Int64.eqm_unsigned_repr_l Int64.eqm_unsigned_repr_r Int64.unsigned_range Int64.unsigned_range_2 Int64.repr_unsigned Int64.repr_signed Int64.unsigned_repr : ints. -Hint Resolve Ptrofs.modulus_pos Ptrofs.eqm_refl Ptrofs.eqm_refl2 Ptrofs.eqm_sym Ptrofs.eqm_trans +Global Hint Resolve + Ptrofs.modulus_pos Ptrofs.eqm_refl Ptrofs.eqm_refl2 Ptrofs.eqm_sym Ptrofs.eqm_trans Ptrofs.eqm_small_eq Ptrofs.eqm_add Ptrofs.eqm_neg Ptrofs.eqm_sub Ptrofs.eqm_mult Ptrofs.eqm_unsigned_repr Ptrofs.eqm_unsigned_repr_l Ptrofs.eqm_unsigned_repr_r Ptrofs.unsigned_range Ptrofs.unsigned_range_2 @@ -41,14 +41,14 @@ Lemma notin_range: forall x i, x < fst i \/ x >= snd i -> ~In x i. Proof. - unfold In; intros; omega. + unfold In; intros; lia. Qed. Lemma range_notin: forall x i, ~In x i -> fst i < snd i -> x < fst i \/ x >= snd i. Proof. - unfold In; intros; omega. + unfold In; intros; lia. Qed. (** * Emptyness *) @@ -60,26 +60,26 @@ Lemma empty_dec: Proof. unfold empty; intros. case (zle (snd i) (fst i)); intros. - left; omega. - right; omega. + left; lia. + right; lia. Qed. Lemma is_notempty: forall i, fst i < snd i -> ~empty i. Proof. - unfold empty; intros; omega. + unfold empty; intros; lia. Qed. Lemma empty_notin: forall x i, empty i -> ~In x i. Proof. - unfold empty, In; intros. omega. + unfold empty, In; intros. lia. Qed. Lemma in_notempty: forall x i, In x i -> ~empty i. Proof. - unfold empty, In; intros. omega. + unfold empty, In; intros. lia. Qed. (** * Disjointness *) @@ -109,7 +109,7 @@ Lemma disjoint_range: forall i j, snd i <= fst j \/ snd j <= fst i -> disjoint i j. Proof. - unfold disjoint, In; intros. omega. + unfold disjoint, In; intros. lia. Qed. Lemma range_disjoint: @@ -127,13 +127,13 @@ Proof. (* Case 1.1: i ends to the left of j, OK *) auto. (* Case 1.2: i ends to the right of j's start, not disjoint. *) - elim (H (fst j)). red; omega. red; omega. + elim (H (fst j)). red; lia. red; lia. (* Case 2: j starts to the left of i *) destruct (zle (snd j) (fst i)). (* Case 2.1: j ends to the left of i, OK *) auto. (* Case 2.2: j ends to the right of i's start, not disjoint. *) - elim (H (fst i)). red; omega. red; omega. + elim (H (fst i)). red; lia. red; lia. Qed. Lemma range_disjoint': @@ -141,7 +141,7 @@ Lemma range_disjoint': disjoint i j -> fst i < snd i -> fst j < snd j -> snd i <= fst j \/ snd j <= fst i. Proof. - intros. exploit range_disjoint; eauto. unfold empty; intuition omega. + intros. exploit range_disjoint; eauto. unfold empty; intuition lia. Qed. Lemma disjoint_dec: @@ -163,14 +163,14 @@ Lemma in_shift: forall x i delta, In x i -> In (x + delta) (shift i delta). Proof. - unfold shift, In; intros. simpl. omega. + unfold shift, In; intros. simpl. lia. Qed. Lemma in_shift_inv: forall x i delta, In x (shift i delta) -> In (x - delta) i. Proof. - unfold shift, In; simpl; intros. omega. + unfold shift, In; simpl; intros. lia. Qed. (** * Enumerating the elements of an interval *) @@ -182,7 +182,7 @@ Variable lo: Z. Function elements_rec (hi: Z) {wf (Zwf lo) hi} : list Z := if zlt lo hi then (hi-1) :: elements_rec (hi-1) else nil. Proof. - intros. red. omega. + intros. red. lia. apply Zwf_well_founded. Qed. @@ -192,8 +192,8 @@ Lemma In_elements_rec: Proof. intros. functional induction (elements_rec hi). simpl; split; intros. - destruct H. clear IHl. omega. rewrite IHl in H. clear IHl. omega. - destruct (zeq (hi - 1) x); auto. right. rewrite IHl. clear IHl. omega. + destruct H. clear IHl. lia. rewrite IHl in H. clear IHl. lia. + destruct (zeq (hi - 1) x); auto. right. rewrite IHl. clear IHl. lia. simpl; intuition. Qed. @@ -241,20 +241,20 @@ Program Fixpoint forall_rec (hi: Z) {wf (Zwf lo) hi}: left _ _ . Next Obligation. - red. omega. + red. lia. Qed. Next Obligation. - assert (x = hi - 1 \/ x < hi - 1) by omega. + assert (x = hi - 1 \/ x < hi - 1) by lia. destruct H2. congruence. auto. Qed. Next Obligation. - exists wildcard'; split; auto. omega. + exists wildcard'; split; auto. lia. Qed. Next Obligation. - exists (hi - 1); split; auto. omega. + exists (hi - 1); split; auto. lia. Qed. Next Obligation. - omegaContradiction. + extlia. Defined. End FORALL. @@ -276,7 +276,7 @@ Variable a: A. Function fold_rec (hi: Z) {wf (Zwf lo) hi} : A := if zlt lo hi then f (hi - 1) (fold_rec (hi - 1)) else a. Proof. - intros. red. omega. + intros. red. lia. apply Zwf_well_founded. Qed. @@ -303,7 +303,7 @@ Qed. (** Hints *) -Hint Resolve +Global Hint Resolve notin_range range_notin is_notempty empty_notin in_notempty disjoint_sym empty_disjoint_r empty_disjoint_l diff --git a/lib/IntvSets.v b/lib/IntvSets.v index b97d9882..7250a9f6 100644 --- a/lib/IntvSets.v +++ b/lib/IntvSets.v @@ -59,7 +59,7 @@ Proof. + destruct (zle l x); simpl. * tauto. * split; intros. congruence. - exfalso. destruct H0. omega. exploit BELOW; eauto. omega. + exfalso. destruct H0. lia. exploit BELOW; eauto. lia. + rewrite IHok. intuition. Qed. @@ -74,14 +74,14 @@ Lemma contains_In: (contains l0 h0 s = true <-> (forall x, l0 <= x < h0 -> In x s)). Proof. induction 2; simpl. -- intuition. elim (H0 l0); omega. +- intuition. elim (H0 l0); lia. - destruct (zle h0 h); simpl. destruct (zle l l0); simpl. intuition. rewrite IHok. intuition. destruct (H3 x); auto. exfalso. - destruct (H3 l0). omega. omega. exploit BELOW; eauto. omega. + destruct (H3 l0). lia. lia. exploit BELOW; eauto. lia. rewrite IHok. intuition. destruct (H3 x); auto. exfalso. - destruct (H3 h). omega. omega. exploit BELOW; eauto. omega. + destruct (H3 h). lia. lia. exploit BELOW; eauto. lia. Qed. Fixpoint add (L H: Z) (s: t) {struct s} : t := @@ -103,9 +103,9 @@ Proof. destruct (zlt h0 l). simpl. tauto. rewrite IHok. intuition idtac. - assert (l0 <= x < h0 \/ l <= x < h) by xomega. tauto. - left; xomega. - left; xomega. + assert (l0 <= x < h0 \/ l <= x < h) by extlia. tauto. + left; extlia. + left; extlia. Qed. Lemma add_ok: @@ -115,11 +115,11 @@ Proof. constructor. auto. intros. inv H0. constructor. destruct (zlt h l0). constructor; auto. intros. rewrite In_add in H1; auto. - destruct H1. omega. auto. + destruct H1. lia. auto. destruct (zlt h0 l). - constructor. auto. simpl; intros. destruct H1. omega. exploit BELOW; eauto. omega. - constructor. omega. auto. auto. - apply IHok. xomega. + constructor. auto. simpl; intros. destruct H1. lia. exploit BELOW; eauto. lia. + constructor. lia. auto. auto. + apply IHok. extlia. Qed. Fixpoint remove (L H: Z) (s: t) {struct s} : t := @@ -141,22 +141,22 @@ Proof. induction 1; simpl. tauto. destruct (zlt h l0). - simpl. rewrite IHok. intuition omega. + simpl. rewrite IHok. intuition lia. destruct (zlt h0 l). - simpl. intuition. exploit BELOW; eauto. omega. + simpl. intuition. exploit BELOW; eauto. lia. destruct (zlt l l0). destruct (zlt h0 h); simpl. clear IHok. split. intros [A | [A | A]]. - split. omega. left; omega. - split. omega. left; omega. - split. exploit BELOW; eauto. omega. auto. + split. lia. left; lia. + split. lia. left; lia. + split. exploit BELOW; eauto. lia. auto. intros [A [B | B]]. - destruct (zlt x l0). left; omega. right; left; omega. + destruct (zlt x l0). left; lia. right; left; lia. auto. - intuition omega. + intuition lia. destruct (zlt h0 h); simpl. - intuition. exploit BELOW; eauto. omega. - rewrite IHok. intuition. omegaContradiction. + intuition. exploit BELOW; eauto. lia. + rewrite IHok. intuition. extlia. Qed. Lemma remove_ok: @@ -170,9 +170,9 @@ Proof. constructor; auto. destruct (zlt l l0). destruct (zlt h0 h). - constructor. omega. intros. inv H1. omega. exploit BELOW; eauto. omega. - constructor. omega. auto. auto. - constructor; auto. intros. rewrite In_remove in H1 by auto. destruct H1. exploit BELOW; eauto. omega. + constructor. lia. intros. inv H1. lia. exploit BELOW; eauto. lia. + constructor. lia. auto. auto. + constructor; auto. intros. rewrite In_remove in H1 by auto. destruct H1. exploit BELOW; eauto. lia. destruct (zlt h0 h). constructor; auto. auto. @@ -204,19 +204,19 @@ Proof. tauto. assert (ok (Cons l0 h0 s0)) by (constructor; auto). destruct (zle h l0). - rewrite IHok; auto. simpl. intuition. omegaContradiction. - exploit BELOW0; eauto. intros. omegaContradiction. + rewrite IHok; auto. simpl. intuition. extlia. + exploit BELOW0; eauto. intros. extlia. destruct (zle h0 l). - simpl in IHok0; rewrite IHok0. intuition. omegaContradiction. - exploit BELOW; eauto. intros; omegaContradiction. + simpl in IHok0; rewrite IHok0. intuition. extlia. + exploit BELOW; eauto. intros; extlia. destruct (zle l l0). destruct (zle h0 h). simpl. simpl in IHok0; rewrite IHok0. intuition. - simpl. rewrite IHok; auto. simpl. intuition. exploit BELOW0; eauto. intros; omegaContradiction. + simpl. rewrite IHok; auto. simpl. intuition. exploit BELOW0; eauto. intros; extlia. destruct (zle h h0). simpl. rewrite IHok; auto. simpl. intuition. simpl. simpl in IHok0; rewrite IHok0. intuition. - exploit BELOW; eauto. intros; omegaContradiction. + exploit BELOW; eauto. intros; extlia. Qed. Lemma inter_ok: @@ -237,12 +237,12 @@ Proof. constructor; auto. intros. assert (In x (inter (Cons l h s) s0)) by exact H3. rewrite In_inter in H4; auto. apply BELOW0. tauto. - constructor. omega. intros. rewrite In_inter in H3; auto. apply BELOW. tauto. + constructor. lia. intros. rewrite In_inter in H3; auto. apply BELOW. tauto. auto. destruct (zle h h0). - constructor. omega. intros. rewrite In_inter in H3; auto. apply BELOW. tauto. + constructor. lia. intros. rewrite In_inter in H3; auto. apply BELOW. tauto. auto. - constructor. omega. intros. + constructor. lia. intros. assert (In x (inter (Cons l h s) s0)) by exact H3. rewrite In_inter in H4; auto. apply BELOW0. tauto. auto. @@ -281,20 +281,20 @@ Lemma beq_spec: Proof. induction 1; destruct 1; simpl. - tauto. -- split; intros. discriminate. exfalso. apply (H0 l). left; omega. -- split; intros. discriminate. exfalso. apply (H0 l). left; omega. +- split; intros. discriminate. exfalso. apply (H0 l). left; lia. +- split; intros. discriminate. exfalso. apply (H0 l). left; lia. - split; intros. + InvBooleans. subst. rewrite IHok in H3 by auto. rewrite H3. tauto. + destruct (zeq l l0). destruct (zeq h h0). simpl. subst. apply IHok. auto. intros; split; intros. - destruct (proj1 (H1 x)); auto. exfalso. exploit BELOW; eauto. omega. - destruct (proj2 (H1 x)); auto. exfalso. exploit BELOW0; eauto. omega. + destruct (proj1 (H1 x)); auto. exfalso. exploit BELOW; eauto. lia. + destruct (proj2 (H1 x)); auto. exfalso. exploit BELOW0; eauto. lia. exfalso. subst l0. destruct (zlt h h0). - destruct (proj2 (H1 h)). left; omega. omega. exploit BELOW; eauto. omega. - destruct (proj1 (H1 h0)). left; omega. omega. exploit BELOW0; eauto. omega. + destruct (proj2 (H1 h)). left; lia. lia. exploit BELOW; eauto. lia. + destruct (proj1 (H1 h0)). left; lia. lia. exploit BELOW0; eauto. lia. exfalso. destruct (zlt l l0). - destruct (proj1 (H1 l)). left; omega. omega. exploit BELOW0; eauto. omega. - destruct (proj2 (H1 l0)). left; omega. omega. exploit BELOW; eauto. omega. + destruct (proj1 (H1 l)). left; lia. lia. exploit BELOW0; eauto. lia. + destruct (proj2 (H1 l0)). left; lia. lia. exploit BELOW; eauto. lia. Qed. End R. @@ -340,7 +340,7 @@ Proof. unfold add, In; intros. destruct (zlt l h). simpl. apply R.In_add. apply proj2_sig. - intuition. omegaContradiction. + intuition. extlia. Qed. Program Definition remove (l h: Z) (s: t) : t := @@ -392,7 +392,7 @@ Theorem contains_spec: Proof. unfold contains, In; intros. destruct (zlt l h). apply R.contains_In. auto. apply proj2_sig. - split; intros. omegaContradiction. auto. + split; intros. extlia. auto. Qed. Program Definition beq (s1 s2: t) : bool := R.beq s1 s2. diff --git a/lib/Iteration.v b/lib/Iteration.v index 6a9d3253..0cca7fb7 100644 --- a/lib/Iteration.v +++ b/lib/Iteration.v @@ -237,8 +237,8 @@ Lemma iter_monot: Proof. induction p; intros. simpl. red; intros; red; auto. - destruct q. elimtype False; omega. - simpl. apply F_iter_monot. apply IHp. omega. + destruct q. elimtype False; lia. + simpl. apply F_iter_monot. apply IHp. lia. Qed. Lemma iter_either: @@ -1442,102 +1442,121 @@ Module ZTree := ITree(ZIndexed). Module Tree_Properties(T: TREE). -(** An induction principle over [fold]. *) +(** Two induction principles over [fold]. *) Section TREE_FOLD_IND. Variables V A: Type. Variable f: A -> T.elt -> V -> A. -Variable P: T.t V -> A -> Prop. +Variable P: T.t V -> A -> Type. Variable init: A. Variable m_final: T.t V. -Hypothesis P_compat: - forall m m' a, - (forall x, T.get x m = T.get x m') -> - P m a -> P m' a. - Hypothesis H_base: - P (T.empty _) init. + forall m, + (forall k, T.get k m = None) -> + P m init. Hypothesis H_rec: forall m a k v, - T.get k m = None -> T.get k m_final = Some v -> P m a -> P (T.set k v m) (f a k v). + T.get k m = Some v -> T.get k m_final = Some v -> + P (T.remove k m) a -> P m (f a k v). -Let f' (a: A) (p : T.elt * V) := f a (fst p) (snd p). +Let f' (p : T.elt * V) (a: A) := f a (fst p) (snd p). -Let P' (l: list (T.elt * V)) (a: A) : Prop := - forall m, list_equiv l (T.elements m) -> P m a. +Let P' (l: list (T.elt * V)) (a: A) : Type := + forall m, (forall k v, In (k, v) l <-> T.get k m = Some v) -> P m a. -Remark H_base': +Let H_base': P' nil init. Proof. - red; intros. apply P_compat with (T.empty _); auto. - intros. rewrite T.gempty. symmetry. case_eq (T.get x m); intros; auto. - assert (In (x, v) nil). rewrite (H (x, v)). apply T.elements_correct. auto. - contradiction. + intros m EQV. apply H_base. + intros. destruct (T.get k m) as [v|] eqn:G; auto. + apply EQV in G. contradiction. Qed. -Remark H_rec': +Let H_rec': forall k v l a, - ~In k (List.map (@fst T.elt V) l) -> - In (k, v) (T.elements m_final) -> + ~In k (List.map fst l) -> + T.get k m_final = Some v -> P' l a -> - P' (l ++ (k, v) :: nil) (f a k v). + P' ((k, v) :: l) (f a k v). Proof. - unfold P'; intros. + unfold P'; intros k v l a NOTIN FINAL HR m EQV. set (m0 := T.remove k m). - apply P_compat with (T.set k v m0). - intros. unfold m0. rewrite T.gsspec. destruct (T.elt_eq x k). - symmetry. apply T.elements_complete. rewrite <- (H2 (x, v)). - apply in_or_app. simpl. intuition congruence. - apply T.gro. auto. - apply H_rec. unfold m0. apply T.grs. apply T.elements_complete. auto. - apply H1. red. intros [k' v']. - split; intros. - apply T.elements_correct. unfold m0. rewrite T.gro. apply T.elements_complete. - rewrite <- (H2 (k', v')). apply in_or_app. auto. - red; intro; subst k'. elim H. change k with (fst (k, v')). apply in_map. auto. - assert (T.get k' m0 = Some v'). apply T.elements_complete. auto. - unfold m0 in H4. rewrite T.grspec in H4. destruct (T.elt_eq k' k). congruence. - assert (In (k', v') (T.elements m)). apply T.elements_correct; auto. - rewrite <- (H2 (k', v')) in H5. destruct (in_app_or _ _ _ H5). auto. - simpl in H6. intuition congruence. + apply H_rec. +- apply EQV. simpl; auto. +- auto. +- apply HR. intros k' v'. rewrite T.grspec. split; intros; destruct (T.elt_eq k' k). + + subst k'. elim NOTIN. change k with (fst (k, v')). apply List.in_map; auto. + + apply EQV. simpl; auto. + + congruence. + + apply EQV in H. simpl in H. intuition congruence. Qed. -Lemma fold_rec_aux: - forall l1 l2 a, - list_equiv (l2 ++ l1) (T.elements m_final) -> - list_disjoint (List.map (@fst T.elt V) l1) (List.map (@fst T.elt V) l2) -> - list_norepet (List.map (@fst T.elt V) l1) -> - P' l2 a -> P' (l2 ++ l1) (List.fold_left f' l1 a). +Lemma fold_ind_aux: + forall l, + (forall k v, In (k, v) l -> T.get k m_final = Some v) -> + list_norepet (List.map fst l) -> + P' l (List.fold_right f' init l). Proof. - induction l1; intros; simpl. - rewrite <- List.app_nil_end. auto. - destruct a as [k v]; simpl in *. inv H1. - change ((k, v) :: l1) with (((k, v) :: nil) ++ l1). rewrite <- List.app_ass. apply IHl1. - rewrite app_ass. auto. - red; intros. rewrite map_app in H3. destruct (in_app_or _ _ _ H3). apply H0; auto with coqlib. - simpl in H4. intuition congruence. - auto. - unfold f'. simpl. apply H_rec'; auto. eapply list_disjoint_notin; eauto with coqlib. - rewrite <- (H (k, v)). apply in_or_app. simpl. auto. -Qed. + induction l as [ | [k v] l ]; simpl; intros FINAL NOREPET. +- apply H_base'. +- apply H_rec'. + + inv NOREPET. auto. + + apply FINAL. auto. + + apply IHl. auto. inv NOREPET; auto. +Defined. + +Theorem fold_ind: + P m_final (T.fold f m_final init). +Proof. + intros. + set (l' := List.rev (T.elements m_final)). + assert (P' l' (List.fold_right f' init l')). + { apply fold_ind_aux. + intros. apply T.elements_complete. apply List.in_rev. auto. + unfold l'; rewrite List.map_rev. apply list_norepet_rev. apply T.elements_keys_norepet. } + unfold l', f' in X; rewrite fold_left_rev_right in X. + rewrite T.fold_spec. apply X. + intros; simpl. rewrite <- List.in_rev. + split. apply T.elements_complete. apply T.elements_correct. +Defined. + +End TREE_FOLD_IND. + +Section TREE_FOLD_REC. + +Variables V A: Type. +Variable f: A -> T.elt -> V -> A. +Variable P: T.t V -> A -> Prop. +Variable init: A. +Variable m_final: T.t V. + +Hypothesis P_compat: + forall m m' a, + (forall x, T.get x m = T.get x m') -> + P m a -> P m' a. + +Hypothesis H_base: + P (T.empty _) init. + +Hypothesis H_rec: + forall m a k v, + T.get k m = None -> T.get k m_final = Some v -> P m a -> P (T.set k v m) (f a k v). Theorem fold_rec: P m_final (T.fold f m_final init). Proof. - intros. rewrite T.fold_spec. fold f'. - assert (P' (nil ++ T.elements m_final) (List.fold_left f' (T.elements m_final) init)). - apply fold_rec_aux. - simpl. red; intros; tauto. - simpl. red; intros. elim H0. - apply T.elements_keys_norepet. - apply H_base'. - simpl in H. red in H. apply H. red; intros. tauto. + apply fold_ind. +- intros. apply P_compat with (T.empty V); auto. + + intros. rewrite T.gempty. auto. +- intros. apply P_compat with (T.set k v (T.remove k m)). + + intros. rewrite T.gsspec, T.grspec. destruct (T.elt_eq x k); auto. congruence. + + apply H_rec; auto. apply T.grs. Qed. -End TREE_FOLD_IND. +End TREE_FOLD_REC. (** A nonnegative measure over trees *) @@ -1552,7 +1571,7 @@ Theorem cardinal_remove: Proof. unfold cardinal; intros. exploit T.elements_remove; eauto. intros (l1 & l2 & P & Q). - rewrite P, Q. rewrite ! app_length. simpl. omega. + rewrite P, Q. rewrite ! app_length. simpl. lia. Qed. Theorem cardinal_set: diff --git a/lib/Ordered.v b/lib/Ordered.v index 1adbd330..69dc1c69 100644 --- a/lib/Ordered.v +++ b/lib/Ordered.v @@ -70,7 +70,7 @@ Proof (@eq_trans t). Lemma lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z. Proof Z.lt_trans. Lemma lt_not_eq : forall x y : t, lt x y -> ~ eq x y. -Proof. unfold lt, eq, t; intros. omega. Qed. +Proof. unfold lt, eq, t; intros. lia. Qed. Lemma compare : forall x y : t, Compare lt eq x y. Proof. intros. destruct (Z.compare x y) as [] eqn:E. @@ -99,11 +99,11 @@ Lemma eq_trans : forall x y z : t, eq x y -> eq y z -> eq x z. Proof (@eq_trans t). Lemma lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z. Proof. - unfold lt; intros. omega. + unfold lt; intros. lia. Qed. Lemma lt_not_eq : forall x y : t, lt x y -> ~ eq x y. Proof. - unfold lt,eq; intros; red; intros. subst. omega. + unfold lt,eq; intros; red; intros. subst. lia. Qed. Lemma compare : forall x y : t, Compare lt eq x y. Proof. @@ -114,7 +114,7 @@ Proof. apply GT. assert (Int.unsigned x <> Int.unsigned y). red; intros. rewrite <- (Int.repr_unsigned x) in n. rewrite <- (Int.repr_unsigned y) in n. congruence. - red. omega. + red. lia. Defined. Definition eq_dec : forall x y, { eq x y } + { ~ eq x y } := Int.eq_dec. diff --git a/lib/Parmov.v b/lib/Parmov.v index db27e83f..f602bd60 100644 --- a/lib/Parmov.v +++ b/lib/Parmov.v @@ -1106,7 +1106,7 @@ Lemma measure_decreasing_1: forall st st', dtransition st st' -> measure st' < measure st. Proof. - induction 1; repeat (simpl; rewrite List.app_length); simpl; omega. + induction 1; repeat (simpl; rewrite List.app_length); simpl; lia. Qed. Lemma measure_decreasing_2: diff --git a/lib/Postorder.v b/lib/Postorder.v index 3181c4cc..eaeaea37 100644 --- a/lib/Postorder.v +++ b/lib/Postorder.v @@ -314,10 +314,10 @@ Proof. destruct (wrk s) as [ | [x succs] l]. discriminate. destruct succs as [ | y succs ]. - inv H. simpl. apply lex_ord_right. omega. + inv H. simpl. apply lex_ord_right. lia. destruct ((gr s)!y) as [succs'|] eqn:?. inv H. simpl. apply lex_ord_left. eapply PTree_Properties.cardinal_remove; eauto. - inv H. simpl. apply lex_ord_right. omega. + inv H. simpl. apply lex_ord_right. lia. Qed. End POSTORDER. diff --git a/lib/UnionFind.v b/lib/UnionFind.v index bd1b763b..ae2c30d2 100644 --- a/lib/UnionFind.v +++ b/lib/UnionFind.v @@ -563,10 +563,10 @@ Proof. destruct (M.elt_eq x0 (repr uf a)). - rewrite e, repr_canonical, dec_eq_true. inversion G. subst x'. rewrite dec_eq_false; auto. - replace (pathlen uf (repr uf a)) with 0; try omega. + replace (pathlen uf (repr uf a)) with 0; try lia. symmetry. apply pathlen_none. apply repr_res_none. - rewrite (repr_unroll uf x0), (pathlen_unroll uf x0), G. - destruct (M.elt_eq (repr uf x') (repr uf a)); omega. + destruct (M.elt_eq (repr uf x') (repr uf a)); lia. + clear H; simpl in G. rewrite M.gsspec in G. destruct (M.elt_eq x0 (repr uf a)); try discriminate. rewrite (repr_none uf x0) by auto. rewrite dec_eq_false; auto. symmetry. apply pathlen_zero; auto. apply repr_none; auto. @@ -595,7 +595,7 @@ Proof. - inversion G; clear G. subst. rewrite !repr_canonical, dec_eq_true. rewrite dec_eq_false; auto. - rewrite LENa. rewrite (pathlen_none uf (repr uf b)); try omega. + rewrite LENa. rewrite (pathlen_none uf (repr uf b)); try lia. apply repr_res_none. - rewrite (repr_unroll uf x0), G, ! (pathlen_some _ _ _ G). destruct (M.elt_eq _ _); auto. @@ -613,7 +613,7 @@ Proof. intros. repeat rewrite pathlen_merge. destruct (M.elt_eq (repr uf a) (repr uf b)). auto. rewrite H. destruct (M.elt_eq (repr uf y) (repr uf a)). - omega. auto. + lia. auto. Qed. (* Path compression *) diff --git a/lib/Zbits.v b/lib/Zbits.v index 6f3acaab..0539d04b 100644 --- a/lib/Zbits.v +++ b/lib/Zbits.v @@ -33,7 +33,7 @@ Definition eqmod (x y: Z) : Prop := exists k, x = k * modul + y. Lemma eqmod_refl: forall x, eqmod x x. Proof. - intros; red. exists 0. omega. + intros; red. exists 0. lia. Qed. Lemma eqmod_refl2: forall x y, x = y -> eqmod x y. @@ -57,7 +57,7 @@ Lemma eqmod_small_eq: Proof. intros x y [k EQ] I1 I2. generalize (Zdiv_unique _ _ _ _ EQ I2). intro. - rewrite (Z.div_small x modul I1) in H. subst k. omega. + rewrite (Z.div_small x modul I1) in H. subst k. lia. Qed. Lemma eqmod_mod_eq: @@ -136,11 +136,11 @@ Lemma P_mod_two_p_range: forall n p, 0 <= P_mod_two_p p n < two_power_nat n. Proof. induction n; simpl; intros. - - rewrite two_power_nat_O. omega. + - rewrite two_power_nat_O. lia. - rewrite two_power_nat_S. destruct p. - + generalize (IHn p). rewrite Z.succ_double_spec. omega. - + generalize (IHn p). rewrite Z.double_spec. omega. - + generalize (two_power_nat_pos n). omega. + + generalize (IHn p). rewrite Z.succ_double_spec. lia. + + generalize (IHn p). rewrite Z.double_spec. lia. + + generalize (two_power_nat_pos n). lia. Qed. Lemma P_mod_two_p_eq: @@ -157,7 +157,7 @@ Proof. + destruct (IHn p) as [y EQ]. exists y. change (Zpos p~0) with (2 * Zpos p). rewrite EQ. rewrite (Z.double_spec (P_mod_two_p p n)). ring. - + exists 0; omega. + + exists 0; lia. } intros. destruct (H n p) as [y EQ]. @@ -221,8 +221,8 @@ Remark Zshiftin_spec: forall b x, Zshiftin b x = 2 * x + (if b then 1 else 0). Proof. unfold Zshiftin; intros. destruct b. - - rewrite Z.succ_double_spec. omega. - - rewrite Z.double_spec. omega. + - rewrite Z.succ_double_spec. lia. + - rewrite Z.double_spec. lia. Qed. Remark Zshiftin_inj: @@ -231,10 +231,10 @@ Remark Zshiftin_inj: Proof. intros. rewrite !Zshiftin_spec in H. destruct b1; destruct b2. - split; [auto|omega]. - omegaContradiction. - omegaContradiction. - split; [auto|omega]. + split; [auto|lia]. + extlia. + extlia. + split; [auto|lia]. Qed. Remark Zdecomp: @@ -255,9 +255,9 @@ Proof. - subst n. destruct b. + apply Z.testbit_odd_0. + rewrite Z.add_0_r. apply Z.testbit_even_0. - - assert (0 <= Z.pred n) by omega. + - assert (0 <= Z.pred n) by lia. set (n' := Z.pred n) in *. - replace n with (Z.succ n') by (unfold n'; omega). + replace n with (Z.succ n') by (unfold n'; lia). destruct b. + apply Z.testbit_odd_succ; auto. + rewrite Z.add_0_r. apply Z.testbit_even_succ; auto. @@ -273,7 +273,7 @@ Remark Ztestbit_shiftin_succ: forall b x n, 0 <= n -> Z.testbit (Zshiftin b x) (Z.succ n) = Z.testbit x n. Proof. intros. rewrite Ztestbit_shiftin. rewrite zeq_false. rewrite Z.pred_succ. auto. - omega. omega. + lia. lia. Qed. Lemma Zshiftin_ind: @@ -287,7 +287,7 @@ Proof. - induction p. + change (P (Zshiftin true (Z.pos p))). auto. + change (P (Zshiftin false (Z.pos p))). auto. - + change (P (Zshiftin true 0)). apply H0. omega. auto. + + change (P (Zshiftin true 0)). apply H0. lia. auto. - compute in H1. intuition congruence. Qed. @@ -323,7 +323,7 @@ Remark Ztestbit_succ: forall n x, 0 <= n -> Z.testbit x (Z.succ n) = Z.testbit (Z.div2 x) n. Proof. intros. rewrite Ztestbit_eq. rewrite zeq_false. rewrite Z.pred_succ. auto. - omega. omega. + lia. lia. Qed. Lemma eqmod_same_bits: @@ -335,13 +335,13 @@ Proof. - change (two_power_nat 0) with 1. exists (x-y); ring. - rewrite two_power_nat_S. assert (eqmod (two_power_nat n) (Z.div2 x) (Z.div2 y)). - apply IHn. intros. rewrite <- !Ztestbit_succ. apply H. rewrite Nat2Z.inj_succ; omega. - omega. omega. + apply IHn. intros. rewrite <- !Ztestbit_succ. apply H. rewrite Nat2Z.inj_succ; lia. + lia. lia. destruct H0 as [k EQ]. exists k. rewrite (Zdecomp x). rewrite (Zdecomp y). replace (Z.odd y) with (Z.odd x). rewrite EQ. rewrite !Zshiftin_spec. ring. - exploit (H 0). rewrite Nat2Z.inj_succ; omega. + exploit (H 0). rewrite Nat2Z.inj_succ; lia. rewrite !Ztestbit_base. auto. Qed. @@ -351,7 +351,7 @@ Lemma same_bits_eqmod: Z.testbit x i = Z.testbit y i. Proof. induction n; intros. - - simpl in H0. omegaContradiction. + - simpl in H0. extlia. - rewrite Nat2Z.inj_succ in H0. rewrite two_power_nat_S in H. rewrite !(Ztestbit_eq i); intuition. destruct H as [k EQ]. @@ -364,7 +364,7 @@ Proof. exploit Zshiftin_inj; eauto. intros [A B]. destruct (zeq i 0). + auto. - + apply IHn. exists k; auto. omega. + + apply IHn. exists k; auto. lia. Qed. Lemma equal_same_bits: @@ -383,7 +383,7 @@ Proof. replace (- Zshiftin (Z.odd x) y - 1) with (Zshiftin (negb (Z.odd x)) (- y - 1)). rewrite !Ztestbit_shiftin; auto. - destruct (zeq i 0). auto. apply IND. omega. + destruct (zeq i 0). auto. apply IND. lia. rewrite !Zshiftin_spec. destruct (Z.odd x); simpl negb; ring. Qed. @@ -395,12 +395,12 @@ Lemma Ztestbit_above: Proof. induction n; intros. - change (two_power_nat 0) with 1 in H. - replace x with 0 by omega. + replace x with 0 by lia. apply Z.testbit_0_l. - rewrite Nat2Z.inj_succ in H0. rewrite Ztestbit_eq. rewrite zeq_false. apply IHn. rewrite two_power_nat_S in H. rewrite (Zdecomp x) in H. - rewrite Zshiftin_spec in H. destruct (Z.odd x); omega. - omega. omega. omega. + rewrite Zshiftin_spec in H. destruct (Z.odd x); lia. + lia. lia. lia. Qed. Lemma Ztestbit_above_neg: @@ -412,10 +412,10 @@ Proof. intros. set (y := -x-1). assert (Z.testbit y i = false). apply Ztestbit_above with n. - unfold y; omega. auto. + unfold y; lia. auto. unfold y in H1. rewrite Z_one_complement in H1. change true with (negb false). rewrite <- H1. rewrite negb_involutive; auto. - omega. + lia. Qed. Lemma Zsign_bit: @@ -425,16 +425,16 @@ Lemma Zsign_bit: Proof. induction n; intros. - change (two_power_nat 1) with 2 in H. - assert (x = 0 \/ x = 1) by omega. + assert (x = 0 \/ x = 1) by lia. destruct H0; subst x; reflexivity. - rewrite Nat2Z.inj_succ. rewrite Ztestbit_eq. rewrite zeq_false. rewrite Z.pred_succ. rewrite IHn. rewrite two_power_nat_S. destruct (zlt (Z.div2 x) (two_power_nat n)); rewrite (Zdecomp x); rewrite Zshiftin_spec. - rewrite zlt_true. auto. destruct (Z.odd x); omega. - rewrite zlt_false. auto. destruct (Z.odd x); omega. + rewrite zlt_true. auto. destruct (Z.odd x); lia. + rewrite zlt_false. auto. destruct (Z.odd x); lia. rewrite (Zdecomp x) in H; rewrite Zshiftin_spec in H. - rewrite two_power_nat_S in H. destruct (Z.odd x); omega. - omega. omega. + rewrite two_power_nat_S in H. destruct (Z.odd x); lia. + lia. lia. Qed. Lemma Ztestbit_le: @@ -444,16 +444,16 @@ Lemma Ztestbit_le: x <= y. Proof. intros x y0 POS0; revert x; pattern y0; apply Zshiftin_ind; auto; intros. - - replace x with 0. omega. apply equal_same_bits; intros. + - replace x with 0. lia. apply equal_same_bits; intros. rewrite Ztestbit_0. destruct (Z.testbit x i) as [] eqn:E; auto. exploit H; eauto. rewrite Ztestbit_0. auto. - assert (Z.div2 x0 <= x). { apply H0. intros. exploit (H1 (Z.succ i)). - omega. rewrite Ztestbit_succ; auto. rewrite Ztestbit_shiftin_succ; auto. + lia. rewrite Ztestbit_succ; auto. rewrite Ztestbit_shiftin_succ; auto. } rewrite (Zdecomp x0). rewrite !Zshiftin_spec. - destruct (Z.odd x0) as [] eqn:E1; destruct b as [] eqn:E2; try omega. - exploit (H1 0). omega. rewrite Ztestbit_base; auto. + destruct (Z.odd x0) as [] eqn:E1; destruct b as [] eqn:E2; try lia. + exploit (H1 0). lia. rewrite Ztestbit_base; auto. rewrite Ztestbit_shiftin_base. congruence. Qed. @@ -464,16 +464,16 @@ Lemma Ztestbit_mod_two_p: Proof. intros n0 x i N0POS. revert x i; pattern n0; apply natlike_ind; auto. - intros. change (two_p 0) with 1. rewrite Zmod_1_r. rewrite Z.testbit_0_l. - rewrite zlt_false; auto. omega. + rewrite zlt_false; auto. lia. - intros. rewrite two_p_S; auto. replace (x0 mod (2 * two_p x)) with (Zshiftin (Z.odd x0) (Z.div2 x0 mod two_p x)). rewrite Ztestbit_shiftin; auto. rewrite (Ztestbit_eq i x0); auto. destruct (zeq i 0). - + rewrite zlt_true; auto. omega. + + rewrite zlt_true; auto. lia. + rewrite H0. destruct (zlt (Z.pred i) x). - * rewrite zlt_true; auto. omega. - * rewrite zlt_false; auto. omega. - * omega. + * rewrite zlt_true; auto. lia. + * rewrite zlt_false; auto. lia. + * lia. + rewrite (Zdecomp x0) at 3. set (x1 := Z.div2 x0). symmetry. apply Zmod_unique with (x1 / two_p x). rewrite !Zshiftin_spec. rewrite Z.add_assoc. f_equal. @@ -481,7 +481,7 @@ Proof. f_equal. apply Z_div_mod_eq. apply two_p_gt_ZERO; auto. ring. rewrite Zshiftin_spec. exploit (Z_mod_lt x1 (two_p x)). apply two_p_gt_ZERO; auto. - destruct (Z.odd x0); omega. + destruct (Z.odd x0); lia. Qed. Corollary Ztestbit_two_p_m1: @@ -491,7 +491,7 @@ Proof. intros. replace (two_p n - 1) with ((-1) mod (two_p n)). rewrite Ztestbit_mod_two_p; auto. destruct (zlt i n); auto. apply Ztestbit_m1; auto. apply Zmod_unique with (-1). ring. - exploit (two_p_gt_ZERO n). auto. omega. + exploit (two_p_gt_ZERO n). auto. lia. Qed. Corollary Ztestbit_neg_two_p: @@ -499,7 +499,7 @@ Corollary Ztestbit_neg_two_p: Z.testbit (- (two_p n)) i = if zlt i n then false else true. Proof. intros. - replace (- two_p n) with (- (two_p n - 1) - 1) by omega. + replace (- two_p n) with (- (two_p n - 1) - 1) by lia. rewrite Z_one_complement by auto. rewrite Ztestbit_two_p_m1 by auto. destruct (zlt i n); auto. @@ -516,16 +516,16 @@ Proof. rewrite (Zdecomp x) in *. rewrite (Zdecomp y) in *. transitivity (Z.testbit (Zshiftin (Z.odd x || Z.odd y) (Z.div2 x + Z.div2 y)) i). - f_equal. rewrite !Zshiftin_spec. - exploit (EXCL 0). omega. rewrite !Ztestbit_shiftin_base. intros. + exploit (EXCL 0). lia. rewrite !Ztestbit_shiftin_base. intros. Opaque Z.mul. destruct (Z.odd x); destruct (Z.odd y); simpl in *; discriminate || ring. - rewrite !Ztestbit_shiftin; auto. destruct (zeq i 0). + auto. - + apply IND. omega. intros. - exploit (EXCL (Z.succ j)). omega. + + apply IND. lia. intros. + exploit (EXCL (Z.succ j)). lia. rewrite !Ztestbit_shiftin_succ. auto. - omega. omega. + lia. lia. Qed. (** ** Zero and sign extensions *) @@ -583,8 +583,8 @@ Lemma Znatlike_ind: forall n, P n. Proof. intros. destruct (zle 0 n). - apply natlike_ind; auto. apply H; omega. - apply H. omega. + apply natlike_ind; auto. apply H; lia. + apply H. lia. Qed. Lemma Zzero_ext_spec: @@ -593,16 +593,16 @@ Lemma Zzero_ext_spec: Proof. unfold Zzero_ext. induction n using Znatlike_ind. - intros. rewrite Ziter_base; auto. - rewrite zlt_false. rewrite Ztestbit_0; auto. omega. + rewrite zlt_false. rewrite Ztestbit_0; auto. lia. - intros. rewrite Ziter_succ; auto. rewrite Ztestbit_shiftin; auto. rewrite (Ztestbit_eq i x); auto. destruct (zeq i 0). - + subst i. rewrite zlt_true; auto. omega. + + subst i. rewrite zlt_true; auto. lia. + rewrite IHn. destruct (zlt (Z.pred i) n). - rewrite zlt_true; auto. omega. - rewrite zlt_false; auto. omega. - omega. + rewrite zlt_true; auto. lia. + rewrite zlt_false; auto. lia. + lia. Qed. Lemma Zsign_ext_spec: @@ -611,29 +611,29 @@ Lemma Zsign_ext_spec: Proof. intros n0 x i I0. unfold Zsign_ext. unfold proj_sumbool; destruct (zlt 0 n0) as [N0|N0]; simpl. -- revert x i I0. pattern n0. apply Zlt_lower_bound_ind with (z := 1); [ | omega ]. +- revert x i I0. pattern n0. apply Zlt_lower_bound_ind with (z := 1); [ | lia ]. unfold Zsign_ext. intros. destruct (zeq x 1). + subst x; simpl. replace (if zlt i 1 then i else 0) with 0. rewrite Ztestbit_base. destruct (Z.odd x0); [ apply Ztestbit_m1; auto | apply Ztestbit_0 ]. - destruct (zlt i 1); omega. - + set (x1 := Z.pred x). replace x1 with (Z.succ (Z.pred x1)) by omega. - rewrite Ziter_succ by (unfold x1; omega). rewrite Ztestbit_shiftin by auto. + destruct (zlt i 1); lia. + + set (x1 := Z.pred x). replace x1 with (Z.succ (Z.pred x1)) by lia. + rewrite Ziter_succ by (unfold x1; lia). rewrite Ztestbit_shiftin by auto. destruct (zeq i 0). - * subst i. rewrite zlt_true. rewrite Ztestbit_base; auto. omega. - * rewrite H by (unfold x1; omega). + * subst i. rewrite zlt_true. rewrite Ztestbit_base; auto. lia. + * rewrite H by (unfold x1; lia). unfold x1; destruct (zlt (Z.pred i) (Z.pred x)). - ** rewrite zlt_true by omega. - rewrite (Ztestbit_eq i x0) by omega. - rewrite zeq_false by omega. auto. - ** rewrite zlt_false by omega. - rewrite (Ztestbit_eq (x - 1) x0) by omega. - rewrite zeq_false by omega. auto. -- rewrite Ziter_base by omega. rewrite andb_false_r. + ** rewrite zlt_true by lia. + rewrite (Ztestbit_eq i x0) by lia. + rewrite zeq_false by lia. auto. + ** rewrite zlt_false by lia. + rewrite (Ztestbit_eq (x - 1) x0) by lia. + rewrite zeq_false by lia. auto. +- rewrite Ziter_base by lia. rewrite andb_false_r. rewrite Z.testbit_0_l, Z.testbit_neg_r. auto. - destruct (zlt i n0); omega. + destruct (zlt i n0); lia. Qed. (** [Zzero_ext n x] is [x modulo 2^n] *) @@ -650,14 +650,14 @@ Qed. Lemma Zzero_ext_range: forall n x, 0 <= n -> 0 <= Zzero_ext n x < two_p n. Proof. - intros. rewrite Zzero_ext_mod; auto. apply Z_mod_lt. apply two_p_gt_ZERO. omega. + intros. rewrite Zzero_ext_mod; auto. apply Z_mod_lt. apply two_p_gt_ZERO. lia. Qed. Lemma eqmod_Zzero_ext: forall n x, 0 <= n -> eqmod (two_p n) (Zzero_ext n x) x. Proof. intros. rewrite Zzero_ext_mod; auto. apply eqmod_sym. apply eqmod_mod. - apply two_p_gt_ZERO. omega. + apply two_p_gt_ZERO. lia. Qed. (** Relation between [Zsign_ext n x] and (Zzero_ext n x] *) @@ -670,13 +670,13 @@ Proof. rewrite Zsign_ext_spec by auto. destruct (Z.testbit x (n - 1)) eqn:SIGNBIT. - set (n' := - two_p n). - replace (Zzero_ext n x - two_p n) with (Zzero_ext n x + n') by (unfold n'; omega). + replace (Zzero_ext n x - two_p n) with (Zzero_ext n x + n') by (unfold n'; lia). rewrite Z_add_is_or; auto. - rewrite Zzero_ext_spec by auto. unfold n'; rewrite Ztestbit_neg_two_p by omega. + rewrite Zzero_ext_spec by auto. unfold n'; rewrite Ztestbit_neg_two_p by lia. destruct (zlt i n). rewrite orb_false_r; auto. auto. - intros. rewrite Zzero_ext_spec by omega. unfold n'; rewrite Ztestbit_neg_two_p by omega. + intros. rewrite Zzero_ext_spec by lia. unfold n'; rewrite Ztestbit_neg_two_p by lia. destruct (zlt j n); auto using andb_false_r. -- replace (Zzero_ext n x - 0) with (Zzero_ext n x) by omega. +- replace (Zzero_ext n x - 0) with (Zzero_ext n x) by lia. rewrite Zzero_ext_spec by auto. destruct (zlt i n); auto. Qed. @@ -688,20 +688,20 @@ Lemma Zsign_ext_range: forall n x, 0 < n -> -two_p (n-1) <= Zsign_ext n x < two_p (n-1). Proof. intros. - assert (A: 0 <= Zzero_ext n x < two_p n) by (apply Zzero_ext_range; omega). + assert (A: 0 <= Zzero_ext n x < two_p n) by (apply Zzero_ext_range; lia). assert (B: Z.testbit (Zzero_ext n x) (n - 1) = if zlt (Zzero_ext n x) (two_p (n - 1)) then false else true). { set (N := Z.to_nat (n - 1)). generalize (Zsign_bit N (Zzero_ext n x)). rewrite ! two_power_nat_two_p. - rewrite inj_S. unfold N; rewrite Z2Nat.id by omega. - intros X; apply X. replace (Z.succ (n - 1)) with n by omega. exact A. + rewrite inj_S. unfold N; rewrite Z2Nat.id by lia. + intros X; apply X. replace (Z.succ (n - 1)) with n by lia. exact A. } assert (C: two_p n = 2 * two_p (n - 1)). - { rewrite <- two_p_S by omega. f_equal; omega. } - rewrite Zzero_ext_spec, zlt_true in B by omega. - rewrite Zsign_ext_zero_ext by omega. rewrite B. - destruct (zlt (Zzero_ext n x) (two_p (n - 1))); omega. + { rewrite <- two_p_S by lia. f_equal; lia. } + rewrite Zzero_ext_spec, zlt_true in B by lia. + rewrite Zsign_ext_zero_ext by lia. rewrite B. + destruct (zlt (Zzero_ext n x) (two_p (n - 1))); lia. Qed. Lemma eqmod_Zsign_ext: @@ -711,9 +711,9 @@ Proof. intros. rewrite Zsign_ext_zero_ext by auto. apply eqmod_trans with (x - 0). apply eqmod_sub. - apply eqmod_Zzero_ext; omega. + apply eqmod_Zzero_ext; lia. exists (if Z.testbit x (n - 1) then 1 else 0). destruct (Z.testbit x (n - 1)); ring. - apply eqmod_refl2; omega. + apply eqmod_refl2; lia. Qed. (** ** Decomposition of a number as a sum of powers of two. *) @@ -743,19 +743,19 @@ Proof. { induction n; intros. simpl. rewrite two_power_nat_O in H0. - assert (x = 0) by omega. subst x. omega. + assert (x = 0) by lia. subst x. lia. rewrite two_power_nat_S in H0. simpl Z_one_bits. rewrite (Zdecomp x) in H0. rewrite Zshiftin_spec in H0. assert (EQ: Z.div2 x * two_p (i + 1) = powerserie (Z_one_bits n (Z.div2 x) (i + 1))). - apply IHn. omega. - destruct (Z.odd x); omega. + apply IHn. lia. + destruct (Z.odd x); lia. rewrite two_p_is_exp in EQ. change (two_p 1) with 2 in EQ. rewrite (Zdecomp x) at 1. rewrite Zshiftin_spec. destruct (Z.odd x); simpl powerserie; rewrite <- EQ; ring. - omega. omega. + lia. lia. } - intros. rewrite <- H. change (two_p 0) with 1. omega. - omega. exact H0. + intros. rewrite <- H. change (two_p 0) with 1. lia. + lia. exact H0. Qed. Lemma Z_one_bits_range: @@ -768,12 +768,12 @@ Proof. tauto. intros x i j. rewrite Nat2Z.inj_succ. assert (In j (Z_one_bits n (Z.div2 x) (i + 1)) -> i <= j < i + Z.succ (Z.of_nat n)). - intros. exploit IHn; eauto. omega. + intros. exploit IHn; eauto. lia. destruct (Z.odd x); simpl. - intros [A|B]. subst j. omega. auto. + intros [A|B]. subst j. lia. auto. auto. } - intros. generalize (H n x 0 i H0). omega. + intros. generalize (H n x 0 i H0). lia. Qed. Remark Z_one_bits_zero: @@ -787,15 +787,15 @@ Remark Z_one_bits_two_p: 0 <= x < Z.of_nat n -> Z_one_bits n (two_p x) i = (i + x) :: nil. Proof. - induction n; intros; simpl. simpl in H. omegaContradiction. + induction n; intros; simpl. simpl in H. extlia. rewrite Nat2Z.inj_succ in H. - assert (x = 0 \/ 0 < x) by omega. destruct H0. - subst x; simpl. decEq. omega. apply Z_one_bits_zero. + assert (x = 0 \/ 0 < x) by lia. destruct H0. + subst x; simpl. decEq. lia. apply Z_one_bits_zero. assert (Z.odd (two_p x) = false /\ Z.div2 (two_p x) = two_p (x-1)). apply Zshiftin_inj. rewrite <- Zdecomp. rewrite !Zshiftin_spec. - rewrite <- two_p_S. rewrite Z.add_0_r. f_equal; omega. omega. + rewrite <- two_p_S. rewrite Z.add_0_r. f_equal; lia. lia. destruct H1 as [A B]; rewrite A; rewrite B. - rewrite IHn. f_equal; omega. omega. + rewrite IHn. f_equal; lia. lia. Qed. (** ** Recognition of powers of two *) @@ -820,7 +820,7 @@ Proof. induction p; simpl P_is_power2; intros. - discriminate. - change (Z.pos p~0) with (2 * Z.pos p). apply IHp in H. - rewrite Z.log2_double by xomega. rewrite two_p_S. congruence. + rewrite Z.log2_double by extlia. rewrite two_p_S. congruence. apply Z.log2_nonneg. - reflexivity. Qed. @@ -848,7 +848,7 @@ Proof. intros. assert (x <> 0) by (red; intros; subst x; discriminate). apply Z_is_power2_sound in H1. destruct H1 as [P Q]. subst i. - split. apply Z.log2_nonneg. apply Z.log2_lt_pow2. omega. rewrite <- two_p_equiv; tauto. + split. apply Z.log2_nonneg. apply Z.log2_lt_pow2. lia. rewrite <- two_p_equiv; tauto. Qed. Lemma Z_is_power2_complete: @@ -858,11 +858,11 @@ Opaque Z.log2. assert (A: forall x i, Z_is_power2 x = Some i -> Z_is_power2 (2 * x) = Some (Z.succ i)). { destruct x; simpl; intros; try discriminate. change (2 * Z.pos p) with (Z.pos (xO p)); simpl. - destruct (P_is_power2 p); inv H. rewrite <- Z.log2_double by xomega. auto. + destruct (P_is_power2 p); inv H. rewrite <- Z.log2_double by extlia. auto. } induction i using Znatlike_ind; intros. -- replace i with 0 by omega. reflexivity. -- rewrite two_p_S by omega. apply A. apply IHi; omega. +- replace i with 0 by lia. reflexivity. +- rewrite two_p_S by lia. apply A. apply IHi; lia. Qed. Definition Z_is_power2m1 (x: Z) : option Z := Z_is_power2 (Z.succ x). @@ -876,13 +876,13 @@ Qed. Lemma Z_is_power2m1_sound: forall x i, Z_is_power2m1 x = Some i -> x = two_p i - 1. Proof. - unfold Z_is_power2m1; intros. apply Z_is_power2_sound in H. omega. + unfold Z_is_power2m1; intros. apply Z_is_power2_sound in H. lia. Qed. Lemma Z_is_power2m1_complete: forall i, 0 <= i -> Z_is_power2m1 (two_p i - 1) = Some i. Proof. - intros. unfold Z_is_power2m1. replace (Z.succ (two_p i - 1)) with (two_p i) by omega. + intros. unfold Z_is_power2m1. replace (Z.succ (two_p i - 1)) with (two_p i) by lia. apply Z_is_power2_complete; auto. Qed. @@ -891,8 +891,8 @@ Lemma Z_is_power2m1_range: 0 <= n -> 0 <= x < two_p n -> Z_is_power2m1 x = Some i -> 0 <= i <= n. Proof. intros. destruct (zeq x (two_p n - 1)). -- subst x. rewrite Z_is_power2m1_complete in H1 by auto. inv H1; omega. -- unfold Z_is_power2m1 in H1. apply (Z_is_power2_range n (Z.succ x) i) in H1; omega. +- subst x. rewrite Z_is_power2m1_complete in H1 by auto. inv H1; lia. +- unfold Z_is_power2m1 in H1. apply (Z_is_power2_range n (Z.succ x) i) in H1; lia. Qed. (** ** Relation between bitwise operations and multiplications / divisions by powers of 2 *) @@ -903,7 +903,7 @@ Lemma Zshiftl_mul_two_p: forall x n, 0 <= n -> Z.shiftl x n = x * two_p n. Proof. intros. destruct n; simpl. - - omega. + - lia. - pattern p. apply Pos.peano_ind. + change (two_power_pos 1) with 2. simpl. ring. + intros. rewrite Pos.iter_succ. rewrite H0. @@ -925,7 +925,7 @@ Proof. rewrite Pplus_one_succ_l. rewrite two_power_pos_is_exp. change (two_power_pos 1) with 2. rewrite Zdiv2_div. rewrite Z.mul_comm. apply Zdiv_Zdiv. - rewrite two_power_pos_nat. apply two_power_nat_pos. omega. + rewrite two_power_pos_nat. apply two_power_nat_pos. lia. - compute in H. congruence. Qed. @@ -938,12 +938,12 @@ Lemma Zquot_Zdiv: Proof. intros. destruct (zlt x 0). - symmetry. apply Zquot_unique_full with ((x + y - 1) mod y - (y - 1)). - + red. right; split. omega. + + red. right; split. lia. exploit (Z_mod_lt (x + y - 1) y); auto. - rewrite Z.abs_eq. omega. omega. + rewrite Z.abs_eq. lia. lia. + transitivity ((y * ((x + y - 1) / y) + (x + y - 1) mod y) - (y-1)). rewrite <- Z_div_mod_eq. ring. auto. ring. - - apply Zquot_Zdiv_pos; omega. + - apply Zquot_Zdiv_pos; lia. Qed. Lemma Zdiv_shift: @@ -953,8 +953,8 @@ Proof. intros. generalize (Z_div_mod_eq x y H). generalize (Z_mod_lt x y H). set (q := x / y). set (r := x mod y). intros. destruct (zeq r 0). - apply Zdiv_unique with (y - 1). rewrite H1. rewrite e. ring. omega. - apply Zdiv_unique with (r - 1). rewrite H1. ring. omega. + apply Zdiv_unique with (y - 1). rewrite H1. rewrite e. ring. lia. + apply Zdiv_unique with (r - 1). rewrite H1. ring. lia. Qed. (** ** Size of integers, in bits. *) @@ -967,7 +967,7 @@ Definition Zsize (x: Z) : Z := Remark Zsize_pos: forall x, 0 <= Zsize x. Proof. - destruct x; simpl. omega. compute; intuition congruence. omega. + destruct x; simpl. lia. compute; intuition congruence. lia. Qed. Remark Zsize_pos': forall x, 0 < x -> 0 < Zsize x. @@ -991,8 +991,8 @@ Lemma Ztestbit_size_1: Proof. intros x0 POS0; pattern x0; apply Zshiftin_pos_ind; auto. intros. rewrite Zsize_shiftin; auto. - replace (Z.pred (Z.succ (Zsize x))) with (Z.succ (Z.pred (Zsize x))) by omega. - rewrite Ztestbit_shiftin_succ. auto. generalize (Zsize_pos' x H); omega. + replace (Z.pred (Z.succ (Zsize x))) with (Z.succ (Z.pred (Zsize x))) by lia. + rewrite Ztestbit_shiftin_succ. auto. generalize (Zsize_pos' x H); lia. Qed. Lemma Ztestbit_size_2: @@ -1002,12 +1002,12 @@ Proof. - subst x0; intros. apply Ztestbit_0. - pattern x0; apply Zshiftin_pos_ind. + simpl. intros. change 1 with (Zshiftin true 0). rewrite Ztestbit_shiftin. - rewrite zeq_false. apply Ztestbit_0. omega. omega. + rewrite zeq_false. apply Ztestbit_0. lia. lia. + intros. rewrite Zsize_shiftin in H1; auto. generalize (Zsize_pos' _ H); intros. - rewrite Ztestbit_shiftin. rewrite zeq_false. apply H0. omega. - omega. omega. - + omega. + rewrite Ztestbit_shiftin. rewrite zeq_false. apply H0. lia. + lia. lia. + + lia. Qed. Lemma Zsize_interval_1: @@ -1029,18 +1029,18 @@ Proof. assert (Z.of_nat N = n) by (apply Z2Nat.id; auto). rewrite <- H1 in H0. rewrite <- two_power_nat_two_p in H0. destruct (zeq x 0). - subst x; simpl; omega. + subst x; simpl; lia. destruct (zlt n (Zsize x)); auto. - exploit (Ztestbit_above N x (Z.pred (Zsize x))). auto. omega. - rewrite Ztestbit_size_1. congruence. omega. + exploit (Ztestbit_above N x (Z.pred (Zsize x))). auto. lia. + rewrite Ztestbit_size_1. congruence. lia. Qed. Lemma Zsize_monotone: forall x y, 0 <= x <= y -> Zsize x <= Zsize y. Proof. intros. apply Z.ge_le. apply Zsize_interval_2. apply Zsize_pos. - exploit (Zsize_interval_1 y). omega. - omega. + exploit (Zsize_interval_1 y). lia. + lia. Qed. (** ** Bit insertion, bit extraction *) @@ -1070,7 +1070,7 @@ Lemma Zextract_s_spec: Proof. unfold Zextract_s; intros. rewrite Zsign_ext_spec by auto. rewrite Z.shiftr_spec. rewrite Z.add_comm. auto. - destruct (zlt i len); omega. + destruct (zlt i len); lia. Qed. (** Insert bits [0...len-1] of [y] into bits [to...to+len-1] of [x] *) @@ -1092,10 +1092,10 @@ Proof. { intros; apply Ztestbit_two_p_m1; auto. } rewrite Z.lor_spec, Z.land_spec, Z.ldiff_spec by auto. destruct (zle to i). -- rewrite ! Z.shiftl_spec by auto. rewrite ! M by omega. +- rewrite ! Z.shiftl_spec by auto. rewrite ! M by lia. unfold proj_sumbool; destruct (zlt (i - to) len); simpl; rewrite andb_true_r, andb_false_r. -+ rewrite zlt_true by omega. apply orb_false_r. -+ rewrite zlt_false by omega; auto. -- rewrite ! Z.shiftl_spec_low by omega. simpl. apply andb_true_r. ++ rewrite zlt_true by lia. apply orb_false_r. ++ rewrite zlt_false by lia; auto. +- rewrite ! Z.shiftl_spec_low by lia. simpl. apply andb_true_r. Qed. diff --git a/powerpc/Asm.v b/powerpc/Asm.v index d9901960..93bc31b8 100644 --- a/powerpc/Asm.v +++ b/powerpc/Asm.v @@ -1276,7 +1276,7 @@ Ltac Equalities := split. auto. intros. destruct B; auto. subst. auto. (* trace length *) red; intros. inv H; simpl. - omega. + lia. eapply external_call_trace_length; eauto. eapply external_call_trace_length; eauto. (* initial states *) diff --git a/powerpc/Asmexpand.ml b/powerpc/Asmexpand.ml index cb6a659f..df712b9d 100644 --- a/powerpc/Asmexpand.ml +++ b/powerpc/Asmexpand.ml @@ -388,8 +388,9 @@ let rec next_arg_locations ir fr ofs = function then next_arg_locations ir (fr + 1) ofs l else next_arg_locations ir fr (align ofs 8 + 8) l | Tlong :: l -> - if ir < 7 - then next_arg_locations (align ir 2 + 2) fr ofs l + let ir = align ir 2 in + if ir < 8 + then next_arg_locations (ir + 2) fr ofs l else next_arg_locations ir fr (align ofs 8 + 8) l let expand_builtin_va_start r = @@ -830,7 +831,7 @@ let expand_builtin_inline name args res = function is unprototyped. *) let set_cr6 sg = - if sg.sig_cc.cc_vararg || sg.sig_cc.cc_unproto then begin + if (sg.sig_cc.cc_vararg <> None) || sg.sig_cc.cc_unproto then begin if List.exists (function Tfloat | Tsingle -> true | _ -> false) sg.sig_args then emit (Pcreqv(CRbit_6, CRbit_6, CRbit_6)) else emit (Pcrxor(CRbit_6, CRbit_6, CRbit_6)) diff --git a/powerpc/Asmgenproof.v b/powerpc/Asmgenproof.v index 93589a31..2fab6d57 100644 --- a/powerpc/Asmgenproof.v +++ b/powerpc/Asmgenproof.v @@ -69,7 +69,7 @@ Lemma transf_function_no_overflow: transf_function f = OK tf -> list_length_z tf.(fn_code) <= Ptrofs.max_unsigned. Proof. intros. monadInv H. destruct (zlt Ptrofs.max_unsigned (list_length_z x.(fn_code))); inv EQ0. - omega. + lia. Qed. Lemma exec_straight_exec: @@ -402,8 +402,8 @@ Proof. split. unfold goto_label. rewrite P. rewrite H1. auto. split. rewrite Pregmap.gss. constructor; auto. rewrite Ptrofs.unsigned_repr. replace (pos' - 0) with pos' in Q. - auto. omega. - generalize (transf_function_no_overflow _ _ H0). omega. + auto. lia. + generalize (transf_function_no_overflow _ _ H0). lia. intros. apply Pregmap.gso; auto. Qed. @@ -934,14 +934,14 @@ Local Transparent destroyed_by_jumptable. simpl const_low. rewrite ATLR. erewrite storev_offset_ptr by eexact P. auto. congruence. auto. auto. auto. left; exists (State rs5 m3'); split. - eapply exec_straight_steps_1; eauto. omega. constructor. + eapply exec_straight_steps_1; eauto. lia. constructor. econstructor; eauto. change (rs5 PC) with (Val.offset_ptr (Val.offset_ptr (Val.offset_ptr (Val.offset_ptr (rs0 PC) Ptrofs.one) Ptrofs.one) Ptrofs.one) Ptrofs.one). rewrite ATPC. simpl. constructor; eauto. - eapply code_tail_next_int. omega. - eapply code_tail_next_int. omega. - eapply code_tail_next_int. omega. - eapply code_tail_next_int. omega. + eapply code_tail_next_int. lia. + eapply code_tail_next_int. lia. + eapply code_tail_next_int. lia. + eapply code_tail_next_int. lia. constructor. unfold rs5, rs4, rs3, rs2. apply agree_nextinstr. apply agree_nextinstr. @@ -966,7 +966,7 @@ Local Transparent destroyed_by_jumptable. - (* return *) inv STACKS. simpl in *. - right. split. omega. split. auto. + right. split. lia. split. auto. rewrite <- ATPC in H5. econstructor; eauto. congruence. diff --git a/powerpc/Asmgenproof1.v b/powerpc/Asmgenproof1.v index 850e95c7..9f928ff8 100644 --- a/powerpc/Asmgenproof1.v +++ b/powerpc/Asmgenproof1.v @@ -81,12 +81,12 @@ Proof. unfold Int.modu, Int.zero. decEq. change 0 with (0 mod 65536). change (Int.unsigned (Int.repr 65536)) with 65536. - apply eqmod_mod_eq. omega. + apply eqmod_mod_eq. lia. unfold x, low_s. eapply eqmod_trans. apply eqmod_divides with Int.modulus. unfold Int.sub. apply Int.eqm_unsigned_repr_l. apply Int.eqm_refl. exists 65536. compute; auto. - replace 0 with (Int.unsigned n - Int.unsigned n) by omega. + replace 0 with (Int.unsigned n - Int.unsigned n) by lia. apply eqmod_sub. apply eqmod_refl. apply Int.eqmod_sign_ext'. compute; auto. rewrite H0 in H. rewrite Int.add_zero in H. @@ -132,7 +132,7 @@ Lemma important_diff: Proof. congruence. Qed. -Hint Resolve important_diff: asmgen. +Global Hint Resolve important_diff: asmgen. Lemma important_data_preg_1: forall r, data_preg r = true -> important_preg r = true. @@ -146,7 +146,7 @@ Proof. intros. destruct (data_preg r) eqn:E; auto. apply important_data_preg_1 in E. congruence. Qed. -Hint Resolve important_data_preg_1 important_data_preg_2: asmgen. +Global Hint Resolve important_data_preg_1 important_data_preg_2: asmgen. Lemma nextinstr_inv2: forall r rs, important_preg r = true -> (nextinstr rs)#r = rs#r. @@ -166,7 +166,7 @@ Lemma gpr_or_zero_zero: Proof. intros. reflexivity. Qed. -Hint Resolve gpr_or_zero_not_zero gpr_or_zero_zero: asmgen. +Global Hint Resolve gpr_or_zero_not_zero gpr_or_zero_zero: asmgen. Lemma gpr_or_zero_l_not_zero: forall rs r, r <> GPR0 -> gpr_or_zero_l rs r = rs#r. @@ -178,21 +178,21 @@ Lemma gpr_or_zero_l_zero: Proof. intros. reflexivity. Qed. -Hint Resolve gpr_or_zero_l_not_zero gpr_or_zero_l_zero: asmgen. +Global Hint Resolve gpr_or_zero_l_not_zero gpr_or_zero_l_zero: asmgen. Lemma ireg_of_not_GPR0: forall m r, ireg_of m = OK r -> IR r <> IR GPR0. Proof. intros. erewrite <- ireg_of_eq; eauto with asmgen. Qed. -Hint Resolve ireg_of_not_GPR0: asmgen. +Global Hint Resolve ireg_of_not_GPR0: asmgen. Lemma ireg_of_not_GPR0': forall m r, ireg_of m = OK r -> r <> GPR0. Proof. intros. generalize (ireg_of_not_GPR0 _ _ H). congruence. Qed. -Hint Resolve ireg_of_not_GPR0': asmgen. +Global Hint Resolve ireg_of_not_GPR0': asmgen. (** Useful properties of the LR register *) @@ -208,7 +208,7 @@ Proof. intros. rewrite preg_notin_charact. intros. apply preg_of_not_LR. Qed. -Hint Resolve preg_of_not_LR preg_notin_LR: asmgen. +Global Hint Resolve preg_of_not_LR preg_notin_LR: asmgen. (** Useful simplification tactic *) @@ -543,7 +543,7 @@ Proof. - econstructor; split; [|split]. + apply exec_straight_one. simpl; eauto. auto. + Simpl. rewrite Int64.add_zero_l. rewrite H. unfold low64_s. - rewrite Int64.sign_ext_widen by omega. auto. + rewrite Int64.sign_ext_widen by lia. auto. + intros; Simpl. - econstructor; split; [|split]. + eapply exec_straight_two. simpl; eauto. simpl; eauto. auto. auto. @@ -551,16 +551,16 @@ Proof. apply Int64.same_bits_eq; intros. assert (Int64.zwordsize = 64) by auto. rewrite Int64.bits_or, Int64.bits_shl by auto. unfold low64_s, low64_u. - rewrite Int64.bits_zero_ext by omega. + rewrite Int64.bits_zero_ext by lia. change (Int64.unsigned (Int64.repr 16)) with 16. destruct (zlt i 16). - * rewrite Int64.bits_sign_ext by omega. rewrite zlt_true by omega. auto. - * rewrite ! Int64.bits_sign_ext by omega. rewrite orb_false_r. + * rewrite Int64.bits_sign_ext by lia. rewrite zlt_true by lia. auto. + * rewrite ! Int64.bits_sign_ext by lia. rewrite orb_false_r. destruct (zlt i 32). - ** rewrite zlt_true by omega. rewrite Int64.bits_shr by omega. + ** rewrite zlt_true by lia. rewrite Int64.bits_shr by lia. change (Int64.unsigned (Int64.repr 16)) with 16. - rewrite zlt_true by omega. f_equal; omega. - ** rewrite zlt_false by omega. rewrite Int64.bits_shr by omega. + rewrite zlt_true by lia. f_equal; lia. + ** rewrite zlt_false by lia. rewrite Int64.bits_shr by lia. change (Int64.unsigned (Int64.repr 16)) with 16. reflexivity. + intros; Simpl. @@ -605,11 +605,11 @@ Proof. rewrite Int64.bits_shl by auto. change (Int64.unsigned (Int64.repr 32)) with 32. destruct (zlt i 32); auto. - rewrite Int64.bits_sign_ext by omega. - rewrite zlt_true by omega. - unfold n2. rewrite Int64.bits_shru by omega. + rewrite Int64.bits_sign_ext by lia. + rewrite zlt_true by lia. + unfold n2. rewrite Int64.bits_shru by lia. change (Int64.unsigned (Int64.repr 32)) with 32. - rewrite zlt_true by omega. f_equal; omega. + rewrite zlt_true by lia. f_equal; lia. } assert (MI: forall i, 0 <= i < Int64.zwordsize -> Int64.testbit mi i = @@ -619,21 +619,21 @@ Proof. rewrite Int64.bits_shl by auto. change (Int64.unsigned (Int64.repr 16)) with 16. destruct (zlt i 16); auto. - unfold n1. rewrite Int64.bits_zero_ext by omega. - rewrite Int64.bits_shru by omega. + unfold n1. rewrite Int64.bits_zero_ext by lia. + rewrite Int64.bits_shru by lia. destruct (zlt i 32). - rewrite zlt_true by omega. + rewrite zlt_true by lia. change (Int64.unsigned (Int64.repr 16)) with 16. - rewrite zlt_true by omega. f_equal; omega. - rewrite zlt_false by omega. auto. + rewrite zlt_true by lia. f_equal; lia. + rewrite zlt_false by lia. auto. } assert (EQ: Int64.or (Int64.or hi mi) n0 = n). { apply Int64.same_bits_eq; intros. rewrite ! Int64.bits_or by auto. - unfold n0; rewrite Int64.bits_zero_ext by omega. + unfold n0; rewrite Int64.bits_zero_ext by lia. rewrite HI, MI by auto. destruct (zlt i 16). - rewrite zlt_true by omega. auto. + rewrite zlt_true by lia. auto. destruct (zlt i 32); rewrite ! orb_false_r; auto. } edestruct (loadimm64_32s_correct r n2) as (rs' & A & B & C). @@ -1180,7 +1180,7 @@ Local Transparent Int.repr. rewrite H2. apply Int.mkint_eq; reflexivity. rewrite Int.not_involutive in H3. congruence. - omega. + lia. Qed. Remark add_carry_ne0: @@ -1198,8 +1198,8 @@ Transparent Int.eq. rewrite Int.unsigned_zero. rewrite Int.unsigned_mone. unfold negb, Val.of_bool, Vtrue, Vfalse. destruct (zeq (Int.unsigned i) 0); decEq. - apply zlt_true. omega. - apply zlt_false. generalize (Int.unsigned_range i). omega. + apply zlt_true. lia. + apply zlt_false. generalize (Int.unsigned_range i). lia. Qed. Lemma transl_cond_op_correct: diff --git a/powerpc/ConstpropOpproof.v b/powerpc/ConstpropOpproof.v index 8687b056..1dd2e0e4 100644 --- a/powerpc/ConstpropOpproof.v +++ b/powerpc/ConstpropOpproof.v @@ -374,7 +374,7 @@ Proof. Int.bit_solve. destruct (zlt i0 n0). replace (Int.testbit n i0) with (negb (Int.testbit Int.zero i0)). rewrite Int.bits_zero. simpl. rewrite andb_true_r. auto. - rewrite <- EQ. rewrite Int.bits_zero_ext by omega. rewrite zlt_true by auto. + rewrite <- EQ. rewrite Int.bits_zero_ext by lia. rewrite zlt_true by auto. rewrite Int.bits_not by auto. apply negb_involutive. rewrite H6 by auto. auto. econstructor; split; eauto. auto. diff --git a/powerpc/Conventions1.v b/powerpc/Conventions1.v index 5c9cbd4f..f05e77df 100644 --- a/powerpc/Conventions1.v +++ b/powerpc/Conventions1.v @@ -268,7 +268,7 @@ Remark loc_arguments_rec_charact: forall_rpair (loc_argument_charact ofs) p. Proof. assert (X: forall ofs1 ofs2 l, loc_argument_charact ofs2 l -> ofs1 <= ofs2 -> loc_argument_charact ofs1 l). - { destruct l; simpl; intros; auto. destruct sl; auto. intuition omega. } + { destruct l; simpl; intros; auto. destruct sl; auto. intuition lia. } assert (Y: forall ofs1 ofs2 p, forall_rpair (loc_argument_charact ofs2) p -> ofs1 <= ofs2 -> forall_rpair (loc_argument_charact ofs1) p). { destruct p; simpl; intuition eauto. } Opaque list_nth_z. @@ -279,52 +279,52 @@ Opaque list_nth_z. destruct (list_nth_z int_param_regs ir) as [r|] eqn:E; destruct H. subst. left. eapply list_nth_z_in; eauto. eapply IHtyl; eauto. - subst. split. omega. apply Z.divide_1_l. - eapply Y; eauto. omega. + subst. split. lia. apply Z.divide_1_l. + eapply Y; eauto. lia. - (* float *) - assert (ofs <= align ofs 2) by (apply align_le; omega). + assert (ofs <= align ofs 2) by (apply align_le; lia). destruct (list_nth_z float_param_regs fr) as [r|] eqn:E; destruct H. subst. right. eapply list_nth_z_in; eauto. eapply IHtyl; eauto. - subst. split. omega. apply Z.divide_1_l. - eapply Y; eauto. omega. + subst. split. lia. apply Z.divide_1_l. + eapply Y; eauto. lia. - (* long *) - assert (ofs <= align ofs 2) by (apply align_le; omega). + assert (ofs <= align ofs 2) by (apply align_le; lia). set (ir' := align ir 2) in *. destruct (list_nth_z int_param_regs ir') as [r1|] eqn:E1. destruct (list_nth_z int_param_regs (ir' + 1)) as [r2|] eqn:E2. destruct H. subst; split; left; eapply list_nth_z_in; eauto. eapply IHtyl; eauto. destruct H. - subst. destruct Archi.ptr64; [split|split;split]; try omega. - apply align_divides; omega. apply Z.divide_1_l. apply Z.divide_1_l. - eapply Y; eauto. omega. + subst. destruct Archi.ptr64; [split|split;split]; try lia. + apply align_divides; lia. apply Z.divide_1_l. apply Z.divide_1_l. + eapply Y; eauto. lia. destruct H. - subst. destruct Archi.ptr64; [split|split;split]; try omega. - apply align_divides; omega. apply Z.divide_1_l. apply Z.divide_1_l. - eapply Y; eauto. omega. + subst. destruct Archi.ptr64; [split|split;split]; try lia. + apply align_divides; lia. apply Z.divide_1_l. apply Z.divide_1_l. + eapply Y; eauto. lia. - (* single *) - assert (ofs <= align ofs 1) by (apply align_le; omega). - assert (ofs <= align ofs 2) by (apply align_le; omega). + assert (ofs <= align ofs 1) by (apply align_le; lia). + assert (ofs <= align ofs 2) by (apply align_le; lia). destruct (list_nth_z float_param_regs fr) as [r|] eqn:E; destruct H. subst. right. eapply list_nth_z_in; eauto. eapply IHtyl; eauto. - subst. split. destruct Archi.single_passed_as_single; simpl; omega. + subst. split. destruct Archi.single_passed_as_single; simpl; lia. destruct Archi.single_passed_as_single; simpl; apply Z.divide_1_l. - eapply Y; eauto. destruct Archi.single_passed_as_single; simpl; omega. + eapply Y; eauto. destruct Archi.single_passed_as_single; simpl; lia. - (* any32 *) destruct (list_nth_z int_param_regs ir) as [r|] eqn:E; destruct H. subst. left. eapply list_nth_z_in; eauto. eapply IHtyl; eauto. - subst. split. omega. apply Z.divide_1_l. - eapply Y; eauto. omega. + subst. split. lia. apply Z.divide_1_l. + eapply Y; eauto. lia. - (* float *) - assert (ofs <= align ofs 2) by (apply align_le; omega). + assert (ofs <= align ofs 2) by (apply align_le; lia). destruct (list_nth_z float_param_regs fr) as [r|] eqn:E; destruct H. subst. right. eapply list_nth_z_in; eauto. eapply IHtyl; eauto. - subst. split. omega. apply Z.divide_1_l. - eapply Y; eauto. omega. + subst. split. lia. apply Z.divide_1_l. + eapply Y; eauto. lia. Qed. Lemma loc_arguments_acceptable: @@ -341,7 +341,7 @@ Proof. unfold forall_rpair; destruct p; intuition auto. Qed. -Hint Resolve loc_arguments_acceptable: locs. +Global Hint Resolve loc_arguments_acceptable: locs. Lemma loc_arguments_main: loc_arguments signature_main = nil. @@ -349,8 +349,9 @@ Proof. reflexivity. Qed. -(** ** Normalization of function results *) +(** ** Normalization of function results and parameters *) (** No normalization needed. *) Definition return_value_needs_normalization (t: rettype) := false. +Definition parameter_needs_normalization (t: rettype) := false. diff --git a/powerpc/NeedOp.v b/powerpc/NeedOp.v index 74ee6b85..85dd9b2e 100644 --- a/powerpc/NeedOp.v +++ b/powerpc/NeedOp.v @@ -162,8 +162,8 @@ Lemma operation_is_redundant_sound: vagree v arg1' nv. Proof. intros. destruct op; simpl in *; try discriminate; inv H1; FuncInv; subst. -- apply sign_ext_redundant_sound; auto. omega. -- apply sign_ext_redundant_sound; auto. omega. +- apply sign_ext_redundant_sound; auto. lia. +- apply sign_ext_redundant_sound; auto. lia. - apply andimm_redundant_sound; auto. - apply orimm_redundant_sound; auto. - apply rolm_redundant_sound; auto. diff --git a/powerpc/SelectLongproof.v b/powerpc/SelectLongproof.v index eba071eb..2264451d 100644 --- a/powerpc/SelectLongproof.v +++ b/powerpc/SelectLongproof.v @@ -222,15 +222,15 @@ Proof. change (Int64.unsigned Int64.iwordsize) with 64. f_equal. rewrite Int.unsigned_repr. - apply eqmod_mod_eq. omega. + apply eqmod_mod_eq. lia. apply eqmod_trans with a. apply eqmod_divides with Int.modulus. apply Int.eqm_sym. apply Int.eqm_unsigned_repr. exists (two_p (32-6)); auto. apply eqmod_divides with Int64.modulus. apply Int64.eqm_unsigned_repr. exists (two_p (64-6)); auto. - assert (0 <= Int.unsigned (Int.repr a) mod 64 < 64) by (apply Z_mod_lt; omega). + assert (0 <= Int.unsigned (Int.repr a) mod 64 < 64) by (apply Z_mod_lt; lia). assert (64 < Int.max_unsigned) by (compute; auto). - omega. + lia. - InvEval. TrivialExists. simpl. rewrite <- H. unfold Val.rolml; destruct v1; simpl; auto. unfold Int64.rolm. rewrite Int64.rol_and. rewrite Int64.and_assoc. auto. diff --git a/powerpc/SelectOpproof.v b/powerpc/SelectOpproof.v index ed81c83f..edc935d4 100644 --- a/powerpc/SelectOpproof.v +++ b/powerpc/SelectOpproof.v @@ -809,7 +809,7 @@ Qed. Theorem eval_cast8unsigned: unary_constructor_sound cast8unsigned (Val.zero_ext 8). Proof. red; intros. unfold cast8unsigned. - rewrite Val.zero_ext_and. apply eval_andimm; auto. omega. + rewrite Val.zero_ext_and. apply eval_andimm; auto. lia. Qed. Theorem eval_cast16signed: unary_constructor_sound cast16signed (Val.sign_ext 16). @@ -822,7 +822,7 @@ Qed. Theorem eval_cast16unsigned: unary_constructor_sound cast16unsigned (Val.zero_ext 16). Proof. red; intros. unfold cast16unsigned. - rewrite Val.zero_ext_and. apply eval_andimm; auto. omega. + rewrite Val.zero_ext_and. apply eval_andimm; auto. lia. Qed. Theorem eval_singleoffloat: unary_constructor_sound singleoffloat Val.singleoffloat. @@ -860,7 +860,7 @@ Proof. simpl; rewrite Heqo; simpl; eauto. constructor. simpl. unfold Int64.loword. rewrite Int64.unsigned_repr, Int.repr_unsigned. auto. assert (Int.modulus < Int64.max_unsigned) by (compute; auto). - generalize (Int.unsigned_range n). omega. + generalize (Int.unsigned_range n). lia. - set (im := Int.repr Int.half_modulus). set (fm := Float.of_intu im). assert (eval_expr ge sp e m (Vfloat fm :: Vfloat f :: le) (Eletvar (S O)) (Vfloat f)). diff --git a/powerpc/Stacklayout.v b/powerpc/Stacklayout.v index cb3806bd..32b11ad5 100644 --- a/powerpc/Stacklayout.v +++ b/powerpc/Stacklayout.v @@ -77,11 +77,11 @@ Local Opaque Z.add Z.mul sepconj range. set (ostkdata := align oendcs 8). generalize b.(bound_local_pos) b.(bound_outgoing_pos) b.(bound_stack_data_pos); intros. unfold fe_ofs_arg. - assert (8 + 4 * b.(bound_outgoing) <= ol) by (apply align_le; omega). - assert (ol <= ora) by (unfold ora; omega). - assert (ora <= ocs) by (unfold ocs; omega). + assert (8 + 4 * b.(bound_outgoing) <= ol) by (apply align_le; lia). + assert (ol <= ora) by (unfold ora; lia). + assert (ora <= ocs) by (unfold ocs; lia). assert (ocs <= oendcs) by (apply size_callee_save_area_incr). - assert (oendcs <= ostkdata) by (apply align_le; omega). + assert (oendcs <= ostkdata) by (apply align_le; lia). (* Reorder as: back link outgoing @@ -90,12 +90,12 @@ Local Opaque Z.add Z.mul sepconj range. callee-save *) rewrite sep_swap3. (* Apply range_split and range_split2 repeatedly *) - apply range_drop_right with 8. omega. - apply range_split. omega. - apply range_split_2. fold ol; omega. omega. - apply range_split. omega. - apply range_split. omega. - apply range_drop_right with ostkdata. omega. + apply range_drop_right with 8. lia. + apply range_split. lia. + apply range_split_2. fold ol; lia. lia. + apply range_split. lia. + apply range_split. lia. + apply range_drop_right with ostkdata. lia. eapply sep_drop2. eexact H. Qed. @@ -112,12 +112,12 @@ Proof. set (ostkdata := align oendcs 8). generalize b.(bound_local_pos) b.(bound_outgoing_pos) b.(bound_stack_data_pos); intros. unfold fe_ofs_arg. - assert (8 + 4 * b.(bound_outgoing) <= ol) by (apply align_le; omega). - assert (ol <= ora) by (unfold ora; omega). - assert (ora <= ocs) by (unfold ocs; omega). + assert (8 + 4 * b.(bound_outgoing) <= ol) by (apply align_le; lia). + assert (ol <= ora) by (unfold ora; lia). + assert (ora <= ocs) by (unfold ocs; lia). assert (ocs <= oendcs) by (apply size_callee_save_area_incr). - assert (oendcs <= ostkdata) by (apply align_le; omega). - split. omega. apply align_le. omega. + assert (oendcs <= ostkdata) by (apply align_le; lia). + split. lia. apply align_le. lia. Qed. Lemma frame_env_aligned: @@ -136,10 +136,10 @@ Proof. set (oendcs := size_callee_save_area b ocs). set (ostkdata := align oendcs 8). split. exists (fe_ofs_arg / 8); reflexivity. - split. apply align_divides; omega. - split. apply align_divides; omega. + split. apply align_divides; lia. + split. apply align_divides; lia. split. apply Z.divide_0_r. apply Z.divide_add_r. - apply Z.divide_trans with 8. exists 2; auto. apply align_divides; omega. + apply Z.divide_trans with 8. exists 2; auto. apply align_divides; lia. apply Z.divide_factor_l. Qed. diff --git a/powerpc/TargetPrinter.ml b/powerpc/TargetPrinter.ml index 554bfe09..a82fa5d9 100644 --- a/powerpc/TargetPrinter.ml +++ b/powerpc/TargetPrinter.ml @@ -120,22 +120,16 @@ module Linux_System : SYSTEM = | Section_data(i, true) -> failwith "_Thread_local unsupported on this platform" | Section_data(i, false) -> - if i then - ".data" - else - common_section ~sec:".section .bss" () + variable_section ~sec:".data" ~bss:".section .bss" i | Section_small_data i -> - if i then - ".section .sdata,\"aw\",@progbits" - else - common_section ~sec:".section .sbss,\"aw\",@nobits" () + variable_section + ~sec:".section .sdata,\"aw\",@progbits" + ~bss:".section .sbss,\"aw\",@nobits" + i | Section_const i -> - if i || (not !Clflags.option_fcommon) then ".rodata" else "COMM" + variable_section ~sec:".rodata" i | Section_small_const i -> - if i || (not !Clflags.option_fcommon) then - ".section .sdata2,\"a\",@progbits" - else - "COMM" + variable_section ~sec:".section .sdata2,\"a\",@progbits" i | Section_string -> ".rodata" | Section_literal -> ".section .rodata.cst8,\"aM\",@progbits,8" | Section_jumptable -> ".text" @@ -222,8 +216,10 @@ module Diab_System : SYSTEM = | Section_text -> ".text" | Section_data(i, true) -> failwith "_Thread_local unsupported on this platform" - | Section_data (i, false) -> if i then ".data" else common_section () - | Section_small_data i -> if i then ".sdata" else ".sbss" + | Section_data (i, false) -> + variable_section ~sec:".data" ~bss:".bss" i + | Section_small_data i -> + variable_section ~sec:".sdata" ~bss:".sbss" ~common:false i | Section_const _ -> ".text" | Section_small_const _ -> ".sdata2" | Section_string -> ".text" diff --git a/riscV/Asmexpand.ml b/riscV/Asmexpand.ml index c5cd6817..a49efce8 100644 --- a/riscV/Asmexpand.ml +++ b/riscV/Asmexpand.ml @@ -24,6 +24,7 @@ open Asmexpandaux open AST open Camlcoq open! Integers +open Locations exception Error of string @@ -50,6 +51,86 @@ let expand_addptrofs dst src n = let expand_storeind_ptr src base ofs = List.iter emit (Asmgen.storeind_ptr src base ofs []) +(* Fix-up code around function calls and function entry. + Some floating-point arguments residing in FP registers need to be + moved to integer registers or register pairs. + Symmetrically, some floating-point parameter passed in integer + registers or register pairs need to be moved to FP registers. *) + +let int_param_regs = [| X10; X11; X12; X13; X14; X15; X16; X17 |] + +let move_single_arg fr i = + emit (Pfmvxs(int_param_regs.(i), fr)) + +let move_double_arg fr i = + if Archi.ptr64 then begin + emit (Pfmvxd(int_param_regs.(i), fr)) + end else begin + emit (Paddiw(X2, X X2, Integers.Int.neg _16)); + emit (Pfsd(fr, X2, Ofsimm _0)); + emit (Plw(int_param_regs.(i), X2, Ofsimm _0)); + if i < 7 then begin + emit (Plw(int_param_regs.(i + 1), X2, Ofsimm _4)) + end else begin + emit (Plw(X31, X2, Ofsimm _4)); + emit (Psw(X31, X2, Ofsimm _16)) + end; + emit (Paddiw(X2, X X2, _16)) + end + +let move_single_param fr i = + emit (Pfmvsx(fr, int_param_regs.(i))) + +let move_double_param fr i = + if Archi.ptr64 then begin + emit (Pfmvdx(fr, int_param_regs.(i))) + end else begin + emit (Paddiw(X2, X X2, Integers.Int.neg _16)); + emit (Psw(int_param_regs.(i), X2, Ofsimm _0)); + if i < 7 then begin + emit (Psw(int_param_regs.(i + 1), X2, Ofsimm _4)) + end else begin + emit (Plw(X31, X2, Ofsimm _16)); + emit (Psw(X31, X2, Ofsimm _4)) + end; + emit (Pfld(fr, X2, Ofsimm _0)); + emit (Paddiw(X2, X X2, _16)) + end + +let float_extra_index = function + | Machregs.F0 -> Some (F0, 0) + | Machregs.F1 -> Some (F1, 1) + | Machregs.F2 -> Some (F2, 2) + | Machregs.F3 -> Some (F3, 3) + | Machregs.F4 -> Some (F4, 4) + | Machregs.F5 -> Some (F5, 5) + | Machregs.F6 -> Some (F6, 6) + | Machregs.F7 -> Some (F7, 7) + | _ -> None + +let fixup_gen single double sg = + let fixup ty loc = + match ty, loc with + | Tsingle, One (R r) -> + begin match float_extra_index r with + | Some(r, i) -> single r i + | None -> () + end + | (Tfloat | Tany64), One (R r) -> + begin match float_extra_index r with + | Some(r, i) -> double r i + | None -> () + end + | _, _ -> () + in + List.iter2 fixup sg.sig_args (Conventions1.loc_arguments sg) + +let fixup_call sg = + fixup_gen move_single_arg move_double_arg sg + +let fixup_function_entry sg = + fixup_gen move_single_param move_double_param sg + (* Built-ins. They come in two flavors: - annotation statements: take their arguments in registers or stack locations; generate no code; @@ -57,51 +138,6 @@ let expand_storeind_ptr src base ofs = registers. *) -(* Fix-up code around calls to variadic functions. Floating-point arguments - residing in FP registers need to be moved to integer registers. *) - -let int_param_regs = [| X10; X11; X12; X13; X14; X15; X16; X17 |] -let float_param_regs = [| F10; F11; F12; F13; F14; F15; F16; F17 |] - -let rec fixup_variadic_call ri rf tyl = - if ri < 8 then - match tyl with - | [] -> - () - | (Tint | Tany32) :: tyl -> - fixup_variadic_call (ri + 1) rf tyl - | Tsingle :: tyl -> - let rs = float_param_regs.(rf) - and rd = int_param_regs.(ri) in - emit (Pfmvxs(rd, rs)); - fixup_variadic_call (ri + 1) (rf + 1) tyl - | Tlong :: tyl -> - let ri' = if Archi.ptr64 then ri + 1 else align ri 2 + 2 in - fixup_variadic_call ri' rf tyl - | (Tfloat | Tany64) :: tyl -> - if Archi.ptr64 then begin - let rs = float_param_regs.(rf) - and rd = int_param_regs.(ri) in - emit (Pfmvxd(rd, rs)); - fixup_variadic_call (ri + 1) (rf + 1) tyl - end else begin - let ri = align ri 2 in - if ri < 8 then begin - let rs = float_param_regs.(rf) - and rd1 = int_param_regs.(ri) - and rd2 = int_param_regs.(ri + 1) in - emit (Paddiw(X2, X X2, Integers.Int.neg _16)); - emit (Pfsd(rs, X2, Ofsimm _0)); - emit (Plw(rd1, X2, Ofsimm _0)); - emit (Plw(rd2, X2, Ofsimm _4)); - emit (Paddiw(X2, X X2, _16)); - fixup_variadic_call (ri + 2) (rf + 1) tyl - end - end - -let fixup_call sg = - if sg.sig_cc.cc_vararg then fixup_variadic_call 0 0 sg.sig_args - (* Handling of annotations *) let expand_annot_val kind txt targ args res = @@ -305,18 +341,53 @@ let expand_builtin_vstore chunk args = (* Handling of varargs *) -(* Size in words of the arguments to a function. This includes both - arguments passed in registers and arguments passed on stack. *) +(* Number of integer registers, FP registers, and stack words + used to pass the (fixed) arguments to a function. *) + +let arg_int_size ri rf ofs k = + if ri < 8 + then k (ri + 1) rf ofs + else k ri rf (ofs + 1) + +let arg_single_size ri rf ofs k = + if rf < 8 + then k ri (rf + 1) ofs + else arg_int_size ri rf ofs k + +let arg_long_size ri rf ofs k = + if Archi.ptr64 then + if ri < 8 + then k (ri + 1) rf ofs + else k ri rf (ofs + 1) + else + if ri < 7 then k (ri + 2) rf ofs + else if ri = 7 then k (ri + 1) rf (ofs + 1) + else k ri rf (align ofs 2 + 2) + +let arg_double_size ri rf ofs k = + if rf < 8 + then k ri (rf + 1) ofs + else arg_long_size ri rf ofs k + +let rec args_size l ri rf ofs = + match l with + | [] -> (ri, rf, ofs) + | (Tint | Tany32) :: l -> + arg_int_size ri rf ofs (args_size l) + | Tsingle :: l -> + arg_single_size ri rf ofs (args_size l) + | Tlong :: l -> + arg_long_size ri rf ofs (args_size l) + | (Tfloat | Tany64) :: l -> + arg_double_size ri rf ofs (args_size l) -let rec args_size sz = function - | [] -> sz - | (Tint | Tsingle | Tany32) :: l -> - args_size (sz + 1) l - | (Tlong | Tfloat | Tany64) :: l -> - args_size (if Archi.ptr64 then sz + 1 else align sz 2 + 2) l +(* Size in words of the arguments to a function. This includes both + arguments passed in integer registers and arguments passed on stack, + but not arguments passed in FP registers. *) let arguments_size sg = - args_size 0 sg.sig_args + let (ri, _, ofs) = args_size sg.sig_args 0 0 0 in + ri + ofs let save_arguments first_reg base_ofs = for i = first_reg to 7 do @@ -628,7 +699,7 @@ let expand_instruction instr = | Pallocframe (sz, ofs) -> let sg = get_current_function_sig() in emit (Pmv (X30, X2)); - if sg.sig_cc.cc_vararg then begin + if (sg.sig_cc.cc_vararg <> None) then begin let n = arguments_size sg in let extra_sz = if n >= 8 then 0 else align ((8 - n) * wordsize) 16 in let full_sz = Z.add sz (Z.of_uint extra_sz) in @@ -646,7 +717,7 @@ let expand_instruction instr = | Pfreeframe (sz, ofs) -> let sg = get_current_function_sig() in let extra_sz = - if sg.sig_cc.cc_vararg then begin + if (sg.sig_cc.cc_vararg <> None) then begin let n = arguments_size sg in if n >= 8 then 0 else align ((8 - n) * wordsize) 16 end else 0 in @@ -746,6 +817,7 @@ let preg_to_dwarf = function let expand_function id fn = try set_current_function fn; + fixup_function_entry fn.fn_sig; expand id (* sp= *) 2 preg_to_dwarf expand_instruction fn.fn_code; Errors.OK (get_current_function ()) with Error s -> diff --git a/riscV/Asmgenproof.v b/riscV/Asmgenproof.v index 6abad4ed..d9715984 100644 --- a/riscV/Asmgenproof.v +++ b/riscV/Asmgenproof.v @@ -67,7 +67,7 @@ Lemma transf_function_no_overflow: transf_function f = OK tf -> list_length_z tf.(fn_code) <= Ptrofs.max_unsigned. Proof. intros. monadInv H. destruct (zlt Ptrofs.max_unsigned (list_length_z x.(fn_code))); inv EQ0. - omega. + lia. Qed. Lemma exec_straight_exec: @@ -332,8 +332,8 @@ Proof. split. unfold goto_label. rewrite P. rewrite H1. auto. split. rewrite Pregmap.gss. constructor; auto. rewrite Ptrofs.unsigned_repr. replace (pos' - 0) with pos' in Q. - auto. omega. - generalize (transf_function_no_overflow _ _ H0). omega. + auto. lia. + generalize (transf_function_no_overflow _ _ H0). lia. intros. apply Pregmap.gso; auto. Qed. @@ -854,10 +854,10 @@ Local Transparent destroyed_by_op. rewrite <- (sp_val _ _ _ AG). rewrite chunk_of_Tptr in F. rewrite F. reflexivity. reflexivity. eexact U. } - exploit exec_straight_steps_2; eauto using functions_transl. omega. constructor. + exploit exec_straight_steps_2; eauto using functions_transl. lia. constructor. intros (ofs' & X & Y). left; exists (State rs3 m3'); split. - eapply exec_straight_steps_1; eauto. omega. constructor. + eapply exec_straight_steps_1; eauto. lia. constructor. econstructor; eauto. rewrite X; econstructor; eauto. apply agree_exten with rs2; eauto with asmgen. @@ -886,7 +886,7 @@ Local Transparent destroyed_at_function_entry. - (* return *) inv STACKS. simpl in *. - right. split. omega. split. auto. + right. split. lia. split. auto. rewrite <- ATPC in H5. econstructor; eauto. congruence. Qed. diff --git a/riscV/ConstpropOpproof.v b/riscV/ConstpropOpproof.v index 26a50317..74dc4a05 100644 --- a/riscV/ConstpropOpproof.v +++ b/riscV/ConstpropOpproof.v @@ -365,7 +365,7 @@ Proof. Int.bit_solve. destruct (zlt i0 n0). replace (Int.testbit n i0) with (negb (Int.testbit Int.zero i0)). rewrite Int.bits_zero. simpl. rewrite andb_true_r. auto. - rewrite <- EQ. rewrite Int.bits_zero_ext by omega. rewrite zlt_true by auto. + rewrite <- EQ. rewrite Int.bits_zero_ext by lia. rewrite zlt_true by auto. rewrite Int.bits_not by auto. apply negb_involutive. rewrite H6 by auto. auto. econstructor; split; eauto. auto. diff --git a/riscV/Conventions1.v b/riscV/Conventions1.v index 17326139..eeaae3c4 100644 --- a/riscV/Conventions1.v +++ b/riscV/Conventions1.v @@ -172,25 +172,29 @@ Qed. (** ** Location of function arguments *) (** The RISC-V ABI states the following conventions for passing arguments - to a function: + to a function. First for non-variadic functions: -- RV64, not variadic: pass the first 8 integer arguments in - integer registers (a1...a8: int_param_regs), the first 8 FP arguments - in FP registers (fa1...fa8: float_param_regs), and the remaining - arguments on the stack, in 8-byte slots. +- RV64: pass the first 8 integer arguments in integer registers + (a1...a8: int_param_regs), the first 8 FP arguments in FP registers + (fa1...fa8: float_param_regs) then in integer registers (a1...a8), + and the remaining arguments on the stack, in 8-byte slots. -- RV32, not variadic: same, but arguments of 64-bit integer type - are passed in two consecutive integer registers (a(i), a(i+1)) - or in a(8) and on a 32-bit word on the stack. Stack-allocated - arguments are aligned to their natural alignment. +- RV32: same, but arguments of size 64 bits that must be passed in + integer registers are passed in two consecutive integer registers + (a(i), a(i+1)), or in a(8) and on a 32-bit word on the stack. + Stack-allocated arguments are aligned to their natural alignment. -- RV64, variadic: pass the first 8 arguments in integer registers - (a1...a8), including FP arguments; pass the remaining arguments on - the stack, in 8-byte slots. +For variadic functions, the fixed arguments are passed as described +above, then the variadic arguments receive special treatment: -- RV32, variadic: same, but arguments of 64-bit types (integers as well +- RV64: FP registers are not used for passing variadic arguments. + All variadic arguments, including FP arguments, are passed in the + remaining integer registers (a1...a8), then on the stack, in 8-byte + slots. + +- RV32: likewise, but arguments of 64-bit types (integers as well as floats) are passed in two consecutive aligned integer registers - (a(2i), a(2i+1)). + (a(2i), a(2i+1)), or on the stack, in aligned 8-byte slots. The passing of FP arguments to variadic functions in integer registers doesn't quite fit CompCert's model. We do our best by passing the FP @@ -204,6 +208,15 @@ Definition int_param_regs := Definition float_param_regs := F10 :: F11 :: F12 :: F13 :: F14 :: F15 :: F16 :: F17 :: nil. +(** To evaluate FP arguments that must be passed in integer registers, + we can use any FP caller-save register that is not already used to pass + a fixed FP argument. Since there are 8 integer registers for argument + passing, we need at most 8 extra more FP registers for these FP + arguments. *) + +Definition float_extra_param_regs := + F0 :: F1 :: F2 :: F3 :: F4 :: F5 :: F6 :: F7 :: nil. + Definition int_arg (ri rf ofs: Z) (ty: typ) (rec: Z -> Z -> Z -> list (rpair loc)) := match list_nth_z int_param_regs ri with @@ -217,26 +230,27 @@ Definition int_arg (ri rf ofs: Z) (ty: typ) Definition float_arg (va: bool) (ri rf ofs: Z) (ty: typ) (rec: Z -> Z -> Z -> list (rpair loc)) := - match list_nth_z float_param_regs rf with + match list_nth_z (if va then nil else float_param_regs) rf with | Some r => - if va then - (let ri' := (* reserve 1 or 2 aligned integer registers *) - if Archi.ptr64 || zeq (typesize ty) 1 then ri + 1 else align ri 2 + 2 in - if zle ri' 8 then - (* we have enough integer registers, put argument in FP reg - and fixup code will put it in one or two integer regs *) - One (R r) :: rec ri' (rf + 1) ofs - else - (* we are out of integer registers, pass argument on stack *) + One (R r) :: rec ri (rf + 1) ofs + | None => + (* We are out of FP registers, or cannot use them because vararg, + so try to put the argument in an extra FP register while + reserving an integer register or register pair into which + fixup code will move the extra FP register. *) + let regpair := negb Archi.ptr64 && zeq (typesize ty) 2 in + let ri' := if va && regpair then align ri 2 else ri in + match list_nth_z float_extra_param_regs ri' with + | Some r => + let ri'' := ri' + (if Archi.ptr64 then 1 else typesize ty) in + let ofs'' := if regpair && zeq ri' 7 then ofs + 1 else ofs in + One (R r) :: rec ri'' rf ofs'' + | None => + (* We are out of integer registers, pass argument on stack *) let ofs := align ofs (typesize ty) in One(S Outgoing ofs ty) - :: rec ri' rf (ofs + (if Archi.ptr64 then 2 else typesize ty))) - else - One (R r) :: rec ri (rf + 1) ofs - | None => - let ofs := align ofs (typesize ty) in - One(S Outgoing ofs ty) - :: rec ri rf (ofs + (if Archi.ptr64 then 2 else typesize ty)) + :: rec ri' rf (ofs + (if Archi.ptr64 then 2 else typesize ty)) + end end. Definition split_long_arg (va: bool) (ri rf ofs: Z) @@ -253,35 +267,43 @@ Definition split_long_arg (va: bool) (ri rf ofs: Z) rec ri rf (ofs + 2) end. -Fixpoint loc_arguments_rec (va: bool) - (tyl: list typ) (ri rf ofs: Z) {struct tyl} : list (rpair loc) := +Fixpoint loc_arguments_rec + (tyl: list typ) (fixed ri rf ofs: Z) {struct tyl} : list (rpair loc) := match tyl with | nil => nil | (Tint | Tany32) as ty :: tys => (* pass in one integer register or on stack *) - int_arg ri rf ofs ty (loc_arguments_rec va tys) + int_arg ri rf ofs ty (loc_arguments_rec tys (fixed - 1)) | Tsingle as ty :: tys => (* pass in one FP register or on stack. If vararg, reserve 1 integer register. *) - float_arg va ri rf ofs ty (loc_arguments_rec va tys) + float_arg (zle fixed 0) ri rf ofs ty (loc_arguments_rec tys (fixed - 1)) | Tlong as ty :: tys => if Archi.ptr64 then (* pass in one integer register or on stack *) - int_arg ri rf ofs ty (loc_arguments_rec va tys) + int_arg ri rf ofs ty (loc_arguments_rec tys (fixed - 1)) else (* pass in register pair or on stack; align register pair if vararg *) - split_long_arg va ri rf ofs(loc_arguments_rec va tys) + split_long_arg (zle fixed 0) ri rf ofs(loc_arguments_rec tys (fixed - 1)) | (Tfloat | Tany64) as ty :: tys => (* pass in one FP register or on stack. If vararg, reserve 1 or 2 integer registers. *) - float_arg va ri rf ofs ty (loc_arguments_rec va tys) + float_arg (zle fixed 0) ri rf ofs ty (loc_arguments_rec tys (fixed - 1)) + end. + +(** Number of fixed arguments for a function with signature [s]. *) + +Definition fixed_arguments (s: signature) : Z := + match s.(sig_cc).(cc_vararg) with + | Some n => n + | None => list_length_z s.(sig_args) end. (** [loc_arguments s] returns the list of locations where to store arguments when calling a function with signature [s]. *) Definition loc_arguments (s: signature) : list (rpair loc) := - loc_arguments_rec s.(sig_cc).(cc_vararg) s.(sig_args) 0 0 0. + loc_arguments_rec s.(sig_args) (fixed_arguments s) 0 0 0. (** Argument locations are either non-temporary registers or [Outgoing] stack slots at nonnegative offsets. *) @@ -306,17 +328,19 @@ Proof. { decide_goal. } assert (CSF: forall r, In r float_param_regs -> is_callee_save r = false). { decide_goal. } + assert (CSFX: forall r, In r float_extra_param_regs -> is_callee_save r = false). + { decide_goal. } assert (AL: forall ofs ty, ofs >= 0 -> align ofs (typesize ty) >= 0). { intros. assert (ofs <= align ofs (typesize ty)) by (apply align_le; apply typesize_pos). - omega. } + lia. } assert (ALD: forall ofs ty, ofs >= 0 -> (typealign ty | align ofs (typesize ty))). { intros. eapply Z.divide_trans. apply typealign_typesize. apply align_divides. apply typesize_pos. } assert (SK: (if Archi.ptr64 then 2 else 1) > 0). - { destruct Archi.ptr64; omega. } + { destruct Archi.ptr64; lia. } assert (SKK: forall ty, (if Archi.ptr64 then 2 else typesize ty) > 0). - { intros. destruct Archi.ptr64. omega. apply typesize_pos. } + { intros. destruct Archi.ptr64. lia. apply typesize_pos. } assert (A: forall ri rf ofs ty f, OKF f -> ofs >= 0 -> OK (int_arg ri rf ofs ty f)). { intros until f; intros OF OO; red; unfold int_arg; intros. @@ -325,23 +349,22 @@ Proof. - eapply OF; eauto. - subst p; simpl. auto using align_divides, typealign_pos. - eapply OF; [idtac|eauto]. - generalize (AL ofs ty OO) (SKK ty); omega. + generalize (AL ofs ty OO) (SKK ty); lia. } assert (B: forall va ri rf ofs ty f, OKF f -> ofs >= 0 -> OK (float_arg va ri rf ofs ty f)). { intros until f; intros OF OO; red; unfold float_arg; intros. - destruct (list_nth_z float_param_regs rf) as [r|] eqn:NTH. - - set (ri' := if Archi.ptr64 || zeq (typesize ty) 1 then ri + 1 else align ri 2 + 2) in *. - destruct va; [destruct (zle ri' 8)|idtac]; destruct H. - + subst p; simpl. apply CSF. eapply list_nth_z_in; eauto. - + eapply OF; eauto. - + subst p; repeat split; auto. - + eapply OF; [idtac|eauto]. generalize (AL ofs ty OO) (SKK ty); omega. - + subst p; simpl. apply CSF. eapply list_nth_z_in; eauto. - + eapply OF; eauto. + destruct (list_nth_z (if va then nil else float_param_regs) rf) as [r|] eqn:NTH. - destruct H. - + subst p; repeat split; auto. - + eapply OF; [idtac|eauto]. generalize (AL ofs ty OO) (SKK ty); omega. + + subst p; simpl. apply CSF. destruct va. simpl in NTH; discriminate. eapply list_nth_z_in; eauto. + + eapply OF; eauto. + - set (regpair := negb Archi.ptr64 && zeq (typesize ty) 2) in *. + set (ri' := if va && regpair then align ri 2 else ri) in *. + destruct (list_nth_z float_extra_param_regs ri') as [r|] eqn:NTH'; destruct H. + + subst p; simpl. apply CSFX. eapply list_nth_z_in; eauto. + + eapply OF; [|eauto]. destruct (regpair && zeq ri' 7); lia. + + subst p; simpl. auto. + + eapply OF; [|eauto]. generalize (AL ofs ty OO) (SKK ty); lia. } assert (C: forall va ri rf ofs f, OKF f -> ofs >= 0 -> OK (split_long_arg va ri rf ofs f)). @@ -353,35 +376,35 @@ Proof. [destruct (list_nth_z int_param_regs (ri'+1)) as [r2|] eqn:NTH2 | idtac]. - red; simpl; intros; destruct H. + subst p; split; apply CSI; eauto using list_nth_z_in. - + eapply OF; [idtac|eauto]. omega. + + eapply OF; [idtac|eauto]. lia. - red; simpl; intros; destruct H. + subst p; split. split; auto using Z.divide_1_l. apply CSI; eauto using list_nth_z_in. - + eapply OF; [idtac|eauto]. omega. + + eapply OF; [idtac|eauto]. lia. - red; simpl; intros; destruct H. - + subst p; repeat split; auto using Z.divide_1_l. omega. - + eapply OF; [idtac|eauto]. omega. + + subst p; repeat split; auto using Z.divide_1_l. lia. + + eapply OF; [idtac|eauto]. lia. } - cut (forall va tyl ri rf ofs, ofs >= 0 -> OK (loc_arguments_rec va tyl ri rf ofs)). + cut (forall tyl fixed ri rf ofs, ofs >= 0 -> OK (loc_arguments_rec tyl fixed ri rf ofs)). unfold OK. eauto. induction tyl as [ | ty1 tyl]; intros until ofs; intros OO; simpl. - red; simpl; tauto. - destruct ty1. -+ (* int *) apply A; auto. -+ (* float *) apply B; auto. ++ (* int *) apply A; unfold OKF; auto. ++ (* float *) apply B; unfold OKF; auto. + (* long *) destruct Archi.ptr64. - apply A; auto. - apply C; auto. -+ (* single *) apply B; auto. -+ (* any32 *) apply A; auto. -+ (* any64 *) apply B; auto. + apply A; unfold OKF; auto. + apply C; unfold OKF; auto. ++ (* single *) apply B; unfold OKF; auto. ++ (* any32 *) apply A; unfold OKF; auto. ++ (* any64 *) apply B; unfold OKF; auto. Qed. Lemma loc_arguments_acceptable: forall (s: signature) (p: rpair loc), In p (loc_arguments s) -> forall_rpair loc_argument_acceptable p. Proof. - unfold loc_arguments; intros. eapply loc_arguments_rec_charact; eauto. omega. + unfold loc_arguments; intros. eapply loc_arguments_rec_charact; eauto. lia. Qed. Lemma loc_arguments_main: @@ -390,8 +413,9 @@ Proof. reflexivity. Qed. -(** ** Normalization of function results *) +(** ** Normalization of function results and parameters *) (** No normalization needed. *) Definition return_value_needs_normalization (t: rettype) := false. +Definition parameter_needs_normalization (t: rettype) := false. diff --git a/riscV/NeedOp.v b/riscV/NeedOp.v index 4b309f5b..fe000976 100644 --- a/riscV/NeedOp.v +++ b/riscV/NeedOp.v @@ -209,8 +209,8 @@ Lemma operation_is_redundant_sound: vagree v arg1' nv. Proof. intros. destruct op; simpl in *; try discriminate; inv H1; FuncInv; subst. -- apply sign_ext_redundant_sound; auto. omega. -- apply sign_ext_redundant_sound; auto. omega. +- apply sign_ext_redundant_sound; auto. lia. +- apply sign_ext_redundant_sound; auto. lia. - apply andimm_redundant_sound; auto. - apply orimm_redundant_sound; auto. Qed. diff --git a/riscV/Stacklayout.v b/riscV/Stacklayout.v index d0c6a526..25f02aab 100644 --- a/riscV/Stacklayout.v +++ b/riscV/Stacklayout.v @@ -68,15 +68,15 @@ Local Opaque Z.add Z.mul sepconj range. set (ol := align (size_callee_save_area b ocs) 8). set (ostkdata := align (ol + 4 * b.(bound_local)) 8). replace (size_chunk Mptr) with w by (rewrite size_chunk_Mptr; auto). - assert (0 < w) by (unfold w; destruct Archi.ptr64; omega). + assert (0 < w) by (unfold w; destruct Archi.ptr64; lia). generalize b.(bound_local_pos) b.(bound_outgoing_pos) b.(bound_stack_data_pos); intros. - assert (0 <= 4 * b.(bound_outgoing)) by omega. - assert (4 * b.(bound_outgoing) <= olink) by (apply align_le; omega). - assert (olink + w <= oretaddr) by (unfold oretaddr; omega). - assert (oretaddr + w <= ocs) by (unfold ocs; omega). + assert (0 <= 4 * b.(bound_outgoing)) by lia. + assert (4 * b.(bound_outgoing) <= olink) by (apply align_le; lia). + assert (olink + w <= oretaddr) by (unfold oretaddr; lia). + assert (oretaddr + w <= ocs) by (unfold ocs; lia). assert (ocs <= size_callee_save_area b ocs) by (apply size_callee_save_area_incr). - assert (size_callee_save_area b ocs <= ol) by (apply align_le; omega). - assert (ol + 4 * b.(bound_local) <= ostkdata) by (apply align_le; omega). + assert (size_callee_save_area b ocs <= ol) by (apply align_le; lia). + assert (ol + 4 * b.(bound_local) <= ostkdata) by (apply align_le; lia). (* Reorder as: outgoing back link @@ -89,11 +89,11 @@ Local Opaque Z.add Z.mul sepconj range. rewrite sep_swap45. (* Apply range_split and range_split2 repeatedly *) unfold fe_ofs_arg. - apply range_split_2. fold olink; omega. omega. - apply range_split. omega. - apply range_split. omega. - apply range_split_2. fold ol. omega. omega. - apply range_drop_right with ostkdata. omega. + apply range_split_2. fold olink; lia. lia. + apply range_split. lia. + apply range_split. lia. + apply range_split_2. fold ol. lia. lia. + apply range_drop_right with ostkdata. lia. eapply sep_drop2. eexact H. Qed. @@ -109,16 +109,16 @@ Proof. set (ocs := oretaddr + w). set (ol := align (size_callee_save_area b ocs) 8). set (ostkdata := align (ol + 4 * b.(bound_local)) 8). - assert (0 < w) by (unfold w; destruct Archi.ptr64; omega). + assert (0 < w) by (unfold w; destruct Archi.ptr64; lia). generalize b.(bound_local_pos) b.(bound_outgoing_pos) b.(bound_stack_data_pos); intros. - assert (0 <= 4 * b.(bound_outgoing)) by omega. - assert (4 * b.(bound_outgoing) <= olink) by (apply align_le; omega). - assert (olink + w <= oretaddr) by (unfold oretaddr; omega). - assert (oretaddr + w <= ocs) by (unfold ocs; omega). + assert (0 <= 4 * b.(bound_outgoing)) by lia. + assert (4 * b.(bound_outgoing) <= olink) by (apply align_le; lia). + assert (olink + w <= oretaddr) by (unfold oretaddr; lia). + assert (oretaddr + w <= ocs) by (unfold ocs; lia). assert (ocs <= size_callee_save_area b ocs) by (apply size_callee_save_area_incr). - assert (size_callee_save_area b ocs <= ol) by (apply align_le; omega). - assert (ol + 4 * b.(bound_local) <= ostkdata) by (apply align_le; omega). - split. omega. apply align_le. omega. + assert (size_callee_save_area b ocs <= ol) by (apply align_le; lia). + assert (ol + 4 * b.(bound_local) <= ostkdata) by (apply align_le; lia). + split. lia. apply align_le. lia. Qed. Lemma frame_env_aligned: @@ -137,11 +137,11 @@ Proof. set (ocs := oretaddr + w). set (ol := align (size_callee_save_area b ocs) 8). set (ostkdata := align (ol + 4 * b.(bound_local)) 8). - assert (0 < w) by (unfold w; destruct Archi.ptr64; omega). + assert (0 < w) by (unfold w; destruct Archi.ptr64; lia). replace (align_chunk Mptr) with w by (rewrite align_chunk_Mptr; auto). split. apply Z.divide_0_r. - split. apply align_divides; omega. - split. apply align_divides; omega. - split. apply align_divides; omega. - apply Z.divide_add_r. apply align_divides; omega. apply Z.divide_refl. + split. apply align_divides; lia. + split. apply align_divides; lia. + split. apply align_divides; lia. + apply Z.divide_add_r. apply align_divides; lia. apply Z.divide_refl. Qed. diff --git a/riscV/Asm.v b/riscV/TO_MERGE/Asm.v index 5d3518f2..f75825a1 100644 --- a/riscV/Asm.v +++ b/riscV/TO_MERGE/Asm.v @@ -256,10 +256,17 @@ Inductive instruction : Type := (* floating point register move *) | Pfmv (rd: freg) (rs: freg) (**r move *) +<<<<<<< HEAD | Pfmvxs (rd: ireg) (rs: freg) (**r bitwise move FP single to integer register *) | Pfmvxd (rd: ireg) (rs: freg) (**r bitwise move FP double to integer register *) | Pfmvsx (rd: freg) (rs: ireg) (**r bitwise move integer register to FP single *) | Pfmvdx (rd: freg) (rs: ireg) (**r bitwise move integer register to FP double*) +======= + | Pfmvxs (rd: ireg) (rs: freg) (**r move FP single to integer register *) + | Pfmvsx (rd: freg) (rs: ireg) (**r move integer register to FP single *) + | Pfmvxd (rd: ireg) (rs: freg) (**r move FP double to integer register *) + | Pfmvdx (rd: freg) (rs: ireg) (**r move integer register to FP double *) +>>>>>>> master (* 32-bit (single-precision) floating point *) | Pfls (rd: freg) (ra: ireg) (ofs: offset) (**r load float *) @@ -987,6 +994,14 @@ Definition exec_instr (f: function) (i: instruction) (rs: regset) (m: mem) : out so we do not model them. *) | Pfence +<<<<<<< HEAD +======= + | Pfmvxs _ _ + | Pfmvsx _ _ + | Pfmvxd _ _ + | Pfmvdx _ _ + +>>>>>>> master | Pfmins _ _ _ | Pfmaxs _ _ _ | Pfsqrts _ _ @@ -1173,7 +1188,7 @@ Ltac Equalities := split. auto. intros. destruct B; auto. subst. auto. - (* trace length *) red; intros. inv H; simpl. - omega. + lia. eapply external_call_trace_length; eauto. eapply external_call_trace_length; eauto. - (* initial states *) diff --git a/riscV/Asmgenproof1.v b/riscV/TO_MERGE/Asmgenproof1.v index f0def29b..1a8ce27d 100644 --- a/riscV/Asmgenproof1.v +++ b/riscV/TO_MERGE/Asmgenproof1.v @@ -35,7 +35,7 @@ Proof. - set (m := Int.sub n lo). assert (A: eqmod (two_p 12) (Int.unsigned lo) (Int.unsigned n)) by (apply Int.eqmod_sign_ext'; compute; auto). assert (B: eqmod (two_p 12) (Int.unsigned n - Int.unsigned lo) 0). - { replace 0 with (Int.unsigned n - Int.unsigned n) by omega. + { replace 0 with (Int.unsigned n - Int.unsigned n) by lia. auto using eqmod_sub, eqmod_refl. } assert (C: eqmod (two_p 12) (Int.unsigned m) 0). { apply eqmod_trans with (Int.unsigned n - Int.unsigned lo); auto. @@ -45,7 +45,7 @@ Proof. { apply eqmod_mod_eq in C. unfold Int.modu. change (Int.unsigned (Int.repr 4096)) with (two_p 12). rewrite C. reflexivity. - apply two_p_gt_ZERO; omega. } + apply two_p_gt_ZERO; lia. } rewrite <- (Int.divu_pow2 m (Int.repr 4096) (Int.repr 12)) by auto. rewrite Int.shl_mul_two_p. change (two_p (Int.unsigned (Int.repr 12))) with 4096. @@ -88,7 +88,7 @@ Proof. intros. apply ireg_of_not_X31 in H. congruence. Qed. -Hint Resolve ireg_of_not_X31 ireg_of_not_X31': asmgen. +Global Hint Resolve ireg_of_not_X31 ireg_of_not_X31': asmgen. (** Useful simplification tactic *) @@ -432,6 +432,408 @@ Proof. intros; Simpl. Qed. +<<<<<<< HEAD +======= +(** Translation of condition operators *) + +Lemma transl_cond_int32s_correct: + forall cmp rd r1 r2 k rs m, + exists rs', + exec_straight ge fn (transl_cond_int32s cmp rd r1 r2 k) rs m k rs' m + /\ Val.lessdef (Val.cmp cmp rs##r1 rs##r2) rs'#rd + /\ forall r, r <> PC -> r <> rd -> rs'#r = rs#r. +Proof. + intros. destruct cmp; simpl. +- econstructor; split. apply exec_straight_one; [simpl; eauto|auto]. + split; intros; Simpl. destruct (rs##r1); auto. destruct (rs##r2); auto. +- econstructor; split. apply exec_straight_one; [simpl; eauto|auto]. + split; intros; Simpl. destruct (rs##r1); auto. destruct (rs##r2); auto. +- econstructor; split. apply exec_straight_one; [simpl; eauto|auto]. + split; intros; Simpl. +- econstructor; split. + eapply exec_straight_two. simpl; eauto. simpl; eauto. auto. auto. + split; intros; Simpl. unfold Val.cmp. rewrite <- Val.swap_cmp_bool. + simpl. rewrite (Val.negate_cmp_bool Clt). + destruct (Val.cmp_bool Clt rs##r2 rs##r1) as [[]|]; auto. +- econstructor; split. apply exec_straight_one; [simpl; eauto|auto]. + split; intros; Simpl. unfold Val.cmp. rewrite <- Val.swap_cmp_bool. auto. +- econstructor; split. + eapply exec_straight_two. simpl; eauto. simpl; eauto. auto. auto. + split; intros; Simpl. unfold Val.cmp. rewrite (Val.negate_cmp_bool Clt). + destruct (Val.cmp_bool Clt rs##r1 rs##r2) as [[]|]; auto. +Qed. + +Lemma transl_cond_int32u_correct: + forall cmp rd r1 r2 k rs m, + exists rs', + exec_straight ge fn (transl_cond_int32u cmp rd r1 r2 k) rs m k rs' m + /\ rs'#rd = Val.cmpu (Mem.valid_pointer m) cmp rs##r1 rs##r2 + /\ forall r, r <> PC -> r <> rd -> rs'#r = rs#r. +Proof. + intros. destruct cmp; simpl. +- econstructor; split. apply exec_straight_one; [simpl; eauto|auto]. + split; intros; Simpl. +- econstructor; split. apply exec_straight_one; [simpl; eauto|auto]. + split; intros; Simpl. +- econstructor; split. apply exec_straight_one; [simpl; eauto|auto]. + split; intros; Simpl. +- econstructor; split. + eapply exec_straight_two. simpl; eauto. simpl; eauto. auto. auto. + split; intros; Simpl. unfold Val.cmpu. rewrite <- Val.swap_cmpu_bool. + simpl. rewrite (Val.negate_cmpu_bool (Mem.valid_pointer m) Cle). + destruct (Val.cmpu_bool (Mem.valid_pointer m) Cle rs##r1 rs##r2) as [[]|]; auto. +- econstructor; split. apply exec_straight_one; [simpl; eauto|auto]. + split; intros; Simpl. unfold Val.cmpu. rewrite <- Val.swap_cmpu_bool. auto. +- econstructor; split. + eapply exec_straight_two. simpl; eauto. simpl; eauto. auto. auto. + split; intros; Simpl. unfold Val.cmpu. rewrite (Val.negate_cmpu_bool (Mem.valid_pointer m) Clt). + destruct (Val.cmpu_bool (Mem.valid_pointer m) Clt rs##r1 rs##r2) as [[]|]; auto. +Qed. + +Lemma transl_cond_int64s_correct: + forall cmp rd r1 r2 k rs m, + exists rs', + exec_straight ge fn (transl_cond_int64s cmp rd r1 r2 k) rs m k rs' m + /\ Val.lessdef (Val.maketotal (Val.cmpl cmp rs###r1 rs###r2)) rs'#rd + /\ forall r, r <> PC -> r <> rd -> rs'#r = rs#r. +Proof. + intros. destruct cmp; simpl. +- econstructor; split. apply exec_straight_one; [simpl; eauto|auto]. + split; intros; Simpl. destruct (rs###r1); auto. destruct (rs###r2); auto. +- econstructor; split. apply exec_straight_one; [simpl; eauto|auto]. + split; intros; Simpl. destruct (rs###r1); auto. destruct (rs###r2); auto. +- econstructor; split. apply exec_straight_one; [simpl; eauto|auto]. + split; intros; Simpl. +- econstructor; split. + eapply exec_straight_two. simpl; eauto. simpl; eauto. auto. auto. + split; intros; Simpl. unfold Val.cmpl. rewrite <- Val.swap_cmpl_bool. + simpl. rewrite (Val.negate_cmpl_bool Clt). + destruct (Val.cmpl_bool Clt rs###r2 rs###r1) as [[]|]; auto. +- econstructor; split. apply exec_straight_one; [simpl; eauto|auto]. + split; intros; Simpl. unfold Val.cmpl. rewrite <- Val.swap_cmpl_bool. auto. +- econstructor; split. + eapply exec_straight_two. simpl; eauto. simpl; eauto. auto. auto. + split; intros; Simpl. unfold Val.cmpl. rewrite (Val.negate_cmpl_bool Clt). + destruct (Val.cmpl_bool Clt rs###r1 rs###r2) as [[]|]; auto. +Qed. + +Lemma transl_cond_int64u_correct: + forall cmp rd r1 r2 k rs m, + exists rs', + exec_straight ge fn (transl_cond_int64u cmp rd r1 r2 k) rs m k rs' m + /\ rs'#rd = Val.maketotal (Val.cmplu (Mem.valid_pointer m) cmp rs###r1 rs###r2) + /\ forall r, r <> PC -> r <> rd -> rs'#r = rs#r. +Proof. + intros. destruct cmp; simpl. +- econstructor; split. apply exec_straight_one; [simpl; eauto|auto]. + split; intros; Simpl. +- econstructor; split. apply exec_straight_one; [simpl; eauto|auto]. + split; intros; Simpl. +- econstructor; split. apply exec_straight_one; [simpl; eauto|auto]. + split; intros; Simpl. +- econstructor; split. + eapply exec_straight_two. simpl; eauto. simpl; eauto. auto. auto. + split; intros; Simpl. unfold Val.cmplu. rewrite <- Val.swap_cmplu_bool. + simpl. rewrite (Val.negate_cmplu_bool (Mem.valid_pointer m) Cle). + destruct (Val.cmplu_bool (Mem.valid_pointer m) Cle rs###r1 rs###r2) as [[]|]; auto. +- econstructor; split. apply exec_straight_one; [simpl; eauto|auto]. + split; intros; Simpl. unfold Val.cmplu. rewrite <- Val.swap_cmplu_bool. auto. +- econstructor; split. + eapply exec_straight_two. simpl; eauto. simpl; eauto. auto. auto. + split; intros; Simpl. unfold Val.cmplu. rewrite (Val.negate_cmplu_bool (Mem.valid_pointer m) Clt). + destruct (Val.cmplu_bool (Mem.valid_pointer m) Clt rs###r1 rs###r2) as [[]|]; auto. +Qed. + +Lemma transl_condimm_int32s_correct: + forall cmp rd r1 n k rs m, + r1 <> X31 -> + exists rs', + exec_straight ge fn (transl_condimm_int32s cmp rd r1 n k) rs m k rs' m + /\ Val.lessdef (Val.cmp cmp rs#r1 (Vint n)) rs'#rd + /\ forall r, r <> PC -> r <> rd -> r <> X31 -> rs'#r = rs#r. +Proof. + intros. unfold transl_condimm_int32s. + predSpec Int.eq Int.eq_spec n Int.zero. +- subst n. exploit transl_cond_int32s_correct. intros (rs' & A & B & C). + exists rs'; eauto. +- assert (DFL: + exists rs', + exec_straight ge fn (loadimm32 X31 n (transl_cond_int32s cmp rd r1 X31 k)) rs m k rs' m + /\ Val.lessdef (Val.cmp cmp rs#r1 (Vint n)) rs'#rd + /\ forall r, r <> PC -> r <> rd -> r <> X31 -> rs'#r = rs#r). + { exploit loadimm32_correct; eauto. intros (rs1 & A1 & B1 & C1). + exploit transl_cond_int32s_correct; eauto. intros (rs2 & A2 & B2 & C2). + exists rs2; split. + eapply exec_straight_trans. eexact A1. eexact A2. + split. simpl in B2. rewrite B1, C1 in B2 by auto with asmgen. auto. + intros; transitivity (rs1 r); auto. } + destruct cmp. ++ unfold xorimm32. + exploit (opimm32_correct Pxorw Pxoriw Val.xor); eauto. intros (rs1 & A1 & B1 & C1). + exploit transl_cond_int32s_correct; eauto. intros (rs2 & A2 & B2 & C2). + exists rs2; split. + eapply exec_straight_trans. eexact A1. eexact A2. + split. simpl in B2; rewrite B1 in B2; simpl in B2. destruct (rs#r1); auto. + unfold Val.cmp in B2; simpl in B2; rewrite Int.xor_is_zero in B2. exact B2. + intros; transitivity (rs1 r); auto. ++ unfold xorimm32. + exploit (opimm32_correct Pxorw Pxoriw Val.xor); eauto. intros (rs1 & A1 & B1 & C1). + exploit transl_cond_int32s_correct; eauto. intros (rs2 & A2 & B2 & C2). + exists rs2; split. + eapply exec_straight_trans. eexact A1. eexact A2. + split. simpl in B2; rewrite B1 in B2; simpl in B2. destruct (rs#r1); auto. + unfold Val.cmp in B2; simpl in B2; rewrite Int.xor_is_zero in B2. exact B2. + intros; transitivity (rs1 r); auto. ++ exploit (opimm32_correct Psltw Psltiw (Val.cmp Clt)); eauto. intros (rs1 & A1 & B1 & C1). + exists rs1; split. eexact A1. split; auto. rewrite B1; auto. ++ predSpec Int.eq Int.eq_spec n (Int.repr Int.max_signed). +* subst n. exploit loadimm32_correct; eauto. intros (rs1 & A1 & B1 & C1). + exists rs1; split. eexact A1. split; auto. + unfold Val.cmp; destruct (rs#r1); simpl; auto. rewrite B1. + unfold Int.lt. rewrite zlt_false. auto. + change (Int.signed (Int.repr Int.max_signed)) with Int.max_signed. + generalize (Int.signed_range i); lia. +* exploit (opimm32_correct Psltw Psltiw (Val.cmp Clt)); eauto. intros (rs1 & A1 & B1 & C1). + exists rs1; split. eexact A1. split; auto. + rewrite B1. unfold Val.cmp; simpl; destruct (rs#r1); simpl; auto. + unfold Int.lt. replace (Int.signed (Int.add n Int.one)) with (Int.signed n + 1). + destruct (zlt (Int.signed n) (Int.signed i)). + rewrite zlt_false by lia. auto. + rewrite zlt_true by lia. auto. + rewrite Int.add_signed. symmetry; apply Int.signed_repr. + assert (Int.signed n <> Int.max_signed). + { red; intros E. elim H1. rewrite <- (Int.repr_signed n). rewrite E. auto. } + generalize (Int.signed_range n); lia. ++ apply DFL. ++ apply DFL. +Qed. + +Lemma transl_condimm_int32u_correct: + forall cmp rd r1 n k rs m, + r1 <> X31 -> + exists rs', + exec_straight ge fn (transl_condimm_int32u cmp rd r1 n k) rs m k rs' m + /\ Val.lessdef (Val.cmpu (Mem.valid_pointer m) cmp rs#r1 (Vint n)) rs'#rd + /\ forall r, r <> PC -> r <> rd -> r <> X31 -> rs'#r = rs#r. +Proof. + intros. unfold transl_condimm_int32u. + predSpec Int.eq Int.eq_spec n Int.zero. +- subst n. exploit transl_cond_int32u_correct. intros (rs' & A & B & C). + exists rs'; split. eexact A. split; auto. rewrite B; auto. +- assert (DFL: + exists rs', + exec_straight ge fn (loadimm32 X31 n (transl_cond_int32u cmp rd r1 X31 k)) rs m k rs' m + /\ Val.lessdef (Val.cmpu (Mem.valid_pointer m) cmp rs#r1 (Vint n)) rs'#rd + /\ forall r, r <> PC -> r <> rd -> r <> X31 -> rs'#r = rs#r). + { exploit loadimm32_correct; eauto. intros (rs1 & A1 & B1 & C1). + exploit transl_cond_int32u_correct; eauto. intros (rs2 & A2 & B2 & C2). + exists rs2; split. + eapply exec_straight_trans. eexact A1. eexact A2. + split. simpl in B2. rewrite B1, C1 in B2 by auto with asmgen. rewrite B2; auto. + intros; transitivity (rs1 r); auto. } + destruct cmp. ++ apply DFL. ++ apply DFL. ++ exploit (opimm32_correct Psltuw Psltiuw (Val.cmpu (Mem.valid_pointer m) Clt) m); eauto. + intros (rs1 & A1 & B1 & C1). + exists rs1; split. eexact A1. split; auto. rewrite B1; auto. ++ apply DFL. ++ apply DFL. ++ apply DFL. +Qed. + +Lemma transl_condimm_int64s_correct: + forall cmp rd r1 n k rs m, + r1 <> X31 -> + exists rs', + exec_straight ge fn (transl_condimm_int64s cmp rd r1 n k) rs m k rs' m + /\ Val.lessdef (Val.maketotal (Val.cmpl cmp rs#r1 (Vlong n))) rs'#rd + /\ forall r, r <> PC -> r <> rd -> r <> X31 -> rs'#r = rs#r. +Proof. + intros. unfold transl_condimm_int64s. + predSpec Int64.eq Int64.eq_spec n Int64.zero. +- subst n. exploit transl_cond_int64s_correct. intros (rs' & A & B & C). + exists rs'; eauto. +- assert (DFL: + exists rs', + exec_straight ge fn (loadimm64 X31 n (transl_cond_int64s cmp rd r1 X31 k)) rs m k rs' m + /\ Val.lessdef (Val.maketotal (Val.cmpl cmp rs#r1 (Vlong n))) rs'#rd + /\ forall r, r <> PC -> r <> rd -> r <> X31 -> rs'#r = rs#r). + { exploit loadimm64_correct; eauto. intros (rs1 & A1 & B1 & C1). + exploit transl_cond_int64s_correct; eauto. intros (rs2 & A2 & B2 & C2). + exists rs2; split. + eapply exec_straight_trans. eexact A1. eexact A2. + split. simpl in B2. rewrite B1, C1 in B2 by auto with asmgen. auto. + intros; transitivity (rs1 r); auto. } + destruct cmp. ++ unfold xorimm64. + exploit (opimm64_correct Pxorl Pxoril Val.xorl); eauto. intros (rs1 & A1 & B1 & C1). + exploit transl_cond_int64s_correct; eauto. intros (rs2 & A2 & B2 & C2). + exists rs2; split. + eapply exec_straight_trans. eexact A1. eexact A2. + split. simpl in B2; rewrite B1 in B2; simpl in B2. destruct (rs#r1); auto. + unfold Val.cmpl in B2; simpl in B2; rewrite Int64.xor_is_zero in B2. exact B2. + intros; transitivity (rs1 r); auto. ++ unfold xorimm64. + exploit (opimm64_correct Pxorl Pxoril Val.xorl); eauto. intros (rs1 & A1 & B1 & C1). + exploit transl_cond_int64s_correct; eauto. intros (rs2 & A2 & B2 & C2). + exists rs2; split. + eapply exec_straight_trans. eexact A1. eexact A2. + split. simpl in B2; rewrite B1 in B2; simpl in B2. destruct (rs#r1); auto. + unfold Val.cmpl in B2; simpl in B2; rewrite Int64.xor_is_zero in B2. exact B2. + intros; transitivity (rs1 r); auto. ++ exploit (opimm64_correct Psltl Psltil (fun v1 v2 => Val.maketotal (Val.cmpl Clt v1 v2))); eauto. intros (rs1 & A1 & B1 & C1). + exists rs1; split. eexact A1. split; auto. rewrite B1; auto. ++ predSpec Int64.eq Int64.eq_spec n (Int64.repr Int64.max_signed). +* subst n. exploit loadimm32_correct; eauto. intros (rs1 & A1 & B1 & C1). + exists rs1; split. eexact A1. split; auto. + unfold Val.cmpl; destruct (rs#r1); simpl; auto. rewrite B1. + unfold Int64.lt. rewrite zlt_false. auto. + change (Int64.signed (Int64.repr Int64.max_signed)) with Int64.max_signed. + generalize (Int64.signed_range i); lia. +* exploit (opimm64_correct Psltl Psltil (fun v1 v2 => Val.maketotal (Val.cmpl Clt v1 v2))); eauto. intros (rs1 & A1 & B1 & C1). + exists rs1; split. eexact A1. split; auto. + rewrite B1. unfold Val.cmpl; simpl; destruct (rs#r1); simpl; auto. + unfold Int64.lt. replace (Int64.signed (Int64.add n Int64.one)) with (Int64.signed n + 1). + destruct (zlt (Int64.signed n) (Int64.signed i)). + rewrite zlt_false by lia. auto. + rewrite zlt_true by lia. auto. + rewrite Int64.add_signed. symmetry; apply Int64.signed_repr. + assert (Int64.signed n <> Int64.max_signed). + { red; intros E. elim H1. rewrite <- (Int64.repr_signed n). rewrite E. auto. } + generalize (Int64.signed_range n); lia. ++ apply DFL. ++ apply DFL. +Qed. + +Lemma transl_condimm_int64u_correct: + forall cmp rd r1 n k rs m, + r1 <> X31 -> + exists rs', + exec_straight ge fn (transl_condimm_int64u cmp rd r1 n k) rs m k rs' m + /\ Val.lessdef (Val.maketotal (Val.cmplu (Mem.valid_pointer m) cmp rs#r1 (Vlong n))) rs'#rd + /\ forall r, r <> PC -> r <> rd -> r <> X31 -> rs'#r = rs#r. +Proof. + intros. unfold transl_condimm_int64u. + predSpec Int64.eq Int64.eq_spec n Int64.zero. +- subst n. exploit transl_cond_int64u_correct. intros (rs' & A & B & C). + exists rs'; split. eexact A. split; auto. rewrite B; auto. +- assert (DFL: + exists rs', + exec_straight ge fn (loadimm64 X31 n (transl_cond_int64u cmp rd r1 X31 k)) rs m k rs' m + /\ Val.lessdef (Val.maketotal (Val.cmplu (Mem.valid_pointer m) cmp rs#r1 (Vlong n))) rs'#rd + /\ forall r, r <> PC -> r <> rd -> r <> X31 -> rs'#r = rs#r). + { exploit loadimm64_correct; eauto. intros (rs1 & A1 & B1 & C1). + exploit transl_cond_int64u_correct; eauto. intros (rs2 & A2 & B2 & C2). + exists rs2; split. + eapply exec_straight_trans. eexact A1. eexact A2. + split. simpl in B2. rewrite B1, C1 in B2 by auto with asmgen. rewrite B2; auto. + intros; transitivity (rs1 r); auto. } + destruct cmp. ++ apply DFL. ++ apply DFL. ++ exploit (opimm64_correct Psltul Psltiul (fun v1 v2 => Val.maketotal (Val.cmplu (Mem.valid_pointer m) Clt v1 v2)) m); eauto. + intros (rs1 & A1 & B1 & C1). + exists rs1; split. eexact A1. split; auto. rewrite B1; auto. ++ apply DFL. ++ apply DFL. ++ apply DFL. +Qed. + +Lemma transl_cond_op_correct: + forall cond rd args k c rs m, + transl_cond_op cond rd args k = OK c -> + exists rs', + exec_straight ge fn c rs m k rs' m + /\ Val.lessdef (Val.of_optbool (eval_condition cond (map rs (map preg_of args)) m)) rs'#rd + /\ forall r, r <> PC -> r <> rd -> r <> X31 -> rs'#r = rs#r. +Proof. + assert (MKTOT: forall ob, Val.of_optbool ob = Val.maketotal (option_map Val.of_bool ob)). + { destruct ob as [[]|]; reflexivity. } + intros until m; intros TR. + destruct cond; simpl in TR; ArgsInv. ++ (* cmp *) + exploit transl_cond_int32s_correct; eauto. intros (rs' & A & B & C). exists rs'; eauto. ++ (* cmpu *) + exploit transl_cond_int32u_correct; eauto. intros (rs' & A & B & C). + exists rs'; repeat split; eauto. rewrite B; auto. ++ (* cmpimm *) + apply transl_condimm_int32s_correct; eauto with asmgen. ++ (* cmpuimm *) + apply transl_condimm_int32u_correct; eauto with asmgen. ++ (* cmpl *) + exploit transl_cond_int64s_correct; eauto. intros (rs' & A & B & C). + exists rs'; repeat split; eauto. rewrite MKTOT; eauto. ++ (* cmplu *) + exploit transl_cond_int64u_correct; eauto. intros (rs' & A & B & C). + exists rs'; repeat split; eauto. rewrite B, MKTOT; eauto. ++ (* cmplimm *) + exploit transl_condimm_int64s_correct; eauto. instantiate (1 := x); eauto with asmgen. + intros (rs' & A & B & C). + exists rs'; repeat split; eauto. rewrite MKTOT; eauto. ++ (* cmpluimm *) + exploit transl_condimm_int64u_correct; eauto. instantiate (1 := x); eauto with asmgen. + intros (rs' & A & B & C). + exists rs'; repeat split; eauto. rewrite MKTOT; eauto. ++ (* cmpf *) + destruct (transl_cond_float c0 rd x x0) as [insn normal] eqn:TR. + fold (Val.cmpf c0 (rs x) (rs x0)). + set (v := Val.cmpf c0 (rs x) (rs x0)). + destruct normal; inv EQ2. +* econstructor; split. + apply exec_straight_one. eapply transl_cond_float_correct with (v := v); eauto. auto. + split; intros; Simpl. +* econstructor; split. + eapply exec_straight_two. + eapply transl_cond_float_correct with (v := Val.notbool v); eauto. + simpl; reflexivity. + auto. auto. + split; intros; Simpl. unfold v, Val.cmpf. destruct (Val.cmpf_bool c0 (rs x) (rs x0)) as [[]|]; auto. ++ (* notcmpf *) + destruct (transl_cond_float c0 rd x x0) as [insn normal] eqn:TR. + rewrite Val.notbool_negb_3. fold (Val.cmpf c0 (rs x) (rs x0)). + set (v := Val.cmpf c0 (rs x) (rs x0)). + destruct normal; inv EQ2. +* econstructor; split. + eapply exec_straight_two. + eapply transl_cond_float_correct with (v := v); eauto. + simpl; reflexivity. + auto. auto. + split; intros; Simpl. unfold v, Val.cmpf. destruct (Val.cmpf_bool c0 (rs x) (rs x0)) as [[]|]; auto. +* econstructor; split. + apply exec_straight_one. eapply transl_cond_float_correct with (v := Val.notbool v); eauto. auto. + split; intros; Simpl. ++ (* cmpfs *) + destruct (transl_cond_single c0 rd x x0) as [insn normal] eqn:TR. + fold (Val.cmpfs c0 (rs x) (rs x0)). + set (v := Val.cmpfs c0 (rs x) (rs x0)). + destruct normal; inv EQ2. +* econstructor; split. + apply exec_straight_one. eapply transl_cond_single_correct with (v := v); eauto. auto. + split; intros; Simpl. +* econstructor; split. + eapply exec_straight_two. + eapply transl_cond_single_correct with (v := Val.notbool v); eauto. + simpl; reflexivity. + auto. auto. + split; intros; Simpl. unfold v, Val.cmpfs. destruct (Val.cmpfs_bool c0 (rs x) (rs x0)) as [[]|]; auto. ++ (* notcmpfs *) + destruct (transl_cond_single c0 rd x x0) as [insn normal] eqn:TR. + rewrite Val.notbool_negb_3. fold (Val.cmpfs c0 (rs x) (rs x0)). + set (v := Val.cmpfs c0 (rs x) (rs x0)). + destruct normal; inv EQ2. +* econstructor; split. + eapply exec_straight_two. + eapply transl_cond_single_correct with (v := v); eauto. + simpl; reflexivity. + auto. auto. + split; intros; Simpl. unfold v, Val.cmpfs. destruct (Val.cmpfs_bool c0 (rs x) (rs x0)) as [[]|]; auto. +* econstructor; split. + apply exec_straight_one. eapply transl_cond_single_correct with (v := Val.notbool v); eauto. auto. + split; intros; Simpl. +Qed. + +>>>>>>> master (** Some arithmetic properties. *) Remark cast32unsigned_from_cast32signed: diff --git a/riscV/SelectLongproof.v b/riscV/TO_MERGE/SelectLongproof.v index 0fc578bf..954dd134 100644 --- a/riscV/SelectLongproof.v +++ b/riscV/TO_MERGE/SelectLongproof.v @@ -506,9 +506,39 @@ Proof. - subst n. destruct x; simpl in H0; inv H0. econstructor; split; eauto. change (Int.ltu Int.zero (Int.repr 63)) with true. simpl. rewrite Int64.shrx'_zero; auto. - TrivialExists. +<<<<<<< HEAD cbn. rewrite H0. reflexivity. +======= +(* + intros. unfold shrxlimm. destruct Archi.splitlong eqn:SL. ++ eapply SplitLongproof.eval_shrxlimm; eauto using Archi.splitlong_ptr32. ++ destruct x; simpl in H0; try discriminate. + destruct (Int.ltu n (Int.repr 63)) eqn:LTU; inv H0. + predSpec Int.eq Int.eq_spec n Int.zero. + - subst n. exists (Vlong i); split; auto. rewrite Int64.shrx'_zero. auto. + - assert (NZ: Int.unsigned n <> 0). + { intro EQ; elim H0. rewrite <- (Int.repr_unsigned n). rewrite EQ; auto. } + assert (LT: 0 <= Int.unsigned n < 63) by (apply Int.ltu_inv in LTU; assumption). + assert (LTU2: Int.ltu (Int.sub Int64.iwordsize' n) Int64.iwordsize' = true). + { unfold Int.ltu; apply zlt_true. + unfold Int.sub. change (Int.unsigned Int64.iwordsize') with 64. + rewrite Int.unsigned_repr. lia. + assert (64 < Int.max_unsigned) by reflexivity. lia. } + assert (X: eval_expr ge sp e m le + (Eop (Oshrlimm (Int.repr (Int64.zwordsize - 1))) (a ::: Enil)) + (Vlong (Int64.shr' i (Int.repr (Int64.zwordsize - 1))))). + { EvalOp. } + assert (Y: eval_expr ge sp e m le (shrxlimm_inner a n) + (Vlong (Int64.shru' (Int64.shr' i (Int.repr (Int64.zwordsize - 1))) (Int.sub Int64.iwordsize' n)))). + { EvalOp. simpl. rewrite LTU2. auto. } + TrivialExists. + constructor. EvalOp. simpl; eauto. constructor. + simpl. unfold Int.ltu; rewrite zlt_true. rewrite Int64.shrx'_shr_2 by auto. reflexivity. + change (Int.unsigned Int64.iwordsize') with 64; lia. +*) +>>>>>>> master Qed. Theorem eval_cmplu: diff --git a/riscV/SelectOpproof.v b/riscV/TO_MERGE/SelectOpproof.v index ce80fc57..9bd66213 100644 --- a/riscV/SelectOpproof.v +++ b/riscV/TO_MERGE/SelectOpproof.v @@ -370,20 +370,20 @@ Proof. change (Int.ltu (Int.repr 32) Int64.iwordsize') with true; simpl. apply Val.lessdef_same. f_equal. transitivity (Int.repr (Z.shiftr (Int.signed i * Int.signed i0) 32)). - unfold Int.mulhs; f_equal. rewrite Zshiftr_div_two_p by omega. reflexivity. + unfold Int.mulhs; f_equal. rewrite Zshiftr_div_two_p by lia. reflexivity. apply Int.same_bits_eq; intros n N. change Int.zwordsize with 32 in *. - assert (N1: 0 <= n < 64) by omega. + assert (N1: 0 <= n < 64) by lia. rewrite Int64.bits_loword by auto. rewrite Int64.bits_shr' by auto. change (Int.unsigned (Int.repr 32)) with 32. change Int64.zwordsize with 64. - rewrite zlt_true by omega. + rewrite zlt_true by lia. rewrite Int.testbit_repr by auto. - unfold Int64.mul. rewrite Int64.testbit_repr by (change Int64.zwordsize with 64; omega). + unfold Int64.mul. rewrite Int64.testbit_repr by (change Int64.zwordsize with 64; lia). transitivity (Z.testbit (Int.signed i * Int.signed i0) (n + 32)). - rewrite Z.shiftr_spec by omega. auto. + rewrite Z.shiftr_spec by lia. auto. apply Int64.same_bits_eqm. apply Int64.eqm_mult; apply Int64.eqm_unsigned_repr. - change Int64.zwordsize with 64; omega. + change Int64.zwordsize with 64; lia. - TrivialExists. Qed. @@ -398,20 +398,20 @@ Proof. change (Int.ltu (Int.repr 32) Int64.iwordsize') with true; simpl. apply Val.lessdef_same. f_equal. transitivity (Int.repr (Z.shiftr (Int.unsigned i * Int.unsigned i0) 32)). - unfold Int.mulhu; f_equal. rewrite Zshiftr_div_two_p by omega. reflexivity. + unfold Int.mulhu; f_equal. rewrite Zshiftr_div_two_p by lia. reflexivity. apply Int.same_bits_eq; intros n N. change Int.zwordsize with 32 in *. - assert (N1: 0 <= n < 64) by omega. + assert (N1: 0 <= n < 64) by lia. rewrite Int64.bits_loword by auto. rewrite Int64.bits_shru' by auto. change (Int.unsigned (Int.repr 32)) with 32. change Int64.zwordsize with 64. - rewrite zlt_true by omega. + rewrite zlt_true by lia. rewrite Int.testbit_repr by auto. - unfold Int64.mul. rewrite Int64.testbit_repr by (change Int64.zwordsize with 64; omega). + unfold Int64.mul. rewrite Int64.testbit_repr by (change Int64.zwordsize with 64; lia). transitivity (Z.testbit (Int.unsigned i * Int.unsigned i0) (n + 32)). - rewrite Z.shiftr_spec by omega. auto. + rewrite Z.shiftr_spec by lia. auto. apply Int64.same_bits_eqm. apply Int64.eqm_mult; apply Int64.eqm_unsigned_repr. - change Int64.zwordsize with 64; omega. + change Int64.zwordsize with 64; lia. - TrivialExists. Qed. @@ -574,12 +574,43 @@ Proof. replace (Int.shrx i Int.zero) with i. auto. unfold Int.shrx, Int.divs. rewrite Int.shl_zero. change (Int.signed Int.one) with 1. rewrite Z.quot_1_r. rewrite Int.repr_signed; auto. +<<<<<<< HEAD econstructor; split. EvalOp. cbn. rewrite H0. cbn. reflexivity. apply Val.lessdef_refl. +======= + econstructor; split. EvalOp. auto. +(* + intros. destruct x; simpl in H0; try discriminate. + destruct (Int.ltu n (Int.repr 31)) eqn:LTU; inv H0. + unfold shrximm. + predSpec Int.eq Int.eq_spec n Int.zero. + - subst n. exists (Vint i); split; auto. + unfold Int.shrx, Int.divs. rewrite Z.quot_1_r. rewrite Int.repr_signed. auto. + - assert (NZ: Int.unsigned n <> 0). + { intro EQ; elim H0. rewrite <- (Int.repr_unsigned n). rewrite EQ; auto. } + assert (LT: 0 <= Int.unsigned n < 31) by (apply Int.ltu_inv in LTU; assumption). + assert (LTU2: Int.ltu (Int.sub Int.iwordsize n) Int.iwordsize = true). + { unfold Int.ltu; apply zlt_true. + unfold Int.sub. change (Int.unsigned Int.iwordsize) with 32. + rewrite Int.unsigned_repr. lia. + assert (32 < Int.max_unsigned) by reflexivity. lia. } + assert (X: eval_expr ge sp e m le + (Eop (Oshrimm (Int.repr (Int.zwordsize - 1))) (a ::: Enil)) + (Vint (Int.shr i (Int.repr (Int.zwordsize - 1))))). + { EvalOp. } + assert (Y: eval_expr ge sp e m le (shrximm_inner a n) + (Vint (Int.shru (Int.shr i (Int.repr (Int.zwordsize - 1))) (Int.sub Int.iwordsize n)))). + { EvalOp. simpl. rewrite LTU2. auto. } + TrivialExists. + constructor. EvalOp. simpl; eauto. constructor. + simpl. unfold Int.ltu; rewrite zlt_true. rewrite Int.shrx_shr_2 by auto. reflexivity. + change (Int.unsigned Int.iwordsize) with 32; lia. +*) +>>>>>>> master Qed. Theorem eval_shl: binary_constructor_sound shl Val.shl. @@ -766,7 +797,7 @@ Qed. Theorem eval_cast8unsigned: unary_constructor_sound cast8unsigned (Val.zero_ext 8). Proof. red; intros until x. unfold cast8unsigned. - rewrite Val.zero_ext_and. apply eval_andimm. omega. + rewrite Val.zero_ext_and. apply eval_andimm. lia. Qed. Theorem eval_cast16signed: unary_constructor_sound cast16signed (Val.sign_ext 16). @@ -779,7 +810,7 @@ Qed. Theorem eval_cast16unsigned: unary_constructor_sound cast16unsigned (Val.zero_ext 16). Proof. red; intros until x. unfold cast8unsigned. - rewrite Val.zero_ext_and. apply eval_andimm. omega. + rewrite Val.zero_ext_and. apply eval_andimm. lia. Qed. Theorem eval_intoffloat: diff --git a/riscV/TargetPrinter.ml b/riscV/TO_MERGE/TargetPrinter.ml index 1f00c440..23fbeb8b 100644 --- a/riscV/TargetPrinter.ml +++ b/riscV/TO_MERGE/TargetPrinter.ml @@ -107,12 +107,17 @@ module Target : TARGET = let name_of_section = function | Section_text -> ".text" +<<<<<<< HEAD | Section_data(i, true) -> failwith "_Thread_local unsupported on this platform" | Section_data(i, false) | Section_small_data i -> if i then ".data" else common_section () +======= + | Section_data i | Section_small_data i -> + variable_section ~sec:".data" ~bss:".bss" i +>>>>>>> master | Section_const i | Section_small_const i -> - if i || (not !Clflags.option_fcommon) then ".section .rodata" else "COMM" + variable_section ~sec:".section .rodata" i | Section_string -> ".section .rodata" | Section_literal -> ".section .rodata" | Section_jumptable -> ".section .rodata" @@ -394,10 +399,15 @@ module Target : TARGET = fprintf oc " fmv.d %a, %a\n" freg fd freg fs | Pfmvxs (rd,fs) -> fprintf oc " fmv.x.s %a, %a\n" ireg rd freg fs + | Pfmvsx (fd,rs) -> + fprintf oc " fmv.s.x %a, %a\n" freg fd ireg rs | Pfmvxd (rd,fs) -> fprintf oc " fmv.x.d %a, %a\n" ireg rd freg fs +<<<<<<< HEAD | Pfmvsx (fd,rs) -> fprintf oc " fmv.s.x %a, %a\n" freg fd ireg rs +======= +>>>>>>> master | Pfmvdx (fd,rs) -> fprintf oc " fmv.d.x %a, %a\n" freg fd ireg rs diff --git a/runtime/aarch64/sysdeps.h b/runtime/aarch64/sysdeps.h index 0cee9ae3..b098cf1c 100644 --- a/runtime/aarch64/sysdeps.h +++ b/runtime/aarch64/sysdeps.h @@ -34,6 +34,25 @@ // System dependencies +#if defined(SYS_macos) + +#define GLOB(x) _##x + +#define FUNCTION(f) FUNCTION f + +.macro FUNCTION name + .text + .globl _\name + .align 4 +_\name: +.endm + +#define ENDFUNCTION(f) + +#else + +#define GLOB(x) x + #define FUNCTION(f) \ .text; \ .balign 16; \ @@ -43,3 +62,4 @@ f: #define ENDFUNCTION(f) \ .type f, @function; .size f, . - f +#endif diff --git a/runtime/aarch64/vararg.S b/runtime/aarch64/vararg.S index b7347d65..488d3459 100644 --- a/runtime/aarch64/vararg.S +++ b/runtime/aarch64/vararg.S @@ -36,7 +36,8 @@ #include "sysdeps.h" -// typedef struct __va_list { +// For the standard ABI: +// struct __va_list { // void *__stack; // next stack parameter // void *__gr_top; // top of the save area for int regs // void *__vr_top; // top of the save area for float regs @@ -44,10 +45,18 @@ // int__vr_offs; // offset from gr_top to next FP reg // } // typedef struct __va_list va_list; // struct passed by reference + +// For the Apple ABI: +// typedef char * va_list; // a single pointer passed by reference +// // points to the next parameter, always on stack + +// In both cases: // unsigned int __compcert_va_int32(va_list * ap); // unsigned long long __compcert_va_int64(va_list * ap); // double __compcert_va_float64(va_list * ap); +#ifdef ABI_standard + FUNCTION(__compcert_va_int32) ldr w1, [x0, #24] // w1 = gr_offs cbz w1, 1f @@ -72,14 +81,14 @@ FUNCTION(__compcert_va_int64) cbz w1, 1f // gr_offs is not zero: load from int save area and update gr_offs ldr x2, [x0, #8] // x2 = gr_top - ldr x2, [x2, w1, sxtw] // w2 = the next long integer + ldr x2, [x2, w1, sxtw] // x2 = the next long integer add w1, w1, #8 str w1, [x0, #24] // update gr_offs mov x0, x2 ret // gr_offs is zero: load from stack save area and update stack pointer 1: ldr x1, [x0, #0] // x1 = stack - ldr x2, [x1, #0] // w2 = the next long integer + ldr x2, [x1, #0] // x2 = the next long integer add x1, x1, #8 str x1, [x0, #0] // update stack mov x0, x2 @@ -103,7 +112,40 @@ FUNCTION(__compcert_va_float64) ret ENDFUNCTION(__compcert_va_float64) +#endif + +#ifdef ABI_apple + +FUNCTION(__compcert_va_int32) + ldr x1, [x0, #0] // x1 = stack pointer + ldr w2, [x1, #0] // w2 = the next integer + add x1, x1, #8 + str x1, [x0, #0] // update stack + mov w0, w2 + ret +ENDFUNCTION(__compcert_va_int32) + +FUNCTION(__compcert_va_int64) + ldr x1, [x0, #0] // x1 = stack pointer + ldr x2, [x1, #0] // x2 = the next long integer + add x1, x1, #8 + str x1, [x0, #0] // update stack + mov x0, x2 + ret +ENDFUNCTION(__compcert_va_int64) + +FUNCTION(__compcert_va_float64) + ldr x1, [x0, #0] // x1 = stack pointer + ldr d0, [x1, #0] // d0 = the next float + add x1, x1, #8 + str x1, [x0, #0] // update stack + ret +ENDFUNCTION(__compcert_va_float64) + +#endif + // Right now we pass structs by reference. This is not ABI conformant. FUNCTION(__compcert_va_composite) - b __compcert_va_int64 + b GLOB(__compcert_va_int64) ENDFUNCTION(__compcert_va_composite) + diff --git a/runtime/x86_32/sysdeps.h b/runtime/x86_32/sysdeps.h index 9d957a88..973bbe2f 100644 --- a/runtime/x86_32/sysdeps.h +++ b/runtime/x86_32/sysdeps.h @@ -48,7 +48,7 @@ f: #endif -#if defined(SYS_macosx) +#if defined(SYS_macos) #define GLOB(x) _##x #define FUNCTION(f) \ diff --git a/runtime/x86_64/sysdeps.h b/runtime/x86_64/sysdeps.h index aacef8f0..9031d5d0 100644 --- a/runtime/x86_64/sysdeps.h +++ b/runtime/x86_64/sysdeps.h @@ -48,7 +48,7 @@ f: #endif -#if defined(SYS_macosx) +#if defined(SYS_macos) #define GLOB(x) _##x #define FUNCTION(f) \ diff --git a/runtime/x86_64/vararg.S b/runtime/x86_64/vararg.S index c5225b34..d3634e4d 100644 --- a/runtime/x86_64/vararg.S +++ b/runtime/x86_64/vararg.S @@ -38,7 +38,7 @@ // ELF ABI -#if defined(SYS_linux) || defined(SYS_bsd) || defined(SYS_macosx) +#if defined(SYS_linux) || defined(SYS_bsd) || defined(SYS_macos) // typedef struct { // unsigned int gp_offset; diff --git a/test/Makefile b/test/Makefile index c371e18a..50cf57fb 100644 --- a/test/Makefile +++ b/test/Makefile @@ -1,12 +1,13 @@ include ../Makefile.config -#DIRS=c compression raytracer spass regression +#DIRS=c compression raytracer spass regression abi # Kalray note - removing compression, raytracer and spass that cannot be executed by the simulator in reasonable time +# TODO: abi for Kalray ? ifeq ($(ARCH),kvx) DIRS=c regression else - DIRS=c compression raytracer spass regression + DIRS=c compression raytracer spass regression abi endif ifeq ($(CLIGHTGEN),true) diff --git a/test/abi/.gitignore b/test/abi/.gitignore new file mode 100644 index 00000000..c115947e --- /dev/null +++ b/test/abi/.gitignore @@ -0,0 +1,8 @@ +*.exe +*.c +*.h +*.compcert +*.cc2compcert +*.compcert2cc +*.light.c +*.s diff --git a/test/abi/Makefile b/test/abi/Makefile new file mode 100644 index 00000000..eb9ca292 --- /dev/null +++ b/test/abi/Makefile @@ -0,0 +1,75 @@ +include ../../Makefile.config + +CCOMP=../../ccomp -stdlib ../../runtime +CCOMPFLAGS= +CFLAGS=-O -Wno-overflow -Wno-constant-conversion + +TESTS=fixed.compcert fixed.cc2compcert fixed.compcert2cc \ + vararg.compcert vararg.cc2compcert vararg.compcert2cc \ + struct.compcert struct.cc2compcert struct.compcert2cc + +all: $(TESTS) + +all_s: fixed_def_compcert.s fixed_use_compcert.s \ + vararg_def_compcert.s vararg_use_compcert.s \ + struct_def_compcert.s struct_use_compcert.s + +test: + @set -e; for t in $(TESTS); do \ + SIMU='$(SIMU)' ARCH=$(ARCH) MODEL=$(MODEL) ABI=$(ABI) SYSTEM=$(SYSTEM) ./Runtest $$t; \ + done + +generator.exe: generator.ml + ocamlopt -g -o $@ generator.ml + +clean:: + rm -f generator.exe *.cm[iox] + +fixed_decl.h: generator.exe + ./generator.exe -rnd 500 -o fixed + +fixed_def.c fixed_use.c: fixed_decl.h + +clean:: + rm -f fixed_decl.h fixed_def.c fixed_use.c + +vararg_decl.h: generator.exe + ./generator.exe -vararg -rnd 500 -o vararg + +vararg_def.c vararg_use.c: vararg_decl.h + +clean:: + rm -f vararg_decl.h vararg_def.c vararg_use.c + +struct_decl.h: generator.exe + ./generator.exe -structs -o struct + +struct_def.c struct_use.c: struct_decl.h + +clean:: + rm -f struct_decl.h struct_def.c struct_use.c + +struct%.o: CCOMPFLAGS += -fstruct-passing -dclight + +%_compcert.o: %.c + $(CCOMP) $(CCOMPFLAGS) -c -o $@ $*.c +%_cc.o: %.c + $(CC) $(CFLAGS) -c -o $@ $*.c + +%_compcert.s: %.c + $(CCOMP) -S -o $@ $*.c +%_cc.s: %.c + $(CC) $(CFLAGS) -S -o $@ $*.c + +%.compcert: %_def_compcert.o %_use_compcert.o + $(CCOMP) -o $@ $*_def_compcert.o $*_use_compcert.o + +%.cc2compcert: %_def_compcert.o %_use_cc.o + $(CCOMP) -o $@ $*_def_compcert.o $*_use_cc.o + +%.compcert2cc: %_def_cc.o %_use_compcert.o + $(CCOMP) -o $@ $*_def_cc.o $*_use_compcert.o + +clean:: + rm -f *.[os] *.compcert *.cc2compcert *.compcert2cc *.light.c + diff --git a/test/abi/Runtest b/test/abi/Runtest new file mode 100755 index 00000000..7ec63188 --- /dev/null +++ b/test/abi/Runtest @@ -0,0 +1,41 @@ +#!/bin/sh + +# The name of the test +name="$1" + +# Skip the test if known to fail + +skip () { + echo "$name: skipped" + exit 0 +} + +case "$name" in + fixed.cc2compcert|fixed.compcert2cc) + if [ $ARCH = arm ] && [ $ABI = hardfloat ] ; then skip; fi + ;; + struct.cc2compcert|struct.compcert2cc) + if [ $ARCH = x86 ] && [ $MODEL = 32sse2 ] ; then + # works except on Cygwin + if [ $SYSTEM = cygwin ] ; then skip; fi + elif [ $ARCH = powerpc ] && [ $ABI = linux ] ; then + # works + : + else + skip + fi + ;; +esac + +# Administer the test + +if $SIMU ./$name +then + echo "$name: passed" + exit 0 +else + echo "$name: FAILED" + exit 2 +fi + + diff --git a/test/abi/generator.ml b/test/abi/generator.ml new file mode 100644 index 00000000..aecee7cf --- /dev/null +++ b/test/abi/generator.ml @@ -0,0 +1,458 @@ +open Printf + +type ty = + | Int8u | Int8s + | Int16u | Int16s + | Int32 + | Int64 + | Float32 + | Float64 + | String + | Struct of int * (string * ty) list + +type funsig = { + args: ty list; + varargs: ty list; (* empty list if fixed-argument function *) + res: ty option + } + +type value = + | VInt of int + | VInt32 of int32 + | VInt64 of int64 + | VFloat of float + | VString of string + | VStruct of value list + +(* Print a value. If [norm] is true, re-normalize values of + small numerical types. *) + +let zero_ext n k = + n land ((1 lsl k) - 1) + +let sign_ext n k = + (n lsl (Sys.int_size - k)) asr (Sys.int_size - k) + +let normalize_float32 n = + Int32.float_of_bits (Int32.bits_of_float n) + +let rec print_value ~norm oc (ty, v) = + match (ty, v) with + | (Int8u, VInt n) -> + fprintf oc "%d" (if norm then zero_ext n 8 else n) + | (Int8s, VInt n) -> + fprintf oc "%d" (if norm then sign_ext n 8 else n) + | (Int16u, VInt n) -> + fprintf oc "%d" (if norm then zero_ext n 16 else n) + | (Int16s, VInt n) -> + fprintf oc "%d" (if norm then sign_ext n 16 else n) + | (Int32, VInt32 n) -> + fprintf oc "%ld" n + | (Int64, VInt64 n) -> + fprintf oc "%Ld" n + | (Float32, VFloat f) -> + if norm + then fprintf oc "%hF" (normalize_float32 f) + else fprintf oc "%h" f + | (Float64, VFloat f) -> + fprintf oc "%h" f + | (String, VString s) -> + fprintf oc "%S" s + | (Struct(id, (fld1, ty1) :: members), VStruct (v1 :: vl)) -> + fprintf oc "(struct s%d){" id; + print_value ~norm oc (ty1, v1); + List.iter2 + (fun (fld, ty) v -> fprintf oc ", %a" (print_value ~norm) (ty, v)) + members vl; + fprintf oc "}" + | _, _ -> + assert false + +(* Generate random values of the given type *) + +let random_char () = Char.chr (Char.code 'a' + Random.int 26) + +let random_string () = + let len = Random.int 3 in + String.init len (fun _ -> random_char ()) + +let random_int () = + Random.bits() - (1 lsl 29) + +let random_int32 () = + Int32.(logxor (of_int (Random.bits())) + (shift_left (of_int (Random.bits())) 30)) + +let random_int64 () = + Int64.(logxor (of_int (Random.bits())) + (logxor (shift_left (of_int (Random.bits())) 30) + (shift_left (of_int (Random.bits())) 60))) + +let random_float64 () = + Random.float 100.0 -. 50.0 + +(* Returns a random value. Small numerical types are not normalized. *) + +let rec random_value = function + | Int8u | Int8s | Int16u | Int16s -> + VInt (random_int()) + | Int32 -> + VInt32 (random_int32()) + | Int64 -> + VInt64 (random_int64()) + | Float32 | Float64 -> + VFloat (random_float64()) + | String -> + VString (random_string()) + | Struct(id, members) -> + VStruct (List.map (fun (fld, ty) -> random_value ty) members) + +let random_retvalue = function + | None -> VInt 0 (* meaningless *) + | Some ty -> random_value ty + +(* Generate function declaration, definition, and call *) + +let string_of_ty = function + | Int8u -> "unsigned char" + | Int8s -> "signed char" + | Int16u -> "unsigned short" + | Int16s -> "short" + | Int32 -> "int" + | Int64 -> "long long" + | Float32 -> "float" + | Float64 -> "double" + | String -> "char *" + | Struct(id, _) -> sprintf "struct s%d" id + +let string_of_optty = function + | None -> "void" + | Some t -> string_of_ty t + +let declare_struct oc id members = + fprintf oc "struct s%d {\n" id; + List.iter + (fun (fld, ty) -> fprintf oc " %s %s;\n" (string_of_ty ty) fld) + members; + fprintf oc "};\n" + +let declare_function oc name sg = + fprintf oc "%s %s(" (string_of_optty sg.res) name; + begin match sg.args with + | [] -> fprintf oc "void" + | t0 :: tl -> + fprintf oc "%s x0" (string_of_ty t0); + List.iteri (fun n t -> fprintf oc ", %s x%d" (string_of_ty t) (n + 1)) tl; + if sg.varargs <> [] then fprintf oc ", ..." + end; + fprintf oc ")" + +let rec compare_value oc variable value ty = + match ty with + | Struct(id, members) -> + begin match value with + | VStruct vl -> + List.iter2 + (fun (fld, ty) v -> + compare_value oc (sprintf "%s.%s" variable fld) v ty) + members vl + | _ -> + assert false + end + | String -> + fprintf oc " check (strcmp(%s, %a) == 0);\n" + variable (print_value ~norm:true) (ty, value) + | _ -> + fprintf oc " check (%s == %a);\n" + variable (print_value ~norm:true) (ty, value) + +let define_function oc name sg vargs vres = + declare_function oc name sg; + fprintf oc "\n{\n"; + if sg.varargs <> [] then begin + fprintf oc " va_list l;\n"; + fprintf oc " va_start(l, x%d);\n" (List.length sg.args - 1); + List.iteri + (fun n t -> + fprintf oc " %s x%d = va_arg(l, %s);\n" + (string_of_ty t) (n + List.length sg.args) (string_of_ty t)) + sg.varargs; + fprintf oc " va_end(l);\n"; + end; + List.iteri + (fun n (t, v) -> compare_value oc (sprintf "x%d" n) v t) + (List.combine (sg.args @ sg.varargs) vargs); + begin match sg.res with + | None -> () + | Some tres -> + fprintf oc " return %a;\n" (print_value ~norm:false) (tres, vres) + end; + fprintf oc "}\n\n" + +let call_function oc name sg vargs vres = + fprintf oc "void call_%s(void)\n" name; + fprintf oc "{\n"; + begin match sg.res with + | None -> fprintf oc " %s(" name + | Some t -> fprintf oc " %s r = %s(" (string_of_ty t) name + end; + begin match (sg.args @ sg.varargs), vargs with + | [], [] -> () + | ty1 :: tyl, v1 :: vl -> + print_value ~norm:false oc (ty1, v1); + List.iter2 + (fun ty v -> fprintf oc ", %a" (print_value ~norm:false) (ty, v)) + tyl vl + | _, _ -> + assert false + end; + fprintf oc ");\n"; + begin match sg.res with + | None -> () + | Some tyres -> compare_value oc "r" vres tyres + end; + fprintf oc "}\n\n" + +let function_counter = ref 0 + +let generate_one_test oc0 oc1 oc2 sg = + incr function_counter; + let num = !function_counter in + let vargs = List.map random_value (sg.args @ sg.varargs) in + let vres = random_retvalue sg.res in + let name = "f" ^ string_of_int num in + fprintf oc0 "extern "; + declare_function oc0 name sg; + fprintf oc0 ";\n"; + define_function oc1 name sg vargs vres; + call_function oc2 name sg vargs vres + +let call_all_test oc = + fprintf oc "int main(void)\n"; + fprintf oc "{\n"; + fprintf oc " alarm(60);\n"; + for i = 1 to !function_counter do + fprintf oc " call_f%d();\n" i + done; + fprintf oc " return failed;\n"; + fprintf oc "}\n" + +(* Generate interesting function signatures *) + +let all_ty = + [| Int8u; Int8s; Int16u; Int16s; Int32; Int64; Float32; Float64; String |] + +let base_ty = + [| Int32; Int64; Float32; Float64 |] + +let makerun pat len = + let rec make i l = + if l <= 0 + then [] + else pat.(i) :: make ((i + 1) mod (Array.length pat)) (l - 1) + in make 0 len + +let gen_fixed_sigs f = + (* All possible return types *) + Array.iter + (fun ty -> f { args = []; varargs = []; res = Some ty }) + all_ty; + (* All possible argument types *) + Array.iter + (fun ty -> f { args = [ty]; varargs = []; res = None }) + all_ty; + (* 2 arguments of base types *) + Array.iter + (fun ty1 -> + Array.iter + (fun ty2 -> f { args = [ty1; ty2]; varargs = []; res = None }) + base_ty) + base_ty; + (* 3 arguments of base types *) + Array.iter + (fun ty1 -> + Array.iter + (fun ty2 -> + Array.iter + (fun ty3 -> f { args = [ty1; ty2; ty3]; varargs = []; res = None }) + base_ty) + base_ty) + base_ty; + (* 4 arguments of base types *) + Array.iter + (fun ty1 -> + Array.iter + (fun ty2 -> + Array.iter + (fun ty3 -> + Array.iter + (fun ty4 -> + f { args = [ty1; ty2; ty3; ty4]; varargs = []; res = None }) + base_ty) + base_ty) + base_ty) + base_ty; + (* Runs of 6, 8, 10, 12, 16, 32 arguments of various patterns *) + Array.iter + (fun pat -> + Array.iter + (fun len -> + f { args = makerun pat len; varargs = []; res = None }) + [| 6;8;10;12;16;32 |]) + [| [|Int32|]; [|Int64|]; [|Float32|]; [|Float64|]; + [|Int32;Int64|]; [|Int32;Float32|]; [|Int32;Float64|]; + [|Int64;Float32|]; [|Int64;Float64|]; [|Float32;Float64|]; + [|Int32;Int64;Float32;Float64|] + |] + +let split_list l n = + let rec split l n accu = + if n <= 0 then (List.rev accu, l) else + match l with + | [] -> assert false + | h :: t -> split t (n - 1) (h :: accu) + in split l n [] + +let is_vararg_type = function + | Int32 | Int64 | Float64 | String -> true + | _ -> false + +let gen_vararg_sigs f = + let make_vararg sg n = + if List.length sg.args > n then begin + let (fixed, varia) = split_list sg.args n in + if List.for_all is_vararg_type varia + && is_vararg_type (List.nth fixed (n - 1)) then + f { args = fixed; varargs = varia; res = sg.res } + end + in + gen_fixed_sigs + (fun sg -> make_vararg sg 2; make_vararg sg 6; make_vararg sg 14) + +(* Generate interesting struct types *) + +let struct_counter = ref 0 + +let mkstruct oc members = + incr struct_counter; + let id = !struct_counter in + declare_struct oc id members; + Struct(id, members) + +let member_ty = + [| Int8u; Int16u; Int32; Int64; Float32; Float64 |] + +let gen_structs oc f = + (* One field of any type *) + Array.iter + (fun ty -> f (mkstruct oc [("a", ty)])) + all_ty; + (* Two fields of interesting types *) + Array.iter + (fun ty1 -> + Array.iter + (fun ty2 -> f (mkstruct oc [("a", ty1); ("b", ty2)])) + member_ty) + member_ty; + (* 3, 4, 6, 8 fields of identical interesting type *) + Array.iter + (fun ty -> + f (mkstruct oc [("a", ty); ("b", ty); ("c", ty)]); + f (mkstruct oc [("a", ty); ("b", ty); ("c", ty); ("d", ty)]); + f (mkstruct oc [("a", ty); ("b", ty); ("c", ty); ("d", ty); + ("e", ty); ("f", ty)]); + f (mkstruct oc [("a", ty); ("b", ty); ("c", ty); ("d", ty); + ("e", ty); ("f", ty); ("g", ty); ("h", ty)])) + member_ty + +let gen_struct_sigs oc f = + let make ty = + (* Struct return *) + f { args = []; varargs = []; res = Some ty }; + (* Struct passing (once, twice) *) + f { args = [ty]; varargs = []; res = None }; + f { args = [ty;ty]; varargs = []; res = None }; + (* Struct passing mixed with scalar arguments *) + f { args = [Int32;ty]; varargs = []; res = None }; + f { args = [Float64;ty]; varargs = []; res = None } + in + gen_structs oc make + +(* Random generation *) + +let pick arr = + arr.(Random.int (Array.length arr)) + +let big_ty = [| Int32; Int64; Float32; Float64; String |] + +let vararg_ty = [| Int32; Int64; Float64; String |] + +let random_funsig vararg = + let res = if Random.bool() then Some (pick all_ty) else None in + let numargs = Random.int 12 in + let args = List.init numargs (fun _ -> pick big_ty) in + let numvarargs = + if vararg && numargs > 0 && is_vararg_type (List.nth args (numargs - 1)) + then 1 + Random.int 12 + else 0 in + let varargs = List.init numvarargs (fun _ -> pick vararg_ty) in + { args; varargs; res } + +let header = +{|#include <stdarg.h> +#include <stdio.h> +#include <string.h> +#include <unistd.h> +|} + +let checking_code = {| +extern int failed; + +static void failure(const char * assertion, const char * file, + int line, const char * fn) +{ + fprintf(stderr, "%s:%d:%s: assertion %s failed\n", file, line, fn, assertion); + failed = 1; +} + +#define check(expr) ((expr) ? (void)0 : failure(#expr,__FILE__,__LINE__,__func__)) +|} + +let output_prefix = ref "abifuzz" +let gen_vararg = ref false +let gen_struct = ref false +let num_random = ref 0 + +let _ = + Arg.parse [ + "-plain", Arg.Unit (fun () -> gen_vararg := false; gen_struct := false), + " generate fixed-argument functions without structs"; + "-vararg", Arg.Set gen_vararg, + " generate variable-argument functions"; + "-structs", Arg.Set gen_struct, + " generate functions that exchange structs"; + "-o", Arg.String (fun s -> output_prefix := s), + " <prefix> produce <prefix>.h, <prefix>def.c and <prefix>use.c files"; + "-rnd", Arg.Int (fun n -> num_random := n), + " <num> produce <num> extra functions with random signatures"; + "-seed", Arg.Int Random.init, + " <seed> use the given seed for randomization" + ] + (fun s -> raise (Arg.Bad ("don't know what to do with " ^ s))) + "Usage: gencalls [options]\n\nOptions are:"; + let oc0 = open_out (!output_prefix ^ "_decl.h") + and oc1 = open_out (!output_prefix ^ "_def.c") + and oc2 = open_out (!output_prefix ^ "_use.c") in + fprintf oc0 "%s\n%s\n" header checking_code; + fprintf oc1 "%s#include \"%s_decl.h\"\n\n" header !output_prefix; + fprintf oc2 "%s#include \"%s_decl.h\"\n\nint failed = 0;\n\n" + header !output_prefix; + let cont = generate_one_test oc0 oc1 oc2 in + if !gen_vararg then gen_vararg_sigs cont + else if !gen_struct then gen_struct_sigs oc0 cont + else gen_fixed_sigs cont; + for i = 1 to !num_random do + cont (random_funsig !gen_vararg) + done; + call_all_test oc2; + close_out oc0; close_out oc1; close_out oc2 diff --git a/test/clightgen/annotations.c b/test/clightgen/annotations.c index e91c7fbc..993fa7d0 100644 --- a/test/clightgen/annotations.c +++ b/test/clightgen/annotations.c @@ -1,6 +1,6 @@ int f(int x, long y) { -#if !defined(SYSTEM_macosx) && !defined(SYSTEM_cygwin) +#if !defined(SYSTEM_macos) && !defined(SYSTEM_cygwin) __builtin_ais_annot("x is %e1, y is %e2", x, y); #endif __builtin_annot("x is %1, y is %2", x, y); diff --git a/test/regression/Makefile b/test/regression/Makefile index 56d90469..f74e1441 100644 --- a/test/regression/Makefile +++ b/test/regression/Makefile @@ -17,7 +17,7 @@ TESTS?=int32 int64 floats floats-basics floats-lit \ volatile1 volatile2 volatile3 volatile4 \ funct3 expr5 struct7 struct8 struct11 struct12 casts1 casts2 char1 \ sizeof1 sizeof2 binops bool for1 for2 switch switch2 compound \ - decl1 interop1 bitfields9 ptrs3 \ + decl1 bitfields9 ptrs3 \ parsing krfun ifconv # Can run, but only in compiled mode, and have reference output in Results @@ -54,13 +54,6 @@ all: $(TESTS:%=%.compcert) $(TESTS_COMP:%=%.compcert) $(TESTS_DIFF:%=%.compcert) all_s: $(TESTS:%=%.s) $(TESTS_COMP:%=%.s) $(TESTS_DIFF:%=%.s) $(EXTRAS:%=%.s) -interop1.compcert: interop1.c - $(CC) -DCC_SIDE -c -o interop1n.o interop1.c - $(CCOMP) $(CCOMPFLAGS) -DCOMPCERT_SIDE -o interop1.compcert interop1.c interop1n.o $(LIBS) - -interop1.s: interop1.c - $(CCOMP) $(CCOMPFLAGS) -S interop1.c - %.compcert: %.c $(CCOMP) $(CCOMPFLAGS) -o $*.compcert $*.c $(LIBS) diff --git a/test/regression/Results/interop1 b/test/regression/Results/interop1 deleted file mode 100644 index 6e32c1cb..00000000 --- a/test/regression/Results/interop1 +++ /dev/null @@ -1,98 +0,0 @@ ---- CompCert calling native: -si8u: 177 -si8s: -79 -si16u: 64305 -si16s: -1231 -s1: { a = 'a' } -s2: { a = 'a', b = 'b' } -s3: { a = 'a', b = 'b', c = ' c' } -s4: { a = 'a', b = 'b', c = ' c', d = 'd' } -s5: { a = 'a', b = 'b', c = ' c', d = 'd', e = 'e' } -s6: { a = 'a', b = 'b', c = ' c', d = 'd', e = 'e', f = 'f' } -s7: { a = 'a', b = 'b', c = ' c', d = 'd', e = 'e', f = 'f', g = 'g' } -s8: "Hello world!" -t1: { a = 123 } -t2: { a = 123, b = 456 } -t3: { a = 123, b = 456, c = 789 } -t4: { a = 123, b = 456, c = 789, d = -111 } -t5: { a = 123, b = 456, c = 789, d = -999, e = 'x' } -u1: { a = 12 } -u2: { a = 12, b = -34 } -u3: { a = 12, b = 34, c = -56 } -u4: { a = 12, b = 34, c = 56, d = -78 } -u5: { a = 1234, b = 'u' } -u6: { a = 55555, b = 666 } -u7: { a = -10001, b = -789, c = 'z' } -u8: { a = 'x', b = 12345 } -after ms4, x = { 's', 'a', 'm', 'e' } -after mu4, x = { a = { 11, 22, 33, 44 } } -rs1: { a = 'a' } -rs2: { a = 'a', b = 'b' } -rs3: { a = 'a', b = 'b', c = ' c' } -rs4: { a = 'a', b = 'b', c = ' c', d = 'd' } -rs5: { a = 'a', b = 'b', c = ' c', d = 'd', e = 'e' } -rs6: { a = 'a', b = 'b', c = ' c', d = 'd', e = 'e', f = 'f' } -rs7: { a = 'a', b = 'b', c = ' c', d = 'd', e = 'e', f = 'f', g = 'g' } -rs8: "Hello world!" -rt1: { a = 123 } -rt2: { a = 123, b = 456 } -rt3: { a = 123, b = 456, c = 789 } -rt4: { a = 123, b = 456, c = 789, d = -111 } -rt5: { a = 123, b = 456, c = 789, d = -999, e = 'x' } -ru1: { a = 12 } -ru2: { a = 12, b = -34 } -ru3: { a = 12, b = 34, c = -56 } -ru4: { a = 12, b = 34, c = 56, d = -78 } -ru5: { a = 1234, b = 'u' } -ru6: { a = 55555, b = 666 } -ru7: { a = -10001, b = -789, c = 'z' } -ru8: { a = 'x', b = 12345 } ---- native calling CompCert: -si8u: 177 -si8s: -79 -si16u: 64305 -si16s: -1231 -s1: { a = 'a' } -s2: { a = 'a', b = 'b' } -s3: { a = 'a', b = 'b', c = ' c' } -s4: { a = 'a', b = 'b', c = ' c', d = 'd' } -s5: { a = 'a', b = 'b', c = ' c', d = 'd', e = 'e' } -s6: { a = 'a', b = 'b', c = ' c', d = 'd', e = 'e', f = 'f' } -s7: { a = 'a', b = 'b', c = ' c', d = 'd', e = 'e', f = 'f', g = 'g' } -s8: "Hello world!" -t1: { a = 123 } -t2: { a = 123, b = 456 } -t3: { a = 123, b = 456, c = 789 } -t4: { a = 123, b = 456, c = 789, d = -111 } -t5: { a = 123, b = 456, c = 789, d = -999, e = 'x' } -u1: { a = 12 } -u2: { a = 12, b = -34 } -u3: { a = 12, b = 34, c = -56 } -u4: { a = 12, b = 34, c = 56, d = -78 } -u5: { a = 1234, b = 'u' } -u6: { a = 55555, b = 666 } -u7: { a = -10001, b = -789, c = 'z' } -u8: { a = 'x', b = 12345 } -after ms4, x = { 's', 'a', 'm', 'e' } -after mu4, x = { a = { 11, 22, 33, 44 } } -rs1: { a = 'a' } -rs2: { a = 'a', b = 'b' } -rs3: { a = 'a', b = 'b', c = ' c' } -rs4: { a = 'a', b = 'b', c = ' c', d = 'd' } -rs5: { a = 'a', b = 'b', c = ' c', d = 'd', e = 'e' } -rs6: { a = 'a', b = 'b', c = ' c', d = 'd', e = 'e', f = 'f' } -rs7: { a = 'a', b = 'b', c = ' c', d = 'd', e = 'e', f = 'f', g = 'g' } -rs8: "Hello world!" -rt1: { a = 123 } -rt2: { a = 123, b = 456 } -rt3: { a = 123, b = 456, c = 789 } -rt4: { a = 123, b = 456, c = 789, d = -111 } -rt5: { a = 123, b = 456, c = 789, d = -999, e = 'x' } -ru1: { a = 12 } -ru2: { a = 12, b = -34 } -ru3: { a = 12, b = 34, c = -56 } -ru4: { a = 12, b = 34, c = 56, d = -78 } -ru5: { a = 1234, b = 'u' } -ru6: { a = 55555, b = 666 } -ru7: { a = -10001, b = -789, c = 'z' } -ru8: { a = 'x', b = 12345 } diff --git a/test/regression/Results/varargs2 b/test/regression/Results/varargs2 index 96ee9d63..9e77da1b 100644 --- a/test/regression/Results/varargs2 +++ b/test/regression/Results/varargs2 @@ -10,4 +10,5 @@ Twice: -1 1.23 With va_copy: -1 1.23 With va_copy: -1 1.23 With extra args: x & Hello, world! & 42 & 123456789012345 & 3.141592654 & 2.718281746 +With extra FP args: 3.141592654 & 2.718281746 & 1 & 2 & 3 & 4 & 5 & 6 & 7 & 8 & 42 va_list compatibility: x & Hello, world! & 42 & 123456789012345 & 3.141592654 & 2.718281746 diff --git a/test/regression/interop1.c b/test/regression/interop1.c deleted file mode 100644 index 6836b89e..00000000 --- a/test/regression/interop1.c +++ /dev/null @@ -1,301 +0,0 @@ -#if defined(COMPCERT_SIDE) -#define US(x) compcert_##x -#define THEM(x) native_##x -#elif defined(CC_SIDE) -#define US(x) native_##x -#define THEM(x) compcert_##x -#else -#define US(x) x -#define THEM(x) x -#endif - -#include <stdio.h> - -/* Alignment 1 */ - -struct S1 { char a; }; -static struct S1 init_S1 = { 'a' }; -#define print_S1(x) printf("{ a = '%c' }\n", x.a) - -struct S2 { char a, b; }; -static struct S2 init_S2 = { 'a', 'b' }; -#define print_S2(x) printf("{ a = '%c', b = '%c' }\n", x.a, x.b) - -struct S3 { char a, b, c; }; -static struct S3 init_S3 = { 'a', 'b', 'c' }; -#define print_S3(x) \ - printf("{ a = '%c', b = '%c', c = ' %c' }\n", x.a, x.b, x.c) - -struct S4 { char a, b, c, d; }; -static struct S4 init_S4 = { 'a', 'b', 'c', 'd' }; -#define print_S4(x) \ - printf("{ a = '%c', b = '%c', c = ' %c', d = '%c' }\n", \ - x.a, x.b, x.c, x.d); - -struct S5 { char a, b, c, d, e; }; -static struct S5 init_S5 = { 'a', 'b', 'c', 'd', 'e' }; -#define print_S5(x) \ - printf("{ a = '%c', b = '%c', c = ' %c', d = '%c', e = '%c' }\n", \ - x.a, x.b, x.c, x.d, x.e) - -struct S6 { char a, b, c, d, e, f; }; -static struct S6 init_S6 = { 'a', 'b', 'c', 'd', 'e', 'f' }; -#define print_S6(x) \ - printf("{ a = '%c', b = '%c', c = ' %c', d = '%c', e = '%c', f = '%c' }\n", \ - x.a, x.b, x.c, x.d, x.e, x.f) - -struct S7 { char a, b, c, d, e, f, g; }; -static struct S7 init_S7 = { 'a', 'b', 'c', 'd', 'e', 'f', 'g' }; -#define print_S7(x) \ - printf("{ a = '%c', b = '%c', c = ' %c', d = '%c', e = '%c', f = '%c', g = '%c' }\n", \ - x.a, x.b, x.c, x.d, x.e, x.f, x.g) - -struct S8 { char a[32]; }; -static struct S8 init_S8 = { "Hello world!" }; -/* Do not use printf("%s") to avoid undefined behavior in the - reference interpreter */ -#define print_S8(x) \ - { char * p; \ - printf("\""); \ - for (p = x.a; *p != 0; p++) printf("%c", *p); \ - printf("\"\n"); \ - } - -/* Alignment 2 */ - -struct T1 { short a; }; -static struct T1 init_T1 = { 123 }; -#define print_T1(x) printf("{ a = %d }\n", x.a) - -struct T2 { short a, b; }; -static struct T2 init_T2 = { 123, 456 }; -#define print_T2(x) printf("{ a = %d, b = %d }\n", x.a, x.b) - -struct T3 { short a, b, c; }; -static struct T3 init_T3 = { 123, 456, 789 }; -#define print_T3(x) printf("{ a = %d, b = %d, c = %d }\n", x.a, x.b, x.c) - -struct T4 { short a, b, c, d; }; -static struct T4 init_T4 = { 123, 456, 789, -111 }; -#define print_T4(x) \ - printf("{ a = %d, b = %d, c = %d, d = %d }\n", x.a, x.b, x.c, x.d) - -struct T5 { short a, b, c, d; char e; }; -static struct T5 init_T5 = { 123, 456, 789, -999, 'x' }; -#define print_T5(x) \ - printf("{ a = %d, b = %d, c = %d, d = %d, e = '%c' }\n", \ - x.a, x.b, x.c, x.d, x.e) - -/* Alignment >= 4 */ - -struct U1 { int a; }; -static struct U1 init_U1 = { 12 }; -#define print_U1(x) printf("{ a = %d }\n", x.a) - -struct U2 { int a, b; }; -static struct U2 init_U2 = { 12, -34 }; -#define print_U2(x) printf("{ a = %d, b = %d }\n", x.a, x.b) - -struct U3 { int a, b, c; }; -static struct U3 init_U3 = { 12, 34, -56}; -#define print_U3(x) printf("{ a = %d, b = %d, c = %d }\n", x.a, x.b, x.c) - -struct U4 { int a, b, c, d; }; -static struct U4 init_U4 = { 12, 34, 56, -78 }; -#define print_U4(x) \ - printf("{ a = %d, b = %d, c = %d, d = %d }\n", x.a, x.b, x.c, x.d) - -struct U5 { int a; char b; }; -static struct U5 init_U5 = { 1234, 'u' }; -#define print_U5(x) \ - printf("{ a = %d, b = '%c' }\n", x.a, x.b) - -struct U6 { int a; short b; }; -static struct U6 init_U6 = { 55555, 666 }; -#define print_U6(x) \ - printf("{ a = %d, b = %d }\n", x.a, x.b) - -struct U7 { int a; short b; char c; }; -static struct U7 init_U7 = { -10001, -789, 'z' }; -#define print_U7(x) \ - printf("{ a = %d, b = %d, c = '%c' }\n", x.a, x.b, x.c) - -struct U8 { char a; int b; }; -static struct U8 init_U8 = { 'x', 12345 }; -#define print_U8(x) \ - printf("{ a = '%c', b = %d }\n", x.a, x.b) - -/* Struct passing */ - -#define PRINT(name,ty,print) \ -extern void THEM(name) (struct ty x); \ -void US(name) (struct ty x) { print(x); } - -PRINT(s1,S1,print_S1) -PRINT(s2,S2,print_S2) -PRINT(s3,S3,print_S3) -PRINT(s4,S4,print_S4) -PRINT(s5,S5,print_S5) -PRINT(s6,S6,print_S6) -PRINT(s7,S7,print_S7) -PRINT(s8,S8,print_S8) -PRINT(t1,T1,print_T1) -PRINT(t2,T2,print_T2) -PRINT(t3,T3,print_T3) -PRINT(t4,T4,print_T4) -PRINT(t5,T5,print_T5) -PRINT(u1,U1,print_U1) -PRINT(u2,U2,print_U2) -PRINT(u3,U3,print_U3) -PRINT(u4,U4,print_U4) -PRINT(u5,U5,print_U5) -PRINT(u6,U6,print_U6) -PRINT(u7,U7,print_U7) -PRINT(u8,U8,print_U8) - -/* Struct passing with modification in the callee */ - -extern void THEM (ms4) (struct S4 x); -void US (ms4) (struct S4 x) -{ - x.a += 1; x.d -= 1; -} - -extern void THEM (mu4) (struct U4 x); -void US (mu4) (struct U4 x) -{ - x.a = 1; x.b = 2; -} - -/* Struct return */ - -#define RETURN(name,ty,init) \ -extern struct ty THEM(name)(void); \ -struct ty US(name)(void) { return init; } - -RETURN(rs1,S1,init_S1) -RETURN(rs2,S2,init_S2) -RETURN(rs3,S3,init_S3) -RETURN(rs4,S4,init_S4) -RETURN(rs5,S5,init_S5) -RETURN(rs6,S6,init_S6) -RETURN(rs7,S7,init_S7) -RETURN(rs8,S8,init_S8) -RETURN(rt1,T1,init_T1) -RETURN(rt2,T2,init_T2) -RETURN(rt3,T3,init_T3) -RETURN(rt4,T4,init_T4) -RETURN(rt5,T5,init_T5) -RETURN(ru1,U1,init_U1) -RETURN(ru2,U2,init_U2) -RETURN(ru3,U3,init_U3) -RETURN(ru4,U4,init_U4) -RETURN(ru5,U5,init_U5) -RETURN(ru6,U6,init_U6) -RETURN(ru7,U7,init_U7) -RETURN(ru8,U8,init_U8) - -/* Returning small integers */ - -#define SMALLINT(name,ty) \ -extern ty THEM(name)(int); \ -ty US(name)(int x) { return x * x; } - -SMALLINT(si8u, unsigned char) -SMALLINT(si8s, signed char) -SMALLINT(si16u, unsigned short) -SMALLINT(si16s, signed short) - -/* Test function, calling the functions compiled by the other compiler */ - -#define CALLPRINT(name,ty,init) \ - printf(#name": "); THEM(name)(init); - -#define CALLRETURN(name,ty,print) \ - { struct ty x = THEM(name)(); \ - printf(#name": "); print(x); } - -extern void THEM(test) (void); -void US(test) (void) -{ - printf("si8u: %d\n", THEM(si8u)(12345)); - printf("si8s: %d\n", THEM(si8s)(12345)); - printf("si16u: %d\n", THEM(si16u)(1234567)); - printf("si16s: %d\n", THEM(si16s)(1234567)); - CALLPRINT(s1,S1,init_S1) - CALLPRINT(s2,S2,init_S2) - CALLPRINT(s3,S3,init_S3) - CALLPRINT(s4,S4,init_S4) - CALLPRINT(s5,S5,init_S5) - CALLPRINT(s6,S6,init_S6) - CALLPRINT(s7,S7,init_S7) - CALLPRINT(s8,S8,init_S8) - CALLPRINT(t1,T1,init_T1) - CALLPRINT(t2,T2,init_T2) - CALLPRINT(t3,T3,init_T3) - CALLPRINT(t4,T4,init_T4) - CALLPRINT(t5,T5,init_T5) - CALLPRINT(u1,U1,init_U1) - CALLPRINT(u2,U2,init_U2) - CALLPRINT(u3,U3,init_U3) - CALLPRINT(u4,U4,init_U4) - CALLPRINT(u5,U5,init_U5) - CALLPRINT(u6,U6,init_U6) - CALLPRINT(u7,U7,init_U7) - CALLPRINT(u8,U8,init_U8) - - { struct S4 x = { 's', 'a', 'm', 'e' }; - THEM(ms4)(x); - printf("after ms4, x = { '%c', '%c', '%c', '%c' }\n", x.a, x.b, x.c, x.d); } - { struct U4 x = { 11, 22, 33, 44 }; - THEM(mu4)(x); - printf("after mu4, x = { a = { %d, %d, %d, %d } }\n", x.a, x.b, x.c, x.d); } - - CALLRETURN(rs1,S1,print_S1) - CALLRETURN(rs2,S2,print_S2) - CALLRETURN(rs3,S3,print_S3) - CALLRETURN(rs4,S4,print_S4) - CALLRETURN(rs5,S5,print_S5) - CALLRETURN(rs6,S6,print_S6) - CALLRETURN(rs7,S7,print_S7) - CALLRETURN(rs8,S8,print_S8) - CALLRETURN(rt1,T1,print_T1) - CALLRETURN(rt2,T2,print_T2) - CALLRETURN(rt3,T3,print_T3) - CALLRETURN(rt4,T4,print_T4) - CALLRETURN(rt5,T5,print_T5) - CALLRETURN(ru1,U1,print_U1) - CALLRETURN(ru2,U2,print_U2) - CALLRETURN(ru3,U3,print_U3) - CALLRETURN(ru4,U4,print_U4) - CALLRETURN(ru5,U5,print_U5) - CALLRETURN(ru6,U6,print_U6) - CALLRETURN(ru7,U7,print_U7) - CALLRETURN(ru8,U8,print_U8) -} - -#if defined(COMPCERT_SIDE) - -int main() -{ - printf("--- CompCert calling native:\n"); - compcert_test(); - printf("--- native calling CompCert:\n"); - native_test(); - return 0; -} - -#elif !defined(CC_SIDE) - -int main() -{ - printf("--- CompCert calling native:\n"); - test(); - printf("--- native calling CompCert:\n"); - test(); - return 0; -} - -#endif - - diff --git a/test/regression/interop1.cond b/test/regression/interop1.cond deleted file mode 100644 index 77904189..00000000 --- a/test/regression/interop1.cond +++ /dev/null @@ -1,10 +0,0 @@ -#!/bin/sh -arch=`sed -n -e 's/^ARCH=//p' ../../Makefile.config` -model=`sed -n -e 's/^MODEL=//p' ../../Makefile.config` -system=`sed -n -e 's/^SYSTEM=//p' ../../Makefile.config` - -case "$arch,$model,$system" in - *,*,cygwin) exit $SKIP;; - x86,32sse2,*|arm,*,*|powerpc,*,*) exit $RUN;; - *) exit $SKIP;; -esac diff --git a/test/regression/varargs2.c b/test/regression/varargs2.c index 3e785a63..e3492ead 100644 --- a/test/regression/varargs2.c +++ b/test/regression/varargs2.c @@ -104,6 +104,17 @@ void miniprintf_extra(int i1, int i2, int i3, int i4, va_end(va); } +/* Add a few dummy FP arguments to test passing of variadic FP arguments + in integer registers (mostly relevant for RISC-V) */ + +void miniprintf_float(double f1, double f2, const char * fmt, ...) +{ + va_list va; + va_start(va, fmt); + minivprintf(fmt, va); + va_end(va); +} + /* Test va_list compatibility with the C library */ void printf_compat(const char * fmt, ...) @@ -157,6 +168,11 @@ int main() 123456789012345LL, 3.141592654, 2.71828182); + miniprintf_float(0.0, 0.5, + "With extra FP args: %e & %f & %e & %e & %e & %e & %e & %e & %e & %e & %d\n", + 3.141592654, + 2.71828182, + 1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0, 42); printf_compat("va_list compatibility: %c & %s & %d & %lld & %.10g & %.10g\n", 'x', "Hello, world!", @@ -1193,7 +1193,7 @@ Ltac Equalities := split. auto. intros. destruct B; auto. subst. auto. - (* trace length *) red; intros; inv H; simpl. - omega. + lia. eapply external_call_trace_length; eauto. eapply external_call_trace_length; eauto. - (* initial states *) diff --git a/x86/Asmexpand.ml b/x86/Asmexpand.ml index 20f5d170..ecdf97f7 100644 --- a/x86/Asmexpand.ml +++ b/x86/Asmexpand.ml @@ -500,7 +500,7 @@ let expand_builtin_inline name args res = unprototyped. *) let fixup_funcall_elf64 sg = - if sg.sig_cc.cc_vararg || sg.sig_cc.cc_unproto then begin + if sg.sig_cc.cc_vararg <> None || sg.sig_cc.cc_unproto then begin let (ir, fr, ofs) = next_arg_locations 0 0 0 sg.sig_args in emit (Pmovl_ri (RAX, coqint_of_camlint (Int32.of_int fr))) end @@ -521,7 +521,7 @@ let rec copy_fregs_to_iregs args fr ir = () let fixup_funcall_win64 sg = - if sg.sig_cc.cc_vararg then + if sg.sig_cc.cc_vararg <> None then copy_fregs_to_iregs sg.sig_args [XMM0; XMM1; XMM2; XMM3] [RCX; RDX; R8; R9] let fixup_funcall sg = diff --git a/x86/Asmgenproof.v b/x86/Asmgenproof.v index 6886b2fd..8c28fb1b 100644 --- a/x86/Asmgenproof.v +++ b/x86/Asmgenproof.v @@ -67,7 +67,7 @@ Lemma transf_function_no_overflow: transf_function f = OK tf -> list_length_z (fn_code tf) <= Ptrofs.max_unsigned. Proof. intros. monadInv H. destruct (zlt Ptrofs.max_unsigned (list_length_z (fn_code x))); monadInv EQ0. - omega. + lia. Qed. Lemma exec_straight_exec: @@ -332,8 +332,8 @@ Proof. split. unfold goto_label. rewrite P. rewrite H1. auto. split. rewrite Pregmap.gss. constructor; auto. rewrite Ptrofs.unsigned_repr. replace (pos' - 0) with pos' in Q. - auto. omega. - generalize (transf_function_no_overflow _ _ H0). omega. + auto. lia. + generalize (transf_function_no_overflow _ _ H0). lia. intros. apply Pregmap.gso; auto. Qed. @@ -858,7 +858,7 @@ Transparent destroyed_by_jumptable. econstructor; eauto. unfold nextinstr. rewrite Pregmap.gss. repeat rewrite Pregmap.gso; auto with asmgen. rewrite ATPC. simpl. constructor; eauto. - unfold fn_code. eapply code_tail_next_int. simpl in g. omega. + unfold fn_code. eapply code_tail_next_int. simpl in g. lia. constructor. apply agree_nextinstr. eapply agree_change_sp; eauto. Transparent destroyed_at_function_entry. @@ -883,7 +883,7 @@ Transparent destroyed_at_function_entry. - (* return *) inv STACKS. simpl in *. - right. split. omega. split. auto. + right. split. lia. split. auto. econstructor; eauto. rewrite ATPC; eauto. congruence. Qed. diff --git a/x86/ConstpropOpproof.v b/x86/ConstpropOpproof.v index 82179fa4..09c6e91b 100644 --- a/x86/ConstpropOpproof.v +++ b/x86/ConstpropOpproof.v @@ -532,7 +532,7 @@ Proof. Int.bit_solve. destruct (zlt i0 n0). replace (Int.testbit n i0) with (negb (Int.testbit Int.zero i0)). rewrite Int.bits_zero. simpl. rewrite andb_true_r. auto. - rewrite <- EQ. rewrite Int.bits_zero_ext by omega. rewrite zlt_true by auto. + rewrite <- EQ. rewrite Int.bits_zero_ext by lia. rewrite zlt_true by auto. rewrite Int.bits_not by auto. apply negb_involutive. rewrite H6 by auto. auto. econstructor; split; eauto. auto. diff --git a/x86/Conventions1.v b/x86/Conventions1.v index b4cb233e..b6fb2620 100644 --- a/x86/Conventions1.v +++ b/x86/Conventions1.v @@ -303,14 +303,14 @@ Remark loc_arguments_32_charact: In p (loc_arguments_32 tyl ofs) -> forall_rpair (loc_argument_32_charact ofs) p. Proof. assert (X: forall ofs1 ofs2 l, loc_argument_32_charact ofs2 l -> ofs1 <= ofs2 -> loc_argument_32_charact ofs1 l). - { destruct l; simpl; intros; auto. destruct sl; auto. intuition omega. } + { destruct l; simpl; intros; auto. destruct sl; auto. intuition lia. } induction tyl as [ | ty tyl]; simpl loc_arguments_32; intros. - contradiction. - destruct H. -+ destruct ty; subst p; simpl; omega. ++ destruct ty; subst p; simpl; lia. + apply IHtyl in H. generalize (typesize_pos ty); intros. destruct p; simpl in *. -* eapply X; eauto; omega. -* destruct H; split; eapply X; eauto; omega. +* eapply X; eauto; lia. +* destruct H; split; eapply X; eauto; lia. Qed. Remark loc_arguments_elf64_charact: @@ -318,7 +318,7 @@ Remark loc_arguments_elf64_charact: In p (loc_arguments_elf64 tyl ir fr ofs) -> (2 | ofs) -> forall_rpair (loc_argument_elf64_charact ofs) p. Proof. assert (X: forall ofs1 ofs2 l, loc_argument_elf64_charact ofs2 l -> ofs1 <= ofs2 -> loc_argument_elf64_charact ofs1 l). - { destruct l; simpl; intros; auto. destruct sl; auto. intuition omega. } + { destruct l; simpl; intros; auto. destruct sl; auto. intuition lia. } assert (Y: forall ofs1 ofs2 p, forall_rpair (loc_argument_elf64_charact ofs2) p -> ofs1 <= ofs2 -> forall_rpair (loc_argument_elf64_charact ofs1) p). { destruct p; simpl; intuition eauto. } assert (Z: forall ofs, (2 | ofs) -> (2 | ofs + 2)). @@ -335,8 +335,8 @@ Opaque list_nth_z. { intros. destruct (list_nth_z int_param_regs_elf64 ir) as [r|] eqn:E; destruct H1. subst. left. eapply list_nth_z_in; eauto. eapply IHtyl; eauto. - subst. split. omega. assumption. - eapply Y; eauto. omega. } + subst. split. lia. assumption. + eapply Y; eauto. lia. } assert (B: forall ty, In p match list_nth_z float_param_regs_elf64 fr with | Some ireg => One (R ireg) :: loc_arguments_elf64 tyl ir (fr + 1) ofs @@ -346,8 +346,8 @@ Opaque list_nth_z. { intros. destruct (list_nth_z float_param_regs_elf64 fr) as [r|] eqn:E; destruct H1. subst. right. eapply list_nth_z_in; eauto. eapply IHtyl; eauto. - subst. split. omega. assumption. - eapply Y; eauto. omega. } + subst. split. lia. assumption. + eapply Y; eauto. lia. } destruct a; eauto. Qed. @@ -356,7 +356,7 @@ Remark loc_arguments_win64_charact: In p (loc_arguments_win64 tyl r ofs) -> (2 | ofs) -> forall_rpair (loc_argument_win64_charact ofs) p. Proof. assert (X: forall ofs1 ofs2 l, loc_argument_win64_charact ofs2 l -> ofs1 <= ofs2 -> loc_argument_win64_charact ofs1 l). - { destruct l; simpl; intros; auto. destruct sl; auto. intuition omega. } + { destruct l; simpl; intros; auto. destruct sl; auto. intuition lia. } assert (Y: forall ofs1 ofs2 p, forall_rpair (loc_argument_win64_charact ofs2) p -> ofs1 <= ofs2 -> forall_rpair (loc_argument_win64_charact ofs1) p). { destruct p; simpl; intuition eauto. } assert (Z: forall ofs, (2 | ofs) -> (2 | ofs + 2)). @@ -373,8 +373,8 @@ Opaque list_nth_z. { intros. destruct (list_nth_z int_param_regs_win64 r) as [r'|] eqn:E; destruct H1. subst. left. eapply list_nth_z_in; eauto. eapply IHtyl; eauto. - subst. split. omega. assumption. - eapply Y; eauto. omega. } + subst. split. lia. assumption. + eapply Y; eauto. lia. } assert (B: forall ty, In p match list_nth_z float_param_regs_win64 r with | Some ireg => One (R ireg) :: loc_arguments_win64 tyl (r + 1) ofs @@ -384,8 +384,8 @@ Opaque list_nth_z. { intros. destruct (list_nth_z float_param_regs_win64 r) as [r'|] eqn:E; destruct H1. subst. right. eapply list_nth_z_in; eauto. eapply IHtyl; eauto. - subst. split. omega. assumption. - eapply Y; eauto. omega. } + subst. split. lia. assumption. + eapply Y; eauto. lia. } destruct a; eauto. Qed. @@ -424,7 +424,7 @@ Proof. unfold forall_rpair; destruct p; intuition auto. Qed. -Hint Resolve loc_arguments_acceptable: locs. +Global Hint Resolve loc_arguments_acceptable: locs. Lemma loc_arguments_main: loc_arguments signature_main = nil. @@ -432,7 +432,7 @@ Proof. unfold loc_arguments; destruct Archi.ptr64; auto; destruct Archi.win64; auto. Qed. -(** ** Normalization of function results *) +(** ** Normalization of function results and parameters *) (** In the x86 ABI, a return value of type "char" is returned in register AL, leaving the top 24 bits of EAX unspecified. @@ -445,3 +445,8 @@ Definition return_value_needs_normalization (t: rettype) : bool := | Tint8signed | Tint8unsigned | Tint16signed | Tint16unsigned => true | _ => false end. + +(** Function parameters are passed in normalized form and do not need + to be re-normalized at function entry. *) + +Definition parameter_needs_normalization (t: rettype) := false. diff --git a/x86/NeedOp.v b/x86/NeedOp.v index d9a58fbb..775a23db 100644 --- a/x86/NeedOp.v +++ b/x86/NeedOp.v @@ -206,9 +206,9 @@ Proof. unfold needs_of_operation; intros; destruct op; try (eapply default_needs_of_operation_sound; eauto; fail); simpl in *; FuncInv; InvAgree; TrivialExists. - apply sign_ext_sound; auto. compute; auto. -- apply zero_ext_sound; auto. omega. +- apply zero_ext_sound; auto. lia. - apply sign_ext_sound; auto. compute; auto. -- apply zero_ext_sound; auto. omega. +- apply zero_ext_sound; auto. lia. - apply neg_sound; auto. - apply mul_sound; auto. - apply mul_sound; auto with na. @@ -246,10 +246,10 @@ Lemma operation_is_redundant_sound: vagree v arg1' nv. Proof. intros. destruct op; simpl in *; try discriminate; inv H1; FuncInv; subst. -- apply sign_ext_redundant_sound; auto. omega. -- apply zero_ext_redundant_sound; auto. omega. -- apply sign_ext_redundant_sound; auto. omega. -- apply zero_ext_redundant_sound; auto. omega. +- apply sign_ext_redundant_sound; auto. lia. +- apply zero_ext_redundant_sound; auto. lia. +- apply sign_ext_redundant_sound; auto. lia. +- apply zero_ext_redundant_sound; auto. lia. - apply andimm_redundant_sound; auto. - apply orimm_redundant_sound; auto. Qed. diff --git a/x86/SelectOpproof.v b/x86/SelectOpproof.v index af1d4e08..c43beb56 100644 --- a/x86/SelectOpproof.v +++ b/x86/SelectOpproof.v @@ -385,9 +385,9 @@ Proof. - TrivialExists. simpl. rewrite Int.and_commut; auto. - TrivialExists. simpl. rewrite Val.and_assoc. rewrite Int.and_commut. auto. - rewrite Val.zero_ext_and. TrivialExists. rewrite Val.and_assoc. - rewrite Int.and_commut. auto. omega. + rewrite Int.and_commut. auto. lia. - rewrite Val.zero_ext_and. TrivialExists. rewrite Val.and_assoc. - rewrite Int.and_commut. auto. omega. + rewrite Int.and_commut. auto. lia. - TrivialExists. Qed. @@ -747,7 +747,7 @@ Proof. red; intros until x. unfold cast8unsigned. destruct (cast8unsigned_match a); intros; InvEval. TrivialExists. subst. rewrite Val.zero_ext_and. rewrite Val.and_assoc. - rewrite Int.and_commut. apply eval_andimm; auto. omega. + rewrite Int.and_commut. apply eval_andimm; auto. lia. TrivialExists. Qed. @@ -763,7 +763,7 @@ Proof. red; intros until x. unfold cast16unsigned. destruct (cast16unsigned_match a); intros; InvEval. TrivialExists. subst. rewrite Val.zero_ext_and. rewrite Val.and_assoc. - rewrite Int.and_commut. apply eval_andimm; auto. omega. + rewrite Int.and_commut. apply eval_andimm; auto. lia. TrivialExists. Qed. @@ -864,7 +864,7 @@ Proof. simpl. rewrite Heqo; reflexivity. simpl. unfold Int64.loword. rewrite Int64.unsigned_repr, Int.repr_unsigned; auto. assert (Int.modulus < Int64.max_unsigned) by reflexivity. - generalize (Int.unsigned_range n); omega. + generalize (Int.unsigned_range n); lia. Qed. Theorem eval_floatofintu: diff --git a/x86/Stacklayout.v b/x86/Stacklayout.v index 4f68cf26..002b86bf 100644 --- a/x86/Stacklayout.v +++ b/x86/Stacklayout.v @@ -69,16 +69,16 @@ Local Opaque Z.add Z.mul sepconj range. set (ostkdata := align (ol + 4 * b.(bound_local)) 8). set (oretaddr := align (ostkdata + b.(bound_stack_data)) w). replace (size_chunk Mptr) with w by (rewrite size_chunk_Mptr; auto). - assert (0 < w) by (unfold w; destruct Archi.ptr64; omega). + assert (0 < w) by (unfold w; destruct Archi.ptr64; lia). generalize b.(bound_local_pos) b.(bound_outgoing_pos) b.(bound_stack_data_pos); intros. - assert (0 <= fe_ofs_arg) by (unfold fe_ofs_arg; destruct Archi.win64; omega). - assert (0 <= 4 * b.(bound_outgoing)) by omega. - assert (fe_ofs_arg + 4 * b.(bound_outgoing) <= olink) by (apply align_le; omega). - assert (olink + w <= ocs) by (unfold ocs; omega). + assert (0 <= fe_ofs_arg) by (unfold fe_ofs_arg; destruct Archi.win64; lia). + assert (0 <= 4 * b.(bound_outgoing)) by lia. + assert (fe_ofs_arg + 4 * b.(bound_outgoing) <= olink) by (apply align_le; lia). + assert (olink + w <= ocs) by (unfold ocs; lia). assert (ocs <= size_callee_save_area b ocs) by (apply size_callee_save_area_incr). - assert (size_callee_save_area b ocs <= ol) by (apply align_le; omega). - assert (ol + 4 * b.(bound_local) <= ostkdata) by (apply align_le; omega). - assert (ostkdata + bound_stack_data b <= oretaddr) by (apply align_le; omega). + assert (size_callee_save_area b ocs <= ol) by (apply align_le; lia). + assert (ol + 4 * b.(bound_local) <= ostkdata) by (apply align_le; lia). + assert (ostkdata + bound_stack_data b <= oretaddr) by (apply align_le; lia). (* Reorder as: outgoing back link @@ -90,13 +90,13 @@ Local Opaque Z.add Z.mul sepconj range. rewrite sep_swap45. rewrite sep_swap34. (* Apply range_split and range_split2 repeatedly *) - apply range_drop_left with 0. omega. - apply range_split_2. fold olink. omega. omega. - apply range_split. omega. - apply range_split_2. fold ol. omega. omega. - apply range_drop_right with ostkdata. omega. + apply range_drop_left with 0. lia. + apply range_split_2. fold olink. lia. lia. + apply range_split. lia. + apply range_split_2. fold ol. lia. lia. + apply range_drop_right with ostkdata. lia. rewrite sep_swap. - apply range_drop_left with (ostkdata + bound_stack_data b). omega. + apply range_drop_left with (ostkdata + bound_stack_data b). lia. rewrite sep_swap. exact H. Qed. @@ -113,17 +113,17 @@ Proof. set (ol := align (size_callee_save_area b ocs) 8). set (ostkdata := align (ol + 4 * b.(bound_local)) 8). set (oretaddr := align (ostkdata + b.(bound_stack_data)) w). - assert (0 < w) by (unfold w; destruct Archi.ptr64; omega). + assert (0 < w) by (unfold w; destruct Archi.ptr64; lia). generalize b.(bound_local_pos) b.(bound_outgoing_pos) b.(bound_stack_data_pos); intros. - assert (0 <= fe_ofs_arg) by (unfold fe_ofs_arg; destruct Archi.win64; omega). - assert (0 <= 4 * b.(bound_outgoing)) by omega. - assert (fe_ofs_arg + 4 * b.(bound_outgoing) <= olink) by (apply align_le; omega). - assert (olink + w <= ocs) by (unfold ocs; omega). + assert (0 <= fe_ofs_arg) by (unfold fe_ofs_arg; destruct Archi.win64; lia). + assert (0 <= 4 * b.(bound_outgoing)) by lia. + assert (fe_ofs_arg + 4 * b.(bound_outgoing) <= olink) by (apply align_le; lia). + assert (olink + w <= ocs) by (unfold ocs; lia). assert (ocs <= size_callee_save_area b ocs) by (apply size_callee_save_area_incr). - assert (size_callee_save_area b ocs <= ol) by (apply align_le; omega). - assert (ol + 4 * b.(bound_local) <= ostkdata) by (apply align_le; omega). - assert (ostkdata + bound_stack_data b <= oretaddr) by (apply align_le; omega). - split. omega. omega. + assert (size_callee_save_area b ocs <= ol) by (apply align_le; lia). + assert (ol + 4 * b.(bound_local) <= ostkdata) by (apply align_le; lia). + assert (ostkdata + bound_stack_data b <= oretaddr) by (apply align_le; lia). + split. lia. lia. Qed. Lemma frame_env_aligned: @@ -142,11 +142,11 @@ Proof. set (ol := align (size_callee_save_area b ocs) 8). set (ostkdata := align (ol + 4 * b.(bound_local)) 8). set (oretaddr := align (ostkdata + b.(bound_stack_data)) w). - assert (0 < w) by (unfold w; destruct Archi.ptr64; omega). + assert (0 < w) by (unfold w; destruct Archi.ptr64; lia). replace (align_chunk Mptr) with w by (rewrite align_chunk_Mptr; auto). split. exists (fe_ofs_arg / 8). unfold fe_ofs_arg; destruct Archi.win64; reflexivity. - split. apply align_divides; omega. - split. apply align_divides; omega. - split. apply align_divides; omega. - apply align_divides; omega. + split. apply align_divides; lia. + split. apply align_divides; lia. + split. apply align_divides; lia. + apply align_divides; lia. Qed. diff --git a/x86/TargetPrinter.ml b/x86/TargetPrinter.ml index 52955dcb..2000f96a 100644 --- a/x86/TargetPrinter.ml +++ b/x86/TargetPrinter.ml @@ -136,9 +136,9 @@ module ELF_System : SYSTEM = | Section_data(i, true) -> failwith "_Thread_local unsupported on this platform" | Section_data(i, false) | Section_small_data i -> - if i then ".data" else common_section () + variable_section ~sec:".data" ~bss:".bss" i | Section_const i | Section_small_const i -> - if i || (not !Clflags.option_fcommon) then ".section .rodata" else "COMM" + variable_section ~sec:".section .rodata" i | Section_string -> ".section .rodata" | Section_literal -> ".section .rodata.cst8,\"aM\",@progbits,8" | Section_jumptable -> ".text" @@ -233,11 +233,11 @@ module MacOS_System : SYSTEM = | Section_data(i, true) -> failwith "_Thread_local unsupported on this platform" | Section_data(i, false) | Section_small_data i -> - if i || (not !Clflags.option_fcommon) then ".data" else "COMM" + variable_section ~sec:".data" i | Section_const i | Section_small_const i -> - if i || (not !Clflags.option_fcommon) then ".const" else "COMM" + variable_section ~sec:".const" ~reloc:".const_data" i | Section_string -> ".const" - | Section_literal -> ".literal8" + | Section_literal -> ".const" | Section_jumptable -> ".text" | Section_user(s, wr, ex) -> sprintf ".section \"%s\", %s, %s" @@ -297,9 +297,9 @@ module Cygwin_System : SYSTEM = | Section_data(i, true) -> failwith "_Thread_local unsupported on this platform" | Section_data(i, false) | Section_small_data i -> - if i then ".data" else common_section () + variable_section ~sec:".data" ~bss:".bss" i | Section_const i | Section_small_const i -> - if i || (not !Clflags.option_fcommon) then ".section .rdata,\"dr\"" else "COMM" + variable_section ~sec:".section .rdata,\"dr\"" i | Section_string -> ".section .rdata,\"dr\"" | Section_literal -> ".section .rdata,\"dr\"" | Section_jumptable -> ".text" @@ -796,7 +796,7 @@ module Target(System: SYSTEM):TARGET = | Pret -> if (not Archi.ptr64) && (!current_function_sig).sig_cc.cc_structret then begin - fprintf oc " movl 0(%%esp), %%eax\n"; + fprintf oc " movl 4(%%esp), %%eax\n"; fprintf oc " ret $4\n" end else begin fprintf oc " ret\n" @@ -979,8 +979,7 @@ module Target(System: SYSTEM):TARGET = let print_epilogue oc = if !need_masks then begin - section oc (Section_const true); - (* not Section_literal because not 8-bytes *) + section oc Section_literal; print_align oc 16; fprintf oc "%a: .quad 0x8000000000000000, 0\n" raw_symbol "__negd_mask"; @@ -1010,7 +1009,7 @@ end let sel_target () = let module S = (val (match Configuration.system with | "linux" | "bsd" -> (module ELF_System:SYSTEM) - | "macosx" -> (module MacOS_System:SYSTEM) + | "macos" -> (module MacOS_System:SYSTEM) | "cygwin" -> (module Cygwin_System:SYSTEM) | _ -> invalid_arg ("System " ^ Configuration.system ^ " not supported") ):SYSTEM) in (module Target(S):TARGET) diff --git a/x86/extractionMachdep.v b/x86/extractionMachdep.v index 20c6a521..614ec589 100644 --- a/x86/extractionMachdep.v +++ b/x86/extractionMachdep.v @@ -28,6 +28,6 @@ Extract Constant Archi.win64 => Extract Constant SelectOp.symbol_is_external => "match Configuration.system with - | ""macosx"" -> C2C.atom_is_extern + | ""macos"" -> C2C.atom_is_extern | ""cygwin"" when Archi.ptr64 -> C2C.atom_is_extern | _ -> (fun _ -> false)". |