Une MAJ de sécurité est nécessaire sur notre version actuelle. Elle sera effectuée lundi 02/08 entre 12h30 et 13h. L'interruption de service devrait durer quelques minutes (probablement moins de 5 minutes).

Commit 18e98705 by Guillaume Melquiond

### Split truncate_correct.

parent 9540d864
 ... @@ -480,14 +480,13 @@ Definition truncate t := ... @@ -480,14 +480,13 @@ Definition truncate t := (Zdiv m p, (e + k)%Z, new_location p (Zmod m p) l) (Zdiv m p, (e + k)%Z, new_location p (Zmod m p) l) else t. else t. Theorem truncate_correct : Theorem truncate_correct_partial : forall x m e l, forall x m e l, (0 <= x)%R -> (0 < x)%R -> inbetween_float beta m e x l -> inbetween_float beta m e x l -> (e <= fexp (digits beta m + e))%Z \/ l = loc_Exact -> (e <= fexp (digits beta m + e))%Z -> let '(m', e', l') := truncate (m, e, l) in let '(m', e', l') := truncate (m, e, l) in inbetween_float beta m' e' x l' /\ inbetween_float beta m' e' x l' /\ e' = canonic_exponent beta fexp x. (e' = canonic_exponent beta fexp x \/ (l' = loc_Exact /\ format x)). Proof. Proof. intros x m e l Hx H1 H2. intros x m e l Hx H1 H2. unfold truncate. unfold truncate. ... @@ -503,15 +502,13 @@ assert (Hm: (0 <= m)%Z). ... @@ -503,15 +502,13 @@ assert (Hm: (0 <= m)%Z). cut (0 < m + 1)%Z. omega. cut (0 < m + 1)%Z. omega. apply F2R_lt_reg with beta e. apply F2R_lt_reg with beta e. rewrite F2R_0. rewrite F2R_0. apply Rle_lt_trans with (1 := Hx). apply Rlt_trans with (1 := Hx). apply Hx'. apply Hx'. destruct Hx as [Hx|Hx]. (* . 0 < x *) assert (He: (e + k = canonic_exponent beta fexp x)%Z). assert (He: (e + k = canonic_exponent beta fexp x)%Z). (* .. *) (* . *) unfold canonic_exponent. unfold canonic_exponent. destruct (Zle_lt_or_eq _ _ Hm) as [Hm'|Hm']. destruct (Zle_lt_or_eq _ _ Hm) as [Hm'|Hm']. (* ... 0 < m *) (* .. 0 < m *) rewrite ln_beta_F2R_bounds with (1 := Hm') (2 := Hx'). rewrite ln_beta_F2R_bounds with (1 := Hm') (2 := Hx'). assert (H: m <> Z0). assert (H: m <> Z0). apply sym_not_eq. apply sym_not_eq. ... @@ -520,8 +517,7 @@ rewrite ln_beta_F2R with (1 := H). ... @@ -520,8 +517,7 @@ rewrite ln_beta_F2R with (1 := H). rewrite <- digits_ln_beta with (1 := H). rewrite <- digits_ln_beta with (1 := H). unfold k. unfold k. ring. ring. destruct H2 as [H2|H2]. (* .. m = 0 *) (* ... m = 0 and enough digits *) rewrite <- Hm' in H2. rewrite <- Hm' in H2. destruct (ln_beta beta x) as (ex, Hex). destruct (ln_beta beta x) as (ex, Hex). simpl. simpl. ... @@ -542,71 +538,103 @@ rewrite <- Hm' in Hx'. ... @@ -542,71 +538,103 @@ rewrite <- Hm' in Hx'. apply Hx'. apply Hx'. now apply Rlt_le. now apply Rlt_le. exact H2. exact H2. (* ... m = 0 and exact location *) (* . *) rewrite H2 in H1. inversion_clear H1. rewrite <- Hm', F2R_0 in H. rewrite H in Hx. elim Rlt_irrefl with (1 := Hx). (* .. *) generalize (Zlt_cases 0 k). generalize (Zlt_cases 0 k). case (Zlt_bool 0 k) ; intros Hk ; unfold k in Hk. case (Zlt_bool 0 k) ; intros Hk ; unfold k in Hk. (* ... shift *) split. split. now apply inbetween_float_new_location. now apply inbetween_float_new_location. now left. exact He. split. split. exact H1. exact H1. destruct H2 as [H2|H2]. left. rewrite <- He. rewrite <- He. unfold k. unfold k. omega. omega. (* ... no shift *) Qed. Theorem truncate_correct : forall x m e l, (0 <= x)%R -> inbetween_float beta m e x l -> (e <= fexp (digits beta m + e))%Z \/ l = loc_Exact -> let '(m', e', l') := truncate (m, e, l) in inbetween_float beta m' e' x l' /\ (e' = canonic_exponent beta fexp x \/ (l' = loc_Exact /\ format x)). Proof. intros x m e l [Hx|Hx] H1 H2. (* 0 < x *) destruct (Zle_or_lt e (fexp (digits beta m + e))) as [H3|H3]. (* . enough digits *) generalize (truncate_correct_partial x m e l Hx H1 H3). destruct (truncate (m, e, l)) as ((m', e'), l'). intros (H4, H5). split. exact H4. now left. (* . not enough digits but loc_Exact *) destruct H2 as [H2|H2]. elim (Zlt_irrefl e). now apply Zle_lt_trans with (1 := H2). rewrite H2 in H1 |- *. unfold truncate. generalize (Zlt_cases 0 (fexp (digits beta m + e) - e)). case Zlt_bool. intros H. apply False_ind. omega. intros _. split. exact H1. right. right. split. split. exact H2. apply refl_equal. rewrite H2 in H1. inversion_clear H1. inversion_clear H1. rewrite H. rewrite H. apply generic_format_canonic_exponent. apply generic_format_canonic_exponent. rewrite <- H, <- He. unfold canonic_exponent. unfold k. rewrite ln_beta_F2R_digits. omega. now apply Zlt_le_weak. (* . x = 0 *) apply sym_not_eq. destruct H1 as [H1|l' H1 _]. apply Zlt_not_eq. (* .. exact location *) rewrite H in Hx. case (Zlt_bool 0 k). apply F2R_gt_0_reg with (1 := Hx). (* ... shift *) (* x = 0 *) assert (Hm': m = Z0). assert (Hm: m = Z0). apply F2R_eq_0_reg with beta e. cut (m <= 0 < m + 1)%Z. omega. rewrite <- H1. assert (Hx': (F2R (Float beta m e) <= x < F2R (Float beta (m + 1) e))%R). now apply sym_eq. apply inbetween_bounds with (2 := H1). rewrite Hm'. apply F2R_lt_compat. rewrite Zdiv_0_l, Zmod_0_l. apply Zlt_succ. replace (new_location p 0 loc_Exact) with loc_Exact. rewrite <- Hx in Hx'. split. split. constructor. apply F2R_le_0_reg with (1 := proj1 Hx'). rewrite F2R_0. apply F2R_gt_0_reg with (1 := proj2 Hx'). now apply sym_eq. rewrite Hm, <- Hx in H1 |- *. right. clear -H1. repeat split. case H1. rewrite <- Hx. (* . *) apply generic_format_0. intros _. assert (exists e', truncate (Z0, e, loc_Exact) = (Z0, e', loc_Exact)). unfold truncate. case Zlt_bool. rewrite Zdiv_0_l, Zmod_0_l. eexists. apply f_equal. unfold new_location. unfold new_location. case (Zeven p) ; [ unfold new_location_even | unfold new_location_odd ] ; now case Zeven. ( case Zeq_bool_spec ; [ easy | intros H ; now elim H ] ). now eexists. (* ... no shift *) destruct H as (e', H). rewrite H. split. split. now constructor. constructor. apply sym_eq. apply F2R_0. right. right. repeat split. repeat split. rewrite <- Hx. apply generic_format_0. apply generic_format_0. (* .. inexact location *) (* . *) elim Rlt_not_le with (1 := proj1 H1). intros l' (H, _) _. rewrite <- Hx. rewrite F2R_0 in H. now apply F2R_ge_0_compat. elim Rlt_irrefl with (1 := H). Qed. Qed. Section round_dir. Section round_dir. ... ...
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!