Changeset 2468


Ignore:
Timestamp:
Nov 15, 2012, 6:12:57 PM (7 years ago)
Author:
garnier
Message:

Floats are gone from the front-end. Some trace amount might remain in RTL/RTLabs, but this should be easily fixable.
Also, work-in-progress in Clight/memoryInjections.ma

Location:
src
Files:
23 edited

Legend:

Unmodified
Added
Removed
  • src/Clight/Cexec.ma

    r2428 r2468  
    1919    | _ ⇒ Error ? (msg TypeMismatch)
    2020    ]
    21   | Vfloat f ⇒ match ty with
     21(*  | Vfloat f ⇒ match ty with
    2222    [ Tfloat _ ⇒ OK ? (¬Fcmp Ceq f Fzero)
    2323    | _ ⇒ Error ? (msg TypeMismatch)
    24     ]
     24    ]*)
    2525  | Vptr _ ⇒ match ty with
    2626    [ Tpointer _ ⇒ OK ? true
     
    3838  [ * #sg #i #ne %{ true} % // whd in ⊢ (??%?); >(eq_bv_false … ne) //
    3939  | #ptr #ty %{ true} % //
    40   | #f #s #ne %{ true} % //; whd in ⊢ (??%?); >(Feq_zero_false … ne) //;
     40(*  | #f #s #ne %{ true} % //; whd in ⊢ (??%?); >(Feq_zero_false … ne) //; *)
    4141  | * #sg %{ false} % //
    4242  | #t %{ false} % //;
    43   | #s %{ false} % //; whd in ⊢ (??%?); >(Feq_zero_true …) //;
     43(*  | #s %{ false} % //; whd in ⊢ (??%?); >(Feq_zero_true …) //;*)
    4444  ]
    4545qed.
     
    110110      match ty' with
    111111      [ Tint sz2 si2 ⇒ OK ? (Vint ? (cast_int_int sz1 si1 sz2 i))
    112       | Tfloat sz2 ⇒ OK ? (Vfloat (cast_float_float sz2 (cast_int_float si1 ? i)))
     112(*      | Tfloat sz2 ⇒ OK ? (Vfloat (cast_float_float sz2 (cast_int_float si1 ? i)))*)
    113113      | Tpointer _ ⇒ do r ← try_cast_null m ? i ty ty'; OK val r
    114114      | Tarray _ _ ⇒ do r ← try_cast_null m ? i ty ty'; OK val r
     
    122122  | _ ⇒ Error ? (msg TypeMismatch)
    123123  ]
    124 | Vfloat f ⇒
     124(*| Vfloat f ⇒
    125125  match ty with
    126126  [ Tfloat sz ⇒
     
    131131    ]
    132132  | _ ⇒ Error ? (msg TypeMismatch)
    133   ]
     133  ]*)
    134134| Vptr ptr ⇒
    135135(*    do s ← match ty with [ Tpointer s _ ⇒ OK ? s | Tarray s _ _ ⇒ OK ? s | Tfunction _ _ ⇒ OK ? Code | _ ⇒ Error ? (msg TypeMismatch) ];
     
    179179      | _ ⇒ Error ? (msg BadlyTypedTerm)
    180180      ]
    181   | Econst_float f ⇒ OK ? 〈Vfloat f, E0〉
     181(*  | Econst_float f ⇒ OK ? 〈Vfloat f, E0〉 *)
    182182  | Evar _ ⇒
    183183      do 〈l,tr〉 ← exec_lvalue' ge en m e' ty;
  • src/Clight/CexecComplete.ma

    r2428 r2468  
    9090elim H;
    9191[ #m #sz1 #sz2 #sg1 #sg2 #i whd in ⊢ (??%?); >intsize_eq_elim_true @refl
    92 | #m #f #sz #szi #sg @refl
     92(*| #m #f #sz #szi #sg @refl
    9393| #m #sz #sz' #sg #i whd in ⊢ (??%?); >intsize_eq_elim_true @refl
    94 | #m #f #sz #sz' @refl
     94| #m #f #sz #sz' @refl*)
    9595| #m #ty0 #ty0' #ptr #H1 #H2 cases H1 cases H2 //
    9696| #m #sz #sg #ty' #H' cases H' [ #ty'' | #ty'' #n | #tys #ty'' ] whd in ⊢ (??%?);
     
    130130    >(eq_bv_false … ne) //
    131131  | *  #b #i #i0  %{ true} % //
    132   | #f #s #ne %{ true} % //; whd; >(Feq_zero_false … ne) //;
     132(*  | #f #s #ne %{ true} % //; whd; >(Feq_zero_false … ne) //;*)
    133133  | #sz #sg %{ false} % // whd in ⊢ (??%?); >intsize_eq_elim_true >eq_bv_true //
    134134  |  #t %{ false} % //;
    135   | #s %{ false} % //; whd; >(Feq_zero_true …) //;
     135(*  | #s %{ false} % //; whd; >(Feq_zero_true …) //;*)
    136136  ]
    137137qed.
     
    140140#v #ty #H elim H;
    141141  [ #i #is #s #ne whd in ⊢ (??%?); >intsize_eq_elim_true >(eq_bv_false … ne) //;
    142   | #s //
    143   | #f #s #ne whd; >(Feq_zero_false … ne) //;
     142  | #s // 
     143(*  | #f #s #ne whd; >(Feq_zero_false … ne) //;*)
    144144  ]
    145145qed.
     
    149149  [ #sz #sg whd in ⊢ (??%?); >intsize_eq_elim_true >eq_bv_true //;
    150150  | #t //;
    151   | #s whd; >(Feq_zero_true …) //;
     151(*  | #s whd; >(Feq_zero_true …) //;*)
    152152  ]
    153153qed.
     
    161161  (λe,l,off,tr,H. yields ? (exec_lvalue ge env m e) (〈〈l,off〉,tr〉)));
    162162[ #sz #sg #i whd in ⊢ (??%?); >eq_intsize_true @refl
    163 | #f #ty @refl
     163(*| #f #ty @refl*)
    164164| #e #ty #l #off #v #tr #H1 #H2 @(lvalue_expr … H1)
    165165    [ #id | #e' | #e' #id ] #H3
     
    268268  (vo:P Tvoid)
    269269  (it:∀i,s. P (Tint i s))
    270   (fl:∀f. P (Tfloat f))
     270(*  (fl:∀f. P (Tfloat f))*)
    271271  (pt:∀t. P t → P (Tpointer t))
    272272  (ar:∀t,n. P t → P (Tarray t n))
     
    281281  [ Tvoid ⇒ vo
    282282  | Tint i s ⇒ it i s
    283   | Tfloat s ⇒ fl s
    284   | Tpointer t' ⇒ pt t' (type_ind2l P Q vo it fl pt ar fn st un cp nl cs t')
    285   | Tarray t' n ⇒ ar t' n (type_ind2l P Q vo it fl pt ar fn st un cp nl cs t')
    286   | Tfunction tl t' ⇒ fn tl t' (typelist_ind2l P Q vo it fl pt ar fn st un cp nl cs tl) (type_ind2l P Q vo it fl pt ar fn st un cp nl cs t')
     283(*  | Tfloat s ⇒ fl s*)
     284  | Tpointer t' ⇒ pt t' (type_ind2l P Q vo it pt ar fn st un cp nl cs t')
     285  | Tarray t' n ⇒ ar t' n (type_ind2l P Q vo it pt ar fn st un cp nl cs t')
     286  | Tfunction tl t' ⇒ fn tl t' (typelist_ind2l P Q vo it pt ar fn st un cp nl cs tl) (type_ind2l P Q vo it pt ar fn st un cp nl cs t')
    287287  | Tstruct i fs ⇒ st i fs
    288288  | Tunion i fs ⇒ un i fs
     
    293293  (vo:P Tvoid)
    294294  (it:∀i,s. P (Tint i s))
    295   (fl:∀f. P (Tfloat f))
     295(*  (fl:∀f. P (Tfloat f))*)
    296296  (pt:∀t. P t → P (Tpointer t))
    297297  (ar:∀t,n. P t → P (Tarray t n))
     
    305305  match ts return λts'.Q ts' with
    306306  [ Tnil ⇒ nl
    307   | Tcons t tl ⇒ cs t tl (type_ind2l P Q vo it fl pt ar fn st un cp nl cs t)
    308                      (typelist_ind2l P Q vo it fl pt ar fn st un cp nl cs tl)
     307  | Tcons t tl ⇒ cs t tl (type_ind2l P Q vo it pt ar fn st un cp nl cs t)
     308                     (typelist_ind2l P Q vo it pt ar fn st un cp nl cs tl)
    309309  ].
    310310
     
    340340lemma eventval_match_complete': ∀ev,ty,v.
    341341  eventval_match ev ty v → yields ? (check_eventval' v ty) ev.
    342 #ev #ty #v #H elim H; // #sz #sg #i whd in ⊢ (??%?); >eq_intsize_true @refl qed.
     342#ev #ty #v #H elim H #sz #sg #i whd in ⊢ (??%?); >eq_intsize_true @refl qed.
    343343
    344344lemma eventval_list_match_complete: ∀vs,tys,evs.
     
    446446    #H1 #H2
    447447    >(yields_eq ??? (eventval_list_match_complete … H1)) whd in ⊢ (??%?);
    448     whd; inversion H2; [ #sz #sg #x | #x #sz ] #e5 #e6 #e7 #e8 %{ x} whd in ⊢ (??%?);
     448    whd; inversion H2; #sz #sg #x (*| #x #sz ]*) #e5 #e6 #e7 #e8 %{ x} whd in ⊢ (??%?);
    449449    @refl
    450450| #v #f #env #k #m @refl
  • src/Clight/CexecInd.ma

    r2019 r2468  
    1515  (Q:expr_descr → type → Prop)
    1616  (ci:∀sz,ty,i.P (Expr (Econst_int sz i) ty))
    17   (cf:∀ty,f.P (Expr (Econst_float f) ty))
     17(*  (cf:∀ty,f.P (Expr (Econst_float f) ty))*)
    1818  (lv:∀e,ty. Q e ty → Plvalue P e ty)
    1919  (vr:∀v,ty.Q (Evar v) ty)
     
    3535  match e' with
    3636  [ Econst_int sz i ⇒ ci sz ty i
    37   | Econst_float f ⇒ cf ty f
     37(*  | Econst_float f ⇒ cf ty f*)
    3838  | Evar v ⇒ lv (Evar v) ty (vr v ty)
    39   | Ederef e'' ⇒ lv (Ederef e'') ty (dr e'' ty (expr_lvalue_ind P Q ci cf lv vr dr ao uo bo ca cd ab ob sz fl co xx e''))
    40   | Eaddrof e'' ⇒ match e'' with [ Expr e0 ty0 ⇒ ao ty e0 ty0 (lvalue_expr_ind P Q ci cf lv vr dr ao uo bo ca cd ab ob sz fl co xx e0 ty0) ]
    41   | Eunop op e'' ⇒ uo ty op e'' (expr_lvalue_ind P Q ci cf lv vr dr ao uo bo ca cd ab ob sz fl co xx e'')
    42   | Ebinop op e1 e2 ⇒ bo ty op e1 e2 (expr_lvalue_ind P Q ci cf lv vr dr ao uo bo ca cd ab ob sz fl co xx e1) (expr_lvalue_ind P Q ci cf lv vr dr ao uo bo ca cd ab ob sz fl co xx e2)
    43   | Ecast ty' e'' ⇒ ca ty ty' e'' (expr_lvalue_ind P Q ci cf lv vr dr ao uo bo ca cd ab ob sz fl co xx e'')
    44   | Econdition e1 e2 e3 ⇒ cd ty e1 e2 e3 (expr_lvalue_ind P Q ci cf lv vr dr ao uo bo ca cd ab ob sz fl co xx e1) (expr_lvalue_ind P Q ci cf lv vr dr ao uo bo ca cd ab ob sz fl co xx e2) (expr_lvalue_ind P Q ci cf lv vr dr ao uo bo ca cd ab ob sz fl co xx e3)
    45   | Eandbool e1 e2 ⇒ ab ty e1 e2 (expr_lvalue_ind P Q ci cf lv vr dr ao uo bo ca cd ab ob sz fl co xx e1) (expr_lvalue_ind P Q ci cf lv vr dr ao uo bo ca cd ab ob sz fl co xx e2)
    46   | Eorbool e1 e2 ⇒ ob ty e1 e2 (expr_lvalue_ind P Q ci cf lv vr dr ao uo bo ca cd ab ob sz fl co xx e1) (expr_lvalue_ind P Q ci cf lv vr dr ao uo bo ca cd ab ob sz fl co xx e2)
     39  | Ederef e'' ⇒ lv (Ederef e'') ty (dr e'' ty (expr_lvalue_ind P Q ci lv vr dr ao uo bo ca cd ab ob sz fl co xx e''))
     40  | Eaddrof e'' ⇒ match e'' with [ Expr e0 ty0 ⇒ ao ty e0 ty0 (lvalue_expr_ind P Q ci lv vr dr ao uo bo ca cd ab ob sz fl co xx e0 ty0) ]
     41  | Eunop op e'' ⇒ uo ty op e'' (expr_lvalue_ind P Q ci lv vr dr ao uo bo ca cd ab ob sz fl co xx e'')
     42  | Ebinop op e1 e2 ⇒ bo ty op e1 e2 (expr_lvalue_ind P Q ci lv vr dr ao uo bo ca cd ab ob sz fl co xx e1) (expr_lvalue_ind P Q ci lv vr dr ao uo bo ca cd ab ob sz fl co xx e2)
     43  | Ecast ty' e'' ⇒ ca ty ty' e'' (expr_lvalue_ind P Q ci lv vr dr ao uo bo ca cd ab ob sz fl co xx e'')
     44  | Econdition e1 e2 e3 ⇒ cd ty e1 e2 e3 (expr_lvalue_ind P Q ci lv vr dr ao uo bo ca cd ab ob sz fl co xx e1) (expr_lvalue_ind P Q ci lv vr dr ao uo bo ca cd ab ob sz fl co xx e2) (expr_lvalue_ind P Q ci lv vr dr ao uo bo ca cd ab ob sz fl co xx e3)
     45  | Eandbool e1 e2 ⇒ ab ty e1 e2 (expr_lvalue_ind P Q ci lv vr dr ao uo bo ca cd ab ob sz fl co xx e1) (expr_lvalue_ind P Q ci lv vr dr ao uo bo ca cd ab ob sz fl co xx e2)
     46  | Eorbool e1 e2 ⇒ ob ty e1 e2 (expr_lvalue_ind P Q ci lv vr dr ao uo bo ca cd ab ob sz fl co xx e1) (expr_lvalue_ind P Q ci lv vr dr ao uo bo ca cd ab ob sz fl co xx e2)
    4747  | Esizeof ty' ⇒ sz ty ty'
    48   | Efield e'' i ⇒ match e'' with [ Expr ef tyf ⇒ lv (Efield (Expr ef tyf) i) ty (fl ty ef tyf i (lvalue_expr_ind P Q ci cf lv vr dr ao uo bo ca cd ab ob sz fl co xx ef tyf)) ]
    49   | Ecost l e'' ⇒ co ty l e'' (expr_lvalue_ind P Q ci cf lv vr dr ao uo bo ca cd ab ob sz fl co xx e'')
     48  | Efield e'' i ⇒ match e'' with [ Expr ef tyf ⇒ lv (Efield (Expr ef tyf) i) ty (fl ty ef tyf i (lvalue_expr_ind P Q ci lv vr dr ao uo bo ca cd ab ob sz fl co xx ef tyf)) ]
     49  | Ecost l e'' ⇒ co ty l e'' (expr_lvalue_ind P Q ci lv vr dr ao uo bo ca cd ab ob sz fl co xx e'')
    5050  ]
    5151]
     
    5454  (Q:expr_descr → type → Prop)
    5555  (ci:∀sz,ty,i.P (Expr (Econst_int sz i) ty))
    56   (cf:∀ty,f.P (Expr (Econst_float f) ty))
     56(*  (cf:∀ty,f.P (Expr (Econst_float f) ty))*)
    5757  (lv:∀e,ty. Q e ty → Plvalue P e ty)
    5858  (vr:∀v,ty.Q (Evar v) ty)
     
    7272  match e return λe0. Q e0 ty with
    7373  [ Evar v ⇒ vr v ty
    74   | Ederef e'' ⇒ dr e'' ty (expr_lvalue_ind P Q ci cf lv vr dr ao uo bo ca cd ab ob sz fl co xx e'')
    75   | Efield e' i ⇒ match e' return λe1.Q (Efield e1 i) ty with [ Expr e'' ty'' ⇒ fl ty e'' ty'' i (lvalue_expr_ind P Q ci cf lv vr dr ao uo bo ca cd ab ob sz fl co xx e'' ty'') ]
     74  | Ederef e'' ⇒ dr e'' ty (expr_lvalue_ind P Q ci lv vr dr ao uo bo ca cd ab ob sz fl co xx e'')
     75  | Efield e' i ⇒ match e' return λe1.Q (Efield e1 i) ty with [ Expr e'' ty'' ⇒ fl ty e'' ty'' i (lvalue_expr_ind P Q ci lv vr dr ao uo bo ca cd ab ob sz fl co xx e'' ty'') ]
    7676  | _ ⇒ xx ? ty ?
    7777  ]. whd; @I qed.
    7878
    7979definition expr_lvalue_ind_combined ≝
    80 λP,Q,ci,cf,lv,vr,dr,ao,uo,bo,ca,cd,ab,ob,sz,fl,co,xx.
     80λP,Q,ci,lv,vr,dr,ao,uo,bo,ca,cd,ab,ob,sz,fl,co,xx.
    8181conj ??
    82  (expr_lvalue_ind P Q ci cf lv vr dr ao uo bo ca cd ab ob sz fl co xx)
    83  (lvalue_expr_ind P Q ci cf lv vr dr ao uo bo ca cd ab ob sz fl co xx).
     82 (expr_lvalue_ind P Q ci lv vr dr ao uo bo ca cd ab ob sz fl co xx)
     83 (lvalue_expr_ind P Q ci lv vr dr ao uo bo ca cd ab ob sz fl co xx).
  • src/Clight/CexecSound.ma

    r2428 r2468  
    55 exec_bool_of_val v ty = OK ? r → bool_of_val v ty (of_bool r).
    66#v #ty #r
    7 cases v; [ | #sz #i | #f |  | #ptr ]
    8 cases ty; [ 2,11,20,29,38: #sz' #sg | 3,12,21,30,39: #sz' | 4,13,22,31,40: (*#rg*) #ty | 5,14,23,32,41: (*#r*) #ty #n | 6,15,24,33,42: #args #rty | 7,8,16,17,25,26,34,35,43,44: #id #fs | 9,18,27,36,45: (*#r*) #id ]
     7cases v; [ | #sz #i (*| #f*) |  | #ptr ]
     8cases ty; [ 2,10,18,26: #sz' #sg | 3,11,19,27: #ty' | 4,12,20,28: (*#r*) #ty #n
     9           | 5,13,21,29: #args #rty | 6,7,14,15,22,23,30,31: #id #fs | 8,16,24,32: (*#r*) #id ]
    910whd in ⊢ (??%? → ?);
    1011[ 2: @intsize_eq_elim_elim
     
    1516    ]
    1617  ]
    17 | 8: #H cases (eq_dec f Fzero)
     18(*| 8: #H cases (eq_dec f Fzero)
    1819  [ #e >e in H ⊢ %; >Feq_zero_true #E destruct @bool_of_val_false @is_false_float
    1920  | #ne >Feq_zero_false in H; // #E destruct @bool_of_val_true @is_true_float @ne
    20   ]
    21 | 14: #H destruct @bool_of_val_false @is_false_pointer
    22 | 15: #H destruct @bool_of_val_true @is_true_pointer_pointer
     21  ]*)
     22| 7: #H destruct @bool_of_val_false @is_false_pointer
     23| 8: #H destruct @bool_of_val_true @is_true_pointer_pointer
    2324| *: #H destruct
    2425] qed.
     
    3940@eq_bv_elim
    4041[ #e >e
    41     cases ty; [ | #sz' #sg | #fs | (*#sp*) #ty | (*#sp*) #ty #n | #args #rty | #id #fs | #id #fs | (*#r*) #id ]
     42    cases ty; [ | #sz' #sg (* | #fs *) | (*#sp*) #ty | (*#sp*) #ty #n | #args #rty | #id #fs | #id #fs | (*#r*) #id ]
    4243    whd in ⊢ (??%? → ?); #H [ 2: | *: destruct ]
    43     cases ty' in H ⊢ %; [ | #sz'' #sg | #fs | (*#sp*) #ty | (*#sp*) #ty #n | #args #rty | #id #fs | #id #fs | (*#r*) #id ]
     44    cases ty' in H ⊢ %; [ | #sz'' #sg (* | #fs*) | (*#sp*) #ty | (*#sp*) #ty #n | #args #rty | #id #fs | #id #fs | (*#r*) #id ]
    4445    try (@eq_intsize_elim #E) whd in ⊢ (??%? → ?); #H destruct @cast_ip_z //
    4546| #_ whd in ⊢ (??%? → ?); #H destruct
    4647]
    47 qed. 
     48qed.
    4849
    4950lemma exec_cast_sound : ∀m:mem. ∀v:val. ∀ty:type. ∀ty':type. ∀v':val. exec_cast m v ty ty' = OK ? v' → cast m v ty ty' v'.
     
    5354| #sz #i cases ty;
    5455  [ #H whd in H:(??%?); destruct;
    55   | 3: #a #H whd in H:(??%?); destruct;
    56   | 7,8,9: #a [ 1,2: #b ] #H whd in H:(??%?); destruct;
     56(* | 3: #a #H whd in H:(??%?); destruct; *)
     57  | 6,7,8: #a [ 1,2: #b ] #H whd in H:(??%?); destruct;
    5758  | #sz1 #si1 cases ty';
    5859    [ whd in ⊢ (??%? → ?); @intsize_eq_elim_elim
     
    6061      | *; whd #H whd in H:(??%?); destruct;
    6162      ]
    62     | 3: #a whd in ⊢ (??%? → ?); @intsize_eq_elim_elim
     63     (* | 3: #a whd in ⊢ (??%? → ?); @intsize_eq_elim_elim
    6364      [ #E #H whd in H:(??%?); destruct
    6465      | *; whd #H whd in H:(??%?); destruct; @cast_if
    65       ]
    66     | 2,7,8,9: #a [1,2,3: #b] whd in ⊢ (??%? → ?); @intsize_eq_elim_elim
     66      ] *)
     67    | 2,6,7,8: #a [1,2,3: #b] whd in ⊢ (??%? → ?); @intsize_eq_elim_elim
    6768      [ 1,3,5,7: #NE #H destruct
    6869      | *: *; whd #H whd in H:(??%?); destruct; //
    6970      ]
    70     | 4,5,6: [ #ty'' letin t ≝ (Tpointer ty'')
     71    | 3,4,5: [ #ty'' letin t ≝ (Tpointer ty'')
    7172             | #ty'' #n letin t ≝ (Tarray ty'' n)
    7273             | #args #rty letin t ≝ (Tfunction args rty) ]
     
    9192        ]
    9293  ]
    93 | #f cases ty;  [ 3,4,9: #x | 2,5,6,7,8: #x #y ]
     94(*| #f cases ty;  [ 3,4,9: #x | 2,5,6,7,8: #x #y ]
    9495                    [ cases ty'; [ #e | 3,4,9: #a #e | 2,6,7,8: #a #b #e | #a #b #e ]
    9596                        whd in e:(??%?); destruct; //;
    9697                    | *: #e whd in e:(??%?); destruct
    97                     ]
    98 | cases ty; [ 3,4,9: #x | 2,5,6,7,8: #x #y ]
     98                    ] *)
     99| cases ty; [ 3,8: #x | 2,4,5,6,7: #x #y ]
    99100    whd in ⊢ (??%? → ?); #H destruct
    100101    cases ty' in H; normalize; try #a try #b try #c try #d destruct;
     
    121122*)
    122123| #ptr
    123   cases ty; [ 3,4,9: #x | 2,5,6,7,8: #x #y ]
     124  cases ty;  [ 3,8: #x | 2,4,5,6,7: #x #y ]
    124125  #E whd in E:(??%?); destruct
    125126  cases ty' in E ⊢ %; normalize #A try #B try #C try #D destruct /2/
    126127] qed.
     128
     129
    127130
    128131
     
    132135[ #sz #ty #c whd in ⊢ (???%); cases ty try #sz' try #sg try #x try @I whd in ⊢ (???%);
    133136  @eq_intsize_elim #E try @I <E whd %
    134 | #ty #c whd //
     137(*| #ty #c whd //*)
    135138(* expressions that are lvalues *)
    136139| #e' #ty cases e'; //; [ #i #He' | #e #He' | #e #i #He' ] whd in He' ⊢ %;
     
    210213(* exec_lvalue fails on non-lvalues. *)
    211214| #e' #ty cases e';
    212     [ 2,5,12: #a #H | 3,4: #a * | 13,14: #a #b * | 1,6,8,10,11: #a #b #H | 7,9: #a #b #c #H ]
    213     @I
     215    [ 2,4,11: #a #H try @I @(False_ind … H) | 3: #a * | 12,13: #a #b * | 1,5,7,9,10: #a #b #H @I | 6,8: #a #b #c #H @I ]
     216    try @I
    214217] qed.
    215218
     
    218221eval_lvalue ge en m e loc off tr.
    219222#ge #en #m #e #loc #off #tr #ty #H inversion H;
    220 [ 1,2,5: #a #b #c #H @False_ind destruct (H);
     223[ 1,4: #a #b #c #H @False_ind destruct (H);
    221224| #a #b #c #d #e #f #H1 #g #H2 #E1 #E2 #E3 <H2 in H1; #H1 @False_ind
    222225    @(eval_lvalue_inv_ind … H1)
     
    318321  [ //
    319322  | #ty #tys whd in ⊢ (???%);
    320     cases ty [ #sz #sg | | #sz ] cases v //
    321     [ #sz' #v @bind_OK #ev whd in ⊢ (??%? → ?);
    322       @eq_intsize_elim #E #CHECKev whd in CHECKev:(??%?); destruct
    323     | #v ] @bind_OK #evs #CHECKevs
     323    cases ty [ #sz #sg | ] cases v //
     324    #sz' #v @bind_OK #ev whd in ⊢ (??%? → ?);
     325    @eq_intsize_elim #E #CHECKev whd in CHECKev:(??%?); destruct
     326    @bind_OK #evs #CHECKevs
    324327      @(evl_match_cons ??????? (P_res_to_P ???? (IH ?) CHECKevs))
    325328      //
  • src/Clight/ClassifyOp.ma

    r2176 r2468  
    2020     necessary casts *)
    2121  | add_case_ii: ∀sz,sg.      classify_add_cases (Tint sz sg)     (Tint sz sg)     (*Tint sz sg*)
    22   | add_case_ff: ∀sz.         classify_add_cases (Tfloat sz)      (Tfloat sz)      (*Tfloat sz*)
    2322  | add_case_pi: ∀n,ty,sz,sg. classify_add_cases (ptr_type  ty n) (Tint sz sg)     (*ptr_type r ty n*)
    2423  | add_case_ip: ∀n,sz,sg,ty. classify_add_cases (Tint sz sg)     (ptr_type  ty n) (*ptr_type r ty n*)
     
    3332    | Tarray ty n ⇒ add_case_ip (Some ? n) …
    3433    | _ ⇒ add_default … ]
    35   | Tfloat sz1 ⇒ match ty2 return λty2. classify_add_cases ? ty2 with [ Tfloat sz2 ⇒ floatsize_eq_elim sz1 sz2 (λsz1,sz2. classify_add_cases (Tfloat sz1) (Tfloat sz2)) (add_case_ff sz1) (add_default …) | _ ⇒ add_default … ]
    3634  | Tpointer ty ⇒ match ty2 return λty2. classify_add_cases ? ty2 with [Tint _ _ ⇒ add_case_pi (None ?) … | _ ⇒ add_default … ]
    3735  | Tarray ty n ⇒ match ty2 return λty2. classify_add_cases ? ty2 with [Tint _ _ ⇒ add_case_pi (Some ? n) … | _ ⇒ add_default … ]
     
    4139inductive classify_sub_cases : type → type → Type[0] ≝
    4240  | sub_case_ii: ∀sz,sg.         classify_sub_cases (Tint sz sg)       (Tint sz sg)
    43   | sub_case_ff: ∀sz.            classify_sub_cases (Tfloat sz)        (Tfloat sz)
    4441  | sub_case_pi: ∀n,ty,sz,sg.    classify_sub_cases (ptr_type  ty n)   (Tint sz sg)
    4542  | sub_case_pp: ∀n1,n2,ty1,ty2. classify_sub_cases (ptr_type  ty1 n1) (ptr_type  ty2 n2)
     
    4946  match ty1 return λty1. classify_sub_cases ty1 ty2 with
    5047  [ Tint sz1 sg1 ⇒ if_type_eq (Tint sz1 sg1) ty2 (λty1, ty2. classify_sub_cases ty1 ty2) (sub_case_ii sz1 sg1) (sub_default …)
    51   | Tfloat sz1 ⇒ if_type_eq (Tfloat sz1) ty2 (λty1,ty2. classify_sub_cases ty1 ty2) (sub_case_ff sz1) (sub_default …)
    5248  | Tpointer ty ⇒
    5349    match ty2 return λty2. classify_sub_cases ? ty2 with
     
    7268inductive classify_aop_cases : type → type → Type[0] ≝
    7369  | aop_case_ii: ∀sz,sg. classify_aop_cases (Tint sz sg) (Tint sz sg)
    74   | aop_case_ff: ∀sz.    classify_aop_cases (Tfloat sz)  (Tfloat sz)
    7570  | aop_default: ∀ty,ty'.classify_aop_cases ty ty'.
    7671
     
    7873  match ty1 return λty1. classify_aop_cases ty1 ty2 with
    7974  [ Tint sz1 sg1 ⇒ if_type_eq (Tint sz1 sg1) ty2 (λty1, ty2. classify_aop_cases ty1 ty2) (aop_case_ii sz1 sg1) (aop_default …)
    80   | Tfloat sz1 ⇒ if_type_eq (Tfloat sz1) ty2 (λty1,ty2. classify_aop_cases ty1 ty2) (aop_case_ff sz1) (aop_default …)
    8175  | _ ⇒ aop_default …
    8276  ].
     
    8579  | cmp_case_ii: ∀sz,sg.  classify_cmp_cases (Tint sz sg)      (Tint sz sg)
    8680  | cmp_case_pp: ∀n,ty.   classify_cmp_cases (ptr_type  ty n)  (ptr_type  ty n)
    87   | cmp_case_ff: ∀sz.     classify_cmp_cases (Tfloat sz)       (Tfloat sz)
    8881  | cmp_default: ∀ty,ty'. classify_cmp_cases ty ty'.
    8982
     
    9184  match ty1 return λty1. classify_cmp_cases ty1 ty2 with
    9285  [ Tint sz1 sg1 ⇒ if_type_eq (Tint sz1 sg1) ty2 (λty1, ty2. classify_cmp_cases ty1 ty2) (cmp_case_ii sz1 sg1) (cmp_default …)
    93   | Tfloat sz1 ⇒ if_type_eq (Tfloat sz1) ty2 (λty1,ty2. classify_cmp_cases ty1 ty2) (cmp_case_ff sz1) (cmp_default …)
    9486  | Tpointer  ty1' ⇒ if_type_eq (Tpointer  ty1') ty2 (λty1,ty2. classify_cmp_cases ty1 ty2) (cmp_case_pp (None ?) …) (cmp_default …)
    9587  | Tarray  ty1' n1 ⇒ if_type_eq (Tarray  ty1' n1) ty2 (λty1,ty2. classify_cmp_cases ty1 ty2) (cmp_case_pp (Some ? n1) …) (cmp_default …)
  • src/Clight/Csem.ma

    r2433 r2468  
    4040      is_false (Vint sz (zero ?)) (Tint sz sg)
    4141  | is_false_pointer: ∀t.
    42       is_false Vnull (Tpointer t)
    43  | is_false_float: ∀sz.
    44       is_false (Vfloat Fzero) (Tfloat sz).
     42      is_false Vnull (Tpointer t).
    4543
    4644inductive is_true: val → type → Prop ≝
     
    4947      is_true (Vint sz n) (Tint sz sg)
    5048  | is_true_pointer_pointer: ∀ptr,t.
    51       is_true (Vptr ptr) (Tpointer t)
    52   | is_true_float: ∀f,sz.
    53       f ≠ Fzero →
    54       is_true (Vfloat f) (Tfloat sz).
     49      is_true (Vptr ptr) (Tpointer t).
    5550
    5651inductive bool_of_val : val → type → val → Prop ≝
     
    7772                     then Some ? (Vint ? (two_complement_negation ? n))
    7873                     else None ?
    79       | _ ⇒ None ?
    80       ]
    81   | Tfloat _ ⇒
    82       match v with
    83       [ Vfloat f ⇒ Some ? (Vfloat (Fneg f))
    8474      | _ ⇒ None ?
    8575      ]
     
    10898      | _ ⇒ None ?
    10999      ]
    110   | Tfloat _ ⇒
    111       match v with
    112       [ Vfloat f ⇒ Some ? (of_bool (Fcmp Ceq f Fzero))
    113       | _ ⇒ None ?
    114       ]
    115100  | _ ⇒ None ?
    116101  ].
     
    123108        [ Vint sz2 n2 ⇒ intsize_eq_elim ? sz1 sz2 ? n1
    124109                        (λn1. Some ? (Vint ? (addition_n ? n1 n2))) (None ?)
    125         | _ ⇒ None ? ]
    126       | _ ⇒ None ? ]
    127   | add_case_ff _ ⇒                       (**r float addition *)
    128       match v1 with
    129       [ Vfloat n1 ⇒ match v2 with
    130         [ Vfloat n2 ⇒ Some ? (Vfloat (Fadd n1 n2))
    131110        | _ ⇒ None ? ]
    132111      | _ ⇒ None ? ]
     
    157136        [ Vint sz2 n2 ⇒ intsize_eq_elim ? sz1 sz2 ? n1
    158137                        (λn1.Some ? (Vint sz2 (subtraction ? n1 n2))) (None ?)
    159         | _ ⇒ None ? ]
    160       | _ ⇒ None ? ]
    161   | sub_case_ff _ ⇒                (**r float subtraction *)
    162       match v1 with
    163       [ Vfloat f1 ⇒ match v2 with
    164         [ Vfloat f2 ⇒ Some ? (Vfloat (Fsub f1 f2))
    165138        | _ ⇒ None ? ]
    166139      | _ ⇒ None ? ]
     
    200173        | _ ⇒ None ? ]
    201174      | _ ⇒ None ? ]
    202   | aop_case_ff _ ⇒
    203       match v1 with
    204       [ Vfloat f1 ⇒ match v2 with
    205         [ Vfloat f2 ⇒ Some ? (Vfloat (Fmul f1 f2))
    206         | _ ⇒ None ? ]
    207       | _ ⇒ None ? ]
    208175  | aop_default _ _ ⇒
    209176      None ?
     
    223190           ]
    224191         | _ ⇒ None ? ]
    225       | _ ⇒ None ? ]
    226   | aop_case_ff _ ⇒
    227       match v1 with
    228       [ Vfloat f1 ⇒ match v2 with
    229         [ Vfloat f2 ⇒ Some ? (Vfloat(Fdiv f1 f2))
    230         | _ ⇒ None ? ]
    231192      | _ ⇒ None ? ]
    232193  | aop_default _ _ ⇒
     
    363324        ]
    364325      | _ ⇒ None ? ]
    365   | cmp_case_ff _ ⇒
    366       match v1 with
    367       [ Vfloat f1 ⇒
    368         match v2 with
    369         [ Vfloat f2 ⇒ Some ? (of_bool (Fcmp c f1 f2))
    370         | _ ⇒ None ? ]
    371       | _ ⇒ None ? ]
    372326  | cmp_default _ _ ⇒ None ?
    373327  ].
     
    412366  match sg with [ Signed ⇒ sign_ext ?? i | Unsigned ⇒ zero_ext ?? i ].
    413367
    414 let rec cast_int_float (si : signedness) (n:nat) (i: BitVector n) : float ≝
    415   match si with
    416   [ Signed ⇒ floatofint ? i
    417   | Unsigned ⇒ floatofintu ? i
    418   ].
    419 
    420 let rec cast_float_int (sz : intsize) (si : signedness) (f: float) : BitVector (bitsize_of_intsize sz) ≝
    421   match si with
    422   [ Signed ⇒ intoffloat ? f
    423   | Unsigned ⇒ intuoffloat ? f
    424   ].
    425 
    426 let rec cast_float_float (sz: floatsize) (f: float) : float ≝
    427   match sz with
    428   [ F32 ⇒ singleoffloat f
    429   | F64 ⇒ f
    430   ].
    431 
    432368(* Only for full 8051 memory spaces
    433369inductive type_region : type → region → Prop ≝
     
    447383      cast m (Vint sz1 i) (Tint sz1 si1) (Tint sz2 si2)
    448384           (Vint sz2 (cast_int_int sz1 si1 sz2 i))
    449   | cast_fi:   ∀m,f,sz1,sz2,si2.                (**r float to int *)
    450       cast m (Vfloat f) (Tfloat sz1) (Tint sz2 si2)
    451            (Vint sz2 (cast_float_int sz2 si2 f))
    452   | cast_if:   ∀m,sz1,sz2,si1,i.                (**r int to float  *)
    453       cast m (Vint sz1 i) (Tint sz1 si1) (Tfloat sz2)
    454           (Vfloat (cast_float_float sz2 (cast_int_float si1 ? i)))
    455   | cast_ff:   ∀m,f,sz1,sz2.                    (**r float to float *)
    456       cast m (Vfloat f) (Tfloat sz1) (Tfloat sz2)
    457            (Vfloat (cast_float_float sz2 f))
    458385  | cast_pp: ∀m,ty,ty',ptr.
    459386(*      type_region ty (ptype ptr) →
     
    607534  | eval_Econst_int:   ∀sz,sg,i.
    608535      eval_expr ge e m (Expr (Econst_int sz i) (Tint sz sg)) (Vint sz i) E0
     536(*
    609537  | eval_Econst_float:   ∀f,ty.
    610       eval_expr ge e m (Expr (Econst_float f) ty) (Vfloat f) E0
     538      eval_expr ge e m (Expr (Econst_float f) ty) (Vfloat f) E0 *)
    611539  | eval_Elvalue: ∀a,ty,loc,ofs,v,tr.
    612540      eval_lvalue ge e m (Expr a ty) loc ofs tr →
     
    698626  (P:∀a,v,tr. eval_expr ge e m a v tr → Prop)
    699627  (eci:∀sz,sg,i. P ??? (eval_Econst_int ge e m sz sg i))
    700   (ecF:∀f,ty. P ??? (eval_Econst_float ge e m f ty))
     628(*  (ecF:∀f,ty. P ??? (eval_Econst_float ge e m f ty)) *)
    701629  (elv:∀a,ty,loc,ofs,v,tr,H1,H2. P ??? (eval_Elvalue ge e m a ty loc ofs v tr H1 H2))
    702630  (ead:∀a,ty,loc,ofs,tr,H. P ??? (eval_Eaddrof ge e m a ty loc ofs tr H))
     
    715643  match ev with
    716644  [ eval_Econst_int sz sg i ⇒ eci sz sg i
    717   | eval_Econst_float f ty ⇒ ecF f ty
     645(*  | eval_Econst_float f ty ⇒ ecF f ty *)
    718646  | eval_Elvalue a ty loc ofs v tr H1 H2 ⇒ elv a ty loc ofs v tr H1 H2
    719647  | eval_Eaddrof a ty loc ofs tr H ⇒ ead a ty loc ofs tr H
    720648  | eval_Esizeof ty' sz sg ⇒ esz ty' sz sg
    721   | eval_Eunop op a ty v1 v tr H1 H2 ⇒ eun op a ty v1 v tr H1 H2 (eval_expr_ind ge e m P eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a v1 tr H1)
    722   | eval_Ebinop op a1 a2 ty v1 v2 v tr1 tr2 H1 H2 H3 ⇒ ebi op a1 a2 ty v1 v2 v tr1 tr2 H1 H2 H3 (eval_expr_ind ge e m P eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a1 v1 tr1 H1) (eval_expr_ind ge e m P eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a2 v2 tr2 H2)
    723   | eval_Econdition_true a1 a2 a3 ty v1 v2 tr1 tr2 H1 H2 H3 ⇒ ect a1 a2 a3 ty v1 v2 tr1 tr2 H1 H2 H3 (eval_expr_ind ge e m P eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a1 v1 tr1 H1) (eval_expr_ind ge e m P eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a2 v2 tr2 H3)
    724   | eval_Econdition_false a1 a2 a3 ty v1 v3 tr1 tr2 H1 H2 H3 ⇒ ecf a1 a2 a3 ty v1 v3 tr1 tr2 H1 H2 H3 (eval_expr_ind ge e m P eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a1 v1 tr1 H1) (eval_expr_ind ge e m P eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a3 v3 tr2 H3)
    725   | eval_Eorbool_1 a1 a2 ty v1 tr H1 H2 ⇒ eo1 a1 a2 ty v1 tr H1 H2 (eval_expr_ind ge e m P eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a1 v1 tr H1)
    726   | eval_Eorbool_2 a1 a2 ty v1 v2 v tr1 tr2 H1 H2 H3 H4 ⇒ eo2 a1 a2 ty v1 v2 v tr1 tr2 H1 H2 H3 H4 (eval_expr_ind ge e m P eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a1 v1 tr1 H1) (eval_expr_ind ge e m P eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a2 v2 tr2 H3)
    727   | eval_Eandbool_1 a1 a2 ty v1 tr H1 H2 ⇒ ea1 a1 a2 ty v1 tr H1 H2 (eval_expr_ind ge e m P eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a1 v1 tr H1)
    728   | eval_Eandbool_2 a1 a2 ty v1 v2 v tr1 tr2 H1 H2 H3 H4 ⇒ ea2 a1 a2 ty v1 v2 v tr1 tr2 H1 H2 H3 H4 (eval_expr_ind ge e m P eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a1 v1 tr1 H1) (eval_expr_ind ge e m P eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a2 v2 tr2 H3)
    729   | eval_Ecast a ty ty' v1 v tr H1 H2 ⇒ ecs a ty ty' v1 v tr H1 H2 (eval_expr_ind ge e m P eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a v1 tr H1)
    730   | eval_Ecost a ty v l tr H ⇒ eco a ty v l tr H (eval_expr_ind ge e m P eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a v tr H)
     649  | eval_Eunop op a ty v1 v tr H1 H2 ⇒ eun op a ty v1 v tr H1 H2 (eval_expr_ind ge e m P eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a v1 tr H1)
     650  | eval_Ebinop op a1 a2 ty v1 v2 v tr1 tr2 H1 H2 H3 ⇒ ebi op a1 a2 ty v1 v2 v tr1 tr2 H1 H2 H3 (eval_expr_ind ge e m P eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a1 v1 tr1 H1) (eval_expr_ind ge e m P eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a2 v2 tr2 H2)
     651  | eval_Econdition_true a1 a2 a3 ty v1 v2 tr1 tr2 H1 H2 H3 ⇒ ect a1 a2 a3 ty v1 v2 tr1 tr2 H1 H2 H3 (eval_expr_ind ge e m P eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a1 v1 tr1 H1) (eval_expr_ind ge e m P eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a2 v2 tr2 H3)
     652  | eval_Econdition_false a1 a2 a3 ty v1 v3 tr1 tr2 H1 H2 H3 ⇒ ecf a1 a2 a3 ty v1 v3 tr1 tr2 H1 H2 H3 (eval_expr_ind ge e m P eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a1 v1 tr1 H1) (eval_expr_ind ge e m P eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a3 v3 tr2 H3)
     653  | eval_Eorbool_1 a1 a2 ty v1 tr H1 H2 ⇒ eo1 a1 a2 ty v1 tr H1 H2 (eval_expr_ind ge e m P eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a1 v1 tr H1)
     654  | eval_Eorbool_2 a1 a2 ty v1 v2 v tr1 tr2 H1 H2 H3 H4 ⇒ eo2 a1 a2 ty v1 v2 v tr1 tr2 H1 H2 H3 H4 (eval_expr_ind ge e m P eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a1 v1 tr1 H1) (eval_expr_ind ge e m P eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a2 v2 tr2 H3)
     655  | eval_Eandbool_1 a1 a2 ty v1 tr H1 H2 ⇒ ea1 a1 a2 ty v1 tr H1 H2 (eval_expr_ind ge e m P eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a1 v1 tr H1)
     656  | eval_Eandbool_2 a1 a2 ty v1 v2 v tr1 tr2 H1 H2 H3 H4 ⇒ ea2 a1 a2 ty v1 v2 v tr1 tr2 H1 H2 H3 H4 (eval_expr_ind ge e m P eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a1 v1 tr1 H1) (eval_expr_ind ge e m P eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a2 v2 tr2 H3)
     657  | eval_Ecast a ty ty' v1 v tr H1 H2 ⇒ ecs a ty ty' v1 v tr H1 H2 (eval_expr_ind ge e m P eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a v1 tr H1)
     658  | eval_Ecost a ty v l tr H ⇒ eco a ty v l tr H (eval_expr_ind ge e m P eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco a v tr H)
    731659  ].
    732660(*
     
    806734  (Q:∀a,loc,ofs,tr. eval_lvalue ge e m a loc ofs tr → Prop)
    807735  (eci:∀sz,sg,i. P ??? (eval_Econst_int ge e m sz sg i))
    808   (ecF:∀f,ty. P ??? (eval_Econst_float ge e m f ty))
    809736  (elv:∀a,ty,loc,ofs,v,tr,H1,H2. Q (Expr a ty) loc ofs tr H1 → P ??? (eval_Elvalue ge e m a ty loc ofs v tr H1 H2))
    810737  (ead:∀a,ty,loc,ofs,tr,H. Q a loc ofs tr H → P ??? (eval_Eaddrof ge e m a ty loc ofs tr H))
     
    829756  match ev with
    830757  [ eval_Econst_int sz sg i ⇒ eci sz sg i
    831   | eval_Econst_float f ty ⇒ ecF f ty
    832   | eval_Elvalue a ty loc ofs v tr H1 H2 ⇒ elv a ty loc ofs v tr H1 H2 (eval_lvalue_ind2 ge e m P Q eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu (Expr a ty) loc ofs tr H1)
    833   | eval_Eaddrof a ty loc ofs tr H ⇒ ead a ty loc ofs tr H (eval_lvalue_ind2 ge e m P Q eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a loc ofs tr H)
     758  | eval_Elvalue a ty loc ofs v tr H1 H2 ⇒ elv a ty loc ofs v tr H1 H2 (eval_lvalue_ind2 ge e m P Q eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu (Expr a ty) loc ofs tr H1)
     759  | eval_Eaddrof a ty loc ofs tr H ⇒ ead a ty loc ofs tr H (eval_lvalue_ind2 ge e m P Q eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a loc ofs tr H)
    834760  | eval_Esizeof ty' sz sg ⇒ esz ty' sz sg
    835   | eval_Eunop op a ty v1 v tr H1 H2 ⇒ eun op a ty v1 v tr H1 H2 (eval_expr_ind2 ge e m P Q eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a v1 tr H1)
    836   | eval_Ebinop op a1 a2 ty v1 v2 v tr1 tr2 H1 H2 H3 ⇒ ebi op a1 a2 ty v1 v2 v tr1 tr2 H1 H2 H3 (eval_expr_ind2 ge e m P Q eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a1 v1 tr1 H1) (eval_expr_ind2 ge e m P Q eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a2 v2 tr2 H2)
    837   | eval_Econdition_true a1 a2 a3 ty v1 v2 tr1 tr2 H1 H2 H3 ⇒ ect a1 a2 a3 ty v1 v2 tr1 tr2 H1 H2 H3 (eval_expr_ind2 ge e m P Q eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a1 v1 tr1 H1) (eval_expr_ind2 ge e m P Q eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a2 v2 tr2 H3)
    838   | eval_Econdition_false a1 a2 a3 ty v1 v3 tr1 tr2 H1 H2 H3 ⇒ ecf a1 a2 a3 ty v1 v3 tr1 tr2 H1 H2 H3 (eval_expr_ind2 ge e m P Q eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a1 v1 tr1 H1) (eval_expr_ind2 ge e m P Q eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a3 v3 tr2 H3)
    839   | eval_Eorbool_1 a1 a2 ty v1 tr H1 H2 ⇒ eo1 a1 a2 ty v1 tr H1 H2 (eval_expr_ind2 ge e m P Q eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a1 v1 tr H1)
    840   | eval_Eorbool_2 a1 a2 ty v1 v2 v tr1 tr2 H1 H2 H3 H4 ⇒ eo2 a1 a2 ty v1 v2 v tr1 tr2 H1 H2 H3 H4 (eval_expr_ind2 ge e m P Q eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a1 v1 tr1 H1) (eval_expr_ind2 ge e m P Q eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a2 v2 tr2 H3)
    841   | eval_Eandbool_1 a1 a2 ty v1 tr H1 H2 ⇒ ea1 a1 a2 ty v1 tr H1 H2 (eval_expr_ind2 ge e m P Q eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a1 v1 tr H1)
    842   | eval_Eandbool_2 a1 a2 ty v1 v2 v tr1 tr2 H1 H2 H3 H4 ⇒ ea2 a1 a2 ty v1 v2 v tr1 tr2 H1 H2 H3 H4 (eval_expr_ind2 ge e m P Q eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a1 v1 tr1 H1) (eval_expr_ind2 ge e m P Q eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a2 v2 tr2 H3)
    843   | eval_Ecast a ty ty' v1 v tr H1 H2 ⇒ ecs a ty ty' v1 v tr H1 H2 (eval_expr_ind2 ge e m P Q eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a v1 tr H1)
    844   | eval_Ecost a ty v l tr H ⇒ eco a ty v l tr H (eval_expr_ind2 ge e m P Q eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a v tr H)
     761  | eval_Eunop op a ty v1 v tr H1 H2 ⇒ eun op a ty v1 v tr H1 H2 (eval_expr_ind2 ge e m P Q eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a v1 tr H1)
     762  | eval_Ebinop op a1 a2 ty v1 v2 v tr1 tr2 H1 H2 H3 ⇒ ebi op a1 a2 ty v1 v2 v tr1 tr2 H1 H2 H3 (eval_expr_ind2 ge e m P Q eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a1 v1 tr1 H1) (eval_expr_ind2 ge e m P Q eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a2 v2 tr2 H2)
     763  | eval_Econdition_true a1 a2 a3 ty v1 v2 tr1 tr2 H1 H2 H3 ⇒ ect a1 a2 a3 ty v1 v2 tr1 tr2 H1 H2 H3 (eval_expr_ind2 ge e m P Q eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a1 v1 tr1 H1) (eval_expr_ind2 ge e m P Q eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a2 v2 tr2 H3)
     764  | eval_Econdition_false a1 a2 a3 ty v1 v3 tr1 tr2 H1 H2 H3 ⇒ ecf a1 a2 a3 ty v1 v3 tr1 tr2 H1 H2 H3 (eval_expr_ind2 ge e m P Q eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a1 v1 tr1 H1) (eval_expr_ind2 ge e m P Q eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a3 v3 tr2 H3)
     765  | eval_Eorbool_1 a1 a2 ty v1 tr H1 H2 ⇒ eo1 a1 a2 ty v1 tr H1 H2 (eval_expr_ind2 ge e m P Q eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a1 v1 tr H1)
     766  | eval_Eorbool_2 a1 a2 ty v1 v2 v tr1 tr2 H1 H2 H3 H4 ⇒ eo2 a1 a2 ty v1 v2 v tr1 tr2 H1 H2 H3 H4 (eval_expr_ind2 ge e m P Q eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a1 v1 tr1 H1) (eval_expr_ind2 ge e m P Q eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a2 v2 tr2 H3)
     767  | eval_Eandbool_1 a1 a2 ty v1 tr H1 H2 ⇒ ea1 a1 a2 ty v1 tr H1 H2 (eval_expr_ind2 ge e m P Q eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a1 v1 tr H1)
     768  | eval_Eandbool_2 a1 a2 ty v1 v2 v tr1 tr2 H1 H2 H3 H4 ⇒ ea2 a1 a2 ty v1 v2 v tr1 tr2 H1 H2 H3 H4 (eval_expr_ind2 ge e m P Q eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a1 v1 tr1 H1) (eval_expr_ind2 ge e m P Q eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a2 v2 tr2 H3)
     769  | eval_Ecast a ty ty' v1 v tr H1 H2 ⇒ ecs a ty ty' v1 v tr H1 H2 (eval_expr_ind2 ge e m P Q eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a v1 tr H1)
     770  | eval_Ecost a ty v l tr H ⇒ eco a ty v l tr H (eval_expr_ind2 ge e m P Q eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a v tr H)
    845771  ]
    846772and eval_lvalue_ind2 (ge:genv) (e:env) (m:mem)
     
    848774  (Q:∀a,loc,ofs,tr. eval_lvalue ge e m a loc ofs tr → Prop)
    849775  (eci:∀sz,sg,i. P ??? (eval_Econst_int ge e m sz sg i))
    850   (ecF:∀f,ty. P ??? (eval_Econst_float ge e m f ty))
    851776  (elv:∀a,ty,loc,ofs,v,tr,H1,H2. Q (Expr a ty) loc ofs tr H1 → P ??? (eval_Elvalue ge e m a ty loc ofs v tr H1 H2))
    852777  (ead:∀a,ty,loc,ofs,tr,H. Q a loc ofs tr H → P ??? (eval_Eaddrof ge e m a ty loc ofs tr H))
     
    871796  [ eval_Evar_local id l ty H ⇒ lvl id l ty H
    872797  | eval_Evar_global id l ty H1 H2 ⇒ lvg id l ty H1 H2
    873   | eval_Ederef a ty l ofs tr H ⇒ lde a ty l ofs tr H (eval_expr_ind2 ge e m P Q eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a (Vptr (mk_pointer l ofs)) tr H)
    874   | eval_Efield_struct a i ty l ofs id fList delta tr H1 H2 H3 ⇒ lfs a i ty l ofs id fList delta tr H1 H2 H3 (eval_lvalue_ind2 ge e m P Q eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a l ofs tr H1)
    875   | eval_Efield_union a i ty l ofs id fList tr H1 H2 ⇒ lfu a i ty l ofs id fList tr H1 H2 (eval_lvalue_ind2 ge e m P Q eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a l ofs tr H1)
     798  | eval_Ederef a ty l ofs tr H ⇒ lde a ty l ofs tr H (eval_expr_ind2 ge e m P Q eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a (Vptr (mk_pointer l ofs)) tr H)
     799  | eval_Efield_struct a i ty l ofs id fList delta tr H1 H2 H3 ⇒ lfs a i ty l ofs id fList delta tr H1 H2 H3 (eval_lvalue_ind2 ge e m P Q eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a l ofs tr H1)
     800  | eval_Efield_union a i ty l ofs id fList tr H1 H2 ⇒ lfu a i ty l ofs id fList tr H1 H2 (eval_lvalue_ind2 ge e m P Q eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu a l ofs tr H1)
    876801  ].
    877802
    878803definition combined_expr_lvalue_ind ≝
    879 λge,e,m,P,Q,eci,ecF,elv,ead,esz,eun,ebi,ect,ecf,eo1,eo2,ea1,ea2,ecs,eco,lvl,lvg,lde,lfs,lfu. 
     804λge,e,m,P,Q,eci,elv,ead,esz,eun,ebi,ect,ecf,eo1,eo2,ea1,ea2,ecs,eco,lvl,lvg,lde,lfs,lfu. 
    880805conj ??
    881   (eval_expr_ind2 ge e m P Q eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu)
    882   (eval_lvalue_ind2 ge e m P Q eci ecF elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu).
     806  (eval_expr_ind2 ge e m P Q eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu)
     807  (eval_lvalue_ind2 ge e m P Q eci elv ead esz eun ebi ect ecf eo1 eo2 ea1 ea2 ecs eco lvl lvg lde lfs lfu).
    883808
    884809(* * [eval_lvalue ge e m a b ofs] defines the evaluation of expression [a]
     
    1028953[ Tvoid ⇒ Tvoid
    1029954| Tint a b ⇒ Tint a b
    1030 | Tfloat a ⇒ Tfloat a
     955(*| Tfloat a ⇒ Tfloat a*)
    1031956| Tpointer ty ⇒ ty
    1032957| Tarray a b ⇒ Tarray a b
  • src/Clight/Csyntax.ma

    r2391 r2468  
    6464  | Tvoid: type                         (**r the [void] type *)
    6565  | Tint: intsize → signedness → type   (**r integer types *)
    66   | Tfloat: floatsize → type            (**r floating-point types *)
    6766  | Tpointer: (*region →*) type → type      (**r pointer types ([*ty]) *)
    6867  | Tarray: (*region →*) type → nat → type  (**r array types ([ty[len]]) *)
     
    8584  (vo:P Tvoid)
    8685  (it:∀i,s. P (Tint i s))
    87   (fl:∀f. P (Tfloat f))
    8886  (pt:∀t. P t → P (Tpointer t))
    8987  (ar:∀t,n. P t → P (Tarray t n))
     
    9694  [ Tvoid ⇒ vo
    9795  | Tint i s ⇒ it i s
    98   | Tfloat s ⇒ fl s
    99   | Tpointer t' ⇒ pt t' (type_ind P vo it fl pt ar fn st un cp t')
    100   | Tarray t' n ⇒ ar t' n (type_ind P vo it fl pt ar fn st un cp t')
    101   | Tfunction tl t' ⇒ fn tl t' (type_ind P vo it fl pt ar fn st un cp t')
     96  | Tpointer t' ⇒ pt t' (type_ind P vo it pt ar fn st un cp t')
     97  | Tarray t' n ⇒ ar t' n (type_ind P vo it pt ar fn st un cp t')
     98  | Tfunction tl t' ⇒ fn tl t' (type_ind P vo it pt ar fn st un cp t')
    10299  | Tstruct i fs ⇒ st i fs
    103100  | Tunion i fs ⇒ un i fs
     
    157154with expr_descr : Type[0] ≝
    158155  | Econst_int: ∀sz:intsize. bvint sz → expr_descr       (**r integer literal *)
    159   | Econst_float: float → expr_descr   (**r float literal *)
    160156  | Evar: ident → expr_descr           (**r variable *)
    161157  | Ederef: expr → expr_descr          (**r pointer dereference (unary [*]) *)
     
    355351  [ Tvoid ⇒ 1
    356352  | Tint sz _ ⇒ match sz with [ I8 ⇒ 1 | I16 ⇒ 2 | I32 ⇒ 4 ]
    357   | Tfloat sz ⇒ match sz with [ F32 ⇒ 4 | F64 ⇒ 8 ]
    358353  | Tpointer _ ⇒ 4
    359354  | Tarray t' n ⇒ alignof t'
     
    380375  (vo:P Tvoid)
    381376  (it:∀i,s. P (Tint i s))
    382   (fl:∀f. P (Tfloat f))
    383377  (pt:∀t. P t → P (Tpointer t))
    384378  (ar:∀t,n. P t → P (Tarray t n))
     
    393387  [ Tvoid ⇒ vo
    394388  | Tint i s ⇒ it i s
    395   | Tfloat s ⇒ fl s
    396   | Tpointer t' ⇒ pt t' (type_ind2 P Q vo it fl pt ar fn st un cp nl cs t')
    397   | Tarray t' n ⇒ ar t' n (type_ind2 P Q vo it fl pt ar fn st un cp nl cs t')
    398   | Tfunction tl t' ⇒ fn tl t' (type_ind2 P Q vo it fl pt ar fn st un cp nl cs t')
    399   | Tstruct i fs ⇒ st i fs (fieldlist_ind2 P Q vo it fl pt ar fn st un cp nl cs fs)
    400   | Tunion i fs ⇒ un i fs (fieldlist_ind2 P Q vo it fl pt ar fn st un cp nl cs fs)
     389  | Tpointer t' ⇒ pt t' (type_ind2 P Q vo it pt ar fn st un cp nl cs t')
     390  | Tarray t' n ⇒ ar t' n (type_ind2 P Q vo it pt ar fn st un cp nl cs t')
     391  | Tfunction tl t' ⇒ fn tl t' (type_ind2 P Q vo it pt ar fn st un cp nl cs t')
     392  | Tstruct i fs ⇒ st i fs (fieldlist_ind2 P Q vo it pt ar fn st un cp nl cs fs)
     393  | Tunion i fs ⇒ un i fs (fieldlist_ind2 P Q vo it pt ar fn st un cp nl cs fs)
    401394  | Tcomp_ptr i ⇒ cp i
    402395  ]
     
    405398  (vo:P Tvoid)
    406399  (it:∀i,s. P (Tint i s))
    407   (fl:∀f. P (Tfloat f))
    408400  (pt:∀t. P t → P (Tpointer t))
    409401  (ar:∀t,n. P t → P (Tarray t n))
     
    417409  match fs return λfs'.Q fs' with
    418410  [ Fnil ⇒ nl
    419   | Fcons i t f' ⇒ cs i t f' (type_ind2 P Q vo it fl pt ar fn st un cp nl cs t)
    420                         (fieldlist_ind2 P Q vo it fl pt ar fn st un cp nl cs f')
     411  | Fcons i t f' ⇒ cs i t f' (type_ind2 P Q vo it pt ar fn st un cp nl cs t)
     412                        (fieldlist_ind2 P Q vo it pt ar fn st un cp nl cs f')
    421413  ].
    422414
     
    439431  [ Tvoid ⇒ 1
    440432  | Tint i _ ⇒ match i with [ I8 ⇒ 1 | I16 ⇒ 2 | I32 ⇒ 4 ]
    441   | Tfloat f ⇒ match f with [ F32 ⇒ 4 | F64 ⇒ 8 ]
    442433  | Tpointer _ ⇒ size_pointer
    443434  | Tarray t' n ⇒ sizeof t' * max 1 n
     
    610601  [ Tvoid ⇒ ASTint I32 Unsigned
    611602  | Tint sz sg ⇒ ASTint sz sg
    612   | Tfloat sz ⇒ ASTfloat sz
    613603  | Tpointer _ ⇒ ASTptr
    614604  | Tarray _ _ ⇒ ASTptr
     
    622612  [ Tvoid ⇒ None ?
    623613  | Tint sz sg ⇒ Some ? (ASTint sz sg)
    624   | Tfloat sz ⇒ Some ? (ASTfloat sz)
    625614  | Tpointer _ ⇒ Some ? ASTptr
    626615  | Tarray _ _ ⇒ Some ? ASTptr
     
    657646  match ty return λty. mode (typ_of_type ty) with
    658647  [ Tint i s ⇒ By_value (ASTint i s)
    659   | Tfloat sz ⇒ By_value (ASTfloat sz)
    660648  | Tvoid ⇒ By_nothing …
    661649  | Tpointer _ ⇒ By_value ASTptr
  • src/Clight/MemProperties.ma

    r2448 r2468  
    144144#m1 #m2 #Hloadsim #ptr #ty #v
    145145cases ty
    146 [ 1: | 2: #sz #sg | 3: #fsz | 4: #ptrty | 5: #arrayty #arraysz | 6: #argsty #retty
    147 | 7: #sid #fields | 8: #uid #fields | 9: #cptr_id ]
     146[ 1: | 2: #sz #sg | 3: #ptrty | 4: #arrayty #arraysz | 5: #argsty #retty
     147| 6: #sid #fields | 7: #uid #fields | 8: #cptr_id ]
    148148whd in match (load_value_of_type ????) in ⊢ ((??%?) → (??%?));
    149 [ 1,7,8: #Habsurd destruct (Habsurd)
    150 | 5,6: #H @H
    151 | 2,3,4,9:
     149[ 1,6,7: #Habsurd destruct (Habsurd)
     150| 4,5: #H @H
     151| 2,3,8:
    152152  generalize in match (mk_pointer (pblock ptr) (poff ptr));
    153153  elim (typesize ?)
    154   [ 1,3,5,7: #p #H @H
    155   | 2,4,6,8: #n' #Hind #p
     154  [ 1,3,5: #p #H @H
     155  | *: #n' #Hind #p
    156156      lapply (load_sim_loadn … Hloadsim (S n') p)
    157157      cases (loadn m1 p (S n')) normalize nodelta
     
    200200cases (Zltb (Z_of_unsigned_bitvector offset_size (offv (poff ptr))) (high (contents (pblock ptr))))
    201201normalize nodelta try // #Habsurd destruct (Habsurd)
     202qed.
     203
     204lemma bestorev_to_valid_pointer_after : ∀m,ptr,v,res. bestorev m ptr v = Some ? res → valid_pointer res ptr = true.
     205* #contents #next #nextpos #ptr #v #res
     206whd in match (bestorev ???);
     207whd in match (valid_pointer ??); #Hvalid
     208cases (if_opt_inversion ???? Hvalid) #Hnextblock normalize nodelta -Hvalid #Hvalid
     209cases (if_opt_inversion ???? Hvalid) #Hin_bounds #Heq destruct (Heq) normalize
     210>Hnextblock normalize nodelta cases (block_region (pblock ptr)) normalize nodelta
     211>eqZb_z_z normalize nodelta @Hin_bounds
    202212qed.
    203213
     
    591601] qed.
    592602
     603(* extension of [bestorev_to_valid_pointer] to storen *)
     604lemma storen_to_valid_pointer :
     605  ∀data,xd,m,ptr,m'. storen m ptr (xd::data) = Some ? m' →
     606    (∀b.low (blocks m' b) = low (blocks m b) ∧
     607         high (blocks m' b) = high (blocks m b)) ∧
     608    nextblock m' = nextblock m ∧         
     609    valid_pointer m ptr = true ∧
     610    valid_pointer m' ptr = true.
     611#data elim data
     612[ 1: #xd #m #ptr #res #Hstoren whd in Hstoren:(??%?);
     613     cases (some_inversion ????? Hstoren) #m' * #Hbestorev #Hstoren'
     614     normalize in Hstoren'; destruct (Hstoren')
     615     lapply (mem_bounds_invariant_after_bestorev … Hbestorev) * * * * #HA #HB #HC #HD #HF
     616     lapply (bestorev_to_valid_pointer … Hbestorev) #Hvalid_ptr @conj try @conj try @conj try assumption
     617     @(bestorev_to_valid_pointer_after … Hbestorev)
     618| 2: #hd #tl #Hind #xd #m #ptr #res whd in match (storen ???); #Hstoren
     619     cases (some_inversion ????? Hstoren) #m' * #Hbestorev #Hstoren' -Hstoren
     620     whd in match (shift_pointer ???) in Hstoren';
     621     lapply (bestorev_to_valid_pointer … Hbestorev) #H @conj try @conj try @conj try //
     622     lapply (Hind … Hstoren') * * * #Hbounds #Hnext #Hvalid1 #Hvalid2
     623     lapply (mem_bounds_invariant_after_bestorev … Hbestorev) * * * * #HA #HB #HC #HD #HF
     624     [ 1: #b @conj cases (Hbounds b) #HG #HH cases (HB b) #HI #HJ try //
     625     | 2: >Hnext >HA @refl ]
     626     @valid_pointer_of_Prop @conj try @conj try @conj
     627     cases (Hbounds (pblock ptr)) #HG #HH cases (HB (pblock ptr)) #HI #HJ
     628     [ 2: cases HC #Hlow #_ whd in match (low_bound ??);
     629           whd in match (Z_of_offset ?) in Hlow;
     630           >HG >HI @Hlow
     631     | 3: cases HC #_ #Hhigh whd in match (high_bound ??); >HH >HJ @Hhigh ]
     632     lapply (valid_pointer_to_Prop … Hvalid2) * * #Hnext #Hlow #Hhigh //
     633] qed.
     634
     635lemma fe_to_be_values_nonempty : ∀typ,v. ∃hd,tl. fe_to_be_values typ v = hd :: tl.
     636*
     637[ 2:  * /3 by ex_intro/ * #i
     638      [ 1: whd in match (fe_to_be_values ??); normalize nodelta normalize
     639           lapply (vsplit_eq … 7 0 … i) * #v1 * #v2 #Heq
     640           <(vsplit_prod … Heq) normalize nodelta /3 by ex_intro/
     641      | 2: whd in match (fe_to_be_values ??); normalize nodelta normalize
     642           lapply (vsplit_eq … 7 8 … i) * #va * #vb #Heq
     643           <(vsplit_prod … Heq) normalize nodelta
     644           lapply (vsplit_eq … 7 0 … vb) * #vba * #vbb #Heq'
     645            /3 by ex_intro/
     646      | 3: whd in match (fe_to_be_values ??); normalize nodelta normalize
     647           lapply (vsplit_eq … 7 24 … i) * #va * #vb #Heq
     648           <(vsplit_prod … Heq) normalize nodelta
     649           lapply (vsplit_eq … 7 16 … vb) * #vba * #vbb #Heq'
     650           <(vsplit_prod … Heq') normalize nodelta
     651           lapply (vsplit_eq … 7 8 … vbb) * #vbba * #vbbb #Heq''
     652           <(vsplit_prod … Heq'') normalize nodelta
     653           lapply (vsplit_eq … 7 0 … vbbb) * #vbx * #vby #Heq'''
     654            /3 by ex_intro/ ]
     655| 1: #sz #sg * /3 by ex_intro/ * #i
     656      [ 1: whd in match (fe_to_be_values ??); normalize nodelta normalize
     657           lapply (vsplit_eq … 7 0 … i) * #v1 * #v2 #Heq
     658           <(vsplit_prod … Heq) normalize nodelta /3 by ex_intro/
     659      | 2: whd in match (fe_to_be_values ??); normalize nodelta normalize
     660           lapply (vsplit_eq … 7 8 … i) * #va * #vb #Heq
     661           <(vsplit_prod … Heq) normalize nodelta
     662           lapply (vsplit_eq … 7 0 … vb) * #vba * #vbb #Heq'
     663            /3 by ex_intro/
     664      | 3: whd in match (fe_to_be_values ??); normalize nodelta normalize
     665           lapply (vsplit_eq … 7 24 … i) * #va * #vb #Heq
     666           <(vsplit_prod … Heq) normalize nodelta
     667           lapply (vsplit_eq … 7 16 … vb) * #vba * #vbb #Heq'
     668           <(vsplit_prod … Heq') normalize nodelta
     669           lapply (vsplit_eq … 7 8 … vbb) * #vbba * #vbbb #Heq''
     670           <(vsplit_prod … Heq'') normalize nodelta
     671           lapply (vsplit_eq … 7 0 … vbbb) * #vbx * #vby #Heq'''
     672            /3 by ex_intro/ ]
     673] qed.           
     674
     675lemma storen_to_valid_pointer_fe_to_be :
     676  ∀typ,v,m,ptr,m'. storen m ptr (fe_to_be_values typ v) = Some ? m' →
     677    (∀b.low (blocks m' b) = low (blocks m b) ∧
     678         high (blocks m' b) = high (blocks m b)) ∧
     679    nextblock m' = nextblock m ∧         
     680    valid_pointer m ptr = true ∧
     681    valid_pointer m' ptr = true.
     682#typ #v cases (fe_to_be_values_nonempty … typ v) #hd * #tl #Heq >Heq
     683@storen_to_valid_pointer
     684qed.
     685
    593686lemma storen_beloadv_ok :
    594687  ∀m,m',b,ofs,hd,tl.
     
    709802   we need to prove the fact that we store stuff of "reasonable" size, i.e. at most 8. *)
    710803lemma typesize_bounded : ∀ty. typesize ty ≤ 8.
    711 * try //
    712 [ 1: * try //
    713 | 2: * try //
    714 ] qed.
     804* try // * try // qed.
    715805
    716806(* Lifting bound on make_list *)
     
    746836  ∀ty,v. |fe_to_be_values ty v| ≤ 8.
    747837#ty cases ty
    748 [ 3: #fsz #v whd in match (fe_to_be_values ??);
     838[ 1: #sz #sg ]
     839#v whd in match (fe_to_be_values ??);
    749840     cases v normalize nodelta
    750      [ 1: @makelist_bounded @typesize_bounded
    751      | 2: * normalize nodelta #bv
     841     [ 1,5: @makelist_bounded @typesize_bounded
     842     | 2,6: * normalize nodelta #bv
    752843          >map_bounded >bytes_of_bitvector_bounded //
    753      | 3: #fl @makelist_bounded @typesize_bounded
    754      | 4: //
    755      | 5: #ptr // ]
    756 | 2: #v whd in match (fe_to_be_values ??);
    757      cases v normalize nodelta
    758      [ 1: @makelist_bounded @typesize_bounded
    759      | 2: * normalize nodelta #bv
    760           >map_bounded >bytes_of_bitvector_bounded //
    761      | 3: #fl @makelist_bounded @typesize_bounded
    762      | 4: //
    763      | 5: #ptr // ]
    764 | 1: #sz #sg #v whd in match (fe_to_be_values ??);
    765      cases v normalize nodelta
    766      [ 1: @makelist_bounded @typesize_bounded
    767      | 2: * normalize nodelta #bv
    768           >map_bounded >bytes_of_bitvector_bounded //
    769      | 3: #fl @makelist_bounded @typesize_bounded
    770      | 4: //
    771      | 5: #ptr // ]
    772 ] qed.
    773 
     844     | 3,7: //
     845     | 4,8: #ptr // ]
     846qed.     
    774847
    775848lemma mem_bounds_after_store_value_of_type :
     
    782855lapply (fe_to_be_values_bounded (typ_of_type ty) v)
    783856cases ty
    784 [ 1: | 2: #sz #sg | 3: #fsz | 4: #ptr_ty | 5: #array_ty #array_sz | 6: #domain #codomain
    785 | 7: #structname #fieldspec | 8: #unionname #fieldspec | 9: #id ]
     857[ 1: | 2: #sz #sg | 3: #ptrty | 4: #arrayty #arraysz | 5: #argsty #retty
     858| 6: #sid #fields | 7: #uid #fields | 8: #cptr_id ]
    786859whd in match (typ_of_type ?); #Hbounded
    787860whd in match (store_value_of_type ?????);
    788 [ 1,5,6,7,8: #Habsurd destruct (Habsurd)
     861[ 1,4,5,6,7: #Habsurd destruct (Habsurd)
    789862| *: #Hstoren lapply (mem_bounds_invariant_after_storen … Hbounded Hstoren)
    790863     * * * * * #Hnextblock #Hbounds_eq #Hnonempty
     
    814887    [ Vptr p ⇒ True
    815888    | _ ⇒ False ]
    816   | ASTfloat fsz ⇒
    817     match v with
    818     [ Vfloat _ ⇒ True
    819     | _ ⇒ False ]   
    820889  ].
    821890
     
    835904     whd in match (fe_to_be_values ??); cases v
    836905     normalize in ⊢ (% → ?);
    837      [ 1,4: @False_ind
     906     [ 1,3: @False_ind
    838907     | 2: #sz' #i normalize in ⊢ (% → ?); #Heq destruct normalize nodelta
    839908          >map_bounded >bytes_of_bitvector_bounded cases sz' //
    840      | 3: #f normalize in ⊢ (% → ?); @False_ind
    841      | 5: #p normalize in ⊢ (% → ?); @False_ind ]
     909     | 4: #p normalize in ⊢ (% → ?); @False_ind ]
    842910| 2: #v cases v
    843911     normalize in ⊢ (% → ?);
    844      [ 1,4: @False_ind
     912     [ 1,3: @False_ind
    845913     | 2: #sz' #i normalize in ⊢ (% → ?); @False_ind
    846      | 3: #f normalize in ⊢ (% → ?); @False_ind
    847      | 5: #p #_ // ]
    848 | 3: #fsz #v cases v
    849      normalize in ⊢ (% → ?);
    850      [ 1: @False_ind
    851      | 2: #sz' #i normalize in ⊢ (% → ?); @False_ind
    852      | 3: #f #_ cases fsz //
    853      | 4: @False_ind
    854      | 5: #p normalize in ⊢ (% → ?); @False_ind ]
    855 ] qed.
    856 
     914     | 4: #p #_ // ]
     915] qed.
    857916
    858917(* Not verified for floats atm. Restricting to integers. *)
     
    863922whd in match (fe_to_be_values ??);
    864923cases v normalize in ⊢ (% → ?);
    865 [ 1,4: @False_ind
    866 | 3: #f @False_ind
    867 | 5: #p @False_ind
     924[ 1,3: @False_ind
     925| 4: #p @False_ind
    868926| 2: #sz' #i' #Heq normalize in Heq; destruct (Heq) normalize nodelta
    869927     cases sz' in i'; #i normalize nodelta
     
    924982#sz #sg #m #b #ofs #v #m' #H lapply H whd in ⊢ (% → ?);
    925983cases v in H; normalize nodelta
    926 [ 1: #_ @False_ind | 2: #vsz #vi #H | 3: #vf #_ @False_ind | 4: #_ @False_ind | 5: #vp #_ @False_ind ]
     984[ 1: #_ @False_ind | 2: #vsz #vi #H | 3: #_ @False_ind | 4: #vp #_ @False_ind ]
    927985#Heq >Heq in H; #H
    928986(* The lack of control on unfolds is extremely annoying. *)
  • src/Clight/SimplifyCasts.ma

    r2441 r2468  
    581581                         ∃i. castee_val = Vint src_sz i ∧ result = Vint cast_sz (cast_int_int src_sz src_sg cast_sz i).
    582582#castee_val #src_sz #src_sg #cast_sz #cast_sg #m #result
    583 elim castee_val 
    584 [ 1: | 2: #sz' #i | 3: #f | 4: | 5: #ptr ]
     583elim castee_val
     584[ 1: | 2: #sz' #i | 3: | 4: #ptr ]
    585585[ 2: | *: whd in ⊢ ((??%?) → ?); #Habsurd destruct ]
    586586whd in ⊢ ((??%?) → ?);
     
    613613#sz #sg #v1 #v2 #m #r
    614614elim v1
    615 [ 1: | 2: #sz' #i | 3: #f | 4: | 5: #ptr ]
     615[ 1: | 2: #sz' #i | 3: | 4: #ptr ]
    616616whd in ⊢ ((??%?) → ?); normalize nodelta
    617617>classify_add_int normalize nodelta #H destruct
    618618elim v2 in H;
    619 [ 1: | 2: #sz'' #i' | 3: #f' | 4:  | 5: #ptr' ]
     619[ 1: | 2: #sz'' #i' | 3: | 4: #ptr' ]
    620620whd in ⊢ ((??%?) → ?); #H destruct
    621621elim (sz_eq_dec sz' sz'')
    622622[ 1: #Heq destruct >intsize_eq_elim_true in H; #Heq destruct %{sz''} %{i} %{i'} /3/
    623623| 2: #Hneq >intsize_eq_elim_false in H; try assumption #H destruct
    624 ] qed. 
     624] qed.
    625625
    626626(* Inversion principle for integer subtraction. *)
     
    629629#sz #sg #v1 #v2 #m #r
    630630elim v1
    631 [ 1: | 2: #sz' #i | 3: #f | 4:  | 5: #ptr ]
     631[ 1: | 2: #sz' #i | 3: | 4: #ptr ]
    632632whd in ⊢ ((??%?) → ?); normalize nodelta
    633633>classify_sub_int normalize nodelta #H destruct
    634634elim v2 in H;
    635 [ 1: | 2: #sz'' #i' | 3: #f' | 4:  | 5: #ptr' ]
     635[ 1: | 2: #sz'' #i' | 3: | 4: #ptr' ]
    636636whd in ⊢ ((??%?) → ?); #H destruct
    637637elim (sz_eq_dec sz' sz'')
     
    652652#sz #sg #v1 #v2 #m
    653653elim v1
    654 [ 1: | 2: #sz' #i | 3: #f | 4:  | 5: #ptr ]
     654[ 1: | 2: #sz' #i | 3: | 4: #ptr ]
    655655[ 2: | *: #_ %1 %1 % #H @H ]
    656656elim v2
    657 [ 1: | 2: #sz'' #i' | 3: #f' | 4:  | 5: #ptr' ]
     657[ 1: | 2: #sz'' #i' | 3: | 4: #ptr' ]
    658658[ 2: | *: #_ %1 %2 % #H @H ]
    659659whd in ⊢ ((??%?) → ?); normalize nodelta
     
    663663| 2: #Hneq >intsize_eq_elim_false try assumption #_
    664664     %2 %{sz'} %{sz''} %{i} %{i'} try @conj try @conj //
    665 ] qed. 
     665] qed.
    666666
    667667(* "negative" inversion principle for integer subtraction *)
     
    671671#sz #sg #v1 #v2 #m
    672672elim v1
    673 [ 1: | 2: #sz' #i | 3: #f | 4:  | 5: #ptr ]
     673[ 1: | 2: #sz' #i | 3: | 4: #ptr ]
    674674[ 2: | *: #_ %1 %1 % #H @H ]
    675675elim v2
    676 [ 1: | 2: #sz'' #i' | 3: #f' | 4:  | 5: #ptr' ]
     676[ 1: | 2: #sz'' #i' | 3: | 4: #ptr' ]
    677677[ 2: | *: #_ %1 %2 % #H @H ]
    678678whd in ⊢ ((??%?) → ?); normalize nodelta
     
    684684] qed.
    685685
    686 
    687686lemma simplifiable_op_inconsistent : ∀op,sz,sg,v1,v2,m.
    688687   ¬ (is_int v1) → binop_simplifiable op = true → sem_binary_operation op v1 (Tint sz sg) v2 (Tint sz sg) m = None ?.
     
    690689elim op normalize in match (binop_simplifiable ?); #H destruct
    691690elim v1 in H;
    692 [ 1,6: | 2,7: #sz' #i normalize in ⊢ (% → ?); * #H @(False_ind … (H I)) | 3,8: #f | 4,9: | 5,10: #ptr ]
     691[ 1,5: | 2,6: #sz' #i normalize in ⊢ (% → ?); * #H @(False_ind … (H I)) | 3,7: | 4,8: #ptr ]
    693692#_
    694693whd in match (sem_binary_operation ??????); normalize nodelta
     
    890889        «〈false, Expr (Ecost l e2) ty〉, ?»
    891890      ]               
    892   | Econst_float f ⇒ λHdesc_eq. «〈false, Expr ed ty〉, ?»
     891(*  | Econst_float f ⇒ λHdesc_eq. «〈false, Expr ed ty〉, ?» *)
    893892(* | Evar id ⇒ λHdesc_eq. «〈false, Expr ed ty〉, ?» *)
    894893  (* In order for the simplification function to be less dymp, we would have to use this line, which would in fact
     
    960959] (refl ? e).
    961960#ge #en #m
    962 [ 1,3,5,6,7,8,9,10,11,12: %1 try @refl
     961[ 1,3,5,6,7,8,9,10,11: %1 try @refl
    963962     cases (exec_expr ge en m e) #res
    964963     try (@(SimOk ???) //)
     
    975974     [ 1: @(simplify_int_implements_cast … Hsimpl_eq)
    976975     | 2: @(simplify_int_success_lt … Hsimpl_eq) ]
    977 | 13: %1 // >Hexpr_eq cases (exec_expr ge en m e) #res
    978       try (@(SimOk ???) //)
    979 | 14: elim (type_eq_dec ty (Tint target_sz target_sg))
     976(*| 14: %1 // >Hexpr_eq cases (exec_expr ge en m e) #res
     977      try (@(SimOk ???) //) *)
     978| 12: elim (type_eq_dec ty (Tint target_sz target_sg))
    980979      [ 1: #Heq >Heq >type_eq_identity @(Inv_coerce_ok ??????? target_sz target_sg)
    981980           destruct
     
    985984           @(SimOk ???) //
    986985      ]
    987 | 15: destruct %1 try @refl elim (Hequiv ge en m) * #Hexpr_sim #Hlvalue_sim #Htype_eq
     986| 13: destruct %1 try @refl elim (Hequiv ge en m) * #Hexpr_sim #Hlvalue_sim #Htype_eq
    988987    [ 1: (* Proving preservation of the semantics for expressions. *)
    989988      cases Hexpr_sim
     
    998997             [ 1: * #val' #trace' normalize nodelta
    999998                  cases val' normalize nodelta
    1000                   [ 1,2,3,4: #H1 destruct #H2 destruct #H3 destruct
    1001                   | 5: #pointer #Heq @(ex_intro … pointer) (* @(ex_intro … trace') *)
     999                  [ 1,2,3: #H1 destruct #H2 destruct #H3 destruct
     1000                  | 4: #pointer #Heq @(ex_intro … pointer) (* @(ex_intro … trace') *)
    10021001                       cases (load_value_of_type ty m (pblock pointer) (poff pointer)) in Heq;
    10031002                       normalize nodelta
     
    10271026             [ 1: * #val' #trace' normalize nodelta
    10281027                  cases val' normalize nodelta
    1029                   [ 1,2,3,4: #H1 destruct #H2 destruct #H3 destruct
    1030                   | 5: #pointer #Heq @(ex_intro … pointer) (* @(ex_intro … trace') *)
     1028                  [ 1,2,3: #H1 destruct #H2 destruct #H3 destruct
     1029                  | 4: #pointer #Heq @(ex_intro … pointer) (* @(ex_intro … trace') *)
    10311030                       destruct try @conj try @conj //
    10321031                  ]
     
    10421041     ]
    10431042   ]
    1044 | 16: destruct %1 try @refl elim (Hequiv ge en m) * #Hexpr_sim #Hlvalue_sim #Htype_eq
     1043| 14: destruct %1 try @refl elim (Hequiv ge en m) * #Hexpr_sim #Hlvalue_sim #Htype_eq
    10451044    [ 1: (* Proving preservation of the semantics for expressions. *)
    10461045      cases Hlvalue_sim
     
    10561055             [ 1: * * #block #offset #trace' normalize nodelta
    10571056                  cases ty
    1058                   [ 2: #sz #sg | 3: #fsz | 4: #ptr_ty | 5: #array_ty #array_sz | 6: #domain #codomain
    1059                   | 7: #structname #fieldspec | 8: #unionname #fieldspec | 9: #id ]
     1057                  [ 2: #sz #sg | 3: #ptr_ty | 4: #array_ty #array_sz | 5: #domain #codomain
     1058                  | 6: #structname #fieldspec | 7: #unionname #fieldspec | 8: #id ]
    10601059                  normalize nodelta try (#Heq destruct)
    10611060                  @(ex_intro … block) @(ex_intro … offset) @(ex_intro … ptr_ty)
     
    10711070         @SimFailNicely
    10721071    ]
    1073 | 17: destruct %1 try @refl elim (Hequiv ge en m) * #Hexpr_sim #Hlvalue_sim #Htype_eq
     1072| 15: destruct %1 try @refl elim (Hequiv ge en m) * #Hexpr_sim #Hlvalue_sim #Htype_eq
    10741073      [ 1: whd in match (exec_expr ge en m (Expr ??));
    10751074           whd in match (exec_expr ge en m (Expr ??));
     
    10851084      | 2: @SimFailNicely
    10861085      ]
    1087 | 18: destruct elim (bool_conj_inv … Hdesired_eq) #Hdesired_lhs #Hdesired_rhs -Hdesired_eq
     1086| 16: destruct elim (bool_conj_inv … Hdesired_eq) #Hdesired_lhs #Hdesired_rhs -Hdesired_eq
    10881087      inversion (Hinv_lhs ge en m)
    10891088      [ 1: #result_flag_lhs #Hresult_lhs #Htype_lhs #Hsim_expr_lhs #Hsim_lvalue_lhs #Hresult_flag_lhs_eq_true
     
    11131112                     whd in match (m_bind ?????);
    11141113                     (* specialize to the actual simplifiable operations. *)
    1115                      cases op in Hop_simplifiable_eq;                     
    1116                      [ 1,2: | *: normalize in ⊢ (% → ?); #H destruct (H) ] #_                     
     1114                     cases op in Hop_simplifiable_eq;                 
     1115                     [ 1,2: | *: normalize in ⊢ (% → ?); #H destruct (H) ] #_
    11171116                     [ 1: lapply (iadd_inv src_sz src_sg val_lhs val_rhs m)
    11181117                     | 2: lapply (isub_inv src_sz src_sg val_lhs val_rhs m) ]
     
    11801179                            ]
    11811180                     ] ] ] ]
    1182 | 19,20,21,22: destruct %1 try @refl
     1181| 17,18,19,20: destruct %1 try @refl
    11831182   elim (Hequiv_lhs ge en m) * #Hexpr_sim_lhs #Hlvalue_sim_lhs #Htype_eq_lhs
    11841183   elim (Hequiv_rhs ge en m) * #Hexpr_sim_rhs #Hlvalue_sim_rhs #Htype_eq_rhs
     
    12081207   ]
    12091208(* Jump to the cast cases *)   
    1210 | 23,30,31,32,33,34,35,36: %1 try @refl
     1209(*| 21,30,31,32,33,34,35,36: *)
     1210| 21,27,28,29,30,31,32,33:
     1211  %1 try @refl
    12111212  [ 1,4,7,10,13,16,19,22: destruct // ]
    12121213  elim (Hcastee_equiv ge en m) * #Hexec_sim #Hlvalue_sim #Htype_eq
     
    12381239  | 2,4,6,8,10,12,14,16: destruct  @SimFailNicely
    12391240  ]
    1240 | 24: destruct inversion (Hcastee_inv ge en m)
     1241| 22: destruct inversion (Hcastee_inv ge en m)
    12411242  [ 1: #result_flag #Hresult_flag #Htype_eq #Hexpr_sim #Hlvalue_sim #Hresult_flag_2
    12421243       <Hresult_flag_2 in Hresult_flag; #Hcontr destruct
     
    12691270                        [ 2,4: * #Heq >Heq #_ elim target_sz //
    12701271                        | 1,3: #Hlt @(size_lt_to_le ?? Hlt) ]
    1271  ] ] ] ] ]
    1272 | 25,27: destruct
     1272 ] ] ] ] ] 
     1273| 23,25: destruct
    12731274      inversion (Hcast2 ge en m)
    12741275      [ 1,3: (* Impossible case.  *)
     
    12981299                ] ]
    12991300      ] ]
    1300 | 26,28: destruct
     1301| 24,26: destruct
    13011302      inversion (Hcast2 ge en m)
    13021303      [ 2,4: (* Impossible case. *)
     
    13221323                 ]
    13231324      ]
     1325(*
    13241326| 29: destruct elim (Hcastee_equiv ge en m) * #Hsim_expr #Hsim_lvalue #Htype_eq
    13251327      @(Inv_eq ???????) //
     
    13361338                     normalize nodelta #H @H
    13371339                ]
    1338            ]
    1339 | 37: destruct elim (bool_conj_inv … Hdesired_eq) #Hdesired_true #Hdesired_false -Hdesired_eq
     1340           ] *)
     1341| 34: destruct elim (bool_conj_inv … Hdesired_eq) #Hdesired_true #Hdesired_false -Hdesired_eq
    13401342      inversion (Htrue_inv ge en m)
    13411343      [ 1: #result_flag_true #Hresult_true #Htype_true #Hsim_expr_true #Hsim_lvalue_true #Hresult_flag_true_eq_false
     
    13931395                                           ] ]
    13941396      ] ] ] ] ] ] ]
    1395 | 38,39,40: destruct
     1397| 35,36,37: destruct
    13961398   elim (Hcond_equiv ge en m) * #Hsim_expr_cond #Hsim_vlalue_cond #Htype_cond_eq
    13971399   elim (Htrue_equiv ge en m) * #Hsim_expr_true #Hsim_vlalue_true #Htype_true_eq
     
    14451447   | 2,4,6: @SimFailNicely
    14461448   ]
    1447 | 41,42: destruct
     1449| 38,39: destruct
    14481450    elim (Hlhs_equiv ge en m) * #Hsim_expr_lhs #Hsim_lvalue_lhs #Htype_eq_lhs
    14491451    elim (Hrhs_equiv ge en m) * #Hsim_expr_rhs #Hsim_lvalue_rhs #Htype_eq_rhs
     
    14811483   | 2,4:  @SimFailNicely
    14821484   ]
    1483 | 43: destruct
     1485| 40: destruct
    14841486      cases (type_eq_dec ty (Tint target_sz target_sg))
    14851487      [ 1: #Htype_eq >Htype_eq >type_eq_identity
     
    14901492           %1 // @SimOk #a #H @H
    14911493      ]
    1492 | 44: destruct elim (Hrec_expr_equiv ge en m) * #Hsim_expr #Hsim_lvalue #Htype_eq
     1494| 41: destruct elim (Hrec_expr_equiv ge en m) * #Hsim_expr #Hsim_lvalue #Htype_eq
    14931495      %1 try @refl
    14941496      [ 1: whd in match (exec_expr ??? (Expr ??)); whd in match (exec_expr ??? (Expr ??));
     
    14981500           >Htype_eq
    14991501           cases (typeof rec_expr1) normalize nodelta
    1500            [ 2: #sz #sg | 3: #fl | 4: #ty | 5: #ty #n | 6: #tl #ty | 7: #id #fl | 8: #id #fl | 9: #ty ]
    1501            [ 1,2,3,4,5,8,9: @SimFailNicely
    1502            | 6,7: cases Hsim_lvalue
     1502           [ 2: #sz #sg | 3: #ty | 4: #ty #n | 5: #tl #ty | 6: #id #fl | 7: #id #fl | 8: #ty ]
     1503           [ 1,2,3,4,7,8: @SimFailNicely
     1504           | 5,6: cases Hsim_lvalue
    15031505              [ 2,4: * #error #Herror >Herror normalize in ⊢ (??%?); @SimFailNicely
    15041506              | 1,3: cases (exec_lvalue ge en m rec_expr)
     
    15131515           >Htype_eq
    15141516           cases (typeof rec_expr1) normalize nodelta
    1515            [ 2: #sz #sg | 3: #fl | 4: #ty | 5: #ty #n | 6: #tl #ty | 7: #id #fl | 8: #id #fl | 9: #ty ]
    1516            [ 1,2,3,4,5,8,9: @SimFailNicely
    1517            | 6,7: cases Hsim_lvalue
     1517           [ 2: #sz #sg | 3: #ty | 4: #ty #n | 5: #tl #ty | 6: #id #fl | 7: #id #fl | 8: #ty ]
     1518           [ 1,2,3,4,7,8: @SimFailNicely
     1519           | 5,6: cases Hsim_lvalue
    15181520              [ 2,4: * #error #Herror >Herror normalize in ⊢ (??%?); @SimFailNicely
    15191521              | 1,3: cases (exec_lvalue ge en m rec_expr)
     
    15261528           ]
    15271529     ]
    1528 | 45: destruct
     1530| 42: destruct
    15291531   inversion (Hinv ge en m)
    15301532   [ 2: #src_sz #src_sg #Htypeof_e1 #Htypeof_e2 #Hsmaller #Hdesired_eq #_
     
    15611563        ]
    15621564   ]
    1563 | 46: destruct elim (Hexpr_equiv ge en m) * #Hsim_expr #Hsim_lvalue #Htype_eq
     1565| 43: destruct elim (Hexpr_equiv ge en m) * #Hsim_expr #Hsim_lvalue #Htype_eq
    15641566      %1 try @refl
    15651567      [ 1: whd in match (exec_expr ??? (Expr ??));
     
    15741576(* simplify_inside cases. Amounts to propagate a simulation result, except for the /cast/ case which actually calls
    15751577 * simplify_expr *)     
    1576 | 47, 48, 49: (* trivial const_int, const_float and var cases *)
     1578| 44, 45: (* trivial const_int, const_float and var cases *)
    15771579  try @conj try @conj try @refl
    15781580  @SimOk #a #H @H
    1579 | 50: (* Deref case *) destruct
     1581| 46: (* Deref case *) destruct
    15801582  elim (Hequiv ge en m) * #Hsim_expr #Hsim_lvalue #Htype_eq
    15811583  try @conj try @conj
     
    15961598         | 1,3: #a #Hsim lapply (Hsim a (refl ? (OK ? a))) #H >H @SimOk #a #H @H ] ]
    15971599  | 3: // ]
    1598 | 51: (* Addrof *) destruct
     1600| 47: (* Addrof *) destruct
    15991601  elim (Hequiv ge en m) * #Hsim_expr #Hsim_lvalue #Htype_eq
    16001602  try @conj try @conj   
     
    16091611  | 2: @SimFailNicely
    16101612  | 3: // ]
    1611 | 52: (* Unop *) destruct
     1613| 48: (* Unop *) destruct
    16121614  elim (Hequiv ge en m) * #Hsim_expr #Hsim_lvalue #Htype_eq
    16131615  try @conj try @conj
     
    16231625  | 2: @SimFailNicely             
    16241626  | 3: // ]
    1625 | 53: (* Binop *) destruct
     1627| 49: (* Binop *) destruct
    16261628  elim (Hequiv_lhs ge en m) * #Hsim_expr_lhs #Hsim_lvalue_lhs #Htype_eq_lhs
    16271629  elim (Hequiv_rhs ge en m) * #Hsim_expr_rhs #Hsim_lvalue_rhs #Htype_eq_rhs
     
    16501652  | 3: //
    16511653  ]
    1652 | 54: (* Cast, fallback case *)
     1654| 50: (* Cast, fallback case *)
    16531655  try @conj try @conj try @refl
    16541656  @SimOk #a #H @H
    1655 | 55: (* Cast, success case *) destruct
     1657| 51: (* Cast, success case *) destruct
    16561658  inversion (Htrans_inv ge en m)
    16571659  [ 1: (* contradiction *)
     
    16801682      ]
    16811683  ]
    1682 | 56: (* Cast, "failure" case *) destruct
     1684| 52: (* Cast, "failure" case *) destruct
    16831685  inversion (Htrans_inv ge en m)
    16841686  [ 2: (* contradiction *)
     
    17001702       ]
    17011703  ]
    1702 | 57,58,59,60,61,62,63,64,68:       
     1704| 53,54,55,56,57,58,59,63:
    17031705  try @conj try @conj try @refl
    17041706  @SimOk #a #H @H
    1705 | 65: destruct
     1707| 60: destruct
    17061708  elim (Hequiv_cond ge en m) * #Hsim_exec_cond #Hsim_lvalue_cond #Htype_eq_cond
    17071709  elim (Hequiv_iftrue ge en m) * #Hsim_exec_true #Hsim_lvalue_true #Htype_eq_true
     
    17461748  | 3: //
    17471749  ]
    1748 | 66,67: destruct
     1750| 61,62: destruct
    17491751  elim (Hequiv_lhs ge en m) * #Hsim_exec_lhs #Hsim_lvalue_lhs #Htype_eq_lhs
    17501752  elim (Hequiv_rhs ge en m) * #Hsim_exec_rhs #Hsim_lvalue_rhs #Htype_eq_rhs
     
    17771779  | 3,6: //
    17781780  ]
    1779 | 69: (* record field *) destruct
     1781| 64: (* record field *) destruct
    17801782   elim (Hequiv_rec ge en m) * #Hsim_expr #Hsim_lvalue #Htype_eq
    17811783   try @conj try @conj   
     
    17851787   whd in match (exec_lvalue' ??? (Efield rec_expr1 f) ty); 
    17861788   [ 1: >Htype_eq cases (typeof rec_expr1) normalize nodelta
    1787        [ 2: #sz #sg | 3: #fl | 4: #ty' | 5: #ty #n | 6: #tl #ty'
    1788        | 7: #id #fl | 8: #id #fl | 9: #id ]
     1789       [ 2: #sz #sg | 3: #ty' | 4: #ty #n | 5: #tl #ty'
     1790       | 6: #id #fl | 7: #id #fl | 8: #id ]
    17891791       try (@SimFailNicely)
    17901792       cases Hsim_lvalue
     
    17971799   | 2: (* Note: identical to previous case. Too lazy to merge and manually shift indices. *)
    17981800       >Htype_eq cases (typeof rec_expr1) normalize nodelta
    1799        [ 2: #sz #sg | 3: #fl | 4: #ty' | 5: #ty #n | 6: #tl #ty'
    1800        | 7: #id #fl | 8: #id #fl | 9: #id ]
     1801       [ 2: #sz #sg | 3: #ty' | 4: #ty #n | 5: #tl #ty'
     1802       | 6: #id #fl | 7: #id #fl | 8: #id ]
    18011803       try (@SimFailNicely)
    18021804       cases Hsim_lvalue
     
    18081810       ]
    18091811   | 3: // ]
    1810 | 70: (* cost label *) destruct
     1812| 65: (* cost label *) destruct
    18111813   elim (Hequiv ge en m) *  #Hsim_expr #Hsim_lvalue #Htype_eq
    18121814   try @conj try @conj
     
    19261928
    19271929definition expr_lvalue_ind_combined ≝
    1928 λP,Q,ci,cf,lv,vr,dr,ao,uo,bo,ca,cd,ab,ob,sz,fl,co,xx.
     1930λP,Q,ci,lv,vr,dr,ao,uo,bo,ca,cd,ab,ob,sz,fl,co,xx.
    19291931conj ??
    1930  (expr_lvalue_ind P Q ci cf lv vr dr ao uo bo ca cd ab ob sz fl co xx)
    1931  (lvalue_expr_ind P Q ci cf lv vr dr ao uo bo ca cd ab ob sz fl co xx).
     1932 (expr_lvalue_ind P Q ci lv vr dr ao uo bo ca cd ab ob sz fl co xx)
     1933 (lvalue_expr_ind P Q ci lv vr dr ao uo bo ca cd ab ob sz fl co xx).
    19321934 
    19331935lemma simulation_transitive : ∀A,r0,r1,r2. res_sim A r0 r1 → res_sim A r1 r2 → res_sim A r0 r2.
     
    19441946#ge #ge' #en #m #Hrelated @expr_lvalue_ind_combined
    19451947[ 1: #sz #ty #i @SimOk #a normalize //
    1946 | 2: #ty #f @SimOk #a normalize //
    1947 | 3: *
    1948     [ 1: #sz #i | 2: #fl | 3: #id | 4: #e1 | 5: #e1 | 6: #op #e1 | 7: #op #e1 #e2 | 8: #cast_ty #e1
    1949     | 9: #cond #iftrue #iffalse | 10: #e1 #e2 | 11: #e1 #e2 | 12: #sizeofty | 13: #e1 #field | 14: #cost #e1 ]
     1948| 2: *
     1949    [ #sz #i | #id | #e1 | #e1 | #op #e1 |#op #e1 #e2 | #cast_ty #e1
     1950    | #cond #iftrue #iffalse | #e1 #e2 | #e1 #e2 | #sizeofty | #e1 #field | #cost #e1 ]
    19501951    #ty #Hsim_lvalue try //
    19511952    whd in match (Plvalue ???);
     
    19591960              @SimOk // ]
    19601961    ]
    1961 | 4: #v #ty whd in match (exec_lvalue' ?????); whd in match (exec_lvalue' ?????);
     1962| 3: #v #ty whd in match (exec_lvalue' ?????); whd in match (exec_lvalue' ?????);
    19621963     cases (lookup SymbolTag block en v) normalize nodelta
    19631964     [ 2: #block @SimOk //
    19641965     | 1: elim Hrelated #Hsymbol #_ #_ >(Hsymbol v) @SimOk //
    19651966     ]
    1966 | 5: #e #ty #Hsim_expr whd in match (exec_lvalue' ?????); whd in match (exec_lvalue' ?????);
     1967| 4: #e #ty #Hsim_expr whd in match (exec_lvalue' ?????); whd in match (exec_lvalue' ?????);
    19671968     cases Hsim_expr
    19681969     [ 2: * #error #Hfail >Hfail @SimFail /2 by ex_intro/
     
    19721973                @SimOk // ]
    19731974     ]
    1974 | 6: #ty #ed #ty' #Hsim_lvalue
     1975| 5: #ty #ed #ty' #Hsim_lvalue
    19751976     whd in match (exec_expr ????); whd in match (exec_expr ????);
    19761977     whd in match (exec_lvalue ????); whd in match (exec_lvalue ????);
     
    19821983              @SimOk // ]
    19831984    ]
    1984 | 7: #ty #op #e #Hsim whd in match (exec_expr ??? (Expr ??)); whd in match (exec_expr ??? (Expr ??));
     1985| 6: #ty #op #e #Hsim whd in match (exec_expr ??? (Expr ??)); whd in match (exec_expr ??? (Expr ??));
    19851986     cases Hsim
    19861987     [ 2: * #error #Hfail >Hfail @SimFail /2 by ex_intro/
     
    19901991               @SimOk // ]
    19911992     ]
    1992 | 8: #ty #op #e1 #e2 #Hsim1 #Hsim2 whd in match (exec_expr ??? (Expr ??)); whd in match (exec_expr ??? (Expr ??));
     1993| 7: #ty #op #e1 #e2 #Hsim1 #Hsim2 whd in match (exec_expr ??? (Expr ??)); whd in match (exec_expr ??? (Expr ??));
    19931994     cases Hsim1
    19941995     [ 2: * #error #Hfail >Hfail @SimFail /2 by ex_intro/
     
    20052006          ]
    20062007     ]
    2007 | 9: #ty #cast_ty #e #Hsim whd in match (exec_expr ??? (Expr ??)); whd in match (exec_expr ??? (Expr ??));
     2008| 8: #ty #cast_ty #e #Hsim whd in match (exec_expr ??? (Expr ??)); whd in match (exec_expr ??? (Expr ??));
    20082009     cases Hsim
    20092010     [ 2: * #error #Hfail >Hfail @SimFail /2 by ex_intro/
     
    20132014               @SimOk // ]
    20142015     ] (* mergeable with 7 modulo intros *)
    2015 | 10: #ty #e1 #e2 #e3 #Hsim1 #Hsim2 #Hsim3 whd in match (exec_expr ??? (Expr ??)); whd in match (exec_expr ??? (Expr ??));
     2016| 9: #ty #e1 #e2 #e3 #Hsim1 #Hsim2 #Hsim3 whd in match (exec_expr ??? (Expr ??)); whd in match (exec_expr ??? (Expr ??));
    20162017     cases Hsim1
    20172018     [ 2: * #error #Hfail >Hfail @SimFail /2 by ex_intro/
     
    20312032          ]
    20322033     ]
    2033 | 11,12: #ty #e1 #e2 #Hsim1 #Hsim2 whd in match (exec_expr ??? (Expr ??)); whd in match (exec_expr ??? (Expr ??));
     2034| 10,11: #ty #e1 #e2 #Hsim1 #Hsim2 whd in match (exec_expr ??? (Expr ??)); whd in match (exec_expr ??? (Expr ??));
    20342035     cases Hsim1
    20352036     [ 2,4: * #error #Hfail >Hfail @SimFailNicely
     
    20522053          ]
    20532054     ]
    2054 | 13: #ty #sizeof_ty @SimOk normalize //
    2055 | 14: #ty #e #ty' #field #Hsim_lvalue
     2055| 12: #ty #sizeof_ty @SimOk normalize //
     2056| 13: #ty #e #ty' #field #Hsim_lvalue
    20562057      whd in match (exec_lvalue' ? en m (Efield ??) ty);
    20572058      whd in match (exec_lvalue' ge' en m (Efield ??) ty);
    20582059      normalize in match (typeof (Expr ??));
    20592060      cases ty' in Hsim_lvalue; normalize nodelta
    2060       [ 2: #sz #sg | 3: #fsz | 4: #ptr_ty | 5: #array_ty #array_sz | 6: #domain #codomain
    2061       | 7: #structname #fieldspec | 8: #unionname #fieldspec | 9: #id ]
     2061      [ | #sz #sg | #ptr_ty | #array_ty #array_sz | #domain #codomain
     2062      | #structname #fieldspec | #unionname #fieldspec | #id ]
    20622063      #Hsim_lvalue
    20632064      try (@SimFail /2 by ex_intro/)
     
    20712072                    @SimOk /2 by ex_intro/ ]
    20722073      ]
    2073 | 15: #ty #lab #e #Hsim
     2074| 14: #ty #lab #e #Hsim
    20742075      whd in match (exec_expr ??? (Expr ??));
    20752076      whd in match (exec_expr ??? (Expr ??));
     
    20812082               @SimOk // ]
    20822083     ] (* cf case 7, again *)
    2083 | 16: *
    2084       [ 1: #sz #i | 2: #fl | 3: #id | 4: #e1 | 5: #e1 | 6: #op #e1 | 7: #op #e1 #e2 | 8: #cast_ty #e1
    2085       | 9: #cond #iftrue #iffalse | 10: #e1 #e2 | 11: #e1 #e2 | 12: #sizeofty | 13: #e1 #field | 14: #cost #e1 ]
    2086       #ty normalize in match (is_not_lvalue ?);
    2087       [ 3,4,13: #Habsurd @(False_ind … Habsurd) ] #_
    2088       @SimFailNicely
     2084| 15: *
     2085    [ #sz #i | #id | #e1 | #e1 | #op #e1 |#op #e1 #e2 | #cast_ty #e1
     2086    | #cond #iftrue #iffalse | #e1 #e2 | #e1 #e2 | #sizeofty | #e1 #field | #cost #e1 ]
     2087    #ty normalize in match (is_not_lvalue ?);
     2088    [ 2,3,12: #Habsurd @(False_ind … Habsurd) ] #_
     2089    @SimFailNicely
    20892090] qed.
    20902091
     
    20952096#ge #ge' #en #m #Hrelated #e whd in match (simplify_e ?);
    20962097cases e #ed #ty cases ed
    2097 [ 1: #sz #i | 2: #fl | 3: #id | 4: #e1 | 5: #e1 | 6: #op #e1 | 7: #op #e1 #e2 | 8: #cast_ty #e1
    2098 | 9: #cond #iftrue #iffalse | 10: #e1 #e2 | 11: #e1 #e2 | 12: #sizeofty | 13: #e1 #field | 14: #cost #e1 ]
     2098[ #sz #i | #id | #e1 | #e1 | #op #e1 |#op #e1 #e2 | #cast_ty #e1
     2099| #cond #iftrue #iffalse | #e1 #e2 | #e1 #e2 | #sizeofty | #e1 #field | #cost #e1 ]
    20992100elim (simplify_inside (Expr ??)) #e' #Hconservation whd in Hconservation; @conj lapply (Hconservation ge en m)
    21002101* * try //
     
    21112112#ge #ge' #en #m #Hrelated #e whd in match (simplify_e ?);
    21122113cases e #ed #ty cases ed
    2113 [ 1: #sz #i | 2: #fl | 3: #id | 4: #e1 | 5: #e1 | 6: #op #e1 | 7: #op #e1 #e2 | 8: #cast_ty #e1
    2114 | 9: #cond #iftrue #iffalse | 10: #e1 #e2 | 11: #e1 #e2 | 12: #sizeofty | 13: #e1 #field | 14: #cost #e1 ]
     2114[ #sz #i | #id | #e1 | #e1 | #op #e1 |#op #e1 #e2 | #cast_ty #e1
     2115| #cond #iftrue #iffalse | #e1 #e2 | #e1 #e2 | #sizeofty | #e1 #field | #cost #e1 ]
    21152116elim (simplify_inside (Expr ??)) #e' #Hconservation whd in Hconservation; @conj lapply (Hconservation ge en m)
    21162117* * try //
     
    24622463                    | 2: #fd #args #k0 #k0' #m0 #Hcont_cast0 #Habsurd destruct (Habsurd)
    24632464                    | 3: #res #k0 #k0' #m0 #Hcont_cast #Habsurd destruct (Habsurd)
    2464                     | 4: #r #Habsurd destruct (Habsurd) ]                   
    2465                | 3,4,9: #irrelevant #Habsurd destruct
     2465                    | 4: #r #Habsurd destruct (Habsurd) ]
     2466               | 3,8: #irrelevant #Habsurd destruct
    24662467               | *: #irrelevant1 #irrelevant2 #Habsurd destruct ]
    24672468          | 2: (* Kseq stm' k' *)
     
    25282529                                  (free_list m (blocks_of_env en)))} @conj
    25292530                    [ 1: // | 2: %3 @cc_call // ]                                 
    2530                | 3,4,9: #irrelevant #Habsurd destruct (Habsurd)
     2531               | 3,8: #irrelevant #Habsurd destruct (Habsurd)
    25312532               | *: #irrelevant1 #irrelevant2 #Habsurd destruct (Habsurd) ]
    25322533           ]
     
    27562757          [ 1: >fn_return_simplify cases (fn_return f) normalize nodelta
    27572758               whd in match (ret ??) in ⊢ (% → %);
    2758                [ 2: #sz #sg | 3: #fl | 4: #ty' | 5: #ty #n | 6: #tl #ty'
    2759                | 7: #id #fl | 8: #id #fl | 9: #id ]
     2759               [ | #sz #sg | #ty' | #ty #n | #tl #ty'
     2760               | #id #fl | #id #fl | #id ]
    27602761               #H destruct (H)
    27612762               %{(Returnstate Vundef (call_cont k') (free_list m (blocks_of_env en)))}
     
    28972898     whd in match (exec_step ??) in ⊢ (% → %);
    28982899     #Habsurd destruct (Habsurd)
    2899 ] qed. 
     2900] qed.
  • src/Clight/TypeComparison.ma

    r2176 r2468  
    99definition sg_eq_dec : ∀s1,s2:signedness. (s1 = s2) + (s1 ≠ s2).
    1010#s1 cases s1; #s2 cases s2; /2/; %2 ; % #H destruct; qed.
    11 definition fs_eq_dec : ∀s1,s2:floatsize. (s1 = s2) + (s1 ≠ s2).
    12 #s1 cases s1; #s2 cases s2; /2/; %2 ; % #H destruct; qed.
    1311
    1412let rec type_eq_dec (t1,t2:type) : Sum (t1 = t2) (t1 ≠ t2) ≝
     
    1917    match sg_eq_dec sg sg' with [ inl e2 ⇒ inl ???
    2018    | inr e ⇒ inr ?? (nmk ? (λH.match e with [ nmk e' ⇒ e' ? ])) ]
    21     | inr e ⇒ inr ?? (nmk ? (λH.match e with [ nmk e' ⇒ e' ? ])) ]
    22     | _ ⇒ inr ?? (nmk ? (λH.?)) ]
    23 | Tfloat f ⇒ match t2 return λt'. Sum (Tfloat ? = t') (Tfloat ? ≠ t')  with [ Tfloat f' ⇒
    24     match fs_eq_dec f f' with [ inl e1 ⇒ inl ???
    2519    | inr e ⇒ inr ?? (nmk ? (λH.match e with [ nmk e' ⇒ e' ? ])) ]
    2620    | _ ⇒ inr ?? (nmk ? (λH.?)) ]
  • src/Clight/frontend_misc.ma

    r2448 r2468  
    1010include "basics/lists/listb.ma".
    1111include "basics/lists/list.ma".
     12
     13
     14(* --------------------------------------------------------------------------- *)
     15(* [cthulhu] plays the same role as daemon. It should be droppable. *)
     16(* --------------------------------------------------------------------------- *)
     17
     18axiom cthulhu : ∀A:Prop. A. (* Because of the nightmares. *)
    1219
    1320(* --------------------------------------------------------------------------- *)
     
    16471654| 3,4: @reflexive_lset_inclusion ]
    16481655qed.
     1656
     1657(* --------------------------------------------------------------------------- *)
     1658(* Stuff on bitvectors, previously in memoryInjections.ma *)
     1659(* --------------------------------------------------------------------------- *)
     1660(* --------------------------------------------------------------------------- *)   
     1661(* Some general lemmas on bitvectors (offsets /are/ bitvectors) *)
     1662(* --------------------------------------------------------------------------- *)
     1663 
     1664lemma add_with_carries_n_O : ∀n,bv. add_with_carries n bv (zero n) false = 〈bv,zero n〉.
     1665#n #bv whd in match (add_with_carries ????); elim bv //
     1666#n #hd #tl #Hind whd in match (fold_right2_i ????????);
     1667>Hind normalize
     1668cases n in tl;
     1669[ 1: #tl cases hd normalize @refl
     1670| 2: #n' #tl cases hd normalize @refl ]
     1671qed.
     1672
     1673lemma addition_n_0 : ∀n,bv. addition_n n bv (zero n) = bv.
     1674#n #bv whd in match (addition_n ???);
     1675>add_with_carries_n_O //
     1676qed.
     1677
     1678lemma replicate_Sn : ∀A,sz,elt.
     1679  replicate A (S sz) elt = elt ::: (replicate A sz elt).
     1680// qed.
     1681
     1682lemma zero_Sn : ∀n. zero (S n) = false ::: (zero n). // qed.
     1683
     1684lemma negation_bv_Sn : ∀n. ∀xa. ∀a : BitVector n. negation_bv … (xa ::: a) = (notb xa) ::: (negation_bv … a).
     1685#n #xa #a normalize @refl qed.
     1686
     1687(* useful facts on carry_of *)
     1688lemma carry_of_TT : ∀x. carry_of true true x = true. // qed.
     1689lemma carry_of_TF : ∀x. carry_of true false x = x. // qed.
     1690lemma carry_of_FF : ∀x. carry_of false false x = false. // qed.
     1691lemma carry_of_lcomm : ∀x,y,z. carry_of x y z = carry_of y x z. * * * // qed.
     1692lemma carry_of_rcomm : ∀x,y,z. carry_of x y z = carry_of x z y. * * * // qed.
     1693
     1694
     1695
     1696definition one_bv ≝ λn. (\fst (add_with_carries … (zero n) (zero n) true)).
     1697
     1698lemma one_bv_Sn_aux : ∀n. ∀bits,flags : BitVector (S n).
     1699    add_with_carries … (zero (S n)) (zero (S n)) true = 〈bits, flags〉 →
     1700    add_with_carries … (zero (S (S n))) (zero (S (S n))) true = 〈false ::: bits, false ::: flags〉.
     1701#n elim n
     1702[ 1: #bits #flags elim (BitVector_Sn … bits) #hd_bits * #tl_bits #Heq_bits
     1703     elim (BitVector_Sn … flags) #hd_flags * #tl_flags #Heq_flags
     1704     >(BitVector_O … tl_flags) >(BitVector_O … tl_bits)
     1705     normalize #Heq destruct (Heq) @refl
     1706| 2: #n' #Hind #bits #flags elim (BitVector_Sn … bits) #hd_bits * #tl_bits #Heq_bits
     1707     destruct #Hind >add_with_carries_Sn >replicate_Sn
     1708     whd in match (zero ?) in Hind; lapply Hind
     1709     elim (add_with_carries (S (S n'))
     1710            (false:::replicate bool (S n') false)
     1711            (false:::replicate bool (S n') false) true) #bits #flags #Heq destruct
     1712            normalize >add_with_carries_Sn in Hind;
     1713     elim (add_with_carries (S n') (replicate bool (S n') false)
     1714                    (replicate bool (S n') false) true) #flags' #bits'
     1715     normalize
     1716     cases (match bits' in Vector return λsz:ℕ.(λfoo:Vector bool sz.bool) with 
     1717            [VEmpty⇒true|VCons (sz:ℕ)   (cy:bool)   (tl:(Vector bool sz))⇒cy])
     1718     normalize #Heq destruct @refl
     1719] qed.     
     1720
     1721lemma one_bv_Sn : ∀n. one_bv (S (S n)) = false ::: (one_bv (S n)).
     1722#n lapply (one_bv_Sn_aux n)
     1723whd in match (one_bv ?) in ⊢ (? → (??%%));
     1724elim (add_with_carries (S n) (zero (S n)) (zero (S n)) true) #bits #flags
     1725#H lapply (H bits flags (refl ??)) #H2 >H2 @refl
     1726qed.
     1727
     1728lemma increment_to_addition_n_aux : ∀n. ∀a : BitVector n.
     1729    add_with_carries ? a (zero n) true = add_with_carries ? a (one_bv n) false.
     1730#n   
     1731elim n
     1732[ 1: #a >(BitVector_O … a) normalize @refl
     1733| 2: #n' cases n'
     1734     [ 1: #Hind #a elim (BitVector_Sn ? a) #xa * #tl #Heq destruct
     1735          >(BitVector_O … tl) normalize cases xa @refl
     1736     | 2: #n'' #Hind #a elim (BitVector_Sn ? a) #xa * #tl #Heq destruct
     1737          >one_bv_Sn >zero_Sn
     1738          lapply (Hind tl)
     1739          >add_with_carries_Sn >add_with_carries_Sn
     1740          #Hind >Hind elim (add_with_carries (S n'') tl (one_bv (S n'')) false) #bits #flags
     1741          normalize nodelta elim (BitVector_Sn … flags) #flags_hd * #flags_tl #Hflags_eq >Hflags_eq
     1742          normalize nodelta @refl
     1743] qed.         
     1744
     1745(* In order to use associativity on increment, we hide it under addition_n. *)
     1746lemma increment_to_addition_n : ∀n. ∀a : BitVector n. increment ? a = addition_n ? a (one_bv n).
     1747#n
     1748whd in match (increment ??) in ⊢ (∀_.??%?);
     1749whd in match (addition_n ???) in ⊢ (∀_.???%);
     1750#a lapply (increment_to_addition_n_aux n a)
     1751#Heq >Heq cases (add_with_carries n a (one_bv n) false) #bits #flags @refl
     1752qed.
     1753
     1754(* Explicit formulation of addition *)
     1755
     1756(* Explicit formulation of the last carry bit *)
     1757let rec ith_carry (n : nat) (a,b : BitVector n) (init : bool) on n : bool ≝
     1758match n return λx. BitVector x → BitVector x → bool with
     1759[ O ⇒ λ_,_. init
     1760| S x ⇒ λa',b'.
     1761  let hd_a ≝ head' … a' in
     1762  let hd_b ≝ head' … b' in
     1763  let tl_a ≝ tail … a' in
     1764  let tl_b ≝ tail … b' in
     1765  carry_of hd_a hd_b (ith_carry x tl_a tl_b init)
     1766] a b.
     1767
     1768lemma ith_carry_unfold : ∀n. ∀init. ∀a,b : BitVector (S n).
     1769  ith_carry ? a b init = (carry_of (head' … a) (head' … b) (ith_carry ? (tail … a) (tail … b) init)).
     1770#n #init #a #b @refl qed.
     1771
     1772lemma ith_carry_Sn : ∀n. ∀init. ∀xa,xb. ∀a,b : BitVector n.
     1773  ith_carry ? (xa ::: a) (xb ::: b) init = (carry_of xa xb (ith_carry ? a b init)). // qed.
     1774
     1775(* correction of [ith_carry] *)
     1776lemma ith_carry_ok : ∀n. ∀init. ∀a,b,res_ab,flags_ab : BitVector (S n).
     1777  〈res_ab,flags_ab〉 = add_with_carries ? a b init →
     1778  head' … flags_ab = ith_carry ? a b init.
     1779#n elim n
     1780[ 1: #init #a #b #res_ab #flags_ab
     1781     elim (BitVector_Sn … a) #hd_a * #tl_a #Heq_a
     1782     elim (BitVector_Sn … b) #hd_b * #tl_b #Heq_b
     1783     elim (BitVector_Sn … res_ab) #hd_res * #tl_res #Heq_res
     1784     elim (BitVector_Sn … flags_ab) #hd_flags * #tl_flags #Heq_flags
     1785     destruct
     1786     >(BitVector_O … tl_a) >(BitVector_O … tl_b)
     1787     cases hd_a cases hd_b cases init normalize #Heq destruct (Heq)
     1788     @refl
     1789| 2: #n' #Hind #init #a #b #res_ab #flags_ab
     1790     elim (BitVector_Sn … a) #hd_a * #tl_a #Heq_a
     1791     elim (BitVector_Sn … b) #hd_b * #tl_b #Heq_b
     1792     elim (BitVector_Sn … res_ab) #hd_res * #tl_res #Heq_res
     1793     elim (BitVector_Sn … flags_ab) #hd_flags * #tl_flags #Heq_flags
     1794     destruct
     1795     lapply (Hind … init tl_a tl_b tl_res tl_flags)
     1796     >add_with_carries_Sn >(ith_carry_Sn (S n'))
     1797     elim (add_with_carries (S n') tl_a tl_b init) #res_ab #flags_ab
     1798     elim (BitVector_Sn … flags_ab) #hd_flags_ab * #tl_flags_ab #Heq_flags_ab >Heq_flags_ab
     1799     normalize nodelta cases hd_flags_ab normalize nodelta
     1800     whd in match (head' ? (S n') ?); #H1 #H2
     1801     destruct (H2) lapply (H1 (refl ??)) whd in match (head' ???); #Heq <Heq @refl
     1802] qed.
     1803
     1804(* Explicit formulation of ith bit of an addition, with explicit initial carry bit. *)
     1805definition ith_bit ≝ λ(n : nat).λ(a,b : BitVector n).λinit.
     1806match n return λx. BitVector x → BitVector x → bool with
     1807[ O ⇒ λ_,_. init
     1808| S x ⇒ λa',b'.
     1809  let hd_a ≝ head' … a' in
     1810  let hd_b ≝ head' … b' in
     1811  let tl_a ≝ tail … a' in
     1812  let tl_b ≝ tail … b' in
     1813  xorb (xorb hd_a hd_b) (ith_carry x tl_a tl_b init)
     1814] a b.
     1815
     1816lemma ith_bit_unfold : ∀n. ∀init. ∀a,b : BitVector (S n).
     1817  ith_bit ? a b init =  xorb (xorb (head' … a) (head' … b)) (ith_carry ? (tail … a) (tail … b) init).
     1818#n #a #b // qed.
     1819
     1820lemma ith_bit_Sn : ∀n. ∀init. ∀xa,xb. ∀a,b : BitVector n.
     1821  ith_bit ? (xa ::: a) (xb ::: b) init =  xorb (xorb xa xb) (ith_carry ? a b init). // qed.
     1822
     1823(* correction of ith_bit *)
     1824lemma ith_bit_ok : ∀n. ∀init. ∀a,b,res_ab,flags_ab : BitVector (S n).
     1825  〈res_ab,flags_ab〉 = add_with_carries ? a b init →
     1826  head' … res_ab = ith_bit ? a b init.
     1827#n
     1828cases n
     1829[ 1: #init #a #b #res_ab #flags_ab
     1830     elim (BitVector_Sn … a) #hd_a * #tl_a #Heq_a
     1831     elim (BitVector_Sn … b) #hd_b * #tl_b #Heq_b
     1832     elim (BitVector_Sn … res_ab) #hd_res * #tl_res #Heq_res
     1833     elim (BitVector_Sn … flags_ab) #hd_flags * #tl_flags #Heq_flags
     1834     destruct
     1835     >(BitVector_O … tl_a) >(BitVector_O … tl_b)
     1836     >(BitVector_O … tl_flags) >(BitVector_O … tl_res)
     1837     normalize cases init cases hd_a cases hd_b normalize #Heq destruct @refl
     1838| 2: #n' #init #a #b #res_ab #flags_ab
     1839     elim (BitVector_Sn … a) #hd_a * #tl_a #Heq_a
     1840     elim (BitVector_Sn … b) #hd_b * #tl_b #Heq_b
     1841     elim (BitVector_Sn … res_ab) #hd_res * #tl_res #Heq_res
     1842     elim (BitVector_Sn … flags_ab) #hd_flags * #tl_flags #Heq_flags
     1843     destruct
     1844     lapply (ith_carry_ok … init tl_a tl_b tl_res tl_flags)
     1845     #Hcarry >add_with_carries_Sn elim (add_with_carries ? tl_a tl_b init) in Hcarry;
     1846     #res #flags normalize nodelta elim (BitVector_Sn … flags) #hd_flags' * #tl_flags' #Heq_flags'
     1847     >Heq_flags' normalize nodelta cases hd_flags' normalize nodelta #H1 #H2 destruct (H2)
     1848     cases hd_a cases hd_b >ith_bit_Sn whd in match (head' ???) in H1 ⊢ %;
     1849     <(H1 (refl ??)) @refl
     1850] qed.
     1851
     1852(* Transform a function from bit-vectors to bits into a vector by folding *)
     1853let rec bitvector_fold (n : nat) (v : BitVector n) (f : ∀sz. BitVector sz → bool) on v : BitVector n ≝
     1854match v with
     1855[ VEmpty ⇒ VEmpty ?
     1856| VCons sz elt tl ⇒
     1857  let bit ≝ f ? v in
     1858  bit ::: (bitvector_fold ? tl f)
     1859].
     1860
     1861(* Two-arguments version *)
     1862let rec bitvector_fold2 (n : nat) (v1, v2 : BitVector n) (f : ∀sz. BitVector sz → BitVector sz → bool) on v1 : BitVector n ≝
     1863match v1  with
     1864[ VEmpty ⇒ λ_. VEmpty ?
     1865| VCons sz elt tl ⇒ λv2'.
     1866  let bit ≝ f ? v1 v2 in
     1867  bit ::: (bitvector_fold2 ? tl (tail … v2') f)
     1868] v2.
     1869
     1870lemma bitvector_fold2_Sn : ∀n,x1,x2,v1,v2,f.
     1871  bitvector_fold2 (S n) (x1 ::: v1) (x2 ::: v2) f = (f ? (x1 ::: v1) (x2 ::: v2)) ::: (bitvector_fold2 … v1 v2 f). // qed.
     1872
     1873(* These functions pack all the relevant information (including carries) directly. *)
     1874definition addition_n_direct ≝ λn,v1,v2,init. bitvector_fold2 n v1 v2 (λn,v1,v2. ith_bit n v1 v2 init).
     1875
     1876lemma addition_n_direct_Sn : ∀n,x1,x2,v1,v2,init.
     1877  addition_n_direct (S n) (x1 ::: v1) (x2 ::: v2) init = (ith_bit ? (x1 ::: v1) (x2 ::: v2) init) ::: (addition_n_direct … v1 v2 init). // qed.
     1878 
     1879lemma tail_Sn : ∀n. ∀x. ∀a : BitVector n. tail … (x ::: a) = a. // qed.
     1880
     1881(* Prove the equivalence of addition_n_direct with add_with_carries *)
     1882lemma addition_n_direct_ok : ∀n,carry,v1,v2.
     1883  (\fst (add_with_carries n v1 v2 carry)) = addition_n_direct n v1 v2 carry.
     1884#n elim n
     1885[ 1: #carry #v1 #v2 >(BitVector_O … v1) >(BitVector_O … v2) normalize @refl
     1886| 2: #n' #Hind #carry #v1 #v2
     1887     elim (BitVector_Sn … v1) #hd1 * #tl1 #Heq1
     1888     elim (BitVector_Sn … v2) #hd2 * #tl2 #Heq2
     1889     lapply (Hind carry tl1 tl2)
     1890     lapply (ith_bit_ok ? carry v1 v2)
     1891     lapply (ith_carry_ok ? carry v1 v2)
     1892     destruct
     1893     #Hind >addition_n_direct_Sn
     1894     >ith_bit_Sn >add_with_carries_Sn
     1895     elim (add_with_carries n' tl1 tl2 carry) #bits #flags normalize nodelta
     1896     cases (match flags in Vector return λsz:ℕ.(λfoo:Vector bool sz.bool) with 
     1897            [VEmpty⇒carry|VCons (sz:ℕ)   (cy:bool)   (tl:(Vector bool sz))⇒cy])
     1898     normalize nodelta #Hcarry' lapply (Hcarry' ?? (refl ??))
     1899     whd in match head'; normalize nodelta
     1900     #H1 #H2 >H1 >H2 @refl
     1901] qed.
     1902
     1903lemma addition_n_direct_ok2 : ∀n,carry,v1,v2.
     1904  (let 〈a,b〉 ≝ add_with_carries n v1 v2 carry in a) = addition_n_direct n v1 v2 carry.
     1905#n #carry #v1 #v2 <addition_n_direct_ok
     1906cases (add_with_carries ????) //
     1907qed.
     1908 
     1909(* trivially lift associativity to our new setting *)     
     1910lemma associative_addition_n_direct : ∀n. ∀carry1,carry2. ∀v1,v2,v3 : BitVector n.
     1911  addition_n_direct ? (addition_n_direct ? v1 v2 carry1) v3 carry2 =
     1912  addition_n_direct ? v1 (addition_n_direct ? v2 v3 carry1) carry2.
     1913#n #carry1 #carry2 #v1 #v2 #v3
     1914<addition_n_direct_ok <addition_n_direct_ok
     1915<addition_n_direct_ok <addition_n_direct_ok
     1916lapply (associative_add_with_carries … carry1 carry2 v1 v2 v3)
     1917elim (add_with_carries n v2 v3 carry1) #bits #carries normalize nodelta
     1918elim (add_with_carries n v1 v2 carry1) #bits' #carries' normalize nodelta
     1919#H @(sym_eq … H)
     1920qed.
     1921
     1922lemma commutative_addition_n_direct : ∀n. ∀v1,v2 : BitVector n.
     1923  addition_n_direct ? v1 v2 false = addition_n_direct ? v2 v1 false.
     1924#n #v1 #v2 /by associative_addition_n, addition_n_direct_ok/
     1925qed.
     1926
     1927definition increment_direct ≝ λn,v. addition_n_direct n v (one_bv ?) false.
     1928definition twocomp_neg_direct ≝ λn,v. increment_direct n (negation_bv n v).
     1929
     1930
     1931(* fold andb on a bitvector. *)
     1932let rec andb_fold (n : nat) (b : BitVector n) on b : bool ≝
     1933match b with
     1934[ VEmpty ⇒ true
     1935| VCons sz elt tl ⇒
     1936  andb elt (andb_fold ? tl)
     1937].
     1938
     1939lemma andb_fold_Sn : ∀n. ∀x. ∀b : BitVector n. andb_fold (S n) (x ::: b) = andb x (andb_fold … n b). // qed.
     1940
     1941lemma andb_fold_inversion : ∀n. ∀elt,x. andb_fold (S n) (elt ::: x) = true → elt = true ∧ andb_fold n x = true.
     1942#n #elt #x cases elt normalize #H @conj destruct (H) try assumption @refl
     1943qed.
     1944
     1945lemma ith_increment_carry : ∀n. ∀a : BitVector (S n).
     1946  ith_carry … a (one_bv ?) false = andb_fold … a.
     1947#n elim n
     1948[ 1: #a elim (BitVector_Sn … a) #hd * #tl #Heq >Heq >(BitVector_O … tl)
     1949     cases hd normalize @refl
     1950| 2: #n' #Hind #a
     1951     elim (BitVector_Sn … a) #hd * #tl #Heq >Heq
     1952     lapply (Hind … tl) #Hind >one_bv_Sn
     1953     >ith_carry_Sn whd in match (andb_fold ??);
     1954     cases hd >Hind @refl
     1955] qed.
     1956
     1957lemma ith_increment_bit : ∀n. ∀a : BitVector (S n).
     1958  ith_bit … a (one_bv ?) false = xorb (head' … a) (andb_fold … (tail … a)).
     1959#n #a
     1960elim (BitVector_Sn … a) #hd * #tl #Heq >Heq
     1961whd in match (head' ???);
     1962-a cases n in tl;
     1963[ 1: #tl >(BitVector_O … tl) cases hd normalize try //
     1964| 2: #n' #tl >one_bv_Sn >ith_bit_Sn
     1965     >ith_increment_carry >tail_Sn
     1966     cases hd try //
     1967] qed.
     1968
     1969(* Lemma used to prove involutivity of two-complement negation *)
     1970lemma twocomp_neg_involutive_aux : ∀n. ∀v : BitVector (S n).
     1971   (andb_fold (S n) (negation_bv (S n) v) =
     1972    andb_fold (S n) (negation_bv (S n) (addition_n_direct (S n) (negation_bv (S n) v) (one_bv (S n)) false))).
     1973#n elim n
     1974[ 1: #v elim (BitVector_Sn … v) #hd * #tl #Heq >Heq >(BitVector_O … tl) cases hd @refl
     1975| 2: #n' #Hind #v elim (BitVector_Sn … v) #hd * #tl #Heq >Heq
     1976     lapply (Hind tl) -Hind #Hind >negation_bv_Sn >one_bv_Sn >addition_n_direct_Sn
     1977     >andb_fold_Sn >ith_bit_Sn >negation_bv_Sn >andb_fold_Sn <Hind
     1978     cases hd normalize nodelta
     1979     [ 1: >xorb_false >(xorb_comm false ?) >xorb_false
     1980     | 2: >xorb_false >(xorb_comm true ?) >xorb_true ]
     1981     >ith_increment_carry
     1982     cases (andb_fold (S n') (negation_bv (S n') tl)) @refl
     1983] qed.
     1984   
     1985(* Test of the 'direct' approach: proof of the involutivity of two-complement negation. *)
     1986lemma twocomp_neg_involutive : ∀n. ∀v : BitVector n. twocomp_neg_direct ? (twocomp_neg_direct ? v) = v.
     1987#n elim n
     1988[ 1: #v >(BitVector_O v) @refl
     1989| 2: #n' cases n'
     1990     [ 1: #Hind #v elim (BitVector_Sn … v) #hd * #tl #Heq >Heq
     1991          >(BitVector_O … tl) normalize cases hd @refl
     1992     | 2: #n'' #Hind #v elim (BitVector_Sn … v) #hd * #tl #Heq >Heq
     1993          lapply (Hind tl) -Hind #Hind <Hind in ⊢ (???%);
     1994          whd in match twocomp_neg_direct; normalize nodelta
     1995          whd in match increment_direct; normalize nodelta
     1996          >(negation_bv_Sn ? hd tl) >one_bv_Sn >(addition_n_direct_Sn ? (¬hd) false ??)
     1997          >ith_bit_Sn >negation_bv_Sn >addition_n_direct_Sn >ith_bit_Sn
     1998          generalize in match (addition_n_direct (S n'')
     1999                                                   (negation_bv (S n'')
     2000                                                   (addition_n_direct (S n'') (negation_bv (S n'') tl) (one_bv (S n'')) false))
     2001                                                   (one_bv (S n'')) false); #tail
     2002          >ith_increment_carry >ith_increment_carry
     2003          cases hd normalize nodelta
     2004          [ 1: normalize in match (xorb false false); >(xorb_comm false ?) >xorb_false >xorb_false
     2005          | 2: normalize in match (xorb true false); >(xorb_comm true ?) >xorb_true >xorb_false ]
     2006          <twocomp_neg_involutive_aux
     2007          cases (andb_fold (S n'') (negation_bv (S n'') tl)) @refl
     2008      ]
     2009] qed.
     2010
     2011lemma bitvector_cons_inj_inv : ∀n. ∀a,b. ∀va,vb : BitVector n. a ::: va = b ::: vb → a =b ∧ va = vb.
     2012#n #a #b #va #vb #H destruct (H) @conj @refl qed.
     2013
     2014lemma bitvector_cons_eq : ∀n. ∀a,b. ∀v : BitVector n. a = b → a ::: v = b ::: v. // qed.
     2015
     2016(* Injectivity of increment *)
     2017lemma increment_inj : ∀n. ∀a,b : BitVector n.
     2018  increment_direct ? a = increment_direct ? b →
     2019  a = b ∧ (ith_carry n a (one_bv n) false = ith_carry n b (one_bv n) false).
     2020#n whd in match increment_direct; normalize nodelta elim n
     2021[ 1: #a #b >(BitVector_O … a) >(BitVector_O … b) normalize #_ @conj //
     2022| 2: #n' cases n'
     2023   [ 1: #_ #a #b
     2024        elim (BitVector_Sn … a) #hd_a * #tl_a #Heq_a >Heq_a
     2025        elim (BitVector_Sn … b) #hd_b * #tl_b #Heq_b >Heq_b
     2026        >(BitVector_O … tl_a) >(BitVector_O … tl_b) cases hd_a cases hd_b
     2027        normalize #H @conj try //
     2028   | 2: #n'' #Hind #a #b
     2029        elim (BitVector_Sn … a) #hd_a * #tl_a #Heq_a >Heq_a
     2030        elim (BitVector_Sn … b) #hd_b * #tl_b #Heq_b >Heq_b
     2031        lapply (Hind … tl_a tl_b) -Hind #Hind
     2032        >one_bv_Sn >addition_n_direct_Sn >ith_bit_Sn
     2033        >addition_n_direct_Sn >ith_bit_Sn >xorb_false >xorb_false
     2034        #H elim (bitvector_cons_inj_inv … H) #Heq1 #Heq2
     2035        lapply (Hind Heq2) * #Heq3 #Heq4
     2036        cut (hd_a = hd_b)
     2037        [ 1: >Heq4 in Heq1; #Heq5 lapply (xorb_inj (ith_carry ? tl_b (one_bv ?) false) hd_a hd_b)
     2038             * #Heq6 #_ >xorb_comm in Heq6; >(xorb_comm  ? hd_b) #Heq6 >(Heq6 Heq5)
     2039             @refl ]
     2040        #Heq5 @conj [ 1: >Heq3 >Heq5 @refl ]
     2041        >ith_carry_Sn >ith_carry_Sn >Heq4 >Heq5 @refl
     2042] qed.
     2043
     2044(* Inverse of injecivity of increment, does not lose information (cf increment_inj) *)
     2045lemma increment_inj_inv : ∀n. ∀a,b : BitVector n.
     2046  a = b → increment_direct ? a = increment_direct ? b. // qed.
     2047
     2048(* A more general result. *)
     2049lemma addition_n_direct_inj : ∀n. ∀x,y,delta: BitVector n.
     2050  addition_n_direct ? x delta false = addition_n_direct ? y delta false →
     2051  x = y ∧ (ith_carry n x delta false = ith_carry n y delta false).
     2052#n elim n
     2053[ 1: #x #y #delta >(BitVector_O … x) >(BitVector_O … y) >(BitVector_O … delta) * @conj @refl
     2054| 2: #n' #Hind #x #y #delta
     2055     elim (BitVector_Sn … x) #hdx * #tlx #Heqx >Heqx
     2056     elim (BitVector_Sn … y) #hdy * #tly #Heqy >Heqy
     2057     elim (BitVector_Sn … delta) #hdd * #tld #Heqd >Heqd
     2058     >addition_n_direct_Sn >ith_bit_Sn
     2059     >addition_n_direct_Sn >ith_bit_Sn
     2060     >ith_carry_Sn >ith_carry_Sn
     2061     lapply (Hind … tlx tly tld) -Hind #Hind #Heq
     2062     elim (bitvector_cons_inj_inv … Heq) #Heq_hd #Heq_tl
     2063     lapply (Hind Heq_tl) -Hind * #HindA #HindB
     2064     >HindA >HindB >HindB in Heq_hd; #Heq_hd
     2065     cut (hdx = hdy)
     2066     [ 1: cases hdd in Heq_hd; cases (ith_carry n' tly tld false)
     2067          cases hdx cases hdy normalize #H try @H try @refl
     2068          >H try @refl ]
     2069     #Heq_hd >Heq_hd @conj @refl
     2070] qed.
     2071
     2072(* We also need it the other way around. *)
     2073lemma addition_n_direct_inj_inv : ∀n. ∀x,y,delta: BitVector n.
     2074  x ≠ y → (* ∧ (ith_carry n x delta false = ith_carry n y delta false). *)
     2075   addition_n_direct ? x delta false ≠ addition_n_direct ? y delta false.
     2076#n elim n
     2077[ 1: #x #y #delta >(BitVector_O … x) >(BitVector_O … y) >(BitVector_O … delta) * #H @(False_ind … (H (refl ??)))
     2078| 2: #n' #Hind #x #y #delta
     2079     elim (BitVector_Sn … x) #hdx * #tlx #Heqx >Heqx
     2080     elim (BitVector_Sn … y) #hdy * #tly #Heqy >Heqy
     2081     elim (BitVector_Sn … delta) #hdd * #tld #Heqd >Heqd
     2082     #Hneq
     2083     cut (hdx ≠ hdy ∨ tlx ≠ tly)
     2084     [ @(eq_bv_elim … tlx tly)
     2085       [ #Heq_tl >Heq_tl >Heq_tl in Hneq;
     2086         #Hneq cut (hdx ≠ hdy) [ % #Heq_hd >Heq_hd in Hneq; *
     2087                                 #H @H @refl ]
     2088         #H %1 @H
     2089       | #H %2 @H ] ]
     2090     -Hneq #Hneq
     2091     >addition_n_direct_Sn >addition_n_direct_Sn
     2092     >ith_bit_Sn >ith_bit_Sn cases Hneq
     2093     [ 1: #Hneq_hd
     2094          lapply (addition_n_direct_inj … tlx tly tld)         
     2095          @(eq_bv_elim … (addition_n_direct ? tlx tld false) (addition_n_direct ? tly tld false))
     2096          [ 1: #Heq -Hind #Hind elim (Hind Heq) #Heq_tl >Heq_tl #Heq_carry >Heq_carry
     2097               % #Habsurd elim (bitvector_cons_inj_inv … Habsurd) -Habsurd
     2098               lapply Hneq_hd
     2099               cases hdx cases hdd cases hdy cases (ith_carry ? tly tld false)
     2100               normalize in ⊢ (? → % → ?); #Hneq_hd #Heq_hd #_
     2101               try @(absurd … Heq_hd Hneq_hd)
     2102               elim Hneq_hd -Hneq_hd #Hneq_hd @Hneq_hd
     2103               try @refl try assumption try @(sym_eq … Heq_hd)
     2104          | 2: #Htl_not_eq #_ % #Habsurd elim (bitvector_cons_inj_inv … Habsurd) #_
     2105               elim Htl_not_eq -Htl_not_eq #HA #HB @HA @HB ]
     2106     | 2: #Htl_not_eq lapply (Hind tlx tly tld Htl_not_eq) -Hind #Hind
     2107          % #Habsurd elim (bitvector_cons_inj_inv … Habsurd) #_
     2108          elim Hind -Hind #HA #HB @HA @HB ]
     2109] qed.
     2110
     2111lemma carry_notb : ∀a,b,c. notb (carry_of a b c) = carry_of (notb a) (notb b) (notb c). * * * @refl qed.
     2112
     2113lemma increment_to_carry_aux : ∀n. ∀a : BitVector (S n).
     2114   ith_carry (S n) a (one_bv (S n)) false
     2115   = ith_carry (S n) a (zero (S n)) true.
     2116#n elim n
     2117[ 1: #a elim (BitVector_Sn ? a) #hd_a * #tl_a #Heq >Heq >(BitVector_O … tl_a) @refl
     2118| 2: #n' #Hind #a elim (BitVector_Sn ? a) #hd_a * #tl_a #Heq >Heq
     2119     lapply (Hind tl_a) #Hind
     2120     >one_bv_Sn >zero_Sn >ith_carry_Sn >ith_carry_Sn >Hind @refl
     2121] qed.
     2122
     2123lemma neutral_addition_n_direct_aux : ∀n. ∀v. ith_carry n v (zero n) false = false.
     2124#n elim n //
     2125#n' #Hind #v elim (BitVector_Sn … v) #hd * #tl #Heq >Heq >zero_Sn
     2126>ith_carry_Sn >(Hind tl) cases hd @refl.
     2127qed.
     2128
     2129lemma neutral_addition_n_direct : ∀n. ∀v : BitVector n.
     2130  addition_n_direct ? v (zero ?) false = v.
     2131#n elim n
     2132[ 1: #v >(BitVector_O … v) normalize @refl
     2133| 2: #n' #Hind #v elim (BitVector_Sn … v) #hd * #tl #Heq >Heq
     2134     lapply (Hind … tl) #H >zero_Sn >addition_n_direct_Sn
     2135     >ith_bit_Sn >H >xorb_false >neutral_addition_n_direct_aux
     2136     >xorb_false @refl
     2137] qed.
     2138
     2139lemma increment_to_carry_zero : ∀n. ∀a : BitVector n. addition_n_direct ? a (one_bv ?) false = addition_n_direct ? a (zero ?) true.
     2140#n elim n
     2141[ 1: #a >(BitVector_O … a) normalize @refl
     2142| 2: #n' cases n'
     2143     [ 1: #_ #a elim (BitVector_Sn … a) #hd_a * #tl_a #Heq >Heq >(BitVector_O … tl_a) cases hd_a @refl
     2144     | 2: #n'' #Hind #a
     2145          elim (BitVector_Sn … a) #hd_a * #tl_a #Heq >Heq
     2146          lapply (Hind tl_a) -Hind #Hind
     2147          >one_bv_Sn >zero_Sn >addition_n_direct_Sn >ith_bit_Sn
     2148          >addition_n_direct_Sn >ith_bit_Sn
     2149          >xorb_false >Hind @bitvector_cons_eq
     2150          >increment_to_carry_aux @refl
     2151     ]
     2152] qed.
     2153
     2154lemma increment_to_carry : ∀n. ∀a,b : BitVector n.
     2155  addition_n_direct ? a (addition_n_direct ? b (one_bv ?) false) false = addition_n_direct ? a b true.
     2156#n #a #b >increment_to_carry_zero <associative_addition_n_direct
     2157>neutral_addition_n_direct @refl
     2158qed.
     2159
     2160lemma increment_direct_ok : ∀n,v. increment_direct n v = increment n v.
     2161#n #v whd in match (increment ??);
     2162>addition_n_direct_ok <increment_to_carry_zero @refl
     2163qed.
     2164
     2165(* Prove -(a + b) = -a + -b *)
     2166lemma twocomp_neg_plus : ∀n. ∀a,b : BitVector n.
     2167  twocomp_neg_direct ? (addition_n_direct ? a b false) = addition_n_direct ? (twocomp_neg_direct … a) (twocomp_neg_direct … b) false.
     2168whd in match twocomp_neg_direct; normalize nodelta
     2169lapply increment_inj_inv
     2170whd in match increment_direct; normalize nodelta
     2171#H #n #a #b
     2172<associative_addition_n_direct @H
     2173>associative_addition_n_direct >(commutative_addition_n_direct ? (one_bv n))
     2174>increment_to_carry
     2175-H lapply b lapply a -b -a
     2176cases n
     2177[ 1: #a #b >(BitVector_O … a) >(BitVector_O … b) @refl
     2178| 2: #n' #a #b
     2179     cut (negation_bv ? (addition_n_direct ? a b false)
     2180           = addition_n_direct ? (negation_bv ? a) (negation_bv ? b) true ∧
     2181          notb (ith_carry ? a b false) = (ith_carry ? (negation_bv ? a) (negation_bv ? b) true))
     2182     [ -n lapply b lapply a elim n'
     2183     [ 1: #a #b elim (BitVector_Sn … a) #hd_a * #tl_a #Heqa >Heqa >(BitVector_O … tl_a)
     2184          elim (BitVector_Sn … b) #hd_b * #tl_b #Heqb >Heqb >(BitVector_O … tl_b)
     2185          cases hd_a cases hd_b normalize @conj @refl
     2186     | 2: #n #Hind #a #b
     2187          elim (BitVector_Sn … a) #hd_a * #tl_a #Heqa >Heqa
     2188          elim (BitVector_Sn … b) #hd_b * #tl_b #Heqb >Heqb
     2189          lapply (Hind tl_a tl_b) * #H1 #H2
     2190          @conj
     2191          [ 2: >ith_carry_Sn >negation_bv_Sn >negation_bv_Sn >ith_carry_Sn
     2192               >carry_notb >H2 @refl
     2193          | 1: >addition_n_direct_Sn >ith_bit_Sn >negation_bv_Sn
     2194               >negation_bv_Sn >negation_bv_Sn
     2195               >addition_n_direct_Sn >ith_bit_Sn >H1 @bitvector_cons_eq
     2196               >xorb_lneg >xorb_rneg >notb_notb
     2197               <xorb_rneg >H2 @refl
     2198          ]
     2199      ] ]
     2200      * #H1 #H2 @H1
     2201] qed.
     2202
     2203lemma addition_n_direct_neg : ∀n. ∀a.
     2204 (addition_n_direct n a (negation_bv n a) false) = replicate ?? true
     2205 ∧ (ith_carry n a (negation_bv n a) false = false).
     2206#n elim n
     2207[ 1: #a >(BitVector_O … a) @conj @refl
     2208| 2: #n' #Hind #a elim (BitVector_Sn … a) #hd * #tl #Heq >Heq
     2209     lapply (Hind … tl) -Hind * #HA #HB
     2210     @conj
     2211     [ 2: >negation_bv_Sn >ith_carry_Sn >HB cases hd @refl
     2212     | 1: >negation_bv_Sn >addition_n_direct_Sn
     2213          >ith_bit_Sn >HB >xorb_false >HA
     2214          @bitvector_cons_eq elim hd @refl
     2215     ]
     2216] qed.
     2217
     2218(* -a + a = 0 *)
     2219lemma bitvector_opp_direct : ∀n. ∀a : BitVector n. addition_n_direct ? a (twocomp_neg_direct ? a) false = (zero ?).
     2220whd in match twocomp_neg_direct;
     2221whd in match increment_direct;
     2222normalize nodelta
     2223#n #a <associative_addition_n_direct
     2224elim (addition_n_direct_neg … a) #H #_ >H
     2225-H -a
     2226cases n try //
     2227#n'
     2228cut ((addition_n_direct (S n') (replicate bool ? true) (one_bv ?) false = (zero (S n')))
     2229       ∧ (ith_carry ? (replicate bool (S n') true) (one_bv (S n')) false = true))
     2230[ elim n'
     2231     [ 1: @conj @refl
     2232     | 2: #n' * #HA #HB @conj
     2233          [ 1: >replicate_Sn >one_bv_Sn  >addition_n_direct_Sn
     2234               >ith_bit_Sn >HA >zero_Sn @bitvector_cons_eq >HB @refl
     2235          | 2: >replicate_Sn >one_bv_Sn >ith_carry_Sn >HB @refl ]
     2236     ]
     2237] * #H1 #H2 @H1
     2238qed.
     2239
     2240(* Lift back the previous result to standard operations. *)
     2241lemma twocomp_neg_direct_ok : ∀n. ∀v. twocomp_neg_direct ? v = two_complement_negation n v.
     2242#n #v whd in match twocomp_neg_direct; normalize nodelta
     2243whd in match increment_direct; normalize nodelta
     2244whd in match two_complement_negation; normalize nodelta
     2245>increment_to_addition_n <addition_n_direct_ok
     2246whd in match addition_n; normalize nodelta
     2247elim (add_with_carries ????) #a #b @refl
     2248qed.
     2249
     2250lemma two_complement_negation_plus : ∀n. ∀a,b : BitVector n.
     2251  two_complement_negation ? (addition_n ? a b) = addition_n ? (two_complement_negation ? a) (two_complement_negation ? b).
     2252#n #a #b
     2253lapply (twocomp_neg_plus ? a b)
     2254>twocomp_neg_direct_ok >twocomp_neg_direct_ok >twocomp_neg_direct_ok
     2255<addition_n_direct_ok <addition_n_direct_ok
     2256whd in match addition_n; normalize nodelta
     2257elim (add_with_carries n a b false) #bits #flags normalize nodelta
     2258elim (add_with_carries n (two_complement_negation n a) (two_complement_negation n b) false) #bits' #flags'
     2259normalize nodelta #H @H
     2260qed.
     2261
     2262lemma bitvector_opp_addition_n : ∀n. ∀a : BitVector n. addition_n ? a (two_complement_negation ? a) = (zero ?).
     2263#n #a lapply (bitvector_opp_direct ? a)
     2264>twocomp_neg_direct_ok <addition_n_direct_ok
     2265whd in match (addition_n ???);
     2266elim (add_with_carries n a (two_complement_negation n a) false) #bits #flags #H @H
     2267qed.
     2268
     2269lemma neutral_addition_n : ∀n. ∀a : BitVector n. addition_n ? a (zero ?) = a.
     2270#n #a
     2271lapply (neutral_addition_n_direct n a)
     2272<addition_n_direct_ok
     2273whd in match (addition_n ???);
     2274elim (add_with_carries n a (zero n) false) #bits #flags #H @H
     2275qed.
     2276
     2277lemma injective_addition_n : ∀n. ∀x,y,delta : BitVector n.
     2278  addition_n ? x delta = addition_n ? y delta → x = y. 
     2279#n #x #y #delta 
     2280lapply (addition_n_direct_inj … x y delta)
     2281<addition_n_direct_ok <addition_n_direct_ok
     2282whd in match addition_n; normalize nodelta
     2283elim (add_with_carries n x delta false) #bitsx #flagsx
     2284elim (add_with_carries n y delta false) #bitsy #flagsy
     2285normalize #H1 #H2 elim (H1 H2) #Heq #_ @Heq
     2286qed.
     2287
     2288lemma injective_inv_addition_n : ∀n. ∀x,y,delta : BitVector n.
     2289  x ≠ y → addition_n ? x delta ≠ addition_n ? y delta. 
     2290#n #x #y #delta 
     2291lapply (addition_n_direct_inj_inv … x y delta)
     2292<addition_n_direct_ok <addition_n_direct_ok
     2293whd in match addition_n; normalize nodelta
     2294elim (add_with_carries n x delta false) #bitsx #flagsx
     2295elim (add_with_carries n y delta false) #bitsy #flagsy
     2296normalize #H1 #H2 @(H1 H2)
     2297qed.
     2298
  • src/Clight/labelSimulation.ma

    r2428 r2468  
    6262   learned from the hypothesis. *)
    6363#ge #ge' #en #m #RG @expr_lvalue_ind_combined
    64 [ 1,2: normalize /3 by ex_intro, conj/
     64[ 1: normalize /3 by ex_intro, conj/
    6565| * //
    6666 [ #id #ty #IH #v #tr #EX #u
     
    103103  whd in ⊢ (?(??%?)?);
    104104  cases ty' in EX1rem ⊢ %;
    105   [ 4: #ty' normalize #E destruct /2/
     105  [ 3: #ty' normalize #E destruct /2/
    106106  | *: normalize #A try #B try #C try #D destruct
    107107  ]
     
    213213| #ty #ty' #v #tr normalize /3/
    214214| #ty #e1 #ty' #id #IH #b #o #tr #EX #u cases ty' in IH EX ⊢ %;
    215   [ 7: #id #fl #IH #EX
     215  [ 6: #id #fl #IH #EX
    216216    cases (bind_inversion ????? EX) * * #b1 #o1 #tr1 * #EX1 #EX1rem
    217217    cases (bind_inversion ????? EX1rem) #n * #EXoff #EXoffrem
     
    221221    whd in ⊢ (??%?); whd in ⊢ (??(match % with [_⇒?|_⇒?])?); >EX1'
    222222    whd in ⊢ (??%?); >EXoff whd in ⊢ (??%?); @refl
    223   | 8: #id #fl #IH #EX
     223  | 7: #id #fl #IH #EX
    224224    cases (bind_inversion ????? EX) * * #b1 #o1 #tr1 * #EX1 #EX1rem
    225225    whd in EX1rem:(???%); destruct >shift_fst >shift_fst
     
    661661        %{0} whd whd in ⊢ (??%?);
    662662        >label_function_return >E whd % /3/
    663       | *: #A [ 1,4,5,6,7: #B ] #E >E in EX; #EX whd in EX:(??%%); destruct
     663      | *: #A [ 1,3,4,5,6: #B ] #E >E in EX; #EX whd in EX:(??%%); destruct
    664664      ]
    665665    | #u #s0 #k0 #k0' #K #_ #E1 #E2 #E3 destruct %{0} whd
     
    699699        %{0} whd whd in ⊢ (??%?); >label_function_return >E in ⊢ (??%?);
    700700        whd % /4/
    701       | *: #A [ 1,4,5,6,7: #B ] #E >E in EX; #EX whd in EX:(??%%); destruct
     701      | *: #A [ 1,3,4,5,6: #B ] #E >E in EX; #EX whd in EX:(??%%); destruct
    702702      ]
    703703    | #ls #u #k0 #k0' #K #_ #E1 #E2 #E3 destruct whd in EX:(??%?); destruct
  • src/Clight/memoryInjections.ma

    r2448 r2468  
    11include "Clight/Cexec.ma".
     2include "Clight/MemProperties.ma". 
    23include "Clight/frontend_misc.ma".
    34
     
    78   not allow to prove that the semantics for pointer less-than comparisons is
    89   conserved). *)
    9 
    10 (* --------------------------------------------------------------------------- *)   
    11 (* Some general lemmas on bitvectors (offsets /are/ bitvectors) *)
    12 (* --------------------------------------------------------------------------- *)
    13  
    14 lemma add_with_carries_n_O : ∀n,bv. add_with_carries n bv (zero n) false = 〈bv,zero n〉.
    15 #n #bv whd in match (add_with_carries ????); elim bv //
    16 #n #hd #tl #Hind whd in match (fold_right2_i ????????);
    17 >Hind normalize
    18 cases n in tl;
    19 [ 1: #tl cases hd normalize @refl
    20 | 2: #n' #tl cases hd normalize @refl ]
    21 qed.
    22 
    23 lemma addition_n_0 : ∀n,bv. addition_n n bv (zero n) = bv.
    24 #n #bv whd in match (addition_n ???);
    25 >add_with_carries_n_O //
    26 qed.
    27 
    28 lemma replicate_Sn : ∀A,sz,elt.
    29   replicate A (S sz) elt = elt ::: (replicate A sz elt).
    30 // qed.
    31 
    32 lemma zero_Sn : ∀n. zero (S n) = false ::: (zero n). // qed.
    33 
    34 lemma negation_bv_Sn : ∀n. ∀xa. ∀a : BitVector n. negation_bv … (xa ::: a) = (notb xa) ::: (negation_bv … a).
    35 #n #xa #a normalize @refl qed.
    36 
    37 (* useful facts on carry_of *)
    38 lemma carry_of_TT : ∀x. carry_of true true x = true. // qed.
    39 lemma carry_of_TF : ∀x. carry_of true false x = x. // qed.
    40 lemma carry_of_FF : ∀x. carry_of false false x = false. // qed.
    41 lemma carry_of_lcomm : ∀x,y,z. carry_of x y z = carry_of y x z. * * * // qed.
    42 lemma carry_of_rcomm : ∀x,y,z. carry_of x y z = carry_of x z y. * * * // qed.
    43 
    44 
    45 
    46 definition one_bv ≝ λn. (\fst (add_with_carries … (zero n) (zero n) true)).
    47 
    48 lemma one_bv_Sn_aux : ∀n. ∀bits,flags : BitVector (S n).
    49     add_with_carries … (zero (S n)) (zero (S n)) true = 〈bits, flags〉 →
    50     add_with_carries … (zero (S (S n))) (zero (S (S n))) true = 〈false ::: bits, false ::: flags〉.
    51 #n elim n
    52 [ 1: #bits #flags elim (BitVector_Sn … bits) #hd_bits * #tl_bits #Heq_bits
    53      elim (BitVector_Sn … flags) #hd_flags * #tl_flags #Heq_flags
    54      >(BitVector_O … tl_flags) >(BitVector_O … tl_bits)
    55      normalize #Heq destruct (Heq) @refl
    56 | 2: #n' #Hind #bits #flags elim (BitVector_Sn … bits) #hd_bits * #tl_bits #Heq_bits
    57      destruct #Hind >add_with_carries_Sn >replicate_Sn
    58      whd in match (zero ?) in Hind; lapply Hind
    59      elim (add_with_carries (S (S n'))
    60             (false:::replicate bool (S n') false)
    61             (false:::replicate bool (S n') false) true) #bits #flags #Heq destruct
    62             normalize >add_with_carries_Sn in Hind;
    63      elim (add_with_carries (S n') (replicate bool (S n') false)
    64                     (replicate bool (S n') false) true) #flags' #bits'
    65      normalize
    66      cases (match bits' in Vector return λsz:ℕ.(λfoo:Vector bool sz.bool) with 
    67             [VEmpty⇒true|VCons (sz:ℕ)   (cy:bool)   (tl:(Vector bool sz))⇒cy])
    68      normalize #Heq destruct @refl
    69 ] qed.     
    70 
    71 lemma one_bv_Sn : ∀n. one_bv (S (S n)) = false ::: (one_bv (S n)).
    72 #n lapply (one_bv_Sn_aux n)
    73 whd in match (one_bv ?) in ⊢ (? → (??%%));
    74 elim (add_with_carries (S n) (zero (S n)) (zero (S n)) true) #bits #flags
    75 #H lapply (H bits flags (refl ??)) #H2 >H2 @refl
    76 qed.
    77 
    78 lemma increment_to_addition_n_aux : ∀n. ∀a : BitVector n.
    79     add_with_carries ? a (zero n) true = add_with_carries ? a (one_bv n) false.
    80 #n   
    81 elim n
    82 [ 1: #a >(BitVector_O … a) normalize @refl
    83 | 2: #n' cases n'
    84      [ 1: #Hind #a elim (BitVector_Sn ? a) #xa * #tl #Heq destruct
    85           >(BitVector_O … tl) normalize cases xa @refl
    86      | 2: #n'' #Hind #a elim (BitVector_Sn ? a) #xa * #tl #Heq destruct
    87           >one_bv_Sn >zero_Sn
    88           lapply (Hind tl)
    89           >add_with_carries_Sn >add_with_carries_Sn
    90           #Hind >Hind elim (add_with_carries (S n'') tl (one_bv (S n'')) false) #bits #flags
    91           normalize nodelta elim (BitVector_Sn … flags) #flags_hd * #flags_tl #Hflags_eq >Hflags_eq
    92           normalize nodelta @refl
    93 ] qed.         
    94 
    95 (* In order to use associativity on increment, we hide it under addition_n. *)
    96 lemma increment_to_addition_n : ∀n. ∀a : BitVector n. increment ? a = addition_n ? a (one_bv n).
    97 #n
    98 whd in match (increment ??) in ⊢ (∀_.??%?);
    99 whd in match (addition_n ???) in ⊢ (∀_.???%);
    100 #a lapply (increment_to_addition_n_aux n a)
    101 #Heq >Heq cases (add_with_carries n a (one_bv n) false) #bits #flags @refl
    102 qed.
    103 
    104 (* Explicit formulation of addition *)
    105 
    106 (* Explicit formulation of the last carry bit *)
    107 let rec ith_carry (n : nat) (a,b : BitVector n) (init : bool) on n : bool ≝
    108 match n return λx. BitVector x → BitVector x → bool with
    109 [ O ⇒ λ_,_. init
    110 | S x ⇒ λa',b'.
    111   let hd_a ≝ head' … a' in
    112   let hd_b ≝ head' … b' in
    113   let tl_a ≝ tail … a' in
    114   let tl_b ≝ tail … b' in
    115   carry_of hd_a hd_b (ith_carry x tl_a tl_b init)
    116 ] a b.
    117 
    118 lemma ith_carry_unfold : ∀n. ∀init. ∀a,b : BitVector (S n).
    119   ith_carry ? a b init = (carry_of (head' … a) (head' … b) (ith_carry ? (tail … a) (tail … b) init)).
    120 #n #init #a #b @refl qed.
    121 
    122 lemma ith_carry_Sn : ∀n. ∀init. ∀xa,xb. ∀a,b : BitVector n.
    123   ith_carry ? (xa ::: a) (xb ::: b) init = (carry_of xa xb (ith_carry ? a b init)). // qed.
    124 
    125 (* correction of [ith_carry] *)
    126 lemma ith_carry_ok : ∀n. ∀init. ∀a,b,res_ab,flags_ab : BitVector (S n).
    127   〈res_ab,flags_ab〉 = add_with_carries ? a b init →
    128   head' … flags_ab = ith_carry ? a b init.
    129 #n elim n
    130 [ 1: #init #a #b #res_ab #flags_ab
    131      elim (BitVector_Sn … a) #hd_a * #tl_a #Heq_a
    132      elim (BitVector_Sn … b) #hd_b * #tl_b #Heq_b
    133      elim (BitVector_Sn … res_ab) #hd_res * #tl_res #Heq_res
    134      elim (BitVector_Sn … flags_ab) #hd_flags * #tl_flags #Heq_flags
    135      destruct
    136      >(BitVector_O … tl_a) >(BitVector_O … tl_b)
    137      cases hd_a cases hd_b cases init normalize #Heq destruct (Heq)
    138      @refl
    139 | 2: #n' #Hind #init #a #b #res_ab #flags_ab
    140      elim (BitVector_Sn … a) #hd_a * #tl_a #Heq_a
    141      elim (BitVector_Sn … b) #hd_b * #tl_b #Heq_b
    142      elim (BitVector_Sn … res_ab) #hd_res * #tl_res #Heq_res
    143      elim (BitVector_Sn … flags_ab) #hd_flags * #tl_flags #Heq_flags
    144      destruct
    145      lapply (Hind … init tl_a tl_b tl_res tl_flags)
    146      >add_with_carries_Sn >(ith_carry_Sn (S n'))
    147      elim (add_with_carries (S n') tl_a tl_b init) #res_ab #flags_ab
    148      elim (BitVector_Sn … flags_ab) #hd_flags_ab * #tl_flags_ab #Heq_flags_ab >Heq_flags_ab
    149      normalize nodelta cases hd_flags_ab normalize nodelta
    150      whd in match (head' ? (S n') ?); #H1 #H2
    151      destruct (H2) lapply (H1 (refl ??)) whd in match (head' ???); #Heq <Heq @refl
    152 ] qed.
    153 
    154 (* Explicit formulation of ith bit of an addition, with explicit initial carry bit. *)
    155 definition ith_bit ≝ λ(n : nat).λ(a,b : BitVector n).λinit.
    156 match n return λx. BitVector x → BitVector x → bool with
    157 [ O ⇒ λ_,_. init
    158 | S x ⇒ λa',b'.
    159   let hd_a ≝ head' … a' in
    160   let hd_b ≝ head' … b' in
    161   let tl_a ≝ tail … a' in
    162   let tl_b ≝ tail … b' in
    163   xorb (xorb hd_a hd_b) (ith_carry x tl_a tl_b init)
    164 ] a b.
    165 
    166 lemma ith_bit_unfold : ∀n. ∀init. ∀a,b : BitVector (S n).
    167   ith_bit ? a b init =  xorb (xorb (head' … a) (head' … b)) (ith_carry ? (tail … a) (tail … b) init).
    168 #n #a #b // qed.
    169 
    170 lemma ith_bit_Sn : ∀n. ∀init. ∀xa,xb. ∀a,b : BitVector n.
    171   ith_bit ? (xa ::: a) (xb ::: b) init =  xorb (xorb xa xb) (ith_carry ? a b init). // qed.
    172 
    173 (* correction of ith_bit *)
    174 lemma ith_bit_ok : ∀n. ∀init. ∀a,b,res_ab,flags_ab : BitVector (S n).
    175   〈res_ab,flags_ab〉 = add_with_carries ? a b init →
    176   head' … res_ab = ith_bit ? a b init.
    177 #n
    178 cases n
    179 [ 1: #init #a #b #res_ab #flags_ab
    180      elim (BitVector_Sn … a) #hd_a * #tl_a #Heq_a
    181      elim (BitVector_Sn … b) #hd_b * #tl_b #Heq_b
    182      elim (BitVector_Sn … res_ab) #hd_res * #tl_res #Heq_res
    183      elim (BitVector_Sn … flags_ab) #hd_flags * #tl_flags #Heq_flags
    184      destruct
    185      >(BitVector_O … tl_a) >(BitVector_O … tl_b)
    186      >(BitVector_O … tl_flags) >(BitVector_O … tl_res)
    187      normalize cases init cases hd_a cases hd_b normalize #Heq destruct @refl
    188 | 2: #n' #init #a #b #res_ab #flags_ab
    189      elim (BitVector_Sn … a) #hd_a * #tl_a #Heq_a
    190      elim (BitVector_Sn … b) #hd_b * #tl_b #Heq_b
    191      elim (BitVector_Sn … res_ab) #hd_res * #tl_res #Heq_res
    192      elim (BitVector_Sn … flags_ab) #hd_flags * #tl_flags #Heq_flags
    193      destruct
    194      lapply (ith_carry_ok … init tl_a tl_b tl_res tl_flags)
    195      #Hcarry >add_with_carries_Sn elim (add_with_carries ? tl_a tl_b init) in Hcarry;
    196      #res #flags normalize nodelta elim (BitVector_Sn … flags) #hd_flags' * #tl_flags' #Heq_flags'
    197      >Heq_flags' normalize nodelta cases hd_flags' normalize nodelta #H1 #H2 destruct (H2)
    198      cases hd_a cases hd_b >ith_bit_Sn whd in match (head' ???) in H1 ⊢ %;
    199      <(H1 (refl ??)) @refl
    200 ] qed.
    201 
    202 (* Transform a function from bit-vectors to bits into a vector by folding *)
    203 let rec bitvector_fold (n : nat) (v : BitVector n) (f : ∀sz. BitVector sz → bool) on v : BitVector n ≝
    204 match v with
    205 [ VEmpty ⇒ VEmpty ?
    206 | VCons sz elt tl ⇒
    207   let bit ≝ f ? v in
    208   bit ::: (bitvector_fold ? tl f)
    209 ].
    210 
    211 (* Two-arguments version *)
    212 let rec bitvector_fold2 (n : nat) (v1, v2 : BitVector n) (f : ∀sz. BitVector sz → BitVector sz → bool) on v1 : BitVector n ≝
    213 match v1  with
    214 [ VEmpty ⇒ λ_. VEmpty ?
    215 | VCons sz elt tl ⇒ λv2'.
    216   let bit ≝ f ? v1 v2 in
    217   bit ::: (bitvector_fold2 ? tl (tail … v2') f)
    218 ] v2.
    219 
    220 lemma bitvector_fold2_Sn : ∀n,x1,x2,v1,v2,f.
    221   bitvector_fold2 (S n) (x1 ::: v1) (x2 ::: v2) f = (f ? (x1 ::: v1) (x2 ::: v2)) ::: (bitvector_fold2 … v1 v2 f). // qed.
    222 
    223 (* These functions pack all the relevant information (including carries) directly. *)
    224 definition addition_n_direct ≝ λn,v1,v2,init. bitvector_fold2 n v1 v2 (λn,v1,v2. ith_bit n v1 v2 init).
    225 
    226 lemma addition_n_direct_Sn : ∀n,x1,x2,v1,v2,init.
    227   addition_n_direct (S n) (x1 ::: v1) (x2 ::: v2) init = (ith_bit ? (x1 ::: v1) (x2 ::: v2) init) ::: (addition_n_direct … v1 v2 init). // qed.
    228  
    229 lemma tail_Sn : ∀n. ∀x. ∀a : BitVector n. tail … (x ::: a) = a. // qed.
    230 
    231 (* Prove the equivalence of addition_n_direct with add_with_carries *)
    232 lemma addition_n_direct_ok : ∀n,carry,v1,v2.
    233   (\fst (add_with_carries n v1 v2 carry)) = addition_n_direct n v1 v2 carry.
    234 #n elim n
    235 [ 1: #carry #v1 #v2 >(BitVector_O … v1) >(BitVector_O … v2) normalize @refl
    236 | 2: #n' #Hind #carry #v1 #v2
    237      elim (BitVector_Sn … v1) #hd1 * #tl1 #Heq1
    238      elim (BitVector_Sn … v2) #hd2 * #tl2 #Heq2
    239      lapply (Hind carry tl1 tl2)
    240      lapply (ith_bit_ok ? carry v1 v2)
    241      lapply (ith_carry_ok ? carry v1 v2)
    242      destruct
    243      #Hind >addition_n_direct_Sn
    244      >ith_bit_Sn >add_with_carries_Sn
    245      elim (add_with_carries n' tl1 tl2 carry) #bits #flags normalize nodelta
    246      cases (match flags in Vector return λsz:ℕ.(λfoo:Vector bool sz.bool) with 
    247             [VEmpty⇒carry|VCons (sz:ℕ)   (cy:bool)   (tl:(Vector bool sz))⇒cy])
    248      normalize nodelta #Hcarry' lapply (Hcarry' ?? (refl ??))
    249      whd in match head'; normalize nodelta
    250      #H1 #H2 >H1 >H2 @refl
    251 ] qed.
    252 
    253 lemma addition_n_direct_ok2 : ∀n,carry,v1,v2.
    254   (let 〈a,b〉 ≝ add_with_carries n v1 v2 carry in a) = addition_n_direct n v1 v2 carry.
    255 #n #carry #v1 #v2 <addition_n_direct_ok
    256 cases (add_with_carries ????) //
    257 qed.
    258  
    259 (* trivially lift associativity to our new setting *)     
    260 lemma associative_addition_n_direct : ∀n. ∀carry1,carry2. ∀v1,v2,v3 : BitVector n.
    261   addition_n_direct ? (addition_n_direct ? v1 v2 carry1) v3 carry2 =
    262   addition_n_direct ? v1 (addition_n_direct ? v2 v3 carry1) carry2.
    263 #n #carry1 #carry2 #v1 #v2 #v3
    264 <addition_n_direct_ok <addition_n_direct_ok
    265 <addition_n_direct_ok <addition_n_direct_ok
    266 lapply (associative_add_with_carries … carry1 carry2 v1 v2 v3)
    267 elim (add_with_carries n v2 v3 carry1) #bits #carries normalize nodelta
    268 elim (add_with_carries n v1 v2 carry1) #bits' #carries' normalize nodelta
    269 #H @(sym_eq … H)
    270 qed.
    271 
    272 lemma commutative_addition_n_direct : ∀n. ∀v1,v2 : BitVector n.
    273   addition_n_direct ? v1 v2 false = addition_n_direct ? v2 v1 false.
    274 #n #v1 #v2 /by associative_addition_n, addition_n_direct_ok/
    275 qed.
    276 
    277 definition increment_direct ≝ λn,v. addition_n_direct n v (one_bv ?) false.
    278 definition twocomp_neg_direct ≝ λn,v. increment_direct n (negation_bv n v).
    279 
    280 
    281 (* fold andb on a bitvector. *)
    282 let rec andb_fold (n : nat) (b : BitVector n) on b : bool ≝
    283 match b with
    284 [ VEmpty ⇒ true
    285 | VCons sz elt tl ⇒
    286   andb elt (andb_fold ? tl)
    287 ].
    288 
    289 lemma andb_fold_Sn : ∀n. ∀x. ∀b : BitVector n. andb_fold (S n) (x ::: b) = andb x (andb_fold … n b). // qed.
    290 
    291 lemma andb_fold_inversion : ∀n. ∀elt,x. andb_fold (S n) (elt ::: x) = true → elt = true ∧ andb_fold n x = true.
    292 #n #elt #x cases elt normalize #H @conj destruct (H) try assumption @refl
    293 qed.
    294 
    295 lemma ith_increment_carry : ∀n. ∀a : BitVector (S n).
    296   ith_carry … a (one_bv ?) false = andb_fold … a.
    297 #n elim n
    298 [ 1: #a elim (BitVector_Sn … a) #hd * #tl #Heq >Heq >(BitVector_O … tl)
    299      cases hd normalize @refl
    300 | 2: #n' #Hind #a
    301      elim (BitVector_Sn … a) #hd * #tl #Heq >Heq
    302      lapply (Hind … tl) #Hind >one_bv_Sn
    303      >ith_carry_Sn whd in match (andb_fold ??);
    304      cases hd >Hind @refl
    305 ] qed.
    306 
    307 lemma ith_increment_bit : ∀n. ∀a : BitVector (S n).
    308   ith_bit … a (one_bv ?) false = xorb (head' … a) (andb_fold … (tail … a)).
    309 #n #a
    310 elim (BitVector_Sn … a) #hd * #tl #Heq >Heq
    311 whd in match (head' ???);
    312 -a cases n in tl;
    313 [ 1: #tl >(BitVector_O … tl) cases hd normalize try //
    314 | 2: #n' #tl >one_bv_Sn >ith_bit_Sn
    315      >ith_increment_carry >tail_Sn
    316      cases hd try //
    317 ] qed.
    318 
    319 (* Lemma used to prove involutivity of two-complement negation *)
    320 lemma twocomp_neg_involutive_aux : ∀n. ∀v : BitVector (S n).
    321    (andb_fold (S n) (negation_bv (S n) v) =
    322     andb_fold (S n) (negation_bv (S n) (addition_n_direct (S n) (negation_bv (S n) v) (one_bv (S n)) false))).
    323 #n elim n
    324 [ 1: #v elim (BitVector_Sn … v) #hd * #tl #Heq >Heq >(BitVector_O … tl) cases hd @refl
    325 | 2: #n' #Hind #v elim (BitVector_Sn … v) #hd * #tl #Heq >Heq
    326      lapply (Hind tl) -Hind #Hind >negation_bv_Sn >one_bv_Sn >addition_n_direct_Sn
    327      >andb_fold_Sn >ith_bit_Sn >negation_bv_Sn >andb_fold_Sn <Hind
    328      cases hd normalize nodelta
    329      [ 1: >xorb_false >(xorb_comm false ?) >xorb_false
    330      | 2: >xorb_false >(xorb_comm true ?) >xorb_true ]
    331      >ith_increment_carry
    332      cases (andb_fold (S n') (negation_bv (S n') tl)) @refl
    333 ] qed.
    334    
    335 (* Test of the 'direct' approach: proof of the involutivity of two-complement negation. *)
    336 lemma twocomp_neg_involutive : ∀n. ∀v : BitVector n. twocomp_neg_direct ? (twocomp_neg_direct ? v) = v.
    337 #n elim n
    338 [ 1: #v >(BitVector_O v) @refl
    339 | 2: #n' cases n'
    340      [ 1: #Hind #v elim (BitVector_Sn … v) #hd * #tl #Heq >Heq
    341           >(BitVector_O … tl) normalize cases hd @refl
    342      | 2: #n'' #Hind #v elim (BitVector_Sn … v) #hd * #tl #Heq >Heq
    343           lapply (Hind tl) -Hind #Hind <Hind in ⊢ (???%);
    344           whd in match twocomp_neg_direct; normalize nodelta
    345           whd in match increment_direct; normalize nodelta
    346           >(negation_bv_Sn ? hd tl) >one_bv_Sn >(addition_n_direct_Sn ? (¬hd) false ??)
    347           >ith_bit_Sn >negation_bv_Sn >addition_n_direct_Sn >ith_bit_Sn
    348           generalize in match (addition_n_direct (S n'')
    349                                                    (negation_bv (S n'')
    350                                                    (addition_n_direct (S n'') (negation_bv (S n'') tl) (one_bv (S n'')) false))
    351                                                    (one_bv (S n'')) false); #tail
    352           >ith_increment_carry >ith_increment_carry
    353           cases hd normalize nodelta
    354           [ 1: normalize in match (xorb false false); >(xorb_comm false ?) >xorb_false >xorb_false
    355           | 2: normalize in match (xorb true false); >(xorb_comm true ?) >xorb_true >xorb_false ]
    356           <twocomp_neg_involutive_aux
    357           cases (andb_fold (S n'') (negation_bv (S n'') tl)) @refl
    358       ]
    359 ] qed.
    360 
    361 lemma bitvector_cons_inj_inv : ∀n. ∀a,b. ∀va,vb : BitVector n. a ::: va = b ::: vb → a =b ∧ va = vb.
    362 #n #a #b #va #vb #H destruct (H) @conj @refl qed.
    363 
    364 lemma bitvector_cons_eq : ∀n. ∀a,b. ∀v : BitVector n. a = b → a ::: v = b ::: v. // qed.
    365 
    366 (* Injectivity of increment *)
    367 lemma increment_inj : ∀n. ∀a,b : BitVector n.
    368   increment_direct ? a = increment_direct ? b →
    369   a = b ∧ (ith_carry n a (one_bv n) false = ith_carry n b (one_bv n) false).
    370 #n whd in match increment_direct; normalize nodelta elim n
    371 [ 1: #a #b >(BitVector_O … a) >(BitVector_O … b) normalize #_ @conj //
    372 | 2: #n' cases n'
    373    [ 1: #_ #a #b
    374         elim (BitVector_Sn … a) #hd_a * #tl_a #Heq_a >Heq_a
    375         elim (BitVector_Sn … b) #hd_b * #tl_b #Heq_b >Heq_b
    376         >(BitVector_O … tl_a) >(BitVector_O … tl_b) cases hd_a cases hd_b
    377         normalize #H @conj try //
    378    | 2: #n'' #Hind #a #b
    379         elim (BitVector_Sn … a) #hd_a * #tl_a #Heq_a >Heq_a
    380         elim (BitVector_Sn … b) #hd_b * #tl_b #Heq_b >Heq_b
    381         lapply (Hind … tl_a tl_b) -Hind #Hind
    382         >one_bv_Sn >addition_n_direct_Sn >ith_bit_Sn
    383         >addition_n_direct_Sn >ith_bit_Sn >xorb_false >xorb_false
    384         #H elim (bitvector_cons_inj_inv … H) #Heq1 #Heq2
    385         lapply (Hind Heq2) * #Heq3 #Heq4
    386         cut (hd_a = hd_b)
    387         [ 1: >Heq4 in Heq1; #Heq5 lapply (xorb_inj (ith_carry ? tl_b (one_bv ?) false) hd_a hd_b)
    388              * #Heq6 #_ >xorb_comm in Heq6; >(xorb_comm  ? hd_b) #Heq6 >(Heq6 Heq5)
    389              @refl ]
    390         #Heq5 @conj [ 1: >Heq3 >Heq5 @refl ]
    391         >ith_carry_Sn >ith_carry_Sn >Heq4 >Heq5 @refl
    392 ] qed.
    393 
    394 (* Inverse of injecivity of increment, does not lose information (cf increment_inj) *)
    395 lemma increment_inj_inv : ∀n. ∀a,b : BitVector n.
    396   a = b → increment_direct ? a = increment_direct ? b. // qed.
    397 
    398 (* A more general result. *)
    399 lemma addition_n_direct_inj : ∀n. ∀x,y,delta: BitVector n.
    400   addition_n_direct ? x delta false = addition_n_direct ? y delta false →
    401   x = y ∧ (ith_carry n x delta false = ith_carry n y delta false).
    402 #n elim n
    403 [ 1: #x #y #delta >(BitVector_O … x) >(BitVector_O … y) >(BitVector_O … delta) * @conj @refl
    404 | 2: #n' #Hind #x #y #delta
    405      elim (BitVector_Sn … x) #hdx * #tlx #Heqx >Heqx
    406      elim (BitVector_Sn … y) #hdy * #tly #Heqy >Heqy
    407      elim (BitVector_Sn … delta) #hdd * #tld #Heqd >Heqd
    408      >addition_n_direct_Sn >ith_bit_Sn
    409      >addition_n_direct_Sn >ith_bit_Sn
    410      >ith_carry_Sn >ith_carry_Sn
    411      lapply (Hind … tlx tly tld) -Hind #Hind #Heq
    412      elim (bitvector_cons_inj_inv … Heq) #Heq_hd #Heq_tl
    413      lapply (Hind Heq_tl) -Hind * #HindA #HindB
    414      >HindA >HindB >HindB in Heq_hd; #Heq_hd
    415      cut (hdx = hdy)
    416      [ 1: cases hdd in Heq_hd; cases (ith_carry n' tly tld false)
    417           cases hdx cases hdy normalize #H try @H try @refl
    418           >H try @refl ]
    419      #Heq_hd >Heq_hd @conj @refl
    420 ] qed.
    421 
    422 (* We also need it the other way around. *)
    423 lemma addition_n_direct_inj_inv : ∀n. ∀x,y,delta: BitVector n.
    424   x ≠ y → (* ∧ (ith_carry n x delta false = ith_carry n y delta false). *)
    425    addition_n_direct ? x delta false ≠ addition_n_direct ? y delta false.
    426 #n elim n
    427 [ 1: #x #y #delta >(BitVector_O … x) >(BitVector_O … y) >(BitVector_O … delta) * #H @(False_ind … (H (refl ??)))
    428 | 2: #n' #Hind #x #y #delta
    429      elim (BitVector_Sn … x) #hdx * #tlx #Heqx >Heqx
    430      elim (BitVector_Sn … y) #hdy * #tly #Heqy >Heqy
    431      elim (BitVector_Sn … delta) #hdd * #tld #Heqd >Heqd
    432      #Hneq
    433      cut (hdx ≠ hdy ∨ tlx ≠ tly)
    434      [ @(eq_bv_elim … tlx tly)
    435        [ #Heq_tl >Heq_tl >Heq_tl in Hneq;
    436          #Hneq cut (hdx ≠ hdy) [ % #Heq_hd >Heq_hd in Hneq; *
    437                                  #H @H @refl ]
    438          #H %1 @H
    439        | #H %2 @H ] ]
    440      -Hneq #Hneq
    441      >addition_n_direct_Sn >addition_n_direct_Sn
    442      >ith_bit_Sn >ith_bit_Sn cases Hneq
    443      [ 1: #Hneq_hd
    444           lapply (addition_n_direct_inj … tlx tly tld)         
    445           @(eq_bv_elim … (addition_n_direct ? tlx tld false) (addition_n_direct ? tly tld false))
    446           [ 1: #Heq -Hind #Hind elim (Hind Heq) #Heq_tl >Heq_tl #Heq_carry >Heq_carry
    447                % #Habsurd elim (bitvector_cons_inj_inv … Habsurd) -Habsurd
    448                lapply Hneq_hd
    449                cases hdx cases hdd cases hdy cases (ith_carry ? tly tld false)
    450                normalize in ⊢ (? → % → ?); #Hneq_hd #Heq_hd #_
    451                try @(absurd … Heq_hd Hneq_hd)
    452                elim Hneq_hd -Hneq_hd #Hneq_hd @Hneq_hd
    453                try @refl try assumption try @(sym_eq … Heq_hd)
    454           | 2: #Htl_not_eq #_ % #Habsurd elim (bitvector_cons_inj_inv … Habsurd) #_
    455                elim Htl_not_eq -Htl_not_eq #HA #HB @HA @HB ]
    456      | 2: #Htl_not_eq lapply (Hind tlx tly tld Htl_not_eq) -Hind #Hind
    457           % #Habsurd elim (bitvector_cons_inj_inv … Habsurd) #_
    458           elim Hind -Hind #HA #HB @HA @HB ]
    459 ] qed.
    460 
    461 lemma carry_notb : ∀a,b,c. notb (carry_of a b c) = carry_of (notb a) (notb b) (notb c). * * * @refl qed.
    462 
    463 lemma increment_to_carry_aux : ∀n. ∀a : BitVector (S n).
    464    ith_carry (S n) a (one_bv (S n)) false
    465    = ith_carry (S n) a (zero (S n)) true.
    466 #n elim n
    467 [ 1: #a elim (BitVector_Sn ? a) #hd_a * #tl_a #Heq >Heq >(BitVector_O … tl_a) @refl
    468 | 2: #n' #Hind #a elim (BitVector_Sn ? a) #hd_a * #tl_a #Heq >Heq
    469      lapply (Hind tl_a) #Hind
    470      >one_bv_Sn >zero_Sn >ith_carry_Sn >ith_carry_Sn >Hind @refl
    471 ] qed.
    472 
    473 lemma neutral_addition_n_direct_aux : ∀n. ∀v. ith_carry n v (zero n) false = false.
    474 #n elim n //
    475 #n' #Hind #v elim (BitVector_Sn … v) #hd * #tl #Heq >Heq >zero_Sn
    476 >ith_carry_Sn >(Hind tl) cases hd @refl.
    477 qed.
    478 
    479 lemma neutral_addition_n_direct : ∀n. ∀v : BitVector n.
    480   addition_n_direct ? v (zero ?) false = v.
    481 #n elim n
    482 [ 1: #v >(BitVector_O … v) normalize @refl
    483 | 2: #n' #Hind #v elim (BitVector_Sn … v) #hd * #tl #Heq >Heq
    484      lapply (Hind … tl) #H >zero_Sn >addition_n_direct_Sn
    485      >ith_bit_Sn >H >xorb_false >neutral_addition_n_direct_aux
    486      >xorb_false @refl
    487 ] qed.
    488 
    489 lemma increment_to_carry_zero : ∀n. ∀a : BitVector n. addition_n_direct ? a (one_bv ?) false = addition_n_direct ? a (zero ?) true.
    490 #n elim n
    491 [ 1: #a >(BitVector_O … a) normalize @refl
    492 | 2: #n' cases n'
    493      [ 1: #_ #a elim (BitVector_Sn … a) #hd_a * #tl_a #Heq >Heq >(BitVector_O … tl_a) cases hd_a @refl
    494      | 2: #n'' #Hind #a
    495           elim (BitVector_Sn … a) #hd_a * #tl_a #Heq >Heq
    496           lapply (Hind tl_a) -Hind #Hind
    497           >one_bv_Sn >zero_Sn >addition_n_direct_Sn >ith_bit_Sn
    498           >addition_n_direct_Sn >ith_bit_Sn
    499           >xorb_false >Hind @bitvector_cons_eq
    500           >increment_to_carry_aux @refl
    501      ]
    502 ] qed.
    503 
    504 lemma increment_to_carry : ∀n. ∀a,b : BitVector n.
    505   addition_n_direct ? a (addition_n_direct ? b (one_bv ?) false) false = addition_n_direct ? a b true.
    506 #n #a #b >increment_to_carry_zero <associative_addition_n_direct
    507 >neutral_addition_n_direct @refl
    508 qed.
    509 
    510 lemma increment_direct_ok : ∀n,v. increment_direct n v = increment n v.
    511 #n #v whd in match (increment ??);
    512 >addition_n_direct_ok <increment_to_carry_zero @refl
    513 qed.
    514 
    515 (* Prove -(a + b) = -a + -b *)
    516 lemma twocomp_neg_plus : ∀n. ∀a,b : BitVector n.
    517   twocomp_neg_direct ? (addition_n_direct ? a b false) = addition_n_direct ? (twocomp_neg_direct … a) (twocomp_neg_direct … b) false.
    518 whd in match twocomp_neg_direct; normalize nodelta
    519 lapply increment_inj_inv
    520 whd in match increment_direct; normalize nodelta
    521 #H #n #a #b
    522 <associative_addition_n_direct @H
    523 >associative_addition_n_direct >(commutative_addition_n_direct ? (one_bv n))
    524 >increment_to_carry
    525 -H lapply b lapply a -b -a
    526 cases n
    527 [ 1: #a #b >(BitVector_O … a) >(BitVector_O … b) @refl
    528 | 2: #n' #a #b
    529      cut (negation_bv ? (addition_n_direct ? a b false)
    530            = addition_n_direct ? (negation_bv ? a) (negation_bv ? b) true ∧
    531           notb (ith_carry ? a b false) = (ith_carry ? (negation_bv ? a) (negation_bv ? b) true))
    532      [ -n lapply b lapply a elim n'
    533      [ 1: #a #b elim (BitVector_Sn … a) #hd_a * #tl_a #Heqa >Heqa >(BitVector_O … tl_a)
    534           elim (BitVector_Sn … b) #hd_b * #tl_b #Heqb >Heqb >(BitVector_O … tl_b)
    535           cases hd_a cases hd_b normalize @conj @refl
    536      | 2: #n #Hind #a #b
    537           elim (BitVector_Sn … a) #hd_a * #tl_a #Heqa >Heqa
    538           elim (BitVector_Sn … b) #hd_b * #tl_b #Heqb >Heqb
    539           lapply (Hind tl_a tl_b) * #H1 #H2
    540           @conj
    541           [ 2: >ith_carry_Sn >negation_bv_Sn >negation_bv_Sn >ith_carry_Sn
    542                >carry_notb >H2 @refl
    543           | 1: >addition_n_direct_Sn >ith_bit_Sn >negation_bv_Sn
    544                >negation_bv_Sn >negation_bv_Sn
    545                >addition_n_direct_Sn >ith_bit_Sn >H1 @bitvector_cons_eq
    546                >xorb_lneg >xorb_rneg >notb_notb
    547                <xorb_rneg >H2 @refl
    548           ]
    549       ] ]
    550       * #H1 #H2 @H1
    551 ] qed.
    552 
    553 lemma addition_n_direct_neg : ∀n. ∀a.
    554  (addition_n_direct n a (negation_bv n a) false) = replicate ?? true
    555  ∧ (ith_carry n a (negation_bv n a) false = false).
    556 #n elim n
    557 [ 1: #a >(BitVector_O … a) @conj @refl
    558 | 2: #n' #Hind #a elim (BitVector_Sn … a) #hd * #tl #Heq >Heq
    559      lapply (Hind … tl) -Hind * #HA #HB
    560      @conj
    561      [ 2: >negation_bv_Sn >ith_carry_Sn >HB cases hd @refl
    562      | 1: >negation_bv_Sn >addition_n_direct_Sn
    563           >ith_bit_Sn >HB >xorb_false >HA
    564           @bitvector_cons_eq elim hd @refl
    565      ]
    566 ] qed.
    567 
    568 (* -a + a = 0 *)
    569 lemma bitvector_opp_direct : ∀n. ∀a : BitVector n. addition_n_direct ? a (twocomp_neg_direct ? a) false = (zero ?).
    570 whd in match twocomp_neg_direct;
    571 whd in match increment_direct;
    572 normalize nodelta
    573 #n #a <associative_addition_n_direct
    574 elim (addition_n_direct_neg … a) #H #_ >H
    575 -H -a
    576 cases n try //
    577 #n'
    578 cut ((addition_n_direct (S n') (replicate bool ? true) (one_bv ?) false = (zero (S n')))
    579        ∧ (ith_carry ? (replicate bool (S n') true) (one_bv (S n')) false = true))
    580 [ elim n'
    581      [ 1: @conj @refl
    582      | 2: #n' * #HA #HB @conj
    583           [ 1: >replicate_Sn >one_bv_Sn  >addition_n_direct_Sn
    584                >ith_bit_Sn >HA >zero_Sn @bitvector_cons_eq >HB @refl
    585           | 2: >replicate_Sn >one_bv_Sn >ith_carry_Sn >HB @refl ]
    586      ]
    587 ] * #H1 #H2 @H1
    588 qed.
    589 
    590 (* Lift back the previous result to standard operations. *)
    591 lemma twocomp_neg_direct_ok : ∀n. ∀v. twocomp_neg_direct ? v = two_complement_negation n v.
    592 #n #v whd in match twocomp_neg_direct; normalize nodelta
    593 whd in match increment_direct; normalize nodelta
    594 whd in match two_complement_negation; normalize nodelta
    595 >increment_to_addition_n <addition_n_direct_ok
    596 whd in match addition_n; normalize nodelta
    597 elim (add_with_carries ????) #a #b @refl
    598 qed.
    599 
    600 lemma two_complement_negation_plus : ∀n. ∀a,b : BitVector n.
    601   two_complement_negation ? (addition_n ? a b) = addition_n ? (two_complement_negation ? a) (two_complement_negation ? b).
    602 #n #a #b
    603 lapply (twocomp_neg_plus ? a b)
    604 >twocomp_neg_direct_ok >twocomp_neg_direct_ok >twocomp_neg_direct_ok
    605 <addition_n_direct_ok <addition_n_direct_ok
    606 whd in match addition_n; normalize nodelta
    607 elim (add_with_carries n a b false) #bits #flags normalize nodelta
    608 elim (add_with_carries n (two_complement_negation n a) (two_complement_negation n b) false) #bits' #flags'
    609 normalize nodelta #H @H
    610 qed.
    611 
    612 lemma bitvector_opp_addition_n : ∀n. ∀a : BitVector n. addition_n ? a (two_complement_negation ? a) = (zero ?).
    613 #n #a lapply (bitvector_opp_direct ? a)
    614 >twocomp_neg_direct_ok <addition_n_direct_ok
    615 whd in match (addition_n ???);
    616 elim (add_with_carries n a (two_complement_negation n a) false) #bits #flags #H @H
    617 qed.
    618 
    619 lemma neutral_addition_n : ∀n. ∀a : BitVector n. addition_n ? a (zero ?) = a.
    620 #n #a
    621 lapply (neutral_addition_n_direct n a)
    622 <addition_n_direct_ok
    623 whd in match (addition_n ???);
    624 elim (add_with_carries n a (zero n) false) #bits #flags #H @H
    625 qed.
    626 
    627 lemma injective_addition_n : ∀n. ∀x,y,delta : BitVector n.
    628   addition_n ? x delta = addition_n ? y delta → x = y. 
    629 #n #x #y #delta 
    630 lapply (addition_n_direct_inj … x y delta)
    631 <addition_n_direct_ok <addition_n_direct_ok
    632 whd in match addition_n; normalize nodelta
    633 elim (add_with_carries n x delta false) #bitsx #flagsx
    634 elim (add_with_carries n y delta false) #bitsy #flagsy
    635 normalize #H1 #H2 elim (H1 H2) #Heq #_ @Heq
    636 qed.
    637 
    638 lemma injective_inv_addition_n : ∀n. ∀x,y,delta : BitVector n.
    639   x ≠ y → addition_n ? x delta ≠ addition_n ? y delta. 
    640 #n #x #y #delta 
    641 lapply (addition_n_direct_inj_inv … x y delta)
    642 <addition_n_direct_ok <addition_n_direct_ok
    643 whd in match addition_n; normalize nodelta
    644 elim (add_with_carries n x delta false) #bitsx #flagsx
    645 elim (add_with_carries n y delta false) #bitsy #flagsy
    646 normalize #H1 #H2 @(H1 H2)
    647 qed.
    64810
    64911
     
    66729
    66830lemma eqZb_reflexive : ∀x:Z. eqZb x x = true. #x /2/. qed.
     31
     32(* --------------------------------------------------------------------------- *)
     33(* Some shorthands for conversion functions from BitVectorZ. *)
     34(* --------------------------------------------------------------------------- *)
     35
     36definition Zoub ≝ Z_of_unsigned_bitvector.
     37definition boZ ≝ bitvector_of_Z.
     38
     39(* Offsets are just bitvectors packed inside some useless and annoying constructor. *)
     40definition Zoo ≝ λx. Zoub ? (offv x).
     41definition boo ≝ λx. mk_offset (boZ ? x).
    66942
    67043(* --------------------------------------------------------------------------- *)   
     
    915288(* Front-end values. *)
    916289inductive value_eq (E : embedding) : val → val → Prop ≝
    917 | undef_eq : ∀v.
    918   value_eq E Vundef v
     290| undef_eq :
     291  value_eq E Vundef Vundef
    919292| vint_eq : ∀sz,i.
    920293  value_eq E (Vint sz i) (Vint sz i)
    921 | vfloat_eq : ∀f.
    922   value_eq E (Vfloat f) (Vfloat f)
    923294| vnull_eq :
    924295  value_eq E Vnull Vnull
     
    944315  load_value_of_type ty m1 b1 off1 = Some ? v1 →
    945316  (∃v2. load_value_of_type ty m2 b2 off2 = Some ? v2 ∧ value_eq E v1 v2).
    946 
     317 
     318(* Adapted from Compcert's Memory *)
     319definition non_aliasing : embedding → mem → Prop ≝
     320  λE,m.
     321  ∀b1,b2,b1',b2',delta1,delta2.
     322  b1 ≠ b2 →
     323  E b1 = Some ? 〈b1',delta1〉 →
     324  E b2 = Some ? 〈b2',delta2〉 →
     325  (b1' ≠ b2') ∨
     326  high_bound m b1 + (Zoo delta1) ≤ low_bound m b2 + (Zoo delta2) ∨
     327  high_bound m b2 + (Zoo delta2) ≤ low_bound m b1 + (Zoo delta1).
     328 
    947329(* Definition of a memory injection *)
    948 record memory_inj (E : embedding) (m1 : mem) (m2 : mem) : Type[0]
     330record memory_inj (E : embedding) (m1 : mem) (m2 : mem) : Prop
    949331{ (* Load simulation *)
    950332  mi_inj : load_sim_ptr E m1 m2;
     
    960342  (* Regions are preserved *)
    961343  mi_region : ∀b,b',o'. E b = Some ? 〈b',o'〉 → block_region b = block_region b';
    962   (* Disjoint blocks are mapped to disjoint blocks. Note that our condition is stronger than compcert's.
    963    * This may cause some problems if we reuse this def for the translation from Clight to Cminor, where
    964    * all variables are allocated in the same block. *)
    965   mi_disjoint : ∀b1,b2,b1',b2',o1',o2'.
    966                 b1 ≠ b2 →
    967                 E b1 = Some ? 〈b1',o1'〉 →
    968                 E b2 = Some ? 〈b2',o2'〉 →
    969                 b1' ≠ b2'
    970 }.
    971 
    972 (* Definition of a memory extension. /!\ Not equivalent to the compcert concept. /!\
    973  * A memory extension is a [memory_inj] with some particular blocks designated as
    974  * being writeable. *)
    975 
    976 alias id "meml" = "cic:/matita/basics/lists/list/mem.fix(0,2,1)".
    977 
    978 record memory_ext (E : embedding) (m1 : mem) (m2 : mem) : Type[0] ≝
    979 { me_inj : memory_inj E m1 m2;
    980   (* A list of blocks where we can write freely *)
    981   me_writeable : list block;
    982   (* These blocks are valid *)
    983   me_writeable_valid : ∀b. meml ? b me_writeable → valid_block m2 b;
    984   (* And pointers to m1 are oblivious to these blocks *)
    985   me_writeable_ok : ∀p,p'.
    986                      valid_pointer m1 p = true →
    987                      pointer_translation p E = Some ? p' →
    988                      ¬ (meml ? (pblock p') me_writeable)
     344  (* sub-blocks do not overlap (non-aliasing property) *)
     345  mi_nonalias : non_aliasing E m1
    989346}.
    990347
     
    996353  ∀E,p1,v. value_eq E (Vptr p1) v → ∃p2. v = Vptr p2 ∧ pointer_translation p1 E = Some ? p2.
    997354#E #p1 #v #Heq inversion Heq
    998 [ 1: #v #Habsurd destruct (Habsurd)
     355[ 1: #Habsurd destruct (Habsurd)
    999356| 2: #sz #i #Habsurd destruct (Habsurd)
    1000 | 3: #f #Habsurd destruct (Habsurd)
    1001 | 4:  #Habsurd destruct (Habsurd)
    1002 | 5: #p1' #p2 #Heq #Heqv #Heqv2 #_ destruct
     357| 3:  #Habsurd destruct (Habsurd)
     358| 4: #p1' #p2 #Heq #Heqv #Heqv2 #_ destruct
    1003359     %{p2} @conj try @refl try assumption
    1004360] qed.
     
    1007363lemma value_eq_inversion :
    1008364  ∀E,v1,v2. ∀P : val → val → Prop. value_eq E v1 v2 →
    1009   (∀v. P Vundef v) →
     365  (P Vundef Vundef) →
    1010366  (∀sz,i. P (Vint sz i) (Vint sz i)) →
    1011   (∀f. P (Vfloat f) (Vfloat f)) →
    1012367  (P Vnull Vnull) →
    1013368  (∀p1,p2. pointer_translation p1 E = Some ? p2 → P (Vptr p1) (Vptr p2)) →
    1014369  P v1 v2.
    1015 #E #v1 #v2 #P #Heq #H1 #H2 #H3 #H4 #H5
     370#E #v1 #v2 #P #Heq #H1 #H2 #H3 #H4
    1016371inversion Heq
    1017 [ 1: #v #Hv1 #Hv2 #_ destruct @H1
     372[ 1: #Hv1 #Hv2 #_ destruct @H1
    1018373| 2: #sz #i #Hv1 #Hv2 #_ destruct @H2
    1019 | 3: #f #Hv1 #Hv2 #_ destruct @H3
    1020 | 4: #Hv1 #Hv2 #_ destruct @H4
    1021 | 5: #p1 #p2 #Hembed #Hv1 #Hv2 #_ destruct @H5 // ] qed.
    1022  
     374| 3: #Hv1 #Hv2 #_ destruct @H3
     375| 4: #p1 #p2 #Hembed #Hv1 #Hv2 #_ destruct @H4 // ] qed.
     376
    1023377(* If we succeed to load something by value from a 〈b,off〉 location,
    1024378   [b] is a valid block. *)
     
    1030384#ty #m * #brg #bid #off #v
    1031385cases ty
    1032 [ 1: | 2: #sz #sg | 3: #fsz | 4: #ptr_ty | 5: #array_ty #array_sz | 6: #domain #codomain
    1033 | 7: #structname #fieldspec | 8: #unionname #fieldspec | 9: #id ]
     386[ | #sz #sg | #ptr_ty | #array_ty #array_sz | #domain #codomain
     387| #structname #fieldspec | #unionname #fieldspec | #id ]
    1034388whd in match (load_value_of_type ????);
    1035 [ 1,7,8: #_ #Habsurd destruct (Habsurd) ]
     389[ 1,6,7: #_ #Habsurd destruct (Habsurd) ]
    1036390#Hmode
    1037 [ 1,2,3,6: [ 1: elim sz | 2: elim fsz ]
     391[ 1,2,5: [ 1: elim sz ]
    1038392     normalize in match (typesize ?);
    1039393     whd in match (loadn ???);
     
    1054408#ty #m * #brg #bid #off #v
    1055409cases ty
    1056 [ 1: | 2: #sz #sg | 3: #fsz | 4: #ptr_ty | 5: #array_ty #array_sz | 6: #domain #codomain
    1057 | 7: #structname #fieldspec | 8: #unionname #fieldspec | 9: #id ]
     410[ | #sz #sg | #ptr_ty | #array_ty #array_sz | #domain #codomain
     411| #structname #fieldspec | #unionname #fieldspec | #id ]
    1058412whd in match (load_value_of_type ????);
    1059 [ 1,7,8: #_ #Habsurd destruct (Habsurd) ]
     413[ 1,6,7: #_ #Habsurd destruct (Habsurd) ]
    1060414#Hmode
    1061 [ 1,2,3,6: [ 1: elim sz | 2: elim fsz ]
     415[ 1,2,5: [ 1: elim sz ]
    1062416     normalize in match (typesize ?);
    1063417     whd in match (loadn ???);
     
    1073427] qed.
    1074428
    1075 
    1076 lemma valid_block_from_bool : ∀b,m. Zltb (block_id b) (nextblock m) = true → valid_block m b.
    1077 * #rg #id #m normalize
    1078 elim id /2/ qed.
    1079 
    1080 lemma valid_block_to_bool : ∀b,m. valid_block m b → Zltb (block_id b) (nextblock m) = true.
    1081 * #rg #id #m normalize
    1082 elim id /2/ qed.
    1083 
    1084429lemma load_by_value_success_valid_block :
    1085430  ∀ty,m,b,off,v.
     
    1088433    valid_block m b.
    1089434#ty #m #b #off #v #Haccess_mode #Hload
    1090 @valid_block_from_bool
     435@Zltb_true_to_Zlt
    1091436elim (load_by_value_success_valid_ptr_aux ty m b off v Haccess_mode Hload) * //
    1092437qed.
     
    1102447qed.
    1103448
    1104 (* Making explicit the contents of memory_inj for load_value_of_type *)
     449(* Making explicit the contents of memory_inj for load_value_of_type.
     450 * Equivalent to Lemma 59 of Leroy & Blazy *)
    1105451lemma load_value_of_type_inj : ∀E,m1,m2,b1,off1,v1,b2,off2,ty.
    1106452    memory_inj E m1 m2 →
     
    1112458lapply (refl ? (access_mode ty))
    1113459cases ty
    1114 [ 1: | 2: #sz #sg | 3: #fsz | 4: #ptr_ty | 5: #array_ty #array_sz | 6: #domain #codomain
    1115 | 7: #structname #fieldspec | 8: #unionname #fieldspec | 9: #id ]
     460[ | #sz #sg | #ptr_ty | #array_ty #array_sz | #domain #codomain
     461| #structname #fieldspec | #unionname #fieldspec | #id ]
    1116462normalize in ⊢ ((???%) → ?); #Hmode #Hyp
    1117 [ 1,7,8: normalize in Hyp; destruct (Hyp)
    1118 | 5,6: normalize in Hyp ⊢ %; destruct (Hyp) /3 by ex_intro, conj, vptr_eq/ ]
     463[ 1,6,7: normalize in Hyp; destruct (Hyp)
     464| 4,5: normalize in Hyp ⊢ %; destruct (Hyp) /3 by ex_intro, conj, vptr_eq/ ]
    1119465lapply (load_by_value_success_valid_pointer … Hmode … Hyp) #Hvalid_pointer
    1120466lapply (mi_inj … Hinj b1 off1 b2 off2 … Hvalid_pointer Hembed Hyp) #H @H
    1121 qed.     
     467qed.
    1122468
    1123469(* -------------------------------------- *)
     
    1154500whd in Halloc:(??%?); destruct (Halloc)
    1155501whd in match (beloadv ??) in ⊢ (??%%);
    1156 lapply (valid_block_to_bool … Hvalid) #Hlt
     502lapply (Zlt_to_Zltb_true … Hvalid) #Hlt
    1157503>Hlt >(zlt_succ … Hlt)
    1158504normalize nodelta whd in match (update_block ?????); whd in match (eq_block ??);
    1159505cut (eqZb (block_id block) next = false)
    1160 [ lapply (Zltb_true_to_Zlt … Hlt) #Hlt' @eqZb_false /2/ ] #Hneq
     506[ lapply (Zltb_true_to_Zlt … Hlt) #Hlt' @eqZb_false /2 by not_to_not/ ] #Hneq
    1161507>Hneq cases (eq_region ??) normalize nodelta  @refl
    1162508qed.
     
    1181527(* Memory allocation preserves [memory_inj] *)
    1182528lemma alloc_memory_inj :
    1183   ∀E:embedding.∀m1,m2,m2',z1,z2,r,new_block. ∀H:memory_inj E m1 m2.
     529  ∀E:embedding.
     530  ∀m1,m2,m2',z1,z2,r,new_block.
     531  ∀H:memory_inj E m1 m2.
    1184532  alloc m2 z1 z2 r = 〈m2', new_block〉 →
    1185533  memory_inj E m1 m2'.
     
    1193541  lapply (refl ? (access_mode ty))
    1194542  cases ty in Hload_eq;
    1195   [ 1: | 2: #sz #sg | 3: #fsz | 4: #ptr_ty | 5: #array_ty #array_sz | 6: #domain #codomain
    1196   | 7: #structname #fieldspec | 8: #unionname #fieldspec | 9: #id ]
     543  [ | #sz #sg | #ptr_ty | #array_ty #array_sz | #domain #codomain
     544  | #structname #fieldspec | #unionname #fieldspec | #id ]
    1197545  #Hload normalize in ⊢ ((???%) → ?); #Haccess
    1198   [ 1,7,8: normalize in Hload; destruct (Hload)
    1199   | 2,3,4,9: whd in match (load_value_of_type ????);
     546  [ 1,6,7: normalize in Hload; destruct (Hload)
     547  | 2,3,8: whd in match (load_value_of_type ????);
    1200548     whd in match (load_value_of_type ????);
    1201549     lapply (load_by_value_success_valid_block … Haccess Hload)
     
    1204552     <(alloc_loadn_conservation … Halloc … Hvalid_block)
    1205553     @Hload
    1206   | 5,6: whd in match (load_value_of_type ????) in Hload ⊢ %; @Hload ]
     554  | 4,5: whd in match (load_value_of_type ????) in Hload ⊢ %; @Hload ]
    1207555| 2: @(mi_freeblock … Hmemory_inj)
    1208556| 3: #p #p' #Hvalid #Hptr_trans lapply (mi_valid_pointers … Hmemory_inj p p' Hvalid Hptr_trans)
     
    1221569     cases (eq_region br' r) normalize #H @H
    1222570| 4: @(mi_region … Hmemory_inj)
    1223 | 5: @(mi_disjoint … Hmemory_inj)
    1224 ] qed.
    1225 
    1226 (* Memory allocation induces a memory extension. *)
    1227 lemma alloc_memory_ext :
    1228   ∀E:embedding.∀m1,m2,m2',z1,z2,r,new_block. ∀H:memory_inj E m1 m2.
    1229   alloc m2 z1 z2 r = 〈m2', new_block〉 →
    1230   memory_ext E m1 m2'.
    1231 #E #m1 #m2 #m2' #z1 #z2 #r * #new_block #Hblock_region_eq #Hmemory_inj #Halloc
    1232 lapply (alloc_memory_inj … Hmemory_inj Halloc)
    1233 #Hinj' %
    1234 [ 1: @Hinj'
    1235 | 2: @[new_block]
    1236 | 3: #b normalize in ⊢ (%→ ?); * [ 2: #H @(False_ind … H) ]
    1237       #Heq destruct (Heq) whd elim m2 in Halloc;
    1238       #Hcontents #nextblock #Hnextblock
    1239       whd in ⊢ ((??%?) → ?); #Heq destruct (Heq)
    1240       /2/
    1241 | 4: * #b #o * #b' #o' #Hvalid_ptr #Hembed %
    1242      normalize in ⊢ (% → ?); * [ 2: #H @H ]
    1243      #Heq destruct (Heq)
    1244      lapply (mi_valid_pointers … Hmemory_inj … Hvalid_ptr Hembed)
    1245      whd in ⊢ (% → ?);
    1246      (* contradiction because ¬ (valid_block m2 new_block)  *)
    1247      elim m2 in Halloc;
    1248      #contents_m2 #nextblock_m2 #Hnextblock_m2
    1249      whd in ⊢ ((??%?) → ?);
    1250      #Heq_alloc destruct (Heq_alloc)
    1251      normalize
    1252      lapply (irreflexive_Zlt nextblock_m2)
    1253      @Zltb_elim_Type0
    1254      [ #H * #Habsurd @(False_ind … (Habsurd H)) ] #_ #_ normalize #Habsurd destruct (Habsurd)
    1255 ] qed.
     571| 5: @(mi_nonalias … Hmemory_inj)
     572qed.
     573
     574(* ---------------------------------------------------------- *)
     575(* Lemma 40 of the paper of Leroy & Blazy on the memory model
     576 * and related lemmas *)
    1256577
    1257578lemma bestorev_beloadv_conservation :
     
    1300621#mA #mB #wb #wo #v #Hstore #rb #ro #Hneq #ty
    1301622cases ty
    1302 [ 1: | 2: #sz #sg | 3: #fsz | 4: #ptr_ty | 5: #array_ty #array_sz | 6: #domain #codomain
    1303 | 7: #structname #fieldspec | 8: #unionname #fieldspec | 9: #id ] try //
    1304 [ 1: elim sz | 2: elim fsz | 3: | 4: ]
     623[ | #sz #sg | #ptr_ty | #array_ty #array_sz | #domain #codomain
     624| #structname #fieldspec | #unionname #fieldspec | #id ]
     625//
     626[ 1: elim sz ]
    1305627whd in ⊢ (??%%);
    1306628>(bestorev_loadn_conservation … Hstore … Hneq) @refl
    1307629qed.
    1308630
    1309 (* Writing in the "extended" part of a memory preserves the underlying injection *)
    1310 lemma bestorev_memory_ext_to_load_sim :
     631(* lift [bestorev_load_value_of_type_conservation] to storen *)
     632lemma storen_load_value_of_type_conservation :
     633  ∀l,mA,mB,wb,wo.
     634    storen mA (mk_pointer wb wo) l = Some ? mB →
     635    ∀rb,ro. eq_block wb rb = false →
     636    ∀ty.load_value_of_type ty mA rb ro = load_value_of_type ty mB rb ro.
     637#l elim l
     638[ 1: #mA #mB #wb #wo normalize #Heq destruct //
     639| 2: #hd #tl #Hind #mA #mB #wb #wo #Hstoren
     640     cases (some_inversion ????? Hstoren) #mA' * #Hbestorev #Hstoren'
     641     whd in match (shift_pointer ???) in Hstoren':(??%?); #rb #ro #Hneq_block #ty
     642     lapply (Hind ???? Hstoren' … ro … Hneq_block ty) #Heq1
     643     lapply (bestorev_load_value_of_type_conservation … Hbestorev … ro … Hneq_block ty) #Heq2
     644     //
     645] qed.     
     646
     647definition typesize' ≝ λty. typesize (typ_of_type ty).
     648
     649lemma storen_load_value_of_type_conservation_in_block_high :
     650  ∀E,mA,mB,mC,wo,l.
     651    memory_inj E mA mB →
     652    ∀blo. storen mB (mk_pointer blo wo) l = Some ? mC →
     653    ∀b1,delta. E b1 = Some ? 〈blo,delta〉 →
     654    high_bound mA b1 + Zoo delta < Zoo wo →
     655    ∀ty,off.
     656       Zoo off + Z_of_nat (typesize' ty) < high_bound mA b1 →
     657       low_bound … mA b1 ≤ Zoo off →
     658       Zoo off < high_bound … mA b1 →
     659       load_value_of_type ty mB blo (mk_offset (addition_n ? (offv off) (offv delta))) =
     660       load_value_of_type ty mC blo (mk_offset (addition_n ? (offv off) (offv delta))).
     661#E #mA #mB #mC #wo #data #Hinj #blo #Hstoren #b1 #delta #Hembed #Hhigh #ty
     662(* need some stuff asserting that if a ptr is valid at the start of a write it's valid at the end. *)
     663cases data in Hstoren;
     664[ 1: normalize in ⊢ (% → ?); #Heq destruct //
     665| 2: #xd #data ]
     666#Hstoren
     667cases ty
     668[ | #sz #sg | #ptr_ty | #array_ty #array_sz | #domain #codomain
     669| #structname #fieldspec | #unionname #fieldspec | #id ]#off #Hofflt #Hlow_load #Hhigh_load try @refl
     670whd in match (load_value_of_type ????) in ⊢ (??%%);
     671[ 1: lapply (storen_to_valid_pointer … Hstoren) * * #Hbounds #Hbefore #Hafter
     672     lapply Hofflt -Hofflt lapply Hlow_load -Hlow_load lapply Hhigh_load -Hhigh_load
     673     lapply off -off whd in match typesize'; normalize nodelta     
     674     generalize in match (typesize ?); #n elim n try //
     675     #n' #Hind #o #Hhigh_load #Hlow_load #Hlt
     676     whd in match (loadn ???) in ⊢ (??%%);
     677     whd in match (beloadv ??) in ⊢ (??%%);
     678     cases (valid_pointer_to_Prop … Hbefore) * #HltB_store #HlowB_store #HhighB_store
     679     cases (valid_pointer_to_Prop … Hafter) * #HltC_store #HlowC_store #HhighC_store
     680     >(Zlt_to_Zltb_true … HltB_store) >(Zlt_to_Zltb_true … HltC_store) normalize nodelta
     681     cut (Zleb (low (blocks mB blo)) (Z_of_unsigned_bitvector ? (addition_n ? (offv o) (offv delta))) = true)
     682     [ 1: (* Notice that:
     683                low mA b1 ≤ o < high mA b1
     684             hence, since E b1 = 〈blo, delta〉 with delta >= 0
     685                low mB blo ≤ (low mA b1 + delta) ≤ o+delta < (high mA b1 + delta) ≤ high mB blo *)
     686          @cthulhu ]
     687     #HA >HA >andb_lsimpl_true -HA
     688     cut (Zltb (Z_of_unsigned_bitvector ? (addition_n ? (offv o) (offv delta))) (high (blocks mB blo)) = true)
     689     [ 1: (* Same argument as above *) @cthulhu ]
     690     #HA >HA normalize nodelta -HA
     691     cut (Zleb (low (blocks mC blo)) (Z_of_unsigned_bitvector ? (addition_n ? (offv o) (offv delta))) = true)
     692     [ 1: (* Notice that storen does not modify the bounds of a block. Related lemma present in [MemProperties].
     693             This cut follows from this lemma (which needs some info on the size of the data written, which we
     694             have but must make explicit) and from the first cut. *)
     695          @cthulhu ]         
     696     #HA >HA >andb_lsimpl_true -HA
     697     cut (Zltb (Z_of_unsigned_bitvector ? (addition_n ? (offv o) (offv delta))) (high (blocks mC blo)) = true)
     698     [ 1: (* Same argument as above *) @cthulhu ]
     699     #HA >HA normalize nodelta -HA
     700     normalize in match (bitvector_of_nat ??); whd in match (shift_pointer ???);
     701     whd in match (shift_offset ???); >commutative_addition_n >associative_addition_n
     702     lapply (Hind (mk_offset (addition_n offset_size (sign_ext 2 ? [[false; true]]) (offv o))) ???)
     703     [ 1: (* Provable from Hlt *) @cthulhu
     704     | 2: (* Provable from Hlow_load, need to make a "succ" commute from bitvector to Z *) @cthulhu
     705     | 3: (* Provable from Hlt, again *) @cthulhu ]
     706     cases (loadn mB (mk_pointer blo
     707              (mk_offset (addition_n ? (addition_n ?
     708                 (sign_ext 2 offset_size [[false; true]]) (offv o)) (offv delta)))) n')
     709     normalize nodelta                 
     710     cases (loadn mC (mk_pointer blo
     711              (mk_offset (addition_n ? (addition_n ?
     712                 (sign_ext 2 offset_size [[false; true]]) (offv o)) (offv delta)))) n')
     713     normalize nodelta try //
     714     [ 1,2: #l #Habsurd destruct ]
     715     #l1 #l2 #Heq
     716     cut (contents (blocks mB blo) (Z_of_unsigned_bitvector ? (addition_n ? (offv o) (offv delta))) =
     717          contents (blocks mC blo) (Z_of_unsigned_bitvector ? (addition_n ? (offv o) (offv delta))))
     718     [ 1: (* Follows from Hhigh, indirectly *) @cthulhu ]
     719     #Hcontents_eq >Hcontents_eq whd in match (be_to_fe_value ??) in ⊢ (??%%);
     720     cases (contents (blocks mC blo) (Z_of_unsigned_bitvector ? (addition_n ? (offv o) (offv delta))))
     721     normalize nodelta try //
     722     (* Ok this is going to be more painful than what I thought. *)
     723     @cthulhu
     724| *: @cthulhu
     725] qed.
     726
     727lemma storen_load_value_of_type_conservation_in_block_low :
     728  ∀E,mA,mB,mC,wo,l.
     729    memory_inj E mA mB →
     730    ∀blo. storen mB (mk_pointer blo wo) l = Some ? mC →
     731    ∀b1,delta. E b1 = Some ? 〈blo,delta〉 →
     732    Zoo wo < low_bound mA b1 + Zoo delta →
     733    ∀ty,off.
     734       Zoo off + Z_of_nat (typesize' ty) < high_bound mA b1 →
     735       low_bound … mA b1 ≤ Zoo off →
     736       Zoo off < high_bound … mA b1 →
     737       load_value_of_type ty mB blo (mk_offset (addition_n ? (offv off) (offv delta))) =
     738       load_value_of_type ty mC blo (mk_offset (addition_n ? (offv off) (offv delta))).
     739@cthulhu
     740qed.
     741
     742(* Writing in the "extended" part of a memory preserves the underlying injection. *)
     743lemma bestorev_memory_inj_to_load_sim :
    1311744  ∀E,mA,mB,mC.
    1312   ∀Hext:memory_ext E mA mB.
    1313   ∀wb,wo,v. meml ? wb (me_writeable … Hext) →
    1314   bestorev mB (mk_pointer wb wo) v = Some ? mC →
     745  ∀Hext:memory_inj E mA mB.
     746  ∀block2. ∀i : offset. ∀ty : type.
     747  (∀block1,delta.
     748    E block1 = Some ? 〈block2, delta〉 →
     749    (high_bound mA block1 + (Zoo delta) < (Zoo i)) ∨ (Zoo i + (sizeof ty) ≤ (low_bound mA block1 + (Zoo delta)))) →
     750  ∀v.store_value_of_type ty mB block2 i v = Some ? mC →
    1315751  load_sim_ptr E mA mC.
    1316 #E #mA #mB #mC #Hext #wb #wo #v #Hwb #Hstore whd
    1317 #b1 #off1 #b2 #off2 #ty #v1 #Hvalid #Hembed #Hload
    1318 (* Show that (wb ≠ b2) by showing b2 ∉ (me_writeable ...) *)
    1319 lapply (me_writeable_ok … Hext (mk_pointer b1 off1) (mk_pointer b2 off2) Hvalid Hembed) #Hb2
    1320 lapply (mem_not_mem_neq … Hwb Hb2) #Hwb_neq_b2
    1321 cut ((eq_block wb b2) = false) [ @neq_block_eq_block_false @Hwb_neq_b2 ] #Heq_block_false
    1322 <(bestorev_load_value_of_type_conservation … Hstore … Heq_block_false)
    1323 @(mi_inj … (me_inj … Hext) … Hvalid  … Hembed …  Hload)
    1324 qed.
    1325 
    1326 (* Writing in the "extended" part of a memory preserves the whole memory injection *)
    1327 lemma bestorev_memory_ext_to_memory_inj :
     752#E #mA #mB #mC #Hinj #block2 #i #storety
     753cases storety
     754[ | #sz #sg | #ptr_ty | #array_ty #array_sz | #domain #codomain
     755| #structname #fieldspec | #unionname #fieldspec | #id ]#Hout #storeval #Hstore whd
     756#b1 #off1 #b2 #off2 #ty #readval #Hvalid #Hptr_trans #Hload_value
     757whd in Hstore:(??%?);
     758[  1,5,6,7,8: destruct ]
     759[ 1:
     760lapply (mi_inj … Hinj … Hvalid … Hptr_trans … Hload_value)
     761lapply Hload_value -Hload_value
     762cases ty
     763[ | #sz' #sg' | #ptr_ty' | #array_ty' #array_sz' | #domain' #codomain'
     764| #structname' #fieldspec' | #unionname' #fieldspec' | #id' ]
     765#Hload_value
     766(* Prove that the contents of mB where v1 was were untouched. *)
     767* #readval' * #Hload_value2 #Hvalue_eq %{readval'} @conj try assumption
     768cases (some_inversion ????? Hptr_trans) * #b2' #delta' * #Hembed -Hptr_trans normalize nodelta
     769#Heq destruct (Heq)
     770@(eq_block_elim  … b2 block2)
     771[ 2,4,6,8: #Hblocks_neq <Hload_value2 @sym_eq @(storen_load_value_of_type_conservation … Hstore)
     772           @not_eq_block @sym_neq @Hblocks_neq
     773| 1,3,5,7: #Heq destruct (Heq) lapply (Hout … Hembed) *
     774           [ 1,3,5,7: #Hhigh <Hload_value2 -Hload_value2 @sym_eq
     775                      lapply (load_by_value_success_valid_ptr_aux … Hload_value) //
     776                      * * #Hlt #Hlowb_off1 #Hhighb_off1
     777                      lapply (Zleb_true_to_Zle … Hlowb_off1) #Hlow_off1 -Hlowb_off1
     778                      lapply (Zltb_true_to_Zlt … Hhighb_off1) #Hhigh_off1 -Hhighb_off1
     779                      @(storen_load_value_of_type_conservation_in_block_high … Hinj … Hstore … Hembed)
     780                      try //
     781                      (* remaining stuff provable from Hload_value  *)
     782                      @cthulhu
     783           | 2,4,6,8: #Hlow <Hload_value2 -Hload_value2 @sym_eq
     784                      lapply (load_by_value_success_valid_ptr_aux … Hload_value) //
     785                      * * #Hlt #Hlowb_off1 #Hhighb_off1
     786                      lapply (Zleb_true_to_Zle … Hlowb_off1) #Hlow_off1 -Hlowb_off1
     787                      lapply (Zltb_true_to_Zlt … Hhighb_off1) #Hhigh_off1 -Hhighb_off1
     788                      @(storen_load_value_of_type_conservation_in_block_low … Hinj … Hstore … Hembed)
     789                      try //
     790                      [ 1,3,5,7: (* deductible from Hlow + (sizeof ?) > 0 *) @cthulhu
     791                      | 2,4,6,8: (* deductible from Hload_value *) @cthulhu ]
     792           ]
     793]
     794| *: (* exactly the same proof as above  *) @cthulhu ]
     795qed.
     796
     797(* Lift the above result to memory_inj
     798 * This is Lemma 40 of Leroy & Blazy *)
     799lemma bestorev_memory_inj_to_memory_inj :
    1328800  ∀E,mA,mB,mC.
    1329   ∀Hext:memory_ext E mA mB.
    1330   ∀wb,wo,v. meml ? wb (me_writeable … Hext) →
    1331   bestorev mB (mk_pointer wb wo) v = Some ? mC →
     801  ∀Hext:memory_inj E mA mB.
     802  ∀block2. ∀i : offset. ∀ty : type.
     803  (∀block1,delta.
     804    E block1 = Some ? 〈block2, delta〉 →
     805    (high_bound mA block1 + (Zoo delta) < (Zoo i)) ∨ (Zoo i + (sizeof ty) ≤ (low_bound mA block1 + (Zoo delta)))) →
     806  ∀v.store_value_of_type ty mB block2 i v = Some ? mC →
    1332807  memory_inj E mA mC.
    1333 #E #mA * #contentsB #nextblockB #HnextblockB #mC
    1334 #Hext #wb #wo #v #Hwb #Hstore
    1335 %
    1336 [ 1: @(bestorev_memory_ext_to_load_sim … Hext … Hwb Hstore) ]
    1337 elim Hext in Hwb; * #Hinj #Hvalid #Hcodomain #Hregion #Hdisjoint #writeable #Hwriteable_valid #Hwriteable_ok
    1338 #Hmem
    1339 [ 1: @Hvalid | 3: @Hregion | 4: @Hdisjoint ] -Hvalid -Hregion -Hdisjoint
    1340 whd in Hstore:(??%?); lapply (Hwriteable_valid … Hmem)
    1341 normalize in ⊢ (% → ?); #Hlt_wb
    1342 #p #p' #HvalidA #Hembed lapply (Hcodomain … HvalidA Hembed) -Hcodomain
    1343 normalize in match (valid_pointer ??) in ⊢ (% → %);
    1344 >(Zlt_to_Zltb_true … Hlt_wb) in Hstore; normalize nodelta
    1345 cases (Zleb (low (contentsB wb)) (Z_of_unsigned_bitvector offset_size (offv wo))
    1346        ∧Zltb (Z_of_unsigned_bitvector offset_size (offv wo)) (high (contentsB wb)))
    1347 normalize nodelta
    1348 [ 2: #Habsurd destruct (Habsurd) ]
    1349 #Heq destruct (Heq)
    1350 cases (Zltb (block_id (pblock p')) nextblockB) normalize nodelta
    1351 [ 2: #H @H ]
    1352 whd in match (update_block ?????);
    1353 cut (eq_block (pblock p') wb = false)
    1354 [ 2: #Heq >Heq normalize nodelta #H @H ]
    1355 @neq_block_eq_block_false @sym_neq
    1356 @(mem_not_mem_neq writeable … Hmem)
    1357 @(Hwriteable_ok … HvalidA Hembed)
    1358 qed.
    1359 
    1360 (* It even preserves memory extensions, with the same writeable blocks.  *)
    1361 lemma bestorev_memory_ext_to_memory_ext :
    1362   ∀E,mA,mB.
    1363   ∀Hext:memory_ext E mA mB.
    1364   ∀wb,wo,v. meml ? wb (me_writeable … Hext) →
    1365   ∀mC.bestorev mB (mk_pointer wb wo) v = Some ? mC →
    1366   ΣExt:memory_ext E mA mC.(me_writeable … Hext = me_writeable … Ext).
    1367 #E #mA #mB #Hext #wb #wo #v #Hmem #mC #Hstore
    1368 %{(mk_memory_ext …
    1369       (bestorev_memory_ext_to_memory_inj … Hext … Hmem … Hstore)
    1370       (me_writeable … Hext)
    1371       ?
    1372       (me_writeable_ok … Hext)
    1373  )} try @refl
    1374 #b #Hmemb
    1375 lapply (me_writeable_valid … Hext b Hmemb)
    1376 lapply (me_writeable_valid … Hext wb Hmem)
    1377 elim mB in Hstore; #contentsB #nextblockB #HnextblockB #Hstore #Hwb_valid #Hb_valid
    1378 lapply Hstore normalize in Hwb_valid Hb_valid ⊢ (% → ?);
    1379 >(Zlt_to_Zltb_true … Hwb_valid) normalize nodelta
    1380 cases (if Zleb (low (contentsB wb)) (Z_of_unsigned_bitvector 16 (offv wo))
    1381        then Zltb (Z_of_unsigned_bitvector 16 (offv wo)) (high (contentsB wb)) 
    1382        else false)
    1383 normalize [ 2: #Habsurd destruct (Habsurd) ]
    1384 #Heq destruct (Heq) @Hb_valid
    1385 qed.
    1386 
    1387 (* Lift [bestorev_memory_ext_to_memory_ext] to storen *)
    1388 lemma storen_memory_ext_to_memory_ext :
    1389   ∀E,mA,l,mB,mC.
    1390   ∀Hext:memory_ext E mA mB.
    1391   ∀wb,wo. meml ? wb (me_writeable … Hext) →
    1392   storen mB (mk_pointer wb wo) l = Some ? mC →
    1393   memory_ext E mA mC.
    1394 #E #mA #l elim l
    1395 [ 1: #mB #mC #Hext #wb #wo #Hmem normalize in ⊢ (% → ?); #Heq destruct (Heq)
    1396      @Hext
    1397 | 2: #hd #tl #Hind #mB #mC #Hext #wb #wo #Hmem
    1398      whd in ⊢ ((??%?) → ?);
    1399      lapply (bestorev_memory_ext_to_memory_ext … Hext … wb wo hd Hmem)
    1400      cases (bestorev mB (mk_pointer wb wo) hd)
    1401      normalize nodelta
    1402      [ 1: #H #Habsurd destruct (Habsurd) ]
    1403      #mD #H lapply (H mD (refl ??)) * #HextD #Heq #Hstore
    1404      @(Hind … HextD … Hstore)
    1405      <Heq @Hmem
    1406 ] qed.     
    1407 
    1408 (* Lift [storen_memory_ext_to_memory_ext] to store_value_of_type *)
    1409 lemma store_value_of_type_memory_ext_to_memory_ext :
    1410   ∀E,mA,mB,mC.
    1411   ∀Hext:memory_ext E mA mB.
    1412   ∀wb,wo. meml ? wb (me_writeable … Hext) →
    1413   ∀ty,v.store_value_of_type ty mB wb wo v = Some ? mC →
    1414   memory_ext E mA mC.
    1415 #E #mA #mB #mC #Hext #wb #wo #Hmem #ty #v
    1416 cases ty
    1417 [ 1: | 2: #sz #sg | 3: #fsz | 4: #ptr_ty | 5: #array_ty #array_sz | 6: #domain #codomain
    1418 | 7: #structname #fieldspec | 8: #unionname #fieldspec | 9: #id ]
    1419 whd in ⊢ ((??%?) → ?);
    1420 [ 1,5,6,7,8: #Habsurd destruct (Habsurd) ]
    1421 #Hstore
    1422 @(storen_memory_ext_to_memory_ext … Hext … Hmem … Hstore)
    1423 qed.
    1424 
    1425 (* Commutation results of standard binary operations with value_eq. *)
     808#E #mA #mB #mC #Hinj #block2 #i #ty #Hout #v #Hstore %
     809lapply (bestorev_memory_inj_to_load_sim … Hinj … Hout … Hstore) #Hsim try //
     810cases Hinj #Hsim' #Hnot_valid #Hvalid #Hregion #Hnonalias try assumption
     811#p #p' #Hptr #Hptr_trans lapply (Hvalid p p' Hptr Hptr_trans) #Hvalid
     812cases ty in Hstore;
     813[ | #sz' #sg' | #ptr_ty' | #array_ty' #array_sz' | #domain' #codomain'
     814| #structname' #fieldspec' | #unionname' #fieldspec' | #id' ]
     815whd in ⊢ ((??%?) → ?);
     816[ 1,4,5,6,7: #Habsurd destruct ]
     817cases (fe_to_be_values ??)
     818[ 1,3,5,7: whd in ⊢ ((??%?) → ?); #Heq <Hvalid -Hvalid destruct @refl
     819| *: #hd #tl #Hstoren cases (storen_to_valid_pointer … Hstoren) * * #Hbounds #Hnext #_ #_
     820     @valid_pointer_of_Prop cases (valid_pointer_to_Prop … Hvalid) * #Hnext' #Hlow #Hhigh
     821     @conj try @conj try assumption >Hnext try //
     822     cases (Hbounds (pblock p')) #HA #HB
     823     whd in match (low_bound ??); whd in match (high_bound ??);
     824     >HA >HB try assumption
     825] qed.
     826
     827(* ---------------------------------------------------------- *)
     828(* Lemma 41 of the paper of Leroy & Blazy on the memory model
     829 * and related lemmas *)
     830
     831(* The back-end might contain something similar to this lemma. *)
     832lemma be_to_fe_value_ptr :
     833  ∀b,o. (be_to_fe_value ASTptr (fe_to_be_values ASTptr (Vptr (mk_pointer b o))) = Vptr (mk_pointer b o)).
     834#b * #o whd in ⊢ (??%%); normalize cases b #br #bid normalize nodelta
     835cases br normalize nodelta >eqZb_z_z normalize nodelta
     836cases (vsplit_eq bool 7 8 … o) #lhs * #rhs #Heq
     837<(vsplit_prod … Heq) >eq_v_true normalize nodelta try @refl
     838* //
     839qed.
     840
     841lemma value_eq_to_be_and_back_again :
     842  ∀E,ty,v1,v2.
     843  value_eq E v1 v2 →
     844  ast_typ_consistent_with_value ty v1 →
     845  ast_typ_consistent_with_value ty v2 →
     846  value_eq E (be_to_fe_value ty (fe_to_be_values ty v1 )) (be_to_fe_value ty (fe_to_be_values ty v2)).
     847#E #ty #v1 #v2 #Hvalue_eq
     848@(value_eq_inversion … Hvalue_eq) try //
     849[ 1: cases ty //
     850| 2: #sz #i cases ty
     851     [ 2: @False_ind
     852     | 1: #sz' #sg #H whd in ⊢ (% → ?); #Heq
     853          lapply (fe_to_be_to_fe_value … H) #H >H // ]
     854| 3: #p1 #p2 #Hembed cases ty
     855     [ 1: #sz #sg @False_ind
     856     | 2: #_ #_
     857          cases p1 in Hembed; #b1 #o1
     858          cases p2 #b2 #o2 whd in ⊢ ((??%%) → ?); #H
     859          cases (some_inversion ????? H) * #b3 #o3 * #Hembed
     860          normalize nodelta #Heq >be_to_fe_value_ptr >be_to_fe_value_ptr
     861          destruct %4 whd in match (pointer_translation ??);
     862          >Hembed normalize nodelta @refl
     863     ]
     864] qed.
     865
     866lemma storen_parallel_memory_exists :
     867  ∀E,m1,m2,m1',b1,i,b2,delta,ty,v1,v2.
     868  memory_inj E m1 m2 →
     869  value_eq E v1 v2 →
     870  storen m1 (mk_pointer b1 i) (fe_to_be_values ty v1) = Some ? m1' →
     871  E b1 = Some ? 〈b2, delta〉 →
     872  ∃m2'. storen m2 (mk_pointer b2 (offset_plus i delta)) (fe_to_be_values ty v2) = Some ? m2'.
     873@cthulhu qed.
     874  (*
     875#E #m1 #m2 #m1' #b1 #i #b2 #delta #ty #v1 #v2 #Hinj #Hvalue_eq
     876@(value_eq_inversion … Hvalue_eq)
     877[ 1: #v #Hstoren *)
     878     
     879
     880lemma storen_parallel_aux :
     881  ∀E,m1,m2.
     882  ∀Hinj:memory_inj E m1 m2.
     883  ∀v1,v2. value_eq E v1 v2 →
     884  ∀b1,b2,delta. E b1 = Some ? 〈b2, delta〉 →
     885  ∀ty,i,m1'.
     886  ast_typ_consistent_with_value ty v1 →
     887  ast_typ_consistent_with_value ty v2 → 
     888  storen m1 (mk_pointer b1 i) (fe_to_be_values ty v1) = Some ? m1' →
     889  ∃m2'. storen m2 (mk_pointer b2 (offset_plus i delta)) (fe_to_be_values ty v2) = Some ? m2' ∧
     890        memory_inj E m1' m2'.
     891#E #m1 #m2 #Hinj #v1 #v2 #Hvalue_eq #b1 #b2 #delta #Hembed #ty #i #m1' #Hok1 #Hok2
     892#Hstoren lapply (storen_to_valid_pointer_fe_to_be … Hstoren)
     893* * * #Hblocks_eq1 #Hnextblock1 #Hvalid_m1 #Hvalid_m1'
     894lapply (mi_valid_pointers … Hinj … (mk_pointer b1 i) (mk_pointer b2 (offset_plus i delta)) Hvalid_m1 ?)
     895[ 1: whd in ⊢ (??%%); >Hembed @refl ]
     896#Hvalid_m2
     897cases (valid_pointer_to_Prop … Hvalid_m2) * #Hnextblock2 #Hlow2 #Hhigh2
     898@cthulhu
     899qed.
     900
     901lemma foo :
     902  ∀E,m1,m2.
     903  ∀Hinj:memory_inj E m1 m2.
     904  ∀v1,v2. value_eq E v1 v2 →
     905  ∀b1,b2,delta. E b1 = Some ? 〈b2, delta〉 →
     906  ∀ty,i,m1'. store_value_of_type ty m1 b1 i v1 = Some ? m1' →
     907  ∃m2'. store_value_of_type ty m2 b2 (offset_plus i delta) v2 = Some ? m2' ∧
     908         memory_inj E m1' m2'.
     909#E #m1 #m2 #Hinj #v1 #v2 #Hvalue_eq #b1 #b2 #delta #Hembed #ty #i #m1' #Hstore
     910@cthulhu qed.
     911
     912(* ------------------------------------------------------------------------- *)
     913(* Commutation results of standard unary and binary operations with value_eq. *)
     914
    1426915lemma unary_operation_value_eq :
    1427916  ∀E,op,v1,v2,ty.
     
    1432921#E #op #v1 #v2 #ty #Hvalue_eq #r1
    1433922inversion Hvalue_eq
    1434 [ 1: #v #Hv1 #Hv2 #_ destruct
     923[ 1: #v #Hv1 #Hv2 destruct
    1435924     cases op normalize
    1436      [ 1: cases ty [ 1: | 2: #sz #sg | 3: #fl | 4: #ty | 5: #ty #n | 6: #tl #ty | 7: #id #fl | 8: #id #fl | 9: #ty ]
     925     [ 1: cases ty [ | #sz #sg | #ty | #ty #n | #tl #ty | #id #fl | #id #fl | #ty ]
    1437926          normalize #Habsurd destruct (Habsurd)
    1438      | 3: cases ty [ 1: | 2: #sz #sg | 3: #fl | 4: #ty | 5: #ty #n | 6: #tl #ty | 7: #id #fl | 8: #id #fl | 9: #ty ]
     927     | 3: cases ty [ | #sz #sg | #ty | #ty #n | #tl #ty | #id #fl | #id #fl | #ty ]
    1439928          normalize #Habsurd destruct (Habsurd)
    1440929     | 2: #Habsurd destruct (Habsurd) ]
    1441930| 2: #vsz #i #Hv1 #Hv2 #_
    1442931     cases op
    1443      [ 1: cases ty
    1444           [ 1: | 2: #sz #sg | 3: #fl | 4: #ty | 5: #ty #n | 6: #tl #ty | 7: #id #fl | 8: #id #fl | 9: #ty ]
     932     [ 1: cases ty [ | #sz #sg | #ty | #ty #n | #tl #ty | #id #fl | #id #fl | #ty ]
    1445933          whd in ⊢ ((??%?) → ?); whd in match (sem_unary_operation ???);
    1446934          [ 2: cases (eq_intsize sz vsz) normalize nodelta #Heq1 destruct
     
    1452940          #Heq1 destruct %{(Vint vsz (exclusive_disjunction_bv (bitsize_of_intsize vsz) i (mone vsz)))} @conj //
    1453941     | 3: whd in match (sem_unary_operation ???);
    1454           cases ty
    1455           [ 1: | 2: #sz #sg | 3: #fl | 4: #ty | 5: #ty #n | 6: #tl #ty | 7: #id #fl | 8: #id #fl | 9: #ty ]
     942          cases ty [ | #sz #sg | #ty | #ty #n | #tl #ty | #id #fl | #id #fl | #ty ]
    1456943          normalize nodelta
    1457944          whd in ⊢ ((??%?) → ?);
     
    1459946               %{(Vint vsz (two_complement_negation (bitsize_of_intsize vsz) i))} @conj //
    1460947          | *: #Habsurd destruct (Habsurd) ] ]
    1461 | 3: #f #Hv1 #Hv2 #_ destruct  whd in match (sem_unary_operation ???);
     948| 3: #Hv1 #Hv2 #_ destruct  whd in match (sem_unary_operation ???);
    1462949     cases op normalize nodelta
    1463      [ 1: cases ty
    1464           [ 1: | 2: #sz #sg | 3: #fl | 4: #ty | 5: #ty #n | 6: #tl #ty | 7: #id #fl | 8: #id #fl | 9: #ty ]
    1465           whd in match (sem_notbool ??);
    1466           #Heq1 destruct
    1467           cases (Fcmp Ceq f Fzero) /3 by ex_intro, vint_eq, conj/
    1468      | 2: normalize #Habsurd destruct (Habsurd)
    1469      | 3: cases ty
    1470           [ 1: | 2: #sz #sg | 3: #fl | 4: #ty | 5: #ty #n | 6: #tl #ty | 7: #id #fl | 8: #id #fl | 9: #ty ]
    1471           whd in match (sem_neg ??);
    1472           #Heq1 destruct /3 by ex_intro, vfloat_eq, conj/ ]
    1473 | 4: #Hv1 #Hv2 #_ destruct  whd in match (sem_unary_operation ???);
    1474      cases op normalize nodelta
    1475      [ 1: cases ty
    1476           [ 1: | 2: #sz #sg | 3: #fl | 4: #ty | 5: #ty #n | 6: #tl #ty | 7: #id #fl | 8: #id #fl | 9: #ty ]
     950     [ 1: cases ty   [ | #sz #sg | #ty | #ty #n | #tl #ty | #id #fl | #id #fl | #ty ]
    1477951          whd in match (sem_notbool ??);
    1478952          #Heq1 destruct /3 by ex_intro, vint_eq, conj/
    1479953     | 2: normalize #Habsurd destruct (Habsurd)
    1480      | 3: cases ty
    1481           [ 1: | 2: #sz #sg | 3: #fl | 4: #ty | 5: #ty #n | 6: #tl #ty | 7: #id #fl | 8: #id #fl | 9: #ty ]
     954     | 3: cases ty    [ | #sz #sg | #ty | #ty #n | #tl #ty | #id #fl | #id #fl | #ty ]
    1482955          whd in match (sem_neg ??);
    1483956          #Heq1 destruct ]
    1484 | 5: #p1 #p2 #Hptr_translation #Hv1 #Hv2 #_  whd in match (sem_unary_operation ???);
     957| 4: #p1 #p2 #Hptr_translation #Hv1 #Hv2 #_  whd in match (sem_unary_operation ???);
    1485958     cases op normalize nodelta
    1486      [ 1: cases ty
    1487           [ 1: | 2: #sz #sg | 3: #fl | 4: #ty | 5: #ty #n | 6: #tl #ty | 7: #id #fl | 8: #id #fl | 9: #ty ]
     959     [ 1: cases ty [ | #sz #sg | #ty | #ty #n | #tl #ty | #id #fl | #id #fl | #ty ]
    1488960          whd in match (sem_notbool ??);         
    1489961          #Heq1 destruct /3 by ex_intro, vint_eq, conj/
    1490962     | 2: normalize #Habsurd destruct (Habsurd)
    1491      | 3: cases ty
    1492           [ 1: | 2: #sz #sg | 3: #fl | 4: #ty | 5: #ty #n | 6: #tl #ty | 7: #id #fl | 8: #id #fl | 9: #ty ]
     963     | 3: cases ty [ | #sz #sg | #ty | #ty #n | #tl #ty | #id #fl | #id #fl | #ty ]
    1493964          whd in match (sem_neg ??);         
    1494965          #Heq1 destruct ]
     
    1506977#E #v1 #v2 #v1' #v2' #ty1 #ty2 #Hvalue_eq1 #Hvalue_eq2 #r1
    1507978@(value_eq_inversion E … Hvalue_eq1)
    1508 [ 1: #v | 2: #sz #i | 3: #f | 4: | 5: #p1 #p2 #Hembed ]
     979[ 1: | 2: #sz #i | 3: | 4: #p1 #p2 #Hembed ]
    1509980[ 1: whd in match (sem_add ????); normalize nodelta
    1510981     cases (classify_add ty1 ty2) normalize nodelta
    1511      [ 1: #sz #sg | 2: #fsz | 3: #n #ty #sz #sg | 4: #n #sz #sg #ty | 5: #ty1' #ty2' ]
     982     [ 1: #sz #sg | 2: #n #ty #sz #sg | 3: #n #sz #sg #ty | 4: #ty1' #ty2' ]
    1512983     #Habsurd destruct (Habsurd)
    1513984| 2: whd in match (sem_add ????); whd in match (sem_add ????); normalize nodelta
    1514      cases (classify_add ty1 ty2) normalize nodelta     
    1515      [ 1: #tsz #tsg | 2: #tfsz | 3: #tn #ty #tsz #tsg | 4: #tn #tsz #tsg #ty | 5: #ty1' #ty2' ]
    1516      [ 2,3,5: #Habsurd destruct (Habsurd) ]
     985     cases (classify_add ty1 ty2) normalize nodelta
     986     [ 1: #tsz #tsg | 2: #tn #ty #tsz #tsg | 3: #tn #tsz #tsg #ty | 4: #ty1' #ty2' ]
     987     [ 2,4: #Habsurd destruct (Habsurd) ]
    1517988     @(value_eq_inversion E … Hvalue_eq2) normalize nodelta
    1518      [ 1,6: #v' | 2,7: #sz' #i' | 3,8: #f' | 4,9: | 5,10: #p1' #p2' #Hembed' ]
    1519      [ 1,2,4,5,6,7,9: #Habsurd destruct (Habsurd) ]
     989     [ 1,5: | 2,6: #sz' #i' | 3,7: | 4,8: #p1' #p2' #Hembed' ]
     990     [ 1,2,4,5,7: #Habsurd destruct (Habsurd) ]
    1520991     [ 1: @intsize_eq_elim_elim
    1521992          [ 1: #_ #Habsurd destruct (Habsurd)
     
    15411012               #Heq >Heq @refl ]
    15421013     ]
     1014(* | 3: whd in match (sem_add ????); whd in match (sem_add ????); normalize nodelta
     1015     cases (classify_add ty1 ty2) normalize nodelta
     1016     [ 1: #tsz #tsg | 2: #tn #ty #tsz #tsg | 3: #tn #tsz #tsg #ty | 4: #ty1' #ty2' ]
     1017     [ 1,3,4: #Habsurd destruct (Habsurd) ]
     1018     @(value_eq_inversion E … Hvalue_eq2) normalize nodelta
     1019     [ 1: | 2: #sz' #i'| 3: | 4: #p1' #p2' #Hembed' ]
     1020     [ 1,3,4,5,7: #Habsurd destruct (Habsurd) ]
     1021     #Heq >Heq %{r1} @conj //
     1022     /3 by ex_intro, conj, vfloat_eq/ *)
    15431023| 3: whd in match (sem_add ????); whd in match (sem_add ????); normalize nodelta
    1544      cases (classify_add ty1 ty2) normalize nodelta     
    1545      [ 1: #tsz #tsg | 2: #tfsz | 3: #tn #ty #tsz #tsg | 4: #tn #tsz #tsg #ty | 5: #ty1' #ty2' ]
     1024     cases (classify_add ty1 ty2) normalize nodelta
     1025     [ 1: #tsz #tsg | 2: #tn #ty #tsz #tsg | 3: #tn #tsz #tsg #ty | 4: #ty1' #ty2' ]
     1026     [ 1,3,4: #Habsurd destruct (Habsurd) ]
     1027     @(value_eq_inversion E … Hvalue_eq2) normalize nodelta
     1028     [ 1: | 2: #sz' #i' | 3: | 4: #p1' #p2' #Hembed' ]
    15461029     [ 1,3,4,5: #Habsurd destruct (Habsurd) ]
    1547      @(value_eq_inversion E … Hvalue_eq2) normalize nodelta
    1548      [ 1: #v' | 2: #sz' #i' | 3: #f' | 4: | 5: #p1' #p2' #Hembed' ]
    1549      [ 1,2,4,5: #Habsurd destruct (Habsurd) ]
    1550      #Heq destruct (Heq)
    1551      /3 by ex_intro, conj, vfloat_eq/
    1552 | 4: whd in match (sem_add ????); whd in match (sem_add ????); normalize nodelta
    1553      cases (classify_add ty1 ty2) normalize nodelta     
    1554      [ 1: #tsz #tsg | 2: #tfsz | 3: #tn #ty #tsz #tsg | 4: #tn #tsz #tsg #ty | 5: #ty1' #ty2' ]
    1555      [ 1,2,4,5: #Habsurd destruct (Habsurd) ]
    1556      @(value_eq_inversion E … Hvalue_eq2) normalize nodelta
    1557      [ 1: #v' | 2: #sz' #i' | 3: #f' | 4: | 5: #p1' #p2' #Hembed' ]
    1558      [ 1,3,4,5: #Habsurd destruct (Habsurd) ]
    1559      @eq_bv_elim
     1030     @eq_bv_elim
    15601031     [ 1: normalize nodelta #Heq1 #Heq2 destruct /3 by ex_intro, conj, vnull_eq/
    15611032     | 2: #_ normalize nodelta #Habsurd destruct (Habsurd) ]
    1562 | 5: whd in match (sem_add ????); whd in match (sem_add ????); normalize nodelta
     1033| 4: whd in match (sem_add ????); whd in match (sem_add ????); normalize nodelta
    15631034     cases (classify_add ty1 ty2) normalize nodelta
    1564      [ 1: #tsz #tsg | 2: #tfsz | 3: #tn #ty #tsz #tsg | 4: #tn #tsz #tsg #ty | 5: #ty1' #ty2' ]
    1565      [ 1,2,4,5: #Habsurd destruct (Habsurd) ]
     1035     [ 1: #tsz #tsg | 2: #tn #ty #tsz #tsg | 3: #tn #tsz #tsg #ty | 4: #ty1' #ty2' ]
     1036     [ 1,3,4: #Habsurd destruct (Habsurd) ]
    15661037     @(value_eq_inversion E … Hvalue_eq2) normalize nodelta
    1567      [ 1: #v' | 2: #sz' #i' | 3: #f' | 4: | 5: #p1' #p2' #Hembed' ]
     1038     [ 1: | 2: #sz' #i' | 3: | 4: #p1' #p2' #Hembed' ]
    15681039     [ 1,3,4,5: #Habsurd destruct (Habsurd) ]
    15691040     #Heq destruct (Heq)
     
    16181089#E #v1 #v2 #v1' #v2' #ty1 #ty2 #Hvalue_eq1 #Hvalue_eq2 #r1
    16191090@(value_eq_inversion E … Hvalue_eq1)
    1620 [ 1: #v | 2: #sz #i | 3: #f | 4: | 5: #p1 #p2 #Hembed ]
     1091[  | #sz #i | 3: | 4: #p1 #p2 #Hembed ]
    16211092[ 1: whd in match (sem_sub ????); normalize nodelta
    16221093     cases (classify_sub ty1 ty2) normalize nodelta
    1623      [ 1: #sz #sg | 2: #fsz | 3: #n #ty #sz #sg | 4: #n #sz #sg #ty | 5: #ty1' #ty2' ]
     1094     [ #sz #sg | #n #ty #sz #sg | #n #sz #sg #ty |#ty1' #ty2' ]
    16241095     #Habsurd destruct (Habsurd)
    16251096| 2: whd in match (sem_sub ????); whd in match (sem_sub ????); normalize nodelta
    16261097     cases (classify_sub ty1 ty2) normalize nodelta     
    1627      [ 1: #tsz #tsg | 2: #tfsz | 3: #tn #ty #tsz #tsg | 4: #tn #tsz #tsg #ty | 5: #ty1' #ty2' ]
    1628      [ 2,3,5: #Habsurd destruct (Habsurd) ]
     1098     [ 1: #tsz #tsg | 2: #tn #ty #tsz #tsg | 3: #tn #tsz #tsg #ty | 4: #ty1' #ty2' ]
     1099     [ 2,3,4: #Habsurd destruct (Habsurd) ]
    16291100     @(value_eq_inversion E … Hvalue_eq2) normalize nodelta
    1630      [ 1,6: #v' | 2,7: #sz' #i' | 3,8: #f' | 4,9: | 5,10: #p1' #p2' #Hembed' ]
    1631      [ 1,2,4,5,6,7,8,9,10: #Habsurd destruct (Habsurd) ]
     1101     [  | #sz' #i' | | #p1' #p2' #Hembed' ]
     1102     [ 1,3,4: #Habsurd destruct (Habsurd) ]
    16321103     @intsize_eq_elim_elim
    16331104      [ 1: #_ #Habsurd destruct (Habsurd)
     
    16361107          /3 by ex_intro, conj, vint_eq/           
    16371108      ]
    1638 | 3: whd in match (sem_sub ????); whd in match (sem_sub ????); normalize nodelta
    1639      cases (classify_sub ty1 ty2) normalize nodelta     
    1640      [ 1: #tsz #tsg | 2: #tfsz | 3: #tn #ty #tsz #tsg | 4: #tn #tsz #tsg #ty | 5: #ty1' #ty2' ]
    1641      [ 1,3,4,5: #Habsurd destruct (Habsurd) ]
     1109(*| 3: whd in match (sem_sub ????); whd in match (sem_sub ????); normalize nodelta
     1110     cases (classify_sub ty1 ty2) normalize nodelta
     1111     [ 1: #tsz #tsg | 2: #tn #ty #tsz #tsg | 3: #tn #tsz #tsg #ty | 4: #ty1' #ty2' ]
     1112     [ 1,4: #Habsurd destruct (Habsurd) ]
    16421113     @(value_eq_inversion E … Hvalue_eq2) normalize nodelta
    1643      [ 1: #v' | 2: #sz' #i' | 3: #f' | 4: | 5: #p1' #p2' #Hembed' ]
     1114     [  | #sz' #i' |  | #p1' #p2' #Hembed' ]
    16441115     [ 1,2,4,5: #Habsurd destruct (Habsurd) ]
    16451116     #Heq destruct (Heq)
    1646      /3 by ex_intro, conj, vfloat_eq/
    1647 | 4: whd in match (sem_sub ????); whd in match (sem_sub ????); normalize nodelta
     1117     /3 by ex_intro, conj, vfloat_eq/ *)
     1118| 3: whd in match (sem_sub ????); whd in match (sem_sub ????); normalize nodelta
    16481119     cases (classify_sub ty1 ty2) normalize nodelta
    1649      [ 1: #tsz #tsg | 2: #tfsz | 3: #tn #ty #tsz #tsg | 4: #tn #tsz #tsg #ty | 5: #ty1' #ty2' ]
    1650      [ 1,2,5: #Habsurd destruct (Habsurd) ]
     1120     [ 1: #tsz #tsg | 2: #tn #ty #tsz #tsg | 3: #tn #tsz #tsg #ty | 4: #ty1' #ty2' ]
     1121     [ 1,4: #Habsurd destruct (Habsurd) ]
    16511122     @(value_eq_inversion E … Hvalue_eq2) normalize nodelta
    1652      [ 1,6: #v' | 2,7: #sz' #i' | 3,8: #f' | 4,9: | 5,10: #p1' #p2' #Hembed' ]
    1653      [ 1,2,4,5,6,7,9,10: #Habsurd destruct (Habsurd) ]         
     1123     [ 1,5: | 2,6: #sz' #i' | 3,7: | 4,8: #p1' #p2' #Hembed' ]
     1124     [ 1,2,4,5,7,8: #Habsurd destruct (Habsurd) ]
    16541125     [ 1: @eq_bv_elim [ 1: normalize nodelta #Heq1 #Heq2 destruct /3 by ex_intro, conj, vnull_eq/
    16551126                      | 2: #_ normalize nodelta #Habsurd destruct (Habsurd) ]
    16561127     | 2: #Heq destruct (Heq) /3 by ex_intro, conj, vnull_eq/ ]
    1657 | 5: whd in match (sem_sub ????); whd in match (sem_sub ????); normalize nodelta
     1128| 4: whd in match (sem_sub ????); whd in match (sem_sub ????); normalize nodelta
    16581129     cases (classify_sub ty1 ty2) normalize nodelta
    1659      [ 1: #tsz #tsg | 2: #tfsz | 3: #tn #ty #tsz #tsg | 4: #tn #tsz #tsg #ty | 5: #ty1' #ty2' ]
    1660      [ 1,2,5: #Habsurd destruct (Habsurd) ]
     1130     [ 1: #tsz #tsg | 2: #tn #ty #tsz #tsg | 3: #tn #tsz #tsg #ty | 4: #ty1' #ty2' ]
     1131     [ 1,4: #Habsurd destruct (Habsurd) ]
    16611132     @(value_eq_inversion E … Hvalue_eq2) normalize nodelta
    1662      [ 1,6: #v' | 2,7: #sz' #i' | 3,8: #f' | 4,9: | 5,10: #p1' #p2' #Hembed' ]
    1663      [ 1,2,4,5,6,7,8,9: #Habsurd destruct (Habsurd) ]
     1133     [ 1,5: | 2,6: #sz' #i' | 3,7: | 4,8: #p1' #p2' #Hembed' ]
     1134     [ 1,2,4,5,6,7: #Habsurd destruct (Habsurd) ]
    16641135     #Heq destruct (Heq)
    16651136     [ 1: %{(Vptr (neg_shift_pointer_n (bitsize_of_intsize sz') p2 (sizeof ty) i'))} @conj try @refl
     
    17071178#E #v1 #v2 #v1' #v2' #ty1 #ty2 #Hvalue_eq1 #Hvalue_eq2 #r1
    17081179@(value_eq_inversion E … Hvalue_eq1)
    1709 [ 1: #v | 2: #sz #i | 3: #f | 4: | 5: #p1 #p2 #Hembed ]
     1180[  | #sz #i | 3: | 4: #p1 #p2 #Hembed ]
    17101181[ 1: whd in match (sem_mul ????); normalize nodelta
    17111182     cases (classify_aop ty1 ty2) normalize nodelta
    1712      [ 1: #sz #sg | 2: #fsz | 3: #ty1' #ty2' ]
     1183     [ 1: #sz #sg | 2: #ty1' #ty2' ]
    17131184     #Habsurd destruct (Habsurd)
    17141185| 2: whd in match (sem_mul ????); whd in match (sem_mul ????); normalize nodelta
    17151186     cases (classify_aop ty1 ty2) normalize nodelta
    1716      [ 1: #sz #sg | 2: #fsz | 3: #ty1' #ty2' ]
    1717      [ 2,3: #Habsurd destruct (Habsurd) ]
     1187     [ 1: #sz #sg | 2: #ty1' #ty2' ]
     1188     [ 2: #Habsurd destruct (Habsurd) ]
    17181189     @(value_eq_inversion E … Hvalue_eq2) normalize nodelta
    1719      [ 1: #v' | 2: #sz' #i' | 3: #f' | 4: | 5: #p1' #p2' #Hembed' ]
    1720      [ 1,3,4,5: #Habsurd destruct (Habsurd) ]
     1190     [  | #sz' #i' |  | #p1' #p2' #Hembed' ]
     1191     [ 1,3,4: #Habsurd destruct (Habsurd) ]
    17211192     @intsize_eq_elim_elim
    17221193      [ 1: #_ #Habsurd destruct (Habsurd)
     
    17271198| 3: whd in match (sem_mul ????); whd in match (sem_mul ????); normalize nodelta
    17281199     cases (classify_aop ty1 ty2) normalize nodelta
    1729      [ 1: #sz #sg | 2: #fsz | 3: #ty1' #ty2' ]
    1730      [ 1,3: #Habsurd destruct (Habsurd) ]
    1731      @(value_eq_inversion E … Hvalue_eq2) normalize nodelta     
    1732      [ 1: #v' | 2: #sz' #i' | 3: #f' | 4: | 5: #p1' #p2' #Hembed' ]
    1733      [ 1,2,4,5: #Habsurd destruct (Habsurd) ]
    1734      #Heq destruct (Heq)
    1735      /3 by ex_intro, conj, vfloat_eq/
     1200     [ 1: #sz #sg | 2: #ty1' #ty2' ]
     1201     [ 1,2: #Habsurd destruct (Habsurd) ]
    17361202| 4: whd in match (sem_mul ????); whd in match (sem_mul ????); normalize nodelta
    17371203     cases (classify_aop ty1 ty2) normalize nodelta
    1738      [ 1: #sz #sg | 2: #fsz | 3: #ty1' #ty2' ]
     1204     [ 1: #sz #sg | 2: #ty1' #ty2' ]
    17391205     #Habsurd destruct (Habsurd)
    1740 | 5: whd in match (sem_mul ????); whd in match (sem_mul ????); normalize nodelta
    1741      cases (classify_aop ty1 ty2) normalize nodelta
    1742      [ 1: #sz #sg | 2: #fsz | 3: #ty1' #ty2' ]     
    1743      #Habsurd destruct (Habsurd)
    1744 ] qed.
     1206] qed.     
    17451207
    17461208lemma div_value_eq :
     
    17521214#E #v1 #v2 #v1' #v2' #ty1 #ty2 #Hvalue_eq1 #Hvalue_eq2 #r1
    17531215@(value_eq_inversion E … Hvalue_eq1)
    1754 [ 1: #v | 2: #sz #i | 3: #f | 4: | 5: #p1 #p2 #Hembed ]
     1216[  | #sz #i | 3: | 4: #p1 #p2 #Hembed ]
    17551217[ 1: whd in match (sem_div ????); normalize nodelta
    17561218     cases (classify_aop ty1 ty2) normalize nodelta
    1757      [ 1: #sz #sg | 2: #fsz | 3: #ty1' #ty2' ]
     1219     [ 1: #sz #sg | 2: #ty1' #ty2' ]
    17581220     #Habsurd destruct (Habsurd)
    17591221| 2: whd in match (sem_div ????); whd in match (sem_div ????); normalize nodelta
    17601222     cases (classify_aop ty1 ty2) normalize nodelta
    1761      [ 1: #sz #sg | 2: #fsz | 3: #ty1' #ty2' ]
    1762      [ 2,3: #Habsurd destruct (Habsurd) ]
     1223     [ 1: #sz #sg | 2: #ty1' #ty2' ]
     1224     [ 2: #Habsurd destruct (Habsurd) ]
    17631225     @(value_eq_inversion E … Hvalue_eq2) normalize nodelta
    1764      [ 1: #v' | 2: #sz' #i' | 3: #f' | 4: | 5: #p1' #p2' #Hembed' ]
    1765      [ 1,3,4,5: #Habsurd destruct (Habsurd) ]
     1226     [  | #sz' #i' |  | #p1' #p2' #Hembed' ]
     1227     [ 1,3,4: #Habsurd destruct (Habsurd) ]
    17661228     elim sg normalize nodelta
    17671229     @intsize_eq_elim_elim
     
    17851247| 3: whd in match (sem_div ????); whd in match (sem_div ????); normalize nodelta
    17861248     cases (classify_aop ty1 ty2) normalize nodelta
    1787      [ 1: #sz #sg | 2: #fsz | 3: #ty1' #ty2' ]
    1788      [ 1,3: #Habsurd destruct (Habsurd) ]
    1789      @(value_eq_inversion E … Hvalue_eq2) normalize nodelta     
    1790      [ 1: #v' | 2: #sz' #i' | 3: #f' | 4: | 5: #p1' #p2' #Hembed' ]
    1791      [ 1,2,4,5: #Habsurd destruct (Habsurd) ]
    1792      #Heq destruct (Heq)
    1793      /3 by ex_intro, conj, vfloat_eq/
     1249     [ 1: #sz #sg | 2: #ty1' #ty2' ]
     1250     [ 1,2: #Habsurd destruct (Habsurd) ]
    17941251| 4: whd in match (sem_div ????); whd in match (sem_div ????); normalize nodelta
    17951252     cases (classify_aop ty1 ty2) normalize nodelta
    1796      [ 1: #sz #sg | 2: #fsz | 3: #ty1' #ty2' ]
     1253     [ 1: #sz #sg | 2: #ty1' #ty2' ]
    17971254     #Habsurd destruct (Habsurd)
    1798 | 5: whd in match (sem_div ????); whd in match (sem_div ????); normalize nodelta
    1799      cases (classify_aop ty1 ty2) normalize nodelta
    1800      [ 1: #sz #sg | 2: #fsz | 3: #ty1' #ty2' ]     
    1801      #Habsurd destruct (Habsurd)
    1802 ] qed.
     1255] qed.     
    18031256
    18041257lemma mod_value_eq :
     
    18101263#E #v1 #v2 #v1' #v2' #ty1 #ty2 #Hvalue_eq1 #Hvalue_eq2 #r1
    18111264@(value_eq_inversion E … Hvalue_eq1)
    1812 [ 1: #v | 2: #sz #i | 3: #f | 4: | 5: #p1 #p2 #Hembed ]
     1265[  | #sz #i | 3: | 4: #p1 #p2 #Hembed ]
    18131266[ 1: whd in match (sem_mod ????); normalize nodelta
    18141267     cases (classify_aop ty1 ty2) normalize nodelta
    1815      [ 1: #sz #sg | 2: #fsz | 3: #ty1' #ty2' ]
     1268     [ 1: #sz #sg | 2: #ty1' #ty2' ]
    18161269     #Habsurd destruct (Habsurd)
    18171270| 2: whd in match (sem_mod ????); whd in match (sem_mod ????); normalize nodelta
    18181271     cases (classify_aop ty1 ty2) normalize nodelta
    1819      [ 1: #sz #sg | 2: #fsz | 3: #ty1' #ty2' ]
    1820      [ 2,3: #Habsurd destruct (Habsurd) ]
     1272     [ 1: #sz #sg | 2: #ty1' #ty2' ]
     1273     [ 2: #Habsurd destruct (Habsurd) ]
    18211274     @(value_eq_inversion E … Hvalue_eq2) normalize nodelta
    1822      [ 1: #v' | 2: #sz' #i' | 3: #f' | 4: | 5: #p1' #p2' #Hembed' ]
    1823      [ 1,3,4,5: #Habsurd destruct (Habsurd) ]
     1275     [  | #sz' #i' |  | #p1' #p2' #Hembed' ]
     1276     [ 1,3,4: #Habsurd destruct (Habsurd) ]
    18241277     elim sg normalize nodelta
    18251278     @intsize_eq_elim_elim
     
    18391292                   #H destruct (H)
    18401293                  /3 by ex_intro, conj, vint_eq/ ]
    1841      ]
    1842 | 3: whd in match (sem_mod ????); whd in match (sem_mod ????); normalize nodelta
    1843      cases (classify_aop ty1 ty2) normalize nodelta
    1844      [ 1: #sz #sg | 2: #fsz | 3: #ty1' #ty2' ]
    1845      #Habsurd destruct (Habsurd)
    1846 | 4: whd in match (sem_mod ????); whd in match (sem_mod ????); normalize nodelta
    1847      cases (classify_aop ty1 ty2) normalize nodelta
    1848      [ 1: #sz #sg | 2: #fsz | 3: #ty1' #ty2' ]
    1849      #Habsurd destruct (Habsurd)
    1850 | 5: whd in match (sem_mod ????); whd in match (sem_mod ????); normalize nodelta
    1851      cases (classify_aop ty1 ty2) normalize nodelta
    1852      [ 1: #sz #sg | 2: #fsz | 3: #ty1' #ty2' ]     
    1853      #Habsurd destruct (Habsurd)
     1294     ]     
     1295| *: whd in match (sem_mod ????); whd in match (sem_mod ????); normalize nodelta
     1296     cases (classify_aop ty1 ty2) normalize nodelta #foo #bar #Habsurd destruct (Habsurd)
    18541297] qed.
    18551298
     
    19291372#E #v1 #v2 #v1' #v2' #Hvalue_eq1 #Hvalue_eq2 #r1
    19301373@(value_eq_inversion E … Hvalue_eq1)
    1931 [ 1: #v | 2: #sz #i | 3: #f | 4: | 5: #p1 #p2 #Hembed ]
     1374[  | #sz #i | 3: | 4: #p1 #p2 #Hembed ]
    19321375[ 2:
    19331376     @(value_eq_inversion E … Hvalue_eq2)
    1934      [ 1: #v' | 2: #sz' #i' | 3: #f' | 4: | 5: #p1' #p2' #Hembed' ]
     1377     [  | #sz' #i' |  | #p1' #p2' #Hembed' ]
    19351378     [ 2: whd in match (sem_shl ??);
    19361379          cases (lt_u ???) normalize nodelta
     
    19501393#E #v1 #v2 #v1' #v2' #ty #ty' #Hvalue_eq1 #Hvalue_eq2 #r1
    19511394@(value_eq_inversion E … Hvalue_eq1)
    1952 [ 1: #v | 2: #sz #i | 3: #f | 4: | 5: #p1 #p2 #Hembed ]
     1395[  | #sz #i | 3: | 4: #p1 #p2 #Hembed ]
    19531396whd in match (sem_shr ????); whd in match (sem_shr ????);
    19541397[ 1: cases (classify_aop ty ty') normalize nodelta
    1955      [ 1: #sz #sg | 2: #fsz | 3: #ty1' #ty2' ]
     1398     [ 1: #sz #sg | 2: #ty1' #ty2' ]
    19561399     #Habsurd destruct (Habsurd)
    19571400| 2: cases (classify_aop ty ty') normalize nodelta
    1958      [ 1: #sz #sg | 2: #fsz | 3: #ty1' #ty2' ]
    1959      [ 2,3: #Habsurd destruct (Habsurd) ]
     1401     [ 1: #sz #sg | 2: #ty1' #ty2' ]
     1402     [ 2: #Habsurd destruct (Habsurd) ]
    19601403     @(value_eq_inversion E … Hvalue_eq2) normalize nodelta
    1961      [ 1: #v' | 2: #sz' #i' | 3: #f' | 4: | 5: #p1' #p2' #Hembed' ]
    1962      [ 1,3,4,5: #Habsurd destruct (Habsurd) ]
     1404     [  | #sz' #i' |  | #p1' #p2' #Hembed' ]
     1405     [ 1,3,4: #Habsurd destruct (Habsurd) ]
    19631406     elim sg normalize nodelta
    19641407     cases (lt_u ???) normalize nodelta #Heq destruct (Heq)
    19651408     /3 by ex_intro, conj, refl, vint_eq/
    1966 | 3: cases (classify_aop ty ty') normalize nodelta
    1967      [ 1: #sz #sg | 2: #fsz | 3: #ty1' #ty2' ]
     1409| *: cases (classify_aop ty ty') normalize nodelta
     1410     #foo #bar
    19681411     #Habsurd destruct (Habsurd)
    1969 | 4: cases (classify_aop ty ty') normalize nodelta
    1970      [ 1: #sz #sg | 2: #fsz | 3: #ty1' #ty2' ]
    1971      #Habsurd destruct (Habsurd)
    1972 | 5: cases (classify_aop ty ty') normalize nodelta
    1973      [ 1: #sz #sg | 2: #fsz | 3: #ty1' #ty2' ]
    1974      #Habsurd destruct (Habsurd)
    1975 ] qed.
     1412] qed.     
    19761413
    19771414lemma eq_offset_translation : ∀delta,x,y. cmp_offset Ceq (offset_plus x delta) (offset_plus y delta) = cmp_offset Ceq x y.
  • src/Clight/switchRemoval.ma

    r2450 r2468  
    303303  let 〈s,vars,u〉 ≝ x in u.
    304304
    305 axiom cthulhu : ∀A:Prop. A. (* Because of the nightmares. *)
    306 
    307305(* Proof that switch_removal_switch_free does its job. *)
    308306lemma switch_removal_switch_free : ∀st,u. switch_free (ret_st ? (switch_removal st u)).
     
    344342  match ed with
    345343  [ Econst_int _ _ ⇒ least_identifier
    346   | Econst_float _ ⇒ least_identifier
    347344  | Evar id ⇒ id
    348345  | Ederef e1 ⇒ max_of_expr e1
     
    604601   Simulation proof and related voodoo.
    605602   ----------------------------------------------------------------------------*)
    606 
     603(*
    607604definition expr_lvalue_ind_combined ≝
    608605λP,Q,ci,cf,lv,vr,dr,ao,uo,bo,ca,cd,ab,ob,sz,fl,co,xx.
    609606conj ??
    610607 (expr_lvalue_ind P Q ci cf lv vr dr ao uo bo ca cd ab ob sz fl co xx)
    611  (lvalue_expr_ind P Q ci cf lv vr dr ao uo bo ca cd ab ob sz fl co xx).
     608 (lvalue_expr_ind P Q ci cf lv vr dr ao uo bo ca cd ab ob sz fl co xx).*)
    612609 
    613610let rec expr_ind2
     
    615612    (IE : ∀ed. ∀t. Q ed t → P (Expr ed t))
    616613    (Iconst_int : ∀sz, i, t. Q (Econst_int sz i) t)
    617     (Iconst_float : ∀f, t. Q (Econst_float f) t)
    618614    (Ivar : ∀id, t. Q (Evar id) t)
    619615    (Ideref : ∀e, t. P e → Q (Ederef e) t)
     
    630626    (e : expr) on e : P e ≝
    631627match e with
    632 [ Expr ed t ⇒ IE ed t (expr_desc_ind2 P Q IE Iconst_int Iconst_float Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost ed t) ]
     628[ Expr ed t ⇒ IE ed t (expr_desc_ind2 P Q IE Iconst_int Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost ed t) ]
    633629
    634630and expr_desc_ind2
     
    636632    (IE : ∀ed. ∀t. Q ed t → P (Expr ed t))
    637633    (Iconst_int : ∀sz, i, t. Q (Econst_int sz i) t)
    638     (Iconst_float : ∀f, t. Q (Econst_float f) t)
    639634    (Ivar : ∀id, t. Q (Evar id) t)
    640635    (Ideref : ∀e, t. P e → Q (Ederef e) t)
     
    652647match ed with
    653648[ Econst_int sz i ⇒ Iconst_int sz i t
    654 | Econst_float f ⇒ Iconst_float f t
    655649| Evar id ⇒ Ivar id t
    656 | Ederef e ⇒ Ideref e t (expr_ind2 P Q IE Iconst_int Iconst_float Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost  e)
    657 | Eaddrof e ⇒ Iaddrof e t (expr_ind2 P Q IE Iconst_int Iconst_float Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost  e)
    658 | Eunop op e ⇒ Iunop op e t (expr_ind2 P Q IE Iconst_int Iconst_float Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost  e)
    659 | Ebinop op e1 e2 ⇒ Ibinop op e1 e2 t (expr_ind2 P Q IE Iconst_int Iconst_float Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost  e1) (expr_ind2 P Q IE Iconst_int Iconst_float Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost  e2)
    660 | Ecast castt e ⇒ Icast castt e t (expr_ind2 P Q IE Iconst_int Iconst_float Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost  e)
    661 | Econdition e1 e2 e3 ⇒ Icond e1 e2 e3 t (expr_ind2 P Q IE Iconst_int Iconst_float Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost  e1) (expr_ind2 P Q IE Iconst_int Iconst_float Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost  e2) (expr_ind2 P Q IE Iconst_int Iconst_float Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost  e3)
    662 | Eandbool e1 e2 ⇒ Iandbool e1 e2 t (expr_ind2 P Q IE Iconst_int Iconst_float Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost  e1) (expr_ind2 P Q IE Iconst_int Iconst_float Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost  e2)
    663 | Eorbool e1 e2 ⇒ Iorbool e1 e2 t (expr_ind2 P Q IE Iconst_int Iconst_float Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost  e1) (expr_ind2 P Q IE Iconst_int Iconst_float Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost  e2)
     650| Ederef e ⇒ Ideref e t (expr_ind2 P Q IE Iconst_int Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost  e)
     651| Eaddrof e ⇒ Iaddrof e t (expr_ind2 P Q IE Iconst_int Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost  e)
     652| Eunop op e ⇒ Iunop op e t (expr_ind2 P Q IE Iconst_int Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost  e)
     653| Ebinop op e1 e2 ⇒ Ibinop op e1 e2 t (expr_ind2 P Q IE Iconst_int Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost  e1) (expr_ind2 P Q IE Iconst_int Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost  e2)
     654| Ecast castt e ⇒ Icast castt e t (expr_ind2 P Q IE Iconst_int Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost  e)
     655| Econdition e1 e2 e3 ⇒ Icond e1 e2 e3 t (expr_ind2 P Q IE Iconst_int Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost  e1) (expr_ind2 P Q IE Iconst_int Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost  e2) (expr_ind2 P Q IE Iconst_int Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost  e3)
     656| Eandbool e1 e2 ⇒ Iandbool e1 e2 t (expr_ind2 P Q IE Iconst_int Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost  e1) (expr_ind2 P Q IE Iconst_int Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost  e2)
     657| Eorbool e1 e2 ⇒ Iorbool e1 e2 t (expr_ind2 P Q IE Iconst_int Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost  e1) (expr_ind2 P Q IE Iconst_int Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost  e2)
    664658| Esizeof sizeoft ⇒ Isizeof sizeoft t
    665 | Efield e field ⇒ Ifield e field t (expr_ind2 P Q IE Iconst_int Iconst_float Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost  e)
    666 | Ecost c e ⇒ Icost c e t (expr_ind2 P Q IE Iconst_int Iconst_float Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost e)
     659| Efield e field ⇒ Ifield e field t (expr_ind2 P Q IE Iconst_int Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost  e)
     660| Ecost c e ⇒ Icost c e t (expr_ind2 P Q IE Iconst_int Ivar Ideref Iaddrof Iunop Ibinop Icast Icond Iandbool Iorbool Isizeof Ifield Icost e)
    667661].
    668662
     
    18021796(* case analysis on access mode of [ty] *)
    18031797cases ty
    1804 [ 1: | 2: #sz #sg | 3: #fsz | 4: #ptr_ty | 5: #array_ty #array_sz | 6: #domain #codomain
    1805 | 7: #structname #fieldspec | 8: #unionname #fieldspec | 9: #id ]
     1798[ | #sz #sg | #ptr_ty | #array_ty #array_sz | #domain #codomain
     1799| #structname #fieldspec | #unionname #fieldspec | #id ]
    18061800whd in ⊢ ((??%?) → (?%?));
    1807 [ 1,5,6,7,8: #Habsurd destruct ]
     1801[ 1,4,5,6,7: #Habsurd destruct ]
    18081802whd in ⊢ (? → (??(λ_.?(??%?)?)));
    18091803lapply loc lapply off lapply Hext lapply m_ext lapply m lapply m' -loc -off -Hext -m_ext -m -m'
    18101804elim (fe_to_be_values ??)
    1811 [ 1,3,5,7: #m' #m #m_ext #Hext #off #loc normalize in ⊢ (% → ?); #Heq destruct (Heq) %{m_ext} @conj normalize //
    1812 | 2,4,6,8: #hd #tl #Hind #m' #m #m_ext #Hext #off #loc whd in ⊢ ((??%?) → ?); #H
    1813            cases (some_inversion ????? H) #m'' * #Hstore_eq #Hstoren_eq
    1814            lapply (bestorev_not_writeable_memory_ext … Hext … Hstore_eq)
    1815            * #m_ext'' * #Hstore_eq2 #Hext2
    1816            lapply (Hind … Hext2 … Hstoren_eq) -Hind * #m_ext' *
    1817            #Hstoren' #Hext3
    1818            %{m_ext'} @conj try assumption
    1819            whd in ⊢ (??%%); >Hstore_eq2 normalize nodelta
    1820            @Hstoren'
     1805[ 1,3,5: #m' #m #m_ext #Hext #off #loc normalize in ⊢ (% → ?); #Heq destruct (Heq) %{m_ext} @conj normalize //
     1806| 2,4,6: #hd #tl #Hind #m' #m #m_ext #Hext #off #loc whd in ⊢ ((??%?) → ?); #H
     1807         cases (some_inversion ????? H) #m'' * #Hstore_eq #Hstoren_eq
     1808         lapply (bestorev_not_writeable_memory_ext … Hext … Hstore_eq)
     1809         * #m_ext'' * #Hstore_eq2 #Hext2
     1810         lapply (Hind … Hext2 … Hstoren_eq) -Hind * #m_ext' *
     1811         #Hstoren' #Hext3
     1812         %{m_ext'} @conj try assumption
     1813         whd in ⊢ (??%%); >Hstore_eq2 normalize nodelta
     1814         @Hstoren'
    18211815] qed.
    18221816
     
    18391833#ty #off #v #m2'
    18401834cases ty
    1841 [ 1: | 2: #sz #sg | 3: #fsz | 4: #ptr_ty | 5: #array_ty #array_sz | 6: #domain #codomain
    1842 | 7: #structname #fieldspec | 8: #unionname #fieldspec | 9: #id ]
     1835[ | #sz #sg | #ptr_ty | #array_ty #array_sz | #domain #codomain
     1836| #structname #fieldspec | #unionname #fieldspec | #id ]
    18431837whd in ⊢ ((??%?) → ?);
    1844 [ 1,5,6,7,8: #Habsurd destruct ]
     1838[ 1,4,5,6,7: #Habsurd destruct ]
    18451839lapply Hext lapply m1 lapply m2 lapply m2' lapply off -Hext -m1 -m2 -m2' -off -ty
    18461840elim (fe_to_be_values ??)
    1847 [ 1,3,5,7: #o #m2' #m2 #m1 #Hext normalize #Heq destruct assumption
     1841[ 1,3,5: #o #m2' #m2 #m1 #Hext normalize #Heq destruct assumption
    18481842| *: #hd #tl #Hind #o #m2_end #m2 #m1 #Hext whd in match (storen ???); #Hbestorev
    18491843     cases (some_inversion ????? Hbestorev) #m2' * #Hbestorev #Hstoren
    18501844     lapply (bestorev_writeable_memory_ext … Hext …  o hd Hmem … Hbestorev) #Hext'
    18511845     @(Hind … Hstoren) //
    1852 ] qed.    
     1846] qed.   
    18531847
    18541848(* In proofs, [disjoint_extension] is not enough. When a variable lookup arises, if
     
    21592153[ 1,2: cases (classify_cmp (typeof e1) (typeof e2))
    21602154     normalize nodelta
    2161      [ 1,5: #sz #sg try //
    2162      | 2,6: #opt #ty
     2155     [ 1,4: #sz #sg try //
     2156     | 2,5: #opt #ty
    21632157          cases v1 normalize nodelta
    2164           [ 1,6: | 2,7: #sz #i | 3,8: #fl | 4,9: | 5,10: #ptr ]
    2165           [ 1,2,3,4,5,6: #Habsurd destruct (Habsurd)
    2166           | 7,8: #H @H ]
     2158          [ 1,5: | 2,6: #sz #i | 3,7: | 4,8: #ptr ]
     2159          [ 1,2,3,4: #Habsurd destruct (Habsurd)
     2160          | 5,6: #H @H ]
    21672161          cases v2 normalize nodelta
    2168           [ 1,6: | 2,7: #sz' #i' | 3,8: #fl' | 4,9: | 5,10: #ptr' ]
    2169           [ 1,2,3,4,5,6: #Habsurd destruct (Habsurd)
    2170           | 7,8: #H @H ]
     2162          [ 1,5: | 2,6: #sz' #i' | 3,7: | 4,8: #ptr' ]
     2163          [ 1,2,3,4: #Habsurd destruct (Habsurd)
     2164          | 5,6: #H @H ]
    21712165          lapply (Hvalid ptr)
    21722166          cases (valid_pointer (mk_mem contents1 nextblocks1 Hnextpos1) ptr)
     
    21772171          [ 2,4: >andb_lsimpl_true #_ normalize nodelta cases (eq_block ??) normalize nodelta #Habsurd destruct (Habsurd) ]
    21782172          #H' >(H' (refl ??)) >andb_lsimpl_true normalize nodelta #H @H
    2179      | 3,7: #fsz #H @H
    2180      | 4,8: #ty1 #ty2 #H @H ]
     2173     | 3,6: #ty1 #ty2 #H @H ]
    21812174| 3,4: cases (classify_cmp (typeof e1) (typeof e2))
    21822175     normalize nodelta
    2183      [ 1,5: #sz #sg try //
    2184      | 2,6: #opt #ty
     2176     [ 1,4: #sz #sg try //
     2177     | 2,5: #opt #ty
    21852178          cases v1 normalize nodelta
    2186           [ 1,6: | 2,7: #sz #i | 3,8: #fl | 4,9: | 5,10: #ptr ]
    2187           [ 1,2,3,4,5,6: #Habsurd destruct (Habsurd)
    2188           | 7,8: #H @H ]
     2179          [ 1,5: | 2,6: #sz #i | 3,7: | 4,8: #ptr ]
     2180          [ 1,2,3,4: #Habsurd destruct (Habsurd)
     2181          | 5,6: #H @H ]
    21892182          cases v2 normalize nodelta
    2190           [ 1,6: | 2,7: #sz' #i' | 3,8: #fl' | 4,9: | 5,10: #ptr' ]
    2191           [ 1,2,3,4,5,6: #Habsurd destruct (Habsurd)
    2192           | 7,8: #H @H ]
     2183          [ 1,5: | 2,6: #sz' #i' | 3,7: | 4,8: #ptr' ]
     2184          [ 1,2,3,4: #Habsurd destruct (Habsurd)
     2185          | 5,6: #H @H ]
    21932186          lapply (Hvalid ptr)
    21942187          cases (valid_pointer (mk_mem contents1 nextblocks1 Hnextpos1) ptr)
     
    21992192          [ 2,4: >andb_lsimpl_true #_ normalize nodelta cases (eq_block ??) normalize nodelta #Habsurd destruct (Habsurd) ]
    22002193          #H' >(H' (refl ??)) >andb_lsimpl_true normalize nodelta #H @H
    2201      | 3,7: #fsz #H @H
    2202      | 4,8: #ty1 #ty2 #H @H ]
     2194     | 3,6: #ty1 #ty2 #H @H ]     
    22032195| 5,6: cases (classify_cmp (typeof e1) (typeof e2))
    22042196     normalize nodelta
    2205      [ 1,5: #sz #sg try //
    2206      | 2,6: #opt #ty
     2197     [ 1,4: #sz #sg try //
     2198     | 2,5: #opt #ty
    22072199          cases v1 normalize nodelta
    2208           [ 1,6: | 2,7: #sz #i | 3,8: #fl | 4,9: | 5,10: #ptr ]
    2209           [ 1,2,3,4,5,6: #Habsurd destruct (Habsurd)
    2210           | 7,8: #H @H ]
     2200          [ 1,5: | 2,6: #sz #i | 3,7: | 4,8: #ptr ]
     2201          [ 1,2,3,4: #Habsurd destruct (Habsurd)
     2202          | 5,6: #H @H ]
    22112203          cases v2 normalize nodelta
    2212           [ 1,6: | 2,7: #sz' #i' | 3,8: #fl' | 4,9: | 5,10: #ptr' ]
    2213           [ 1,2,3,4,5,6: #Habsurd destruct (Habsurd)
    2214           | 7,8: #H @H ]
     2204          [ 1,5: | 2,6: #sz' #i' | 3,7: | 4,8: #ptr' ]
     2205          [ 1,2,3,4: #Habsurd destruct (Habsurd)
     2206          | 5,6: #H @H ]
    22152207          lapply (Hvalid ptr)
    22162208          cases (valid_pointer (mk_mem contents1 nextblocks1 Hnextpos1) ptr)
     
    22212213          [ 2,4: >andb_lsimpl_true #_ normalize nodelta cases (eq_block ??) normalize nodelta #Habsurd destruct (Habsurd) ]
    22222214          #H' >(H' (refl ??)) >andb_lsimpl_true normalize nodelta #H @H
    2223      | 3,7: #fsz #H @H
    2224      | 4,8: #ty1 #ty2 #H @H ]
     2215     | 3,6: #ty1 #ty2 #H @H ]
    22252216] qed.
    22262217
     
    22382229[ 1: #csz #cty #i #a1
    22392230     whd in match (exec_expr ????); elim cty
    2240      [ 1: | 2: #sz #sg | 3: #fl | 4: #ty | 5: #ty #n | 6: #tl #ty | 7: #id #fl | 8: #id #fl | 9: #ty ]
     2231     [ | #sz #sg | #ty | #ty #n | #tl #ty | #id #fl | #id #fl | #ty ]
    22412232     normalize nodelta
    22422233     [ 2: cases (eq_intsize csz sz) normalize nodelta
    22432234          [ 1: #H destruct (H) /4 by ex_intro, conj, vint_eq/
    22442235          | 2: #Habsurd destruct (Habsurd) ]
    2245      | 4,5,6: #_ #H destruct (H)
     2236     | 3,4,5: #_ #H destruct (H)
    22462237     | *: #H destruct (H) ]
    2247 | 2: #ty #fl #a1
    2248      whd in match (exec_expr ????); #H1 destruct (H1) /4 by ex_intro, conj, vint_eq/
    2249 | 3: *
    2250   [ 1: #sz #i | 2: #fl | 3: #var_id | 4: #e1 | 5: #e1 | 6: #op #e1 | 7: #op #e1 #e2 | 8: #cast_ty #e1
    2251   | 9: #cond #iftrue #iffalse | 10: #e1 #e2 | 11: #e1 #e2 | 12: #sizeofty | 13: #e1 #field | 14: #cost #e1 ]
     2238| 2: *
     2239  [ #sz #i | #var_id | #e1 | #e1 | #op #e1 | #op #e1 #e2 | #cast_ty #e1
     2240  | #cond #iftrue #iffalse | #e1 #e2 | #e1 #e2 | #sizeofty | #e1 #field | #cost #e1 ]
    22522241  #ty whd in ⊢ (% → ?); #Hind try @I
    22532242  whd in match (Plvalue ???);
     
    22662255                    >(H v (refl ??)) @refl
    22672256  ] ] ]
    2268 | 4: #v #ty whd * * #b #o #tr
     2257| 3: #v #ty whd * * #b #o #tr
    22692258     whd in match (exec_lvalue' ?????);
    22702259     whd in match (exec_lvalue' ?????); cases Hdisjoint *
     
    22802269               #H @H
    22812270          | 2: #blo #Hlookup2 <(Hlookup2 (refl ??)) #Heq normalize nodelta @Heq ] ]
    2282 | 5: #e #ty whd in ⊢ (% → %);
     2271| 4: #e #ty whd in ⊢ (% → %);
    22832272     whd in match (exec_lvalue' ?????);
    22842273     whd in match (exec_lvalue' ?????);
     
    22862275     [ 1: * #v1 #tr1 #H elim (H 〈v1,tr1〉 (refl ??)) * #v1' #tr1' #H @H
    22872276     | 2: #error #_ normalize #a1 #Habsurd destruct (Habsurd) ]
    2288 | 6: #ty #e #ty'
     2277| 5: #ty #e #ty'
    22892278     #Hsim @(exec_lvalue_expr_elim … Hsim)
    22902279     cases ty
    2291      [ 1: | 2: #sz #sg | 3: #fl | 4: #ty | 5: #ty #n | 6: #tl #ty | 7: #id #fl | 8: #id #fl | 9: #ty ]
     2280     [ | #sz #sg | #ty | #ty #n | #tl #ty | #id #fl | #id #fl | #ty ]
    22922281     * #b #o normalize nodelta try /2 by I/
    22932282     #tr @conj try @refl
    2294 | 7: #ty #op #e
     2283| 6: #ty #op #e
    22952284     #Hsim @(exec_expr_expr_elim … Hsim) #v #trace
    22962285     cases (sem_unary_operation op v (typeof e)) normalize nodelta
    22972286     try @I
    22982287     #v @conj @refl
    2299 | 8: #ty #op #e1 #e2 #Hsim1 #Hsim2
     2288| 7: #ty #op #e1 #e2 #Hsim1 #Hsim2
    23002289     @(exec_expr_expr_elim … Hsim1) #v #trace
    23012290     cases (exec_expr ge en1 m1 e2) in Hsim2;
     
    23092298     [ 1: #_ // ] #val #H >(H val (refl ??))
    23102299     normalize destruct @conj @refl
    2311 | 9: #ty #cast_ty #e #Hsim @(exec_expr_expr_elim … Hsim)
     2300| 8: #ty #cast_ty #e #Hsim @(exec_expr_expr_elim … Hsim)
    23122301     #v #tr
    23132302     cut (exec_cast m1 v (typeof e) cast_ty = exec_cast m2 v (typeof e) cast_ty)
     
    23172306     [ 2: //
    23182307     | 1: #v normalize @conj @refl ]
    2319 | 10: #ty #e1 #e2 #e3 #Hsim1 #Hsim2 #Hsim3
     2308| 9: #ty #e1 #e2 #e3 #Hsim1 #Hsim2 #Hsim3
    23202309     @(exec_expr_expr_elim … Hsim1) #v #tr
    23212310     cases (exec_bool_of_val ? (typeof e1)) #b
     
    23352324          | 1: * #e3v #e3tr normalize #H >(H ? (refl ??)) normalize nodelta
    23362325               @conj @refl ] ]
    2337 | 11,12: #ty #e1 #e2 #Hsim1 #Hsim2
     2326| 10,11: #ty #e1 #e2 #Hsim1 #Hsim2
    23382327     @(exec_expr_expr_elim … Hsim1) #v #tr
    23392328     cases (exec_bool_of_val v (typeof e1))
     
    23502339     [ 2,4: #error normalize @I ]
    23512340     * normalize @conj @refl
    2352 | 13: #ty #ty' cases ty
    2353      [ 1: | 2: #sz #sg | 3: #fl | 4: #ty | 5: #ty #n
    2354      | 6: #tl #ty | 7: #id #fl | 8: #id #fl | 9: #ty ]
     2341| 12: #ty #ty' cases ty
     2342     [ | #sz #sg | #ty | #ty #n | #tl #ty | #id #fl | #id #fl | #ty ]
    23552343     whd in match (exec_expr ????); whd #a #H @H
    2356 | 14: #ty #ed #aggregty #i #Hsim whd * * #b #o #tr
     2344| 13: #ty #ed #aggregty #i #Hsim whd * * #b #o #tr
    23572345    whd in match (exec_lvalue' ?????);
    23582346    whd in match (exec_lvalue' ge' en2 m2 (Efield (Expr ed aggregty) i) ty);
    23592347    whd in match (typeof ?);
    23602348    cases aggregty in Hsim;
    2361     [ 1: | 2: #sz' #sg' | 3: #fl' | 4: #ty' | 5: #ty' #n'
    2362     | 6: #tl' #ty' | 7: #id' #fl' | 8: #id' #fl' | 9: #ty' ]
     2349    [ | #sz #sg | #ty | #ty #n | #tl #ty | #id #fl | #id #fl | #ty ]
    23632350    normalize nodelta #Hsim
    2364     [ 1,2,3,4,5,6,9: #Habsurd destruct (Habsurd) ]
     2351    [ 1,2,3,4,5,8: #Habsurd destruct (Habsurd) ]
    23652352    whd in match (m_bind ?????);
    23662353    whd in match (m_bind ?????);
     
    23712358    whd in match (exec_lvalue ge' en2 m2 (Expr ed ?));   
    23722359     >(H ? (refl ??)) normalize nodelta #H @H
    2373 | 15: #ty #l #e #Hsim
     2360| 14: #ty #l #e #Hsim
    23742361     @(exec_expr_expr_elim … Hsim) #v #tr normalize nodelta @conj //
    2375 | 16: *
    2376   [ 1: #sz #i | 2: #fl | 3: #var_id | 4: #e1 | 5: #e1 | 6: #op #e1 | 7: #op #e1 #e2 | 8: #cast_ty #e1
    2377   | 9: #cond #iftrue #iffalse | 10: #e1 #e2 | 11: #e1 #e2 | 12: #sizeofty | 13: #e1 #field | 14: #cost #e1 ]
     2362| 15: *
     2363  [ #sz #i | #var_id | #e1 | #e1 | #op #e1 | #op #e1 #e2 | #cast_ty #e1
     2364  | #cond #iftrue #iffalse | #e1 #e2 | #e1 #e2 | #sizeofty | #e1 #field | #cost #e1 ]
    23782365  #ty normalize in ⊢ (% → ?);
    2379   [ 3,4,13: @False_ind
     2366  [ 2,3,12: @False_ind
    23802367  | *: #_ normalize #a1 #Habsurd @Habsurd ]
    23812368] qed.
     
    25682555| 1: * #val #trace cases val
    25692556     [ 2: #sz #n %1 %{sz} %{n} %{trace} @refl
    2570      | 3: #fl | 4: | 5: #ptr ]
     2557     | 3: | 4: #ptr ]
    25712558     %2 #sz #n #tr % #H destruct (H)
    25722559] qed.
     
    28002787         whd in match (exec_step ??) in Hexec_step;
    28012788         (* IV. Case analysis on the return type *)
    2802          cases (fn_return sss_func) in Hexec_step;
    2803          [ 1: | 2: #sz #sg | 3: #fsz | 4: #ptr_ty | 5: #array_ty #array_sz | 6: #domain #codomain
    2804          | 7: #structname #fieldspec | 8: #unionname #fieldspec | 9: #id ]
     2789         cases (fn_return sss_func) in Hexec_step;         
     2790         [ | #sz #sg | #ptr_ty | #array_ty #array_sz | #domain #codomain
     2791         | #structname #fieldspec | #unionname #fieldspec | #id ]
    28052792         normalize nodelta
    28062793         whd in ⊢ ((??%?) → ?);
     
    28862873         >(prod_eq_lproj ????? sss_func_hyp) >fn_return_simplify
    28872874         cases (fn_return sss_func) in Hexec; normalize nodelta
    2888          [ 1: | 2: #sz #sg | 3: #fsz | 4: #ptr_ty | 5: #array_ty #array_sz | 6: #domain #codomain
    2889          | 7: #structname #fieldspec | 8: #unionname #fieldspec | 9: #id ]
     2875         [ | #sz #sg | #ptr_ty | #array_ty #array_sz | #domain #codomain
     2876         | #structname #fieldspec | #unionname #fieldspec | #id ]         
     2877(*         [ 1: | 2: #sz #sg | 3: #fsz | 4: #ptr_ty | 5: #array_ty #array_sz | 6: #domain #codomain
     2878         | 7: #structname #fieldspec | 8: #unionname #fieldspec | 9: #id ] *)
    28902879         #Hexec whd in Hexec:(??%?); destruct (Hexec) whd @conj try @refl
    28912880         /3 by sws_returnstate, swc_call, memext_free_extended_environment/
     
    31953184             >fn_return_simplify
    31963185             cases (fn_return sss_func) normalize nodelta
    3197              [ 1: | 2: #sz #sg | 3: #fsz | 4: #ptr_ty | 5: #array_ty #array_sz | 6: #domain #codomain
    3198              | 7: #structname #fieldspec | 8: #unionname #fieldspec | 9: #id ]
     3186             [ | #sz #sg | #ptr_ty | #array_ty #array_sz | #domain #codomain
     3187             | #structname #fieldspec | #unionname #fieldspec | #id ]
    31993188             [ 1: whd in ⊢ ((??%%) → ?); #Heq destruct (Heq) whd @conj try @refl
    32003189                  /3 by sws_returnstate, call_cont_swremoval, memext_free_extended_environment, memory_ext_writeable_eq/
     
    32203209        cases condval normalize nodelta
    32213210        [ 1: * #_ #Habsurd normalize in Habsurd; destruct (Habsurd)
    3222         | 3: #f * #_ #Habsurd normalize in Habsurd; destruct (Habsurd)
    3223         | 4: * #_ #Habsurd normalize in Habsurd; destruct (Habsurd)
    3224         | 5: #ptr * #_ #Habsurd normalize in Habsurd; destruct (Habsurd) ]
     3211        | 3: * #_ #Habsurd normalize in Habsurd; destruct (Habsurd)
     3212        | 4: #ptr * #_ #Habsurd normalize in Habsurd; destruct (Habsurd) ]
    32253213        #sz #i * #Hexec_eq #Heq
    32263214        cut (∃sg. typeof cond = Tint sz sg) whd in Heq:(??%%); destruct (Heq)
    32273215        [ 1: cases (typeof cond) in Heq; normalize nodelta
    3228              [ 1: | 2: #sz' #sg' | 3: #fsz | 4: #ptrty | 5: #arrayty #arraysz | 6: #argsty #retty
    3229              | 7: #sid #fields | 8: #uid #fields | 9: #cptr_id ]
     3216             [ | #sz' #sg' | #ptrty | #arrayty #arraysz | #domain #codomain
     3217             | #structname #fieldspec | #unionname #fieldspec | #id ]
    32303218             [ 2: cases (sz_eq_dec ??) normalize nodelta #H
    32313219                  [ 2: #Habsurd destruct
  • src/Clight/toCminor.ma

    r2465 r2468  
    268268(* same gig for AST typs *)
    269269definition typ_should_eq : ∀ty1,ty2. ∀P:typ → Type[0]. P ty1 → res (P ty2).
    270 * [ #sz1 #sg1 | | #sz1 ]
    271 * [ 1,5,9: | *: #a #b try #c try #d @(Error ? (msg TypeMismatch)) ]
    272 [ *; cases sz1 [ 1,5,9: | *: #a #b #c @(Error ? (msg TypeMismatch)) ]
    273   *; cases sg1 #P #p try @(OK ? p) @(Error ? (msg TypeMismatch))
    274 | #P #p @(OK ? p)
    275 | *; cases sz1 #P #p try @(OK ? p) @(Error ? (msg TypeMismatch))
    276 ] qed.
     270* [ #sz1 #sg1 | ]
     271* try /2 by Error/
     272qed.
    277273
    278274alias id "CLunop" = "cic:/matita/cerco/Clight/Csyntax/unary_operation.ind(1,0,0)".
     
    309305      match t' return λt'. res (CMunop t t') with
    310306      [ ASTint sz sg ⇒ typ_should_eq ?? (λt.CMunop t (ASTint ??)) (Onegint sz sg)
    311       | ASTfloat sz ⇒ typ_should_eq ?? (λt.CMunop t (ASTfloat sz)) (Onegf sz)
     307    (*  | ASTfloat sz ⇒ typ_should_eq ?? (λt.CMunop t (ASTfloat sz)) (Onegf sz) *)
    312308      | _ ⇒ Error ? (msg TypeMismatch)
    313309      ]
     
    334330match classify_add ty1 ty2 return λty1,ty2.λ_. CMexpr (typ_of_type ty1) → CMexpr (typ_of_type ty2) → res (CMexpr (typ_of_type ty')) with
    335331[ add_case_ii sz sg ⇒ λe1,e2. typ_should_eq ??? (Op2 ??? (Oadd ??) e1 e2)
    336 | add_case_ff sz ⇒ λe1,e2. typ_should_eq ??? (Op2 ??? (Oaddf sz) e1 e2)
     332(*| add_case_ff sz ⇒ λe1,e2. typ_should_eq ??? (Op2 ??? (Oaddf sz) e1 e2) *)
    337333(* XXX we cast up to I16 Signed to prevent overflow, but often we could use I8 *)
    338334| add_case_pi n ty sz sg ⇒
     
    350346match classify_sub ty1 ty2 return λty1,ty2.λ_. CMexpr (typ_of_type ty1) → CMexpr (typ_of_type ty2) → res (CMexpr (typ_of_type ty')) with
    351347[ sub_case_ii sz sg ⇒ λe1,e2. typ_should_eq ??? (Op2 ??? (Osub ??) e1 e2)
    352 | sub_case_ff sz ⇒ λe1,e2. typ_should_eq ??? (Op2 ??? (Osubf sz) e1 e2)
     348(* | sub_case_ff sz ⇒ λe1,e2. typ_should_eq ??? (Op2 ??? (Osubf sz) e1 e2) *)
    353349(* XXX could optimise cast as above *)
    354350| sub_case_pi n ty sz sg ⇒
     
    369365match classify_aop ty1 ty2 return λty1,ty2.λ_. CMexpr (typ_of_type ty1) → CMexpr (typ_of_type ty2) → res (CMexpr (typ_of_type ty')) with
    370366[ aop_case_ii sz sg ⇒ λe1,e2. typ_should_eq ??? (Op2 ??? (Omul …) e1 e2)
    371 | aop_case_ff sz ⇒ λe1,e2. typ_should_eq ??? (Op2 ??? (Omulf …) e1 e2)
     367(* | aop_case_ff sz ⇒ λe1,e2. typ_should_eq ??? (Op2 ??? (Omulf …) e1 e2) *)
    372368| aop_default _ _ ⇒ λ_.λ_. Error ? (msg TypeMismatch)
    373369].
     
    383379    | Signed ⇒ λe1,e2. typ_should_eq ??? (Op2 ??? (Odiv …) e1 e2)
    384380    ]
    385 | aop_case_ff sz ⇒ λe1,e2. typ_should_eq ??? (Op2 ??? (Odivf …) e1 e2)
     381(* | aop_case_ff sz ⇒ λe1,e2. typ_should_eq ??? (Op2 ??? (Odivf …) e1 e2) *)
    386382| aop_default _ _ ⇒ λ_.λ_. Error ? (msg TypeMismatch)
    387383].
     
    434430| cmp_case_pp n ty ⇒
    435431    λe1,e2. complete_cmp ty' (Op2 ??? (Ocmpp … c) (fix_ptr_type … e1) (fix_ptr_type … e2))
    436 | cmp_case_ff sz ⇒ λe1,e2. complete_cmp ty' (Op2 ??? (Ocmpf … c) e1 e2)
     432(* | cmp_case_ff sz ⇒ λe1,e2. complete_cmp ty' (Op2 ??? (Ocmpf … c) e1 e2) *)
    437433| cmp_default _ _ ⇒ λ_.λ_. Error ? (msg TypeMismatch)
    438434].
     
    473469  P t1 v1 →
    474470  P t2 v2.
    475 * [ * * | | * ]
    476 * try * try *
     471* [ #sz #sg | ]
     472* [ 1,3: * * ]
    477473#P #v1 #v2 #E whd in E:(??%?); destruct
    478 #H @H
    479474qed.
    480475
     
    501496  [ #sz #sg #E1 #E2 #E3 destruct >E3 #E4 -E3 change with (typ_should_eq ???? = OK ??) in E4;
    502497    @(typ_equals … E4) % //
    503   | #sz #E1 #E2 #E3 destruct >E3 #E4
    504     @(typ_equals … E4) % //
     498(*  | #sz #E1 #E2 #E3 destruct >E3 #E4
     499    @(typ_equals … E4) % // *)
    505500  | #n #ty0 #sz #sg #E1 #E2 #E3 destruct >E3 #E4
    506501    @(typ_equals … E4) -E4 -E3 % [ @(unfix_ptr_type ??? (λt,e. expr_vars t e P) H1)| % // ]
     
    509504  | #ty1' #ty2' #E1 #E2 #E3 destruct >E3 #E4 whd in E4:(??%?); destruct
    510505  ]
     506 
    511507| inversion (classify_sub ty1 ty2) in ⊢ ?;
    512508  [ #sz #sg #E1 #E2 #E3 destruct >E3 #E4
    513509    @(typ_equals … E4) % //
    514   | #sz #E1 #E2 #E3 destruct >E3 #E4
    515     @(typ_equals … E4) % //
     510(*  | #sz #E1 #E2 #E3 destruct >E3 #E4
     511    @(typ_equals … E4) % // *)
    516512  | #n #ty0 #sz #sg #E1 #E2 #E3 destruct >E3 #E4
    517513    @(typ_equals … E4) % [ @(unfix_ptr_type ??? (λt,e. expr_vars t e P) H1)| % // ]
    518514  | #n1 #n2 #ty1' #ty2' #E1 #E2 #E3 destruct >E3
    519515    whd in ⊢ (??%? → ?); cases ty in e ⊢ %;
    520     [ 2: #sz #sg #e #E4 | 4: #ty #e #E4 | 5: #ty' #n' #e #E4
     516    [ 2: #sz #sg #e #E4 | 3: #ty #e #E4 | 4: #ty' #n' #e #E4
    521517    | *: normalize #X1 #X2 try #X3 try #X4 destruct
    522518    ] whd in E4:(??%?); destruct % // %
     
    526522| 3,4,5,6,7,8,9,10: inversion (classify_aop ty1 ty2) in ⊢ ?;
    527523  (* Note that some cases require a split on signedness of integer type. *)
    528   [ 1,4,7,10,13,16,19,22: #sz * #E1 #E2 #E3 destruct >E3 #E4
     524  [ 1,3,5,7,9,11,13,15: #sz * #E1 #E2 #E3 destruct >E3 #E4
    529525    @(typ_equals … E4) % //
    530   | 2,5: #sz #E1 #E2 #E3 destruct >E3 #E4
    531     @(typ_equals … E4) % //
    532   | 8,11,14,17,20,23: #sz #E1 #E2 #E3 destruct >E3 #E4 whd in E4:(??%?); destruct
    533   | 3,6,9,12,15,18,21,24: #ty1' #ty2' #E1 #E2 #E3 destruct >E3 #E4 whd in E4:(??%?); destruct
     526  | 2,4,6,8,10,12,14,16,18: #ty1' #ty2' #E1 #E2 #E3 destruct >E3 #E4 whd in E4:(??%?); destruct
    534527  ]
    535 | 11,12,13,14,15,16: inversion (classify_cmp ty1 ty2) in ⊢ ?;
    536   [ 1,5,9,13,17,21: #sz * #E1 #E2 #E3 destruct >E3
    537   | 2,6,10,14,18,22: #n #ty' #E1 #E2 #E3 destruct >E3
    538   | 3,7,11,15,19,23: #sz #E1 #E2 #E3 destruct >E3
     528| *: inversion (classify_cmp ty1 ty2) in ⊢ ?;
     529  [ 1,4,7,10,13,16: #sz * #E1 #E2 #E3 destruct >E3
     530  | 2,5,8,11,14,17: #n #ty' #E1 #E2 #E3 destruct >E3
    539531  | *: #ty1' #ty2' #E1 #E2 #E3 destruct >E3 #E4 whd in E4:(??%?); @⊥ destruct
    540   ] whd in ⊢ (??%? → ?); cases ty in e ⊢ %;
     532  ] whd in ⊢ (??%? → ?); cases ty in e ⊢ %; normalize nodelta
    541533  try (normalize #X1 #X2 try #X3 try #X4 try #X5 destruct #FAIL)
    542534  #sz #sg #e #E4
    543   whd in E4:(??%?); destruct %
    544   [ 25,27,29,31,33,35: @(unfix_ptr_type ??? (λt,e. expr_vars t e P) H1)
    545   | 26,28,30,32,34,36: @(unfix_ptr_type ??? (λt,e. expr_vars t e P) H2)
    546   | *: //
    547   ]
    548 ] qed.
    549 
     535  whd in E4:(??%?); destruct % try @H1 try @H2
     536  try  @(unfix_ptr_type ??? (λt,e. expr_vars t e P) H1)
     537  try  @(unfix_ptr_type ??? (λt,e. expr_vars t e P) H2)
     538] qed. 
    550539
    551540(* We'll need to implement proper translation of pointers if we really do memory
     
    576565    match ty2 return λx.res (Σe':CMexpr (typ_of_type x).expr_vars ? e' P) with
    577566    [ Tint sz2 sg2 ⇒ OK ? (Op1 ?? (Ocastint ? sg1 sz2 ?) e)
    578     | Tfloat sz2 ⇒ OK ? (Op1 ?? (match sg1 with [ Unsigned ⇒ Ofloatofintu ?? | _ ⇒ Ofloatofint ??]) e)
     567  (*  | Tfloat sz2 ⇒ OK ? (Op1 ?? (match sg1 with [ Unsigned ⇒ Ofloatofintu ?? | _ ⇒ Ofloatofint ??]) e)*)
    579568    | Tpointer _ ⇒ OK ? (Op1 ?? (Optrofint ??) e)
    580569    | Tarray _ _ ⇒ OK ? (Op1 ?? (Optrofint ??) e)
    581570    | _ ⇒ Error ? (msg TypeMismatch)
    582571    ]
    583 | Tfloat sz1 ⇒ λe.
     572(* | Tfloat sz1 ⇒ λe.
    584573    match ty2 return λx.res (Σe':CMexpr (typ_of_type x).expr_vars ? e' P) with
    585574    [ Tint sz2 sg2 ⇒ OK ? «Op1 ?? (match sg2 with [ Unsigned ⇒ Ointuoffloat ? sz2 | _ ⇒ Ointoffloat ? sz2 ]) e, ?»
    586575    | Tfloat sz2 ⇒ Error ? (msg FIXME) (* OK ? «Op1 ?? (Oid ?) e, ?» (* FIXME *) *)
    587576    | _ ⇒ Error ? (msg TypeMismatch)
    588     ]
     577    ] *)
    589578| Tpointer _ ⇒ λe. (* will need changed for memory regions *)
    590579    match ty2 return λx.res (Σe':CMexpr (typ_of_type x). expr_vars ? e' P) with
     
    626615      | _ ⇒ Error ? (msg TypeMismatch)
    627616      ]
    628   | Econst_float f ⇒
     617 (* | Econst_float f ⇒
    629618      match ty return λty. res (Σe':CMexpr (typ_of_type ty). ?) with
    630619      [ Tfloat sz ⇒ OK ? «Cst ? (Ofloatconst sz f), ?»
    631620      | _ ⇒ Error ? (msg TypeMismatch)
    632       ]
     621      ] *)
    633622  | Evar id ⇒
    634623      do 〈c,t〉 as E ← lookup' vars id; (* E is an equality proof of the shape "lookup' vars id = Ok <c,t>" *)
     
    676665          ]
    677666      | _ ⇒ λ_. Error ? (msg TypeMismatch)
    678       ] e1'
     667      ] e1'             
    679668  | Eaddrof e1 ⇒
    680669      do e1' ← translate_addr vars e1;
     
    716705      [ Tint sz sg ⇒
    717706        do e2' ← type_should_eq ? (Tint sz sg) (λx.Σe:CMexpr (typ_of_type x).?) e2';
    718         match typ_of_type (typeof e1) return λx.(Σe:CMexpr x. expr_vars ? e (local_id vars)) → res ? with
     707        match typ_of_type (typeof e1) return λx.(Σe:CMexpr x. expr_vars ? e (local_id vars)) → (res (Σe:CMexpr x. expr_vars ? e (local_id vars))) with
    719708        [ ASTint _ _ ⇒ λe1'. OK ? «Cond ??? e1' e2' (Cst ? (Ointconst sz sg (zero ?))), ?»
    720709        | _ ⇒ λ_.Error ? (msg TypeMismatch)
    721710        ] e1'
    722711      | _ ⇒ Error ? (msg TypeMismatch)
    723       ]
     712      ]     
    724713  | Eorbool e1 e2 ⇒
    725714      do e1' ← translate_expr vars e1;
     
    728717      [ Tint sz sg ⇒
    729718        do e2' ← type_should_eq ? (Tint sz sg) (λx.Σe:CMexpr (typ_of_type x).?) e2';
    730         match typ_of_type (typeof e1) return λx.(Σe:CMexpr x. expr_vars ? e (local_id vars)) → ? with
     719        match typ_of_type (typeof e1)
     720        return λx.(Σe:CMexpr x. expr_vars ? e (local_id vars)) → ? with
    731721        [ ASTint _ _ ⇒ λe1'. OK ? «Cond ??? e1' (Cst ? (Ointconst sz sg (repr ? 1))) e2', ?»
    732         | _ ⇒ λ_.Error ? (msg TypeMismatch)
     722        | _ ⇒ λ_. Error ? (msg TypeMismatch)
    733723        ] e1'
    734724      | _ ⇒ Error ? (msg TypeMismatch)
    735       ]
     725      ]     
    736726  | Esizeof ty1 ⇒
    737727      match ty return λty. res (Σe':CMexpr (typ_of_type ty). ?) with
    738728      [ Tint sz sg ⇒ OK ? «Cst ? (Ointconst sz sg (repr ? (sizeof ty1))), ?»
    739729      | _ ⇒ Error ? (msg TypeMismatch)
    740       ]
     730      ]     
    741731  | Efield e1 id ⇒
    742732      match typeof e1 with
     
    764754            ]
    765755      | _ ⇒ Error ? (msg BadlyTypedAccess)
    766       ]
     756      ]           
    767757  | Ecost l e1 ⇒
    768758      do e1' ← translate_expr vars e1;
    769759      do e' ← OK ? «Ecost ? l e1',?»;
    770       typ_should_eq (typ_of_type (typeof e1)) (typ_of_type ty) (λx.Σe:CMexpr x.?) e'
     760      typ_should_eq (typ_of_type (typeof e1)) (typ_of_type ty) (λx.Σe:CMexpr x.?) e'     
    771761  ]
    772762]
  • src/Cminor/initialisation.ma

    r2319 r2468  
    1212| Init_int16 i         ⇒ Some ? (mk_DPair ?? (ASTint I16 Unsigned) (Cst ? (Ointconst I16 Unsigned i)))
    1313| Init_int32 i         ⇒ Some ? (mk_DPair ?? (ASTint I32 Unsigned) (Cst ? (Ointconst I32 Unsigned i)))
    14 | Init_float32 f       ⇒ Some ? (mk_DPair ?? (ASTfloat F32) (Cst ? (Ofloatconst F32 f)))
    15 | Init_float64 f       ⇒ Some ? (mk_DPair ?? (ASTfloat F64) (Cst ? (Ofloatconst F64 f)))
     14| Init_float32 f       ⇒ None ? (*Some ? (mk_DPair ?? (ASTfloat F32) (Cst ? (Ofloatconst F32 f)))*)
     15| Init_float64 f       ⇒ None ? (*Some ? (mk_DPair ?? (ASTfloat F64) (Cst ? (Ofloatconst F64 f)))*)
    1616| Init_space n         ⇒ None ?
    1717| Init_null            ⇒ Some ? (mk_DPair ?? ASTptr (Op1 (ASTint I8 Unsigned) ? (Optrofint ??) (Cst ? (Ointconst I8 Unsigned (zero ?)))))
  • src/common/AST.ma

    r2439 r2468  
    128128inductive typ : Type[0] ≝
    129129  | ASTint : intsize → signedness → typ
    130   | ASTptr : (*region →*) typ
    131   | ASTfloat : floatsize → typ.
     130  | ASTptr : (*region →*) typ.
     131(*  | ASTfloat : floatsize → typ. *)
    132132
    133133(* XXX aliases *)
     
    246246  match ty with
    247247  [ ASTint sz _ ⇒ size_intsize sz
    248   | ASTptr  ⇒ size_pointer
    249   | ASTfloat sz ⇒ size_floatsize sz ].
     248  | ASTptr  ⇒ size_pointer ].
     249(*  | ASTfloat sz ⇒ size_floatsize sz ].*)
    250250
    251251lemma typesize_pos: ∀ty. typesize ty > 0.
  • src/common/Events.ma

    r1599 r2468  
    3838
    3939inductive eventval: Type[0] ≝
    40   | EVint: ∀sz. bvint sz → eventval
    41   | EVfloat: float → eventval.
     40  | EVint: ∀sz. bvint sz → eventval.
     41(*  | EVfloat: float → eventval.*)
    4242
    4343inductive event : Type[0] ≝
     
    194194  | ev_match_int:
    195195      ∀sz,sg,i. eventval_match (EVint sz i) (ASTint sz sg) (Vint sz i)
    196   | ev_match_float:
    197       ∀f,sz. eventval_match (EVfloat f) (ASTfloat sz) (Vfloat f).
     196(*  | ev_match_float:
     197      ∀f,sz. eventval_match (EVfloat f) (ASTfloat sz) (Vfloat f) *).
    198198
    199199inductive eventval_list_match: list eventval -> list typ -> list val -> Prop :=
  • src/common/FrontEndOps.ma

    r2432 r2468  
    2323inductive constant : typ → Type[0] ≝
    2424  | Ointconst: ∀sz,sg. bvint sz → constant (ASTint sz sg)
    25   | Ofloatconst: ∀sz. float → constant (ASTfloat sz)
     25(*  | Ofloatconst: ∀sz. float → constant (ASTfloat sz) *)
    2626  | Oaddrsymbol: ident → nat → constant ASTptr (**r address of the symbol plus the offset *)
    2727  | Oaddrstack: nat → constant ASTptr.         (**r stack pointer plus the given offset *)
     
    3434  | Onotbool: ∀t,sz,sg. boolsrc t → unary_operation t (ASTint sz sg)           (**r boolean negation  *)
    3535  | Onotint:  ∀sz,sg. unary_operation (ASTint sz sg) (ASTint sz sg)            (**r bitwise complement  *)
    36   | Onegf: ∀sz. unary_operation (ASTfloat sz) (ASTfloat sz)                    (**r float opposite *)
    37   | Oabsf: ∀sz. unary_operation (ASTfloat sz) (ASTfloat sz)                    (**r float absolute value *)
    38   | Osingleoffloat: unary_operation (ASTfloat F64) (ASTfloat F32)              (**r float truncation *)
    39   | Ointoffloat:  ∀fsz,sz. unary_operation (ASTfloat fsz) (ASTint sz Signed)  (**r signed integer to float *)
    40   | Ointuoffloat: ∀fsz,sz. unary_operation (ASTfloat fsz) (ASTint sz Unsigned) (**r unsigned integer to float *)
    41   | Ofloatofint:  ∀fsz,sz. unary_operation (ASTint sz Signed) (ASTfloat fsz)   (**r float to signed integer *)
    42   | Ofloatofintu: ∀fsz,sz. unary_operation (ASTint sz Unsigned) (ASTfloat fsz) (**r float to unsigned integer *)
     36(*| Onegf: ∀sz. unary_operation (ASTfloat sz) (ASTfloat sz)*)                  (**r float opposite *)
     37(*| Oabsf: ∀sz. unary_operation (ASTfloat sz) (ASTfloat sz)*)                  (**r float absolute value *)
     38(*| Osingleoffloat: unary_operation (ASTfloat F64) (ASTfloat F32)*)            (**r float truncation *)
     39(*| Ointoffloat:  ∀fsz,sz. unary_operation (ASTfloat fsz) (ASTint sz Signed)*) (**r signed integer to float *)
     40(*| Ointuoffloat: ∀fsz,sz. unary_operation (ASTfloat fsz) (ASTint sz Unsigned)*) (**r unsigned integer to float *)
     41(*| Ofloatofint:  ∀fsz,sz. unary_operation (ASTint sz Signed) (ASTfloat fsz)*)   (**r float to signed integer *)
     42(*| Ofloatofintu: ∀fsz,sz. unary_operation (ASTint sz Unsigned) (ASTfloat fsz)*) (**r float to unsigned integer *)
    4343  | Oid: ∀t. unary_operation t t                                               (**r identity (used to move between registers *)
    4444  | Optrofint: ∀sz,sg. unary_operation (ASTint sz sg) ASTptr                   (**r int to pointer with given representation *)
     
    5959  | Oshr:  ∀sz,sg. binary_operation (ASTint sz sg)       (ASTint sz sg)       (ASTint sz sg)       (**r right signed shift *)
    6060  | Oshru: ∀sz,sg. binary_operation (ASTint sz Unsigned) (ASTint sz sg)       (ASTint sz sg)       (**r right unsigned shift *)
    61   | Oaddf: ∀sz.    binary_operation (ASTfloat sz)        (ASTfloat sz)        (ASTfloat sz)        (**r float addition *)
    62   | Osubf: ∀sz.    binary_operation (ASTfloat sz)        (ASTfloat sz)        (ASTfloat sz)        (**r float subtraction *)
    63   | Omulf: ∀sz.    binary_operation (ASTfloat sz)        (ASTfloat sz)        (ASTfloat sz)        (**r float multiplication *)
    64   | Odivf: ∀sz.    binary_operation (ASTfloat sz)        (ASTfloat sz)        (ASTfloat sz)        (**r float division *)
     61(*  | Oaddf: ∀sz.    binary_operation (ASTfloat sz)        (ASTfloat sz)        (ASTfloat sz)*)        (**r float addition *)
     62(*  | Osubf: ∀sz.    binary_operation (ASTfloat sz)        (ASTfloat sz)        (ASTfloat sz)*)        (**r float subtraction *)
     63(*  | Omulf: ∀sz.    binary_operation (ASTfloat sz)        (ASTfloat sz)        (ASTfloat sz)*)        (**r float multiplication *)
     64(*  | Odivf: ∀sz.    binary_operation (ASTfloat sz)        (ASTfloat sz)        (ASTfloat sz)*)        (**r float division *)
    6565  | Ocmp: ∀sz,sg,sg'. comparison -> binary_operation (ASTint sz sg)       (ASTint sz sg)       (ASTint I8 sg') (**r integer signed comparison *)
    6666  | Ocmpu: ∀sz,sg'.   comparison -> binary_operation (ASTint sz Unsigned) (ASTint sz Unsigned) (ASTint I8 sg') (**r integer unsigned comparison *)
    67   | Ocmpf: ∀sz,sg'.   comparison -> binary_operation (ASTfloat sz)        (ASTfloat sz)        (ASTint I8 sg') (**r float comparison *)
     67(*  | Ocmpf: ∀sz,sg'.   comparison -> binary_operation (ASTfloat sz)        (ASTfloat sz)        (ASTint I8 sg') *) (**r float comparison *)
    6868  | Oaddp: ∀sz.    binary_operation  ASTptr              (ASTint sz Signed)    ASTptr              (**r add an integer to a pointer *)
    6969  | Osubpi: ∀sz.   binary_operation  ASTptr              (ASTint sz Signed)    ASTptr              (**r subtract int from a pointers *)
     
    7676match t with
    7777[ ASTint sz sg ⇒ ∀i.P (Vint sz i)
    78 | ASTfloat sz ⇒ ∀f.P (Vfloat f)
     78(*| ASTfloat sz ⇒ ∀f.P (Vfloat f) *)
    7979| ASTptr ⇒ P Vnull ∧ ∀b,o. P (Vptr (mk_pointer b o))
    8080] →
    8181P v.
    8282#v #t #P *
    83 [ 1,2: //
     83[ 1: //
    8484| * //
    8585| #b #o * //
     
    9595  match cst with
    9696  [ Ointconst sz sg n ⇒ Some ? (Vint sz n)
    97   | Ofloatconst sz n ⇒ Some ? (Vfloat n)
     97(*  | Ofloatconst sz n ⇒ Some ? (Vfloat n)*)
    9898  | Oaddrsymbol s ofs ⇒
    9999      match find_symbol s with
     
    113113#t #f #sp *
    114114[ #sz #sg #i #v #E normalize in E; destruct //
    115 | #sz #f #v #E normalize in E; destruct //
     115(*| #sz #f #v #E normalize in E; destruct //*)
    116116| #id #n #v whd in ⊢ (??%? → ?); cases (f id) [2:#b] #E whd in E:(??%?); destruct
    117117(*  cases (pointer_compat_dec b r) in E; #pc #E whd in E:(??%?); destruct *)
     
    137137      ]
    138138  | Onotint sz sg ⇒ match arg with [ Vint sz1 n1 ⇒ Some ? (Vint sz1 (exclusive_disjunction_bv ? n1 (mone ?))) | _ ⇒ None ? ]
    139   | Onegf _ ⇒ match arg with [ Vfloat f1 ⇒ Some ? (Vfloat (Fneg f1)) | _ ⇒ None ? ]
    140   | Oabsf _ ⇒ match arg with [ Vfloat f1 ⇒ Some ? (Vfloat (Fabs f1)) | _ ⇒ None ? ]
     139(*  | Onegf _ ⇒ match arg with [ Vfloat f1 ⇒ Some ? (Vfloat (Fneg f1)) | _ ⇒ None ? ]
     140  | Oabsf _ ⇒ match arg with [ Vfloat f1 ⇒ Some ? (Vfloat (Fabs f1)) | _ ⇒ None ? ] 
    141141  | Osingleoffloat ⇒ Some ? (singleoffloat arg)
    142142  | Ointoffloat _ sz ⇒ match arg with [ Vfloat f1 ⇒ Some ? (Vint sz (intoffloat ? f1)) | _ ⇒ None ? ]
    143143  | Ointuoffloat _ sz ⇒ match arg with [ Vfloat f1 ⇒ Some ? (Vint sz (intuoffloat ? f1)) | _ ⇒ None ? ]
    144144  | Ofloatofint _ _ ⇒ match arg with [ Vint sz1 n1 ⇒ Some ? (Vfloat (floatofint ? n1)) | _ ⇒ None ? ]
    145   | Ofloatofintu _ _ ⇒ match arg with [ Vint sz1 n1 ⇒ Some ? (Vfloat (floatofintu ? n1)) | _ ⇒ None ? ]
     145  | Ofloatofintu _ _ ⇒ match arg with [ Vint sz1 n1 ⇒ Some ? (Vfloat (floatofintu ? n1)) | _ ⇒ None ? ] *)
    146146  | Oid t ⇒ Some ? arg (* XXX should we restricted the values allowed? *)
    147147  (* Only conversion of null pointers is specified. *)
     
    164164    | #b #o whd in ⊢ (??%? → ?); #E' destruct %
    165165    ]
    166   | #f *
     166(*  | #f * *)
    167167  ]
    168168| #sz #sg #v #v' #H @(elim_val_typ … H) #i whd in ⊢ (??%? → ?); #E destruct %
     169(*
    169170| #sz #v #v' #H @(elim_val_typ … H) #f whd in ⊢ (??%? → ?); #E destruct %2
    170171| #sz #v #v' #H @(elim_val_typ … H) #f whd in ⊢ (??%? → ?); #E destruct %2
     
    174175| #fsz #sz #v #v' #H @(elim_val_typ … H) #i whd in ⊢ (??%? → ?); #E destruct %2
    175176| #fsz #sz #v #v' #H @(elim_val_typ … H) #i whd in ⊢ (??%? → ?); #E destruct %2
     177*)
    176178| #t'' #v #v' #H whd in ⊢ (??%? → ?); #E destruct @H
    177179| #sz #sg #v #v' #H @(elim_val_typ … H) #i whd in ⊢ (??%? → ?); cases (eq_bv ???)
     
    349351  | _ ⇒ None ? ].
    350352
     353(*
    351354definition ev_addf ≝ λv1,v2: val.
    352355  match v1 with
     
    375378    [ Vfloat f2 ⇒ Some ? (Vfloat (Fdiv f1 f2))
    376379    | _ ⇒ None ? ]
    377   | _ ⇒ None ? ].
     380  | _ ⇒ None ? ]. *)
    378381
    379382definition FEtrue : val ≝ Vint I8 (repr I8 1).
     
    434437  | _ ⇒ None ? ].
    435438
     439(*
    436440definition ev_cmpf ≝ λc: comparison. λv1,v2: val.
    437441  match v1 with
     
    439443    [ Vfloat f2 ⇒ Some ? (FE_of_bool (Fcmp c f1 f2))
    440444    | _ ⇒ None ? ]
    441   | _ ⇒ None ? ].
     445  | _ ⇒ None ? ]. *)
    442446
    443447definition eval_binop : mem → ∀t1,t2,t'. binary_operation t1 t2 t' → val → val → option val ≝
     
    457461  | Oshr _ _ ⇒ ev_shr
    458462  | Oshru _ _ ⇒ ev_shru
    459   | Oaddf _ ⇒ ev_addf
     463(*  | Oaddf _ ⇒ ev_addf
    460464  | Osubf _ ⇒ ev_subf
    461465  | Omulf _ ⇒ ev_mulf
    462   | Odivf _ ⇒ ev_divf
     466  | Odivf _ ⇒ ev_divf *)
    463467  | Ocmp _ _ _ c ⇒ ev_cmp c
    464468  | Ocmpu _ _ c ⇒ ev_cmpu c
    465   | Ocmpf _ _ c ⇒ ev_cmpf c
     469(*  | Ocmpf _ _ c ⇒ ev_cmpf c *)
    466470  | Oaddp _ ⇒ ev_addp
    467471  | Osubpi _ ⇒ ev_subpi
     
    490494  whd in ⊢ (??%? → ?); cases (lt_u ???) whd in ⊢ (??%? → ?); #E destruct //
    491495(* floats *)
    492 | 14,15,16,17: #sz #v1 #v2 #v' #V1 #V2 @(elim_val_typ … V1) #f1 @(elim_val_typ … V2) #f2
    493   whd in ⊢ (??%? → ?); #E destruct //
     496(*| 14,15,16,17: #sz #v1 #v2 #v' #V1 #V2 @(elim_val_typ … V1) #f1 @(elim_val_typ … V2) #f2
     497  whd in ⊢ (??%? → ?); #E destruct // *)
    494498(* comparisons *)
    495499| #sz #sg #sg' #c #v1 #v2 #v' #V1 #V2 @(elim_val_typ … V1) #i1 @(elim_val_typ … V2) #i2
     
    497501| #sz #sg' #c #v1 #v2 #v' #V1 #V2 @(elim_val_typ … V1) #i1 @(elim_val_typ … V2) #i2
    498502  whd in ⊢ (??%? → ?); >intsize_eq_elim_true cases (cmpu_int ????) #E destruct //
    499 | #sz #sg' #c #v1 #v2 #v' #V1 #V2 @(elim_val_typ … V1) #f1 @(elim_val_typ … V2) #f2
    500   whd in ⊢ (??%? → ?); cases (Fcmp ???) #E destruct //
     503(*| #sz #sg' #c #v1 #v2 #v' #V1 #V2 @(elim_val_typ … V1) #f1 @(elim_val_typ … V2) #f2
     504  whd in ⊢ (??%? → ?); cases (Fcmp ???) #E destruct // *)
    501505(* pointers *)
    502 | 21,22: #sz #v1 #v2 #v' #V1 #V2 @(elim_val_typ … V1) % [ 2,4: #b #o ] @(elim_val_typ … V2) #i2
     506| 16,17: #sz #v1 #v2 #v' #V1 #V2 @(elim_val_typ … V1) % [ 2,4: #b #o ] @(elim_val_typ … V2) #i2
    503507  whd in ⊢ (??%? → ?); [ 3,4: cases (eq_bv ???) whd in ⊢ (??%? → ?); | ] #E destruct //
    504508| #sz #v1 #v2 #v' #V1 #V2 @(elim_val_typ … V1) % [ | #b1 #o1 ] @(elim_val_typ … V2) % [ 2,4: #b2 #o2 ]
  • src/common/FrontEndVal.ma

    r2435 r2468  
    2222[ Vundef ⇒ make_list ? BVundef (typesize t)
    2323| Vint sz i ⇒ map ?? (λb.BVByte b) (bytes_of_bitvector ? (i⌈bvint sz ↦ BitVector (size_intsize sz * 8)⌉))
    24 | Vfloat _ ⇒ make_list ? BVundef (typesize t) (* unsupported *)
     24(*| Vfloat _ ⇒ make_list ? BVundef (typesize t) *) (* unsupported *)
    2525| Vptr ptr ⇒ bevals_of_pointer ptr
    2626| Vnull  ⇒ make_be_null
  • src/common/Globalenvs.ma

    r2439 r2468  
    181181  | Init_int16 n ⇒ store (ASTint I16 Unsigned) m ptr (Vint I16 n)
    182182  | Init_int32 n ⇒ store (ASTint I32 Unsigned) m ptr (Vint I32 n)
    183   | Init_float32 n ⇒ store (ASTfloat F32) m ptr (Vfloat n)
    184   | Init_float64 n ⇒ store (ASTfloat F64) m ptr (Vfloat n)
     183  | Init_float32 n ⇒ None ? (*store (ASTfloat F32) m ptr (Vfloat n)*)
     184  | Init_float64 n ⇒ None ? (*store (ASTfloat F64) m ptr (Vfloat n) *)
    185185  | Init_addrof (*r'*) symb ofs ⇒
    186186      match find_symbol … ge symb with
     
    334334[ #f #E normalize in E; destruct
    335335| #sz #i #f #E normalize in E; destruct
    336 | #f #fn #E normalize in E; destruct
     336(*| #f #fn #E normalize in E; destruct*)
    337337| (*#r*) #f #E normalize in E; destruct
    338338| * (*#pty*) #b (*#c*) * #off #f whd in ⊢ (??%? → ?);
     
    10671067  | skip
    10681068  ]
    1069 | * [5: #ptr #fn whd in match (find_funct ???);
     1069| * [ 4: #ptr #fn whd in match (find_funct ???);
    10701070     @if_elim #Eoff #FFP
    10711071     [ cases (find_funct_ptr_match … (transform_program_gen_match … tf p) … FFP)
  • src/common/IO.ma

    r2176 r2468  
    66
    77definition eventval_type : ∀ty:typ. Type[0] ≝
    8 λty. match ty with [ ASTint sz _ ⇒ bvint sz | ASTptr ⇒ False | ASTfloat _ ⇒ float ].
     8λty. match ty return λ_. Type[0] with [ ASTptr ⇒ False | ASTint sz _ ⇒ bvint sz ].
    99
    1010definition mk_eventval: ∀ty:typ. eventval_type ty → eventval ≝
    11 λty:typ. match ty return λty'.eventval_type ty' → eventval with [ ASTint sz sg ⇒ λv.EVint sz v | ASTptr ⇒ ? | ASTfloat _ ⇒ λv.EVfloat v ].
     11λty:typ. match ty return λty'.eventval_type ty' → eventval with [ ASTint sz sg ⇒ λv.EVint sz v | ASTptr ⇒ ?  (*| ASTfloat _ ⇒ λv.EVfloat v*) ].
    1212*; qed.
    1313
    1414definition mk_val: ∀ty:typ. eventval_type ty → val ≝
    15 λty:typ. match ty return λty'.eventval_type ty' → val with [ ASTint sz _ ⇒ λv.Vint sz v | ASTptr ⇒ ? | ASTfloat _ ⇒ λv.Vfloat v ].
     15λty:typ. match ty return λty'.eventval_type ty' → val with [ ASTint sz _ ⇒ λv.Vint sz v | ASTptr ⇒ ? (*| ASTfloat _ ⇒ λv.Vfloat v*) ].
    1616*; qed.
    1717
     
    2828  [ EVint sz' i ⇒ if eq_intsize sz sz' then OK ? (Vint sz' i) else Error ? (msg IllTypedEvent)
    2929  | _ ⇒ Error ? (msg IllTypedEvent)]
    30 | ASTfloat _ ⇒ match ev with [ EVfloat f ⇒ OK ? (Vfloat f) | _ ⇒ Error ? (msg IllTypedEvent)]
     30(*| ASTfloat _ ⇒ match ev with [ EVfloat f ⇒ OK ? (Vfloat f) | _ ⇒ Error ? (msg IllTypedEvent)] *)
    3131| _ ⇒ Error ? (msg IllTypedEvent)
    3232].
     
    3838  [ Vint sz' i ⇒ if eq_intsize sz sz' then OK ? (EVint sz' i) else Error ? (msg IllTypedEvent)
    3939  | _ ⇒ Error ? (msg IllTypedEvent) ]
    40 | ASTfloat _ ⇒ match v with [ Vfloat f ⇒ OK ? (EVfloat f) | _ ⇒ Error ? (msg IllTypedEvent) ]
     40(*| ASTfloat _ ⇒ match v with [ Vfloat f ⇒ OK ? (EVfloat f) | _ ⇒ Error ? (msg IllTypedEvent) ]*)
    4141| _ ⇒ Error ? (msg IllTypedEvent)
    4242].
  • src/common/Values.ma

    r2176 r2468  
    1818
    1919include "utilities/Coqlib.ma".
    20 include "common/Floats.ma".
     20(*include "common/Floats.ma".*)
    2121include "common/Errors.ma".
    2222include "common/Pointers.ma".
     
    2525(* * A value is either:
    2626- a machine integer;
    27 - a floating-point number;
     27- /* a floating-point number; */ No more
    2828- a pointer: a triple giving the representation of the pointer (in terms of the
    2929             memory regions such a pointer could address), a memory address and
     
    3737  | Vundef: val
    3838  | Vint: ∀sz:intsize. bvint sz → val
    39   | Vfloat: float → val
     39(*  | Vfloat: float → val*)
    4040  | Vnull: (*region →*) val
    4141  | Vptr: pointer → val.
     
    5252inductive val_typ : val → typ → Prop ≝
    5353  | VTint: ∀sz,sg,i. val_typ (Vint sz i) (ASTint sz sg)
    54   | VTfloat: ∀sz,f. val_typ (Vfloat f) (ASTfloat sz)
     54(*  | VTfloat: ∀sz,f. val_typ (Vfloat f) (ASTfloat sz)*)
    5555  | VTnull: val_typ Vnull ASTptr
    5656  | VTptr: ∀b,o. val_typ (Vptr (mk_pointer b o)) ASTptr.
     
    109109  ].
    110110
     111(*
    111112definition negf : val → val ≝ λv.
    112113  match v with
     
    115116  ].
    116117
     118
    117119definition absf : val → val ≝ λv.
    118120  match v with
     
    121123  ].
    122124
     125
    123126definition intoffloat : intsize → val → val ≝ λsz,v.
    124127  match v with
     
    143146  [ Vint sz n ⇒ Vfloat (floatofintu ? n)
    144147  | _ ⇒ Vundef
    145   ].
     148  ]. *)
    146149
    147150definition notint : val → val ≝ λv.
     
    171174  ].
    172175
     176(*
    173177definition singleoffloat : val → val ≝ λv.
    174178  match v with
    175179  [ Vfloat f ⇒ Vfloat (singleoffloat f)
    176180  | _ ⇒ Vundef
    177   ].
     181  ]. *)
    178182
    179183(* TODO: add zero to null? *)
     
    334338  end.
    335339*)
     340
     341(*
    336342definition addf ≝ λv1,v2: val.
    337343  match v1 with
     
    360366    [ Vfloat f2 ⇒ Vfloat (Fdiv f1 f2)
    361367    | _ ⇒ Vundef ]
    362   | _ ⇒ Vundef ].
     368  | _ ⇒ Vundef ]. *)
    363369
    364370definition cmp_match : comparison → val ≝ λc.
     
    451457  | _ ⇒ Vundef ].
    452458
     459
     460(*
    453461definition cmpf ≝ λc: comparison. λsz:intsize. λv1,v2: val.
    454462  match v1 with
     
    456464    [ Vfloat f2 ⇒ of_bool (Fcmp c f1 f2)
    457465    | _ ⇒ Vundef ]
    458   | _ ⇒ Vundef ].
     466  | _ ⇒ Vundef ]. *)
    459467
    460468(* * [load_result] is used in the memory model (library [Mem])
     
    487495    | _ ⇒ Vundef
    488496    ]
    489   | Vfloat f ⇒
     497(*  | Vfloat f ⇒
    490498    match chunk with
    491499    [ ASTfloat sz ⇒ match sz with [ F32 ⇒ Vfloat(singleoffloat f) | F64 ⇒ Vfloat f ]
    492500    | _ ⇒ Vundef
    493     ]
     501    ] *)
    494502  | _ ⇒ Vundef
    495503  ].
     
    10801088  Val_lessdef v1 v2 → Val_lessdef (load_result chunk v1) (load_result chunk v2).
    10811089#chunk #v1 #v2 #H inversion H; //; #v #e1 #e2 #e3 cases chunk
    1082 [ #sz #sg | | #sz ] whd in ⊢ (?%?); //;
     1090[ #sz #sg | ] whd in ⊢ (?%?); //;
    10831091qed.
    10841092
Note: See TracChangeset for help on using the changeset viewer.