Ignore:
Timestamp:
Feb 9, 2011, 11:49:17 AM (9 years ago)
Author:
campbell
Message:

Port Clight semantics to the new-new matita syntax.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • Deliverables/D3.1/C-semantics/Mem.ma

    r485 r487  
    3636include "extralib.ma".
    3737
    38 ndefinition update : ∀A: Type[0]. ∀x: Z. ∀v: A. ∀f: Z → A. Z → A ≝
     38definition update : ∀A: Type[0]. ∀x: Z. ∀v: A. ∀f: Z → A. Z → A ≝
    3939  λA,x,v,f.
    4040    λy.match eqZb y x with [ true ⇒ v | false ⇒ f y ].
     
    4242(* Implicit Arguments update [A].*)
    4343
    44 nlemma update_s:
     44lemma update_s:
    4545  ∀A: Type[0]. ∀x: Z. ∀v: A. ∀f: Z -> A.
    4646  update … x v f x = v.
    47 #A;#x;#v;#f;nwhd in ⊢ (??%?);
    48 nrewrite > (eqZb_z_z …);//;
    49 nqed.
    50 
    51 nlemma update_o:
     47#A #x #v #f whd in ⊢ (??%?);
     48>(eqZb_z_z …) //;
     49qed.
     50
     51lemma update_o:
    5252  ∀A: Type[0]. ∀x: Z. ∀v: A. ∀f: Z -> A. ∀y: Z.
    5353  x ≠ y → update … x v f y = f y.
    54 #A;#x;#v;#f;#y;#H;nwhd in ⊢ (??%?);
    55 napply eqZb_elim;//;
    56 #H2;ncases H;#H3;nelim (H3 ?);//;
    57 nqed.
     54#A #x #v #f #y #H whd in ⊢ (??%?);
     55@eqZb_elim //;
     56#H2 cases H;#H3 elim (H3 ?);//;
     57qed.
    5858
    5959(* FIXME: workaround for lack of nunfold *)
    60 nlemma unfold_update : ∀A,x,v,f,y. update A x v f y = match eqZb y x with [ true ⇒ v | false ⇒ f y ].
    61 //; nqed.
     60lemma unfold_update : ∀A,x,v,f,y. update A x v f y = match eqZb y x with [ true ⇒ v | false ⇒ f y ].
     61//; qed.
    6262
    6363
     
    7474  that would partially overlap the 4-byte value. *)
    7575
    76 ninductive content : Type[0] ≝
     76inductive content : Type[0] ≝
    7777  | Undef: content                 (*r undefined contents *)
    7878  | Datum: nat → val → content   (*r first byte of a value *)
    7979  | Cont: content.          (*r continuation bytes for a multi-byte value *)
    8080
    81 ndefinition contentmap : Type[0] ≝ Z → content.
     81definition contentmap : Type[0] ≝ Z → content.
    8282
    8383(* A memory block comprises the dimensions of the block (low and high bounds)
    8484  plus a mapping from byte offsets to contents.  *)
    8585
    86 (* XXX: mkblock *)
    87 nrecord block_contents : Type[0] ≝ {
     86record block_contents : Type[0] ≝ {
    8887  low: Z;
    8988  high: Z;
     
    9594  integers) to blocks.  We also maintain the address of the next
    9695  unallocated block, and a proof that this address is positive. *)
    97 (* XXX: mkmem *)
    98 
    99 nrecord mem : Type ≝ {
     96
     97record mem : Type[0] ≝ {
    10098  blocks: Z -> block_contents;
    10199  nextblock: block;
     
    109107  The following functions extract the size information from a chunk. *)
    110108
    111 ndefinition size_pointer : region → Z ≝
    112 λsp. match sp with [ Data ⇒ 1 | IData ⇒ 1 | PData ⇒ 1 | XData ⇒ 2 | Code ⇒ 2 | Any ⇒ 3 ].
    113 
    114 ndefinition size_chunk : memory_chunk → Z ≝
     109definition size_pointer : region → Z ≝
     110λsp. match sp return λ_.Z with [ Data ⇒ 1 | IData ⇒ 1 | PData ⇒ 1 | XData ⇒ 2 | Code ⇒ 2 | Any ⇒ 3 ].
     111
     112definition size_chunk : memory_chunk → Z ≝
    115113  λchunk.match chunk with
    116114  [ Mint8signed => 1
     
    124122  ].
    125123
    126 ndefinition pred_size_pointer : region → nat ≝
     124definition pred_size_pointer : region → nat ≝
    127125λsp. match sp with [ Data ⇒ 0 | IData ⇒ 0 | PData ⇒ 0 | XData ⇒ 1 | Code ⇒ 1 | Any ⇒ 2 ].
    128126
    129 ndefinition pred_size_chunk : memory_chunk → nat ≝
     127definition pred_size_chunk : memory_chunk → nat ≝
    130128  λchunk.match chunk with
    131129  [ Mint8signed => 0
     
    140138
    141139alias symbol "plus" (instance 2) = "integer plus".
    142 nlemma size_chunk_pred:
     140lemma size_chunk_pred:
    143141  ∀chunk. size_chunk chunk = 1 + pred_size_chunk chunk.
    144 #chunk;ncases chunk;//; #r; ncases r; napply refl;
    145 nqed.
    146 
    147 nlemma size_chunk_pos:
     142#chunk cases chunk;//; #r cases r; @refl
     143qed.
     144
     145lemma size_chunk_pos:
    148146  ∀chunk. 0 < size_chunk chunk.
    149 #chunk;nrewrite > (size_chunk_pred ?);ncases (pred_size_chunk chunk);
    150 nnormalize;//;
    151 nqed.
     147#chunk >(size_chunk_pred ?) cases (pred_size_chunk chunk);
     148normalize;//;
     149qed.
    152150
    153151(* Memory reads and writes must respect alignment constraints:
     
    161159  appropriate for PowerPC and ARM. *)
    162160
    163 ndefinition align_chunk : memory_chunk → Z ≝
     161definition align_chunk : memory_chunk → Z ≝
    164162  λchunk.match chunk return λ_.Z with
    165163  [ Mint8signed ⇒ 1
     
    169167  | _ ⇒ 1 ].
    170168
    171 nlemma align_chunk_pos:
     169lemma align_chunk_pos:
    172170  ∀chunk. OZ < align_chunk chunk.
    173 #chunk;ncases chunk;nnormalize;//;
    174 nqed.
    175 
    176 nlemma align_size_chunk_divides:
     171#chunk cases chunk;normalize;//;
     172qed.
     173
     174lemma align_size_chunk_divides:
    177175  ∀chunk. (align_chunk chunk ∣ size_chunk chunk).
    178 #chunk;ncases chunk;##[##8:#r; ncases r ##]nnormalize;/3/;
    179 nqed.
    180 
    181 nlemma align_chunk_compat:
     176#chunk cases chunk;[8:#r cases r ]normalize;/3/;
     177qed.
     178
     179lemma align_chunk_compat:
    182180  ∀chunk1,chunk2.
    183181    size_chunk chunk1 = size_chunk chunk2 →
    184182      align_chunk chunk1 = align_chunk chunk2.
    185 #chunk1;#chunk2;
    186 ncases chunk1; ntry ( #r1 ncases r1 );
    187 ncases chunk2; ntry ( #r2 ncases r2 );
    188 nnormalize;//;
    189 nqed.
     183#chunk1 #chunk2
     184cases chunk1; try ( #r1 #cases #r1 )
     185cases chunk2; try ( #r2 #cases #r2 )
     186normalize;//;
     187qed.
    190188
    191189(* The initial store. *)
    192190
    193 ndefinition oneZ ≝ pos one.
    194 
    195 nremark one_pos: OZ < oneZ.
     191definition oneZ ≝ pos one.
     192
     193lemma one_pos: OZ < oneZ.
    196194//;
    197 nqed.
    198 
    199 ndefinition empty_block : Z → Z → region → block_contents ≝
     195qed.
     196
     197definition empty_block : Z → Z → region → block_contents ≝
    200198  λlo,hi,bty.mk_block_contents lo hi (λy. Undef) bty.
    201199
    202 ndefinition empty: mem ≝
     200definition empty: mem ≝
    203201  mk_mem (λx.empty_block OZ OZ Any) (pos one) one_pos.
    204202
    205 ndefinition nullptr: block ≝ OZ.
     203definition nullptr: block ≝ OZ.
    206204
    207205(* Allocation of a fresh block with the given bounds.  Return an updated
     
    210208  infinite memory. *)
    211209
    212 nremark succ_nextblock_pos:
     210lemma succ_nextblock_pos:
    213211  ∀m. OZ < Zsucc (nextblock m). (* XXX *)
    214 #m;nlapply (nextblock_pos m);nnormalize;
    215 ncases (nextblock m);//;
    216 #n;ncases n;//;
    217 nqed.
    218 
    219 ndefinition alloc : mem → Z → Z → region → mem × block ≝
     212#m lapply (nextblock_pos m);normalize;
     213cases (nextblock m);//;
     214#n cases n;//;
     215qed.
     216
     217definition alloc : mem → Z → Z → region → mem × block ≝
    220218  λm,lo,hi,bty.〈mk_mem
    221219              (update … (nextblock m)
     
    232230  later. *)
    233231
    234 ndefinition free ≝
     232definition free ≝
    235233  λm,b.mk_mem (update … b
    236234                (empty_block OZ OZ Any)
     
    241239(* Freeing of a list of blocks. *)
    242240
    243 ndefinition free_list ≝
     241definition free_list ≝
    244242  λm,l.foldr ?? (λb,m.free m b) m l.
    245243(* XXX hack for lack of reduction with restricted unfolding *)
    246 nlemma unfold_free_list : ∀m,h,t. free_list m (h::t) = free (free_list m t) h.
    247 nnormalize; //; nqed.
     244lemma unfold_free_list : ∀m,h,t. free_list m (h::t) = free (free_list m t) h.
     245normalize; //; qed.
    248246
    249247(* Return the low and high bounds for the given block address.
    250248   Those bounds are 0 for freed or not yet allocated address. *)
    251249
    252 ndefinition low_bound : mem → block → Z ≝
     250definition low_bound : mem → block → Z ≝
    253251  λm,b.low (blocks m b).
    254 ndefinition high_bound : mem → block → Z ≝
     252definition high_bound : mem → block → Z ≝
    255253  λm,b.high (blocks m b).
    256 ndefinition block_space: mem → block → region ≝
     254definition block_space: mem → block → region ≝
    257255  λm,b.space (blocks m b).
    258256
     
    260258  even after being freed. *)
    261259
    262 ndefinition valid_block : mem → block → Prop ≝
     260definition valid_block : mem → block → Prop ≝
    263261  λm,b.b < nextblock m.
    264262
    265263(* FIXME: hacks to get around lack of nunfold *)
    266 nlemma unfold_low_bound : ∀m,b. low_bound m b = low (blocks m b).
    267 //; nqed.
    268 nlemma unfold_high_bound : ∀m,b. high_bound m b = high (blocks m b).
    269 //; nqed.
    270 nlemma unfold_valid_block : ∀m,b. (valid_block m b) = (b < nextblock m).
    271 //; nqed.
     264lemma unfold_low_bound : ∀m,b. low_bound m b = low (blocks m b).
     265//; qed.
     266lemma unfold_high_bound : ∀m,b. high_bound m b = high (blocks m b).
     267//; qed.
     268lemma unfold_valid_block : ∀m,b. (valid_block m b) = (b < nextblock m).
     269//; qed.
    272270
    273271(* Reading and writing [N] adjacent locations in a [contentmap].
     
    281279 *)
    282280
    283 nlet rec check_cont (n: nat) (p: Z) (m: contentmap) on n : bool ≝
     281let rec check_cont (n: nat) (p: Z) (m: contentmap) on n : bool ≝
    284282  match n return λ_.bool with
    285283  [ O ⇒ true
     
    291289(* XXX : was +, not ∨ logical or
    292290   is used when eqb is expected, coq idiom, is it necessary?? *)
    293 ndefinition eq_nat: ∀p,q: nat. p=q ∨ p≠q.
    294 napply decidable_eq_nat; (* // not working, why *)
    295 nqed.
    296 
    297 ndefinition getN : nat → Z → contentmap → val ≝
     291definition eq_nat: ∀p,q: nat. p=q ∨ p≠q.
     292@decidable_eq_nat (* // not working, why *)
     293qed.
     294
     295definition getN : nat → Z → contentmap → val ≝
    298296  λn,p,m.match m p with
    299297  [ Datum n' v ⇒
     
    304302      Vundef ].
    305303
    306 nlet rec set_cont (n: nat) (p: Z) (m: contentmap) on n : contentmap ≝
     304let rec set_cont (n: nat) (p: Z) (m: contentmap) on n : contentmap ≝
    307305  match n with
    308306  [ O ⇒ m
    309307  | S n1 ⇒ update ? p Cont (set_cont n1 (p + oneZ) m) ].
    310308
    311 ndefinition setN : nat → Z → val → contentmap → contentmap ≝
     309definition setN : nat → Z → val → contentmap → contentmap ≝
    312310  λn,p,v,m.update ? p (Datum n v) (set_cont n (p + oneZ) m).
    313311
    314312(* Nonessential properties that may require arithmetic
    315313(* XXX: the daemons *)
    316 naxiom daemon : ∀A:Prop.A.
    317 
    318 nlemma check_cont_spec:
     314axiom daemon : ∀A:Prop.A.
     315
     316lemma check_cont_spec:
    319317  ∀n,m,p.
    320318  match (check_cont n p m) with
    321319  [ true ⇒ ∀q.p ≤ q → q < p + n → m q = Cont
    322320  | false ⇒ ∃q. p ≤ q ∧ q < (p + n) ∧ m q ≠ Cont ].
    323 #n;nelim n;
    324 ##[#m;#p;#q;#Hl;#Hr;
     321#n elim n;
     322[#m #p #q #Hl #Hr
    325323   (* derive contradiction from Hl, Hr; needs:
    326324      - p + O = p
    327325      - p ≤ q → q < p → False *)
    328326   napply daemon
    329 ##|#n1;#IH;#m;#p;
    330    (* nwhd : doesn't work either *)
    331    ncut (check_cont (S n1) p m = match m p with [ Undef ⇒ false | Datum _ _ ⇒ false | Cont ⇒ check_cont n1 (Zplus p oneZ) m ])
    332    ##[@
    333    ##|#Heq;nrewrite > Heq;nlapply (refl ? (m p));
    334       ncases (m p) in ⊢ (???% → %);
    335       ##[#Heq1;@;
    336            ##[napply p
    337            ##|@; ##[napply daemon
    338                  ##|napply nmk;#Hfalse;nrewrite > Hfalse in Heq1;#Heq1;
    339                     ndestruct ]
    340            ##]
    341       ##|#n2;#v;#Heq1; @;
    342            ##[napply p
    343            ##| @; ##[ (* refl≤ and  p < p + S n1 *)napply daemon
    344                   ##|napply nmk;#Hfalse;nrewrite > Hfalse in Heq1;#Heq1;
    345                      ndestruct ]
    346            ##]
    347       ##|#Heq1;nlapply (IH m (p + 1));
    348          nlapply (refl ? (check_cont n1 (p + 1) m));
     327|#n1 #IH #m #p
     328   (* whd : doesn't work either *)
     329   cut (check_cont (S n1) p m = match m p with [ Undef ⇒ false | Datum _ _ ⇒ false | Cont ⇒ check_cont n1 (Zplus p oneZ) m ])
     330   [@
     331   |#Heq >Heq lapply (refl ? (m p));
     332      cases (m p) in ⊢ (???% → %);
     333      [#Heq1 %
     334           [napply p
     335           |% [napply daemon
     336                 |@nmk #Hfalse >Hfalse in Heq1 #Heq1
     337                    destruct ]
     338           ]
     339      |#n2 #v #Heq1 %
     340           [napply p
     341           | % [ (* refl≤ and  p < p + S n1 *)napply daemon
     342                  |@nmk #Hfalse >Hfalse in Heq1 #Heq1
     343                     destruct ]
     344           ]
     345      |#Heq1 lapply (IH m (p + 1));
     346         lapply (refl ? (check_cont n1 (p + 1) m));
    349347         (* napply daemon *)
    350          ncases (check_cont n1 (p + 1) m) in ⊢ (???% → %);
    351          nwhd in ⊢ (? → % → %);
    352          ##[#H;#H1;#q;#Hl;#Hr;
    353             ncut (p = q ∨ p + 1 ≤ q)
    354             ##[(* Hl *) napply daemon
    355             ##|*;
    356                ##[//
    357                ##|#Hl2;napply H1;//;(*Hr*)napply daemon ##] ##]
    358          ##|#H;#H1;ncases H1;#x;*;*;#Hl;#Hr;#Hx;
    359             @ x;@
    360             ##[@
    361                ##[(*Hl*) napply daemon
    362                ##|(*Hr*) napply daemon ##]
    363             ##|//##]##]##]##]
    364 nqed.
    365 
    366 nlemma check_cont_true:
     348         cases (check_cont n1 (p + 1) m) in ⊢ (???% → %);
     349         whd in ⊢ (? → % → %);
     350         [#H #H1 #q #Hl #Hr
     351            cut (p = q ∨ p + 1 ≤ q)
     352            [(* Hl *) napply daemon
     353            |*;
     354               [//
     355               |#Hl2 @H1 //;(*Hr*)napply daemon ] ]
     356         |#H #H1 cases H1;#x *;*;#Hl #Hr #Hx
     357            %{ x} @
     358            [@
     359               [(*Hl*) napply daemon
     360               |(*Hr*) napply daemon ]
     361            |//]]]]
     362qed.
     363
     364lemma check_cont_true:
    367365  ∀n:nat.∀m,p.
    368366  (∀q. p ≤ q → q < p + n → m q = Cont) →
    369367  check_cont n p m = true.
    370 #n;#m;#p;#H;nlapply (check_cont_spec n m p);
    371 ncases (check_cont n p m);//;
    372 nwhd in ⊢ (%→?);*;
    373 #q;*;*;#Hl;#Hr;#Hfalse;ncases Hfalse;#H1;nelim (H1 ?);napply H;//;
    374 nqed.
    375 
    376 nlemma check_cont_false:
     368#n #m #p #H lapply (check_cont_spec n m p);
     369cases (check_cont n p m);//;
     370whd in ⊢ (%→?);*;
     371#q *;*;#Hl #Hr #Hfalse cases Hfalse;#H1 elim (H1 ?);@H //;
     372qed.
     373
     374lemma check_cont_false:
    377375  ∀n:nat.∀m,p,q.
    378376  p ≤ q → q < p + n → m q ≠ Cont →
    379377  check_cont n p m = false.
    380 #n;#m;#p;#q;nlapply (check_cont_spec n m p);
    381 ncases (check_cont n p m);//;
    382 nwhd in ⊢ (%→?);#H;
    383 #Hl;#Hr;#Hfalse;ncases Hfalse;#H1;nelim (H1 ?);napply H;//;
    384 nqed.
    385 
    386 nlemma set_cont_inside:
     378#n #m #p #q lapply (check_cont_spec n m p);
     379cases (check_cont n p m);//;
     380whd in ⊢ (%→?);#H
     381#Hl #Hr #Hfalse cases Hfalse;#H1 elim (H1 ?);@H //;
     382qed.
     383
     384lemma set_cont_inside:
    387385  ∀n:nat.∀p:Z.∀m.∀q:Z.
    388386  p ≤ q → q < p + n →
    389387  (set_cont n p m) q = Cont.
    390 #n;nelim n;
    391 ##[#p;#m;#q;#Hl;#Hr;(* by Hl, Hr → False *)napply daemon
    392 ##|#n1;#IH;#p;#m;#q;#Hl;#Hr;
    393    ncut (p = q ∨ p+1 ≤ q)
    394    ##[napply daemon
    395    ##|*;
    396       ##[#Heq;nrewrite > Heq;napply update_s;
    397       ##|#Hl2;nwhd in ⊢ (??%?);nrewrite > (? : eqZb q p = false)
    398          ##[nwhd in ⊢ (??%?);napply IH
    399             ##[napply Hl2
    400             ##|(* Hr *) napply daemon ##]
    401          ##|(*Hl2*)napply daemon ##]
    402       ##]
    403    ##]
    404 ##]
    405 nqed.
    406 
    407 nlemma set_cont_outside:
     388#n elim n;
     389[#p #m #q #Hl #Hr (* by Hl, Hr → False *)napply daemon
     390|#n1 #IH #p #m #q #Hl #Hr
     391   cut (p = q ∨ p+1 ≤ q)
     392   [napply daemon
     393   |*;
     394      [#Heq >Heq @update_s
     395      |#Hl2 whd in ⊢ (??%?);nrewrite > (? : eqZb q p = false)
     396         [whd in ⊢ (??%?);napply IH
     397            [napply Hl2
     398            |(* Hr *) napply daemon ]
     399         |(*Hl2*)napply daemon ]
     400      ]
     401   ]
     402]
     403qed.
     404
     405lemma set_cont_outside:
    408406  ∀n:nat.∀p:Z.∀m.∀q:Z.
    409407  q < p ∨ p + n ≤ q →
    410408  (set_cont n p m) q = m q.
    411 #n;nelim n
    412 ##[#p;#m;#q;#_;@
    413 ##|#n1;#IH;#p;#m;#q;
    414    #H;nwhd in ⊢ (??%?);nrewrite > (? : eqZb q p = false);
    415    ##[nwhd in ⊢ (??%?);napply IH;ncases H;
    416       ##[#Hl;@;napply daemon
    417       ##|#Hr;@2;napply daemon##]
    418    ##|(*H*)napply daemon ##]
    419 ##]
    420 nqed.
    421 
    422 nlemma getN_setN_same:
     409#n elim n
     410[#p #m #q #_ @
     411|#n1 #IH #p #m #q
     412   #H whd in ⊢ (??%?);>(? : eqZb q p = false)
     413   [whd in ⊢ (??%?);@IH cases H;
     414      [#Hl % napply daemon
     415      |#Hr %{2} napply daemon]
     416   |(*H*)napply daemon ]
     417]
     418qed.
     419
     420lemma getN_setN_same:
    423421  ∀n,p,v,m.
    424422  getN n p (setN n p v m) = v.
    425 #n;#p;#v;#m;nchange in ⊢ (??(???%)?) with (update ????);
    426 nwhd in ⊢ (??%?);
    427 nrewrite > (update_s content p ??);nwhd in ⊢ (??%?);
    428 nrewrite > (eqb_n_n n);
     423#n #p #v #m nchange in ⊢ (??(???%)?) with (update ????);
     424whd in ⊢ (??%?);
     425>(update_s content p ??) whd in ⊢ (??%?);
     426>(eqb_n_n n)
    429427nrewrite > (check_cont_true ????)
    430 ##[@
    431 ##|#q;#Hl;#Hr;nrewrite > (update_o content …);
    432    ##[/2/;
    433    ##|(*Hl*)napply daemon ##]
    434 ##]
    435 nqed.
    436 
    437 nlemma getN_setN_other:
     428[@
     429|#q #Hl #Hr >(update_o content …)
     430   [/2/;
     431   |(*Hl*)napply daemon ]
     432]
     433qed.
     434
     435lemma getN_setN_other:
    438436  ∀n1,n2:nat.∀p1,p2:Z.∀v,m.
    439437  p1 + n1 < p2 ∨ p2 + n2 < p1 →
    440438  getN n2 p2 (setN n1 p1 v m) = getN n2 p2 m.
    441 #n1;#n2;#p1;#p2;#v;#m;#H;
     439#n1 #n2 #p1 #p2 #v #m #H
    442440ngeneralize in match (check_cont_spec n2 m (p2 + oneZ));
    443 nlapply (refl ? (check_cont n2 (p2+oneZ) m));
    444 ncases (check_cont n2 (p2+oneZ) m) in ⊢ (???% → %);
    445 #H1;nwhd in ⊢ (% →?); nwhd in ⊢ (?→(???%)); nrewrite > H1;
    446 ##[#H2;
     441lapply (refl ? (check_cont n2 (p2+oneZ) m));
     442cases (check_cont n2 (p2+oneZ) m) in ⊢ (???% → %);
     443#H1 whd in ⊢ (% →?); whd in ⊢ (?→(???%)); >H1
     444[#H2
    447445   nchange in ⊢ (??(???%)?) with (update ????);
    448    nwhd in ⊢(??%%);nrewrite > (check_cont_true …);
    449    ##[ nrewrite > (check_cont_true … H2);
    450        nrewrite > (update_o content ?????);
    451        ##[ nrewrite > (set_cont_outside ?????); //; (* arith *) napply daemon
    452        ##| (* arith *) napply daemon
    453        ##]
    454    ##| #q;#Hl;#Hh; nrewrite > (update_o content ?????);
    455        ##[ nrewrite > (set_cont_outside ?????); /2/; (* arith *) napply daemon
    456        ##| (* arith *) napply daemon
    457        ##]
    458    ##]
    459 ##| *; #q;*;#A;#B;
     446   whd in ⊢(??%%);>(check_cont_true …)
     447   [ >(check_cont_true … H2)
     448       >(update_o content ?????)
     449       [ >(set_cont_outside ?????) //; (* arith *) napply daemon
     450       | (* arith *) napply daemon
     451       ]
     452   | #q #Hl #Hh >(update_o content ?????)
     453       [ >(set_cont_outside ?????) /2/; (* arith *) napply daemon
     454       | (* arith *) napply daemon
     455       ]
     456   ]
     457| *; #q *;#A #B
    460458   nchange in ⊢ (??(???%)?) with (update ????);
    461    nwhd in ⊢(??%%);
    462    nrewrite > (check_cont_false n2 (update ? p1 (Datum n1 v) (set_cont n1 (p1 + 1) m)) (p2 + 1) q …);
    463    ##[ nrewrite > (update_o content ?????);
    464        ##[ nrewrite > (set_cont_outside ?????); //; (* arith *) napply daemon
    465        ##| napply daemon
    466        ##]
    467    ##| nrewrite > (update_o content ?????);
    468        ##[ nrewrite > (set_cont_outside ?????); //; (* arith *) napply daemon
    469        ##| napply daemon
    470        ##]
    471    ##| napply daemon
    472    ##| napply daemon
    473    ##]
    474 ##] nqed.
    475 
    476 nlemma getN_setN_overlap:
     459   whd in ⊢(??%%);
     460   >(check_cont_false n2 (update ? p1 (Datum n1 v) (set_cont n1 (p1 + 1) m)) (p2 + 1) q …)
     461   [ >(update_o content ?????)
     462       [ >(set_cont_outside ?????) //; (* arith *) napply daemon
     463       | napply daemon
     464       ]
     465   | >(update_o content ?????)
     466       [ >(set_cont_outside ?????) //; (* arith *) napply daemon
     467       | napply daemon
     468       ]
     469   | napply daemon
     470   | napply daemon
     471   ]
     472] qed.
     473
     474lemma getN_setN_overlap:
    477475  ∀n1,n2,p1,p2,v,m.
    478476  p1 ≠ p2 →
    479477  p2 ≤ p1 + Z_of_nat n1 →  p1 ≤ p2 + Z_of_nat n2 →
    480478  getN n2 p2 (setN n1 p1 v m) = Vundef.
    481 #n1;#n2;#p1;#p2;#v;#m;
    482 #H;#H1;#H2;
     479#n1 #n2 #p1 #p2 #v #m
     480#H #H1 #H2
    483481nchange in ⊢ (??(???%)?) with (update ????);
    484 nwhd in ⊢(??%?);nrewrite > (update_o content ?????);
    485 ##[nlapply (Z_compare_to_Prop p2 p1);
    486    nlapply (refl ? (Z_compare p2 p1));
    487    ncases (Z_compare p2 p1) in ⊢ (???% → %);#H3;
    488    ##[nchange in ⊢ (% → ?) with (p2 < p1);#H4;
     482whd in ⊢(??%?);>(update_o content ?????)
     483[lapply (Z_compare_to_Prop p2 p1);
     484   lapply (refl ? (Z_compare p2 p1));
     485   cases (Z_compare p2 p1) in ⊢ (???% → %);#H3
     486   [nchange in ⊢ (% → ?) with (p2 < p1);#H4
    489487  (* [p1] belongs to [[p2, p2 + n2 - 1]],
    490488     therefore [check_cont n2 (p2 + 1) ...] is false. *)
    491      nrewrite > (check_cont_false …);
    492      ##[ncases (set_cont n1 (p1+oneZ) m p2)
    493         ##[##1,3:@
    494         ##|#n3;#v1;nwhd in ⊢ (??%?);
    495            ncases (eqb n2 n3);@ ##]
    496      ##|nrewrite > (update_s content …);napply nmk;
    497         #Hfalse;ndestruct
    498      ##|(*H2*) napply daemon
    499      ##|(*H4*) napply daemon
    500      ##|##skip ##]
    501   ##|nwhd in ⊢ (% → ?);#H4;nelim H;#H5;nelim (H5 ?);//;
    502   ##|nchange in ⊢ (% → ?) with (p1 < p2);#H4;
     489     >(check_cont_false …)
     490     [cases (set_cont n1 (p1+oneZ) m p2)
     491        [1,3:@
     492        |#n3 #v1 whd in ⊢ (??%?);
     493           cases (eqb n2 n3);@ ]
     494     |>(update_s content …) @nmk
     495        #Hfalse destruct
     496     |(*H2*) napply daemon
     497     |(*H4*) napply daemon
     498     |##skip ]
     499  |whd in ⊢ (% → ?);#H4 elim H;#H5 elim (H5 ?);//;
     500  |nchange in ⊢ (% → ?) with (p1 < p2);#H4
    503501  (* [p2] belongs to [[p1 + 1, p1 + n1 - 1]],
    504502     therefore [
    505503     set_cont n1 (p1 + 1) m p2] is [Cont]. *)
    506      nrewrite > (set_cont_inside …);
    507      ##[@
    508      ##|(*H1*)napply daemon
    509      ##|(*H4*)napply daemon##]
    510   ##]
    511 ##|//##]
    512 nqed.
    513 
    514 nlemma getN_setN_mismatch:
     504     >(set_cont_inside …)
     505     [@
     506     |(*H1*)napply daemon
     507     |(*H4*)napply daemon]
     508  ]
     509|//]
     510qed.
     511
     512lemma getN_setN_mismatch:
    515513  ∀n1,n2,p,v,m.
    516514  n1 ≠ n2 →
    517515  getN n2 p (setN n1 p v m) = Vundef.
    518 #n1;#n2;#p;#v;#m;#H;
     516#n1 #n2 #p #v #m #H
    519517nchange in ⊢ (??(???%)?) with (update ????);
    520 nwhd in ⊢(??%?);nrewrite > (update_s content …);
    521 nwhd in ⊢(??%?);nrewrite > (not_eq_to_eqb_false … (sym_neq … H));//;
    522 nqed.
    523 
    524 nlemma getN_setN_characterization:
     518whd in ⊢(??%?);>(update_s content …)
     519whd in ⊢(??%?);>(not_eq_to_eqb_false … (sym_neq … H)) //;
     520qed.
     521
     522lemma getN_setN_characterization:
    525523  ∀m,v,n1,p1,n2,p2.
    526524  getN n2 p2 (setN n1 p1 v m) = v
    527525  ∨ getN n2 p2 (setN n1 p1 v m) = getN n2 p2 m
    528526  ∨ getN n2 p2 (setN n1 p1 v m) = Vundef.
    529 #m;#v;#n1;#p1;#n2;#p2;
    530 nlapply (eqZb_to_Prop p1 p2); ncases (eqZb p1 p2); #Hp;
    531 ##[nrewrite > Hp;
    532    napply (eqb_elim n1 n2); #Hn;
    533    ##[nrewrite > Hn;@; @; //;
    534    ##|@2;/2/]
    535 ##|nlapply (Z_compare_to_Prop (p1 + n1) p2);
    536    ncases  (Z_compare (p1 + n1) p2);#Hcmp;
    537    ##[@;@2;napply getN_setN_other; /2/
    538    ##|nlapply (Z_compare_to_Prop (p2 + n2) p1);
    539       ncases  (Z_compare (p2 + n2) p1);#Hcmp2;
    540       ##[@;@2;napply getN_setN_other;/2/
    541       ##|@2;napply getN_setN_overlap;
    542          ##[//
    543          ##|##*:(* arith *) napply daemon]
    544       ##|@2;napply getN_setN_overlap;
    545          ##[//
    546          ##|##*:(* arith *) napply daemon]
    547       ##]
    548    ##|nlapply (Z_compare_to_Prop (p2 + n2) p1);
    549       ncases  (Z_compare (p2 + n2) p1);#Hcmp2;
    550       ##[@;@2;napply getN_setN_other;/2/
    551       ##|@2;napply getN_setN_overlap;
    552          ##[//
    553          ##|##*:(* arith *) napply daemon]
    554       ##|@2;napply getN_setN_overlap;
    555          ##[//
    556          ##|##*:(* arith *) napply daemon]
    557       ##]
    558    ##]
    559 ##]
    560 nqed.
    561 
    562 nlemma getN_init:
     527#m #v #n1 #p1 #n2 #p2
     528lapply (eqZb_to_Prop p1 p2); cases (eqZb p1 p2); #Hp
     529[>Hp
     530   @(eqb_elim n1 n2) #Hn
     531   [>Hn % % //;
     532   |%{2} /2/]
     533|lapply (Z_compare_to_Prop (p1 + n1) p2);
     534   cases  (Z_compare (p1 + n1) p2);#Hcmp
     535   [% %{2} @getN_setN_other /2/
     536   |lapply (Z_compare_to_Prop (p2 + n2) p1);
     537      cases  (Z_compare (p2 + n2) p1);#Hcmp2
     538      [% %{2} @getN_setN_other /2/
     539      |%{2} @getN_setN_overlap
     540         [//
     541         |*:(* arith *) napply daemon]
     542      |%{2} @getN_setN_overlap
     543         [//
     544         |*:(* arith *) napply daemon]
     545      ]
     546   |lapply (Z_compare_to_Prop (p2 + n2) p1);
     547      cases  (Z_compare (p2 + n2) p1);#Hcmp2
     548      [% %{2} @getN_setN_other /2/
     549      |%{2} @getN_setN_overlap
     550         [//
     551         |*:(* arith *) napply daemon]
     552      |%{2} @getN_setN_overlap
     553         [//
     554         |*:(* arith *) napply daemon]
     555      ]
     556   ]
     557]
     558qed.
     559
     560lemma getN_init:
    563561  ∀n,p.
    564562  getN n p (λ_.Undef) = Vundef.
    565 #n;#p;//;
    566 nqed.
     563#n #p //;
     564qed.
    567565*)
    568566(* pointer_compat block_space pointer_space *)
    569567
    570 ninductive pointer_compat : region → region → Prop ≝
     568inductive pointer_compat : region → region → Prop ≝
    571569|  same_compat : ∀s. pointer_compat s s
    572570| pxdata_compat : pointer_compat PData XData
     
    574572| universal_compat : ∀b. pointer_compat b Any.
    575573
    576 nlemma pointer_compat_dec : ∀b,p. pointer_compat b p + ¬pointer_compat b p.
    577 #b p; ncases b;
    578 ##[ ##1: @1; //;
    579 ##| ##*: ncases p; /2/; @2; @; #H; ninversion H; #e1 e2; ndestruct; #e3; ndestruct;
    580 ##] nqed.
    581 
    582 ndefinition is_pointer_compat : region → region → bool ≝
     574lemma pointer_compat_dec : ∀b,p. pointer_compat b p + ¬pointer_compat b p.
     575#b #p cases b;
     576[ 1: %1 //;
     577| *: cases p; /2/; %2 % #H inversion H; #e1 #e2 destruct; #e3 destruct;
     578] qed.
     579
     580definition is_pointer_compat : region → region → bool ≝
    583581λb,p. match pointer_compat_dec b p with [ inl _ ⇒ true | inr _ ⇒ false ].
    584582
     
    592590*)
    593591
    594 ninductive valid_access (m: mem) (chunk: memory_chunk) (psp: region) (b: block) (ofs: Z)
     592inductive valid_access (m: mem) (chunk: memory_chunk) (psp: region) (b: block) (ofs: Z)
    595593            : Prop ≝
    596594  | valid_access_intro:
     
    606604
    607605(* XXX: Using + and ¬ instead of Sum and Not causes trouble *)
    608 nlet rec in_bounds
     606let rec in_bounds
    609607  (m:mem) (chunk:memory_chunk) (psp:region) (b:block) (ofs:Z) on b : 
    610608    Sum (valid_access m chunk psp b ofs) (Not (valid_access m chunk psp b ofs)) ≝ ?.
    611 napply (Zltb_elim_Type0 b (nextblock m)); #Hnext;
    612 ##[ napply (Zleb_elim_Type0 (low_bound m b) ofs); #Hlo;
    613     ##[ napply (Zleb_elim_Type0 (ofs + size_chunk chunk) (high_bound m b)); #Hhi;
    614         ##[ nelim (dec_dividesZ (align_chunk chunk) ofs); #Hal;
    615           ##[ ncases (pointer_compat_dec (block_space m b) psp); #Hcl;
    616             ##[ @1; @; // ##]
    617           ##]
    618         ##]
    619     ##]
    620 ##]
    621 @2; napply nmk; *; #Hval; #Hlo'; #Hhi'; #Hal'; #Hcl'; napply (absurd ???); //;
    622 nqed.
    623 
    624 nlemma in_bounds_true:
     609@(Zltb_elim_Type0 b (nextblock m)) #Hnext
     610[ @(Zleb_elim_Type0 (low_bound m b) ofs) #Hlo
     611    [ @(Zleb_elim_Type0 (ofs + size_chunk chunk) (high_bound m b)) #Hhi
     612        [ elim (dec_dividesZ (align_chunk chunk) ofs); #Hal
     613          [ cases (pointer_compat_dec (block_space m b) psp); #Hcl
     614            [ %1 % // ]
     615          ]
     616        ]
     617    ]
     618]
     619%2 @nmk *; #Hval #Hlo' #Hhi' #Hal' #Hcl' @(absurd ???) //;
     620qed.
     621
     622lemma in_bounds_true:
    625623  ∀m,chunk,psp,b,ofs. ∀A: Type[0]. ∀a1,a2: A.
    626624  valid_access m chunk psp b ofs ->
    627625  (match in_bounds m chunk psp b ofs with
    628626   [ inl _ ⇒ a1 | inr _ ⇒ a2 ]) = a1.
    629 #m chunk psp b ofs A a1 a2 H;
    630 ncases (in_bounds m chunk psp b ofs);nnormalize;#H1;
    631 ##[//
    632 ##|nelim (?:False);napply (absurd ? H H1)]
    633 nqed.
     627#m #chunk #psp #b #ofs #A #a1 #a2 #H
     628cases (in_bounds m chunk psp b ofs);normalize;#H1
     629[//
     630|elim (?:False); @(absurd ? H H1)]
     631qed.
    634632
    635633(* [valid_pointer] holds if the given block address is valid and the
    636634  given offset falls within the bounds of the corresponding block. *)
    637635
    638 ndefinition valid_pointer : mem → region → block → Z → bool ≝
     636definition valid_pointer : mem → region → block → Z → bool ≝
    639637λm,psp,b,ofs. Zltb b (nextblock m) ∧
    640638  Zleb (low_bound m b) ofs ∧
     
    646644  or the memory access is out of bounds. *)
    647645
    648 ndefinition load : memory_chunk → mem → region → block → Z → option val ≝
     646definition load : memory_chunk → mem → region → block → Z → option val ≝
    649647λchunk,m,psp,b,ofs.
    650648  match in_bounds m chunk psp b ofs with
     
    653651  | inr _ ⇒ None ? ].
    654652
    655 nlemma load_inv:
     653lemma load_inv:
    656654  ∀chunk,m,psp,b,ofs,v.
    657655  load chunk m psp b ofs = Some ? v →
     
    659657  v = load_result chunk
    660658           (getN (pred_size_chunk chunk) ofs (contents (blocks m b))).
    661 #chunk m psp b ofs v; nwhd in ⊢ (??%? → ?);
    662 ncases (in_bounds m chunk psp b ofs); #Haccess; nwhd in ⊢ ((??%?) → ?); #H;
    663 ##[ @;//; ndestruct; //;
    664 ##| ndestruct
    665 ##]
    666 nqed.
     659#chunk #m #psp #b #ofs #v whd in ⊢ (??%? → ?);
     660cases (in_bounds m chunk psp b ofs); #Haccess whd in ⊢ ((??%?) → ?); #H
     661[ % //; destruct; //;
     662| destruct
     663]
     664qed.
    667665
    668666(* [loadv chunk m addr] is similar, but the address and offset are given
    669667  as a single value [addr], which must be a pointer value. *)
    670668
    671 nlet rec loadv (chunk:memory_chunk) (m:mem) (addr:val) on addr : option val ≝
     669let rec loadv (chunk:memory_chunk) (m:mem) (addr:val) on addr : option val ≝
    672670  match addr with
    673671  [ Vptr psp b ofs ⇒ load chunk m psp b (signed ofs)
     
    677675   in block [b]. *)
    678676
    679 ndefinition unchecked_store : memory_chunk → mem → block → Z → val → mem ≝
     677definition unchecked_store : memory_chunk → mem → block → Z → val → mem ≝
    680678λchunk,m,b,ofs,v.
    681679  let c ≝ (blocks m b) in
     
    693691  or the memory access is out of bounds. *)
    694692
    695 ndefinition store : memory_chunk → mem → region → block → Z → val → option mem ≝
     693definition store : memory_chunk → mem → region → block → Z → val → option mem ≝
    696694λchunk,m,psp,b,ofs,v.
    697695  match in_bounds m chunk psp b ofs with
     
    699697  | inr _ ⇒ None ? ].
    700698
    701 nlemma store_inv:
     699lemma store_inv:
    702700  ∀chunk,m,psp,b,ofs,v,m'.
    703701  store chunk m psp b ofs v = Some ? m' →
    704702  valid_access m chunk psp b ofs ∧
    705703  m' = unchecked_store chunk m b ofs v.
    706 #chunk m psp b ofs v m'; nwhd in ⊢ (??%? → ?);
     704#chunk #m #psp #b #ofs #v #m' whd in ⊢ (??%? → ?);
    707705(*9*)
    708 ncases (in_bounds m chunk psp b ofs);#Hv;nwhd in ⊢(??%? → ?);#Heq;
    709 ##[@; ##[//|ndestruct;//]
    710 ##|ndestruct]
    711 nqed.
     706cases (in_bounds m chunk psp b ofs);#Hv whd in ⊢(??%? → ?);#Heq
     707[% [//|destruct;//]
     708|destruct]
     709qed.
    712710
    713711(* [storev chunk m addr v] is similar, but the address and offset are given
    714712  as a single value [addr], which must be a pointer value. *)
    715713
    716 ndefinition storev : memory_chunk → mem → val → val → option mem ≝
     714definition storev : memory_chunk → mem → val → val → option mem ≝
    717715λchunk,m,addr,v.
    718716  match addr with
     
    724722(* ** Properties related to block validity *)
    725723
    726 nlemma valid_not_valid_diff:
     724lemma valid_not_valid_diff:
    727725  ∀m,b,b'. valid_block m b →  ¬(valid_block m b') → b ≠ b'.
    728 #m;#b;#b';#H;#H';napply nmk;#e;nrewrite > e in H;#H;
    729 napply (absurd ? H H');
    730 nqed.
    731 
    732 nlemma valid_access_valid_block:
     726#m #b #b' #H #H' @nmk #e >e in H #H
     727@(absurd ? H H')
     728qed.
     729
     730lemma valid_access_valid_block:
    733731  ∀m,chunk,psp,b,ofs. valid_access m chunk psp b ofs → valid_block m b.
    734 #m;#chunk;#psp;#b;#ofs;#H;
    735 nelim H;//;
    736 nqed.
    737 
    738 nlemma valid_access_aligned:
     732#m #chunk #psp #b #ofs #H
     733elim H;//;
     734qed.
     735
     736lemma valid_access_aligned:
    739737  ∀m,chunk,psp,b,ofs.
    740738  valid_access m chunk psp b ofs → (align_chunk chunk ∣ ofs).
    741 #m;#chunk;#psp;#b;#ofs;#H;
    742 nelim H;//;
    743 nqed.
    744 
    745 nlemma valid_access_compat:
     739#m #chunk #psp #b #ofs #H
     740elim H;//;
     741qed.
     742
     743lemma valid_access_compat:
    746744  ∀m,chunk1,chunk2,psp,b,ofs.
    747745  size_chunk chunk1 = size_chunk chunk2 →
    748746  valid_access m chunk1 psp b ofs →
    749747  valid_access m chunk2 psp b ofs.
    750 #m;#chunk;#chunk2;#psp;#b;#ofs;#H1;#H2;
    751 nelim H2;#H3;#H4;#H5;#H6;#H7;
    752 nrewrite > H1 in H5;#H5;
    753 @;//;
    754 nrewrite < (align_chunk_compat … H1);//;
    755 nqed.
     748#m #chunk #chunk2 #psp #b #ofs #H1 #H2
     749elim H2;#H3 #H4 #H5 #H6 #H7
     750>H1 in H5 #H5
     751% //;
     752<(align_chunk_compat … H1) //;
     753qed.
    756754
    757755(* Hint Resolve valid_not_valid_diff valid_access_valid_block valid_access_aligned: mem.*)
     
    759757(* ** Properties related to [load] *)
    760758
    761 ntheorem valid_access_load:
     759theorem valid_access_load:
    762760  ∀m,chunk,psp,b,ofs.
    763761  valid_access m chunk psp b ofs →
    764762  ∃v. load chunk m psp b ofs = Some ? v.
    765 #m;#chunk;#psp;#b;#ofs;#H;@;
    766 ##[##2:nwhd in ⊢ (??%?);napply in_bounds_true;//;
    767 ##|##skip]
    768 nqed.
    769 
    770 ntheorem load_valid_access:
     763#m #chunk #psp #b #ofs #H %
     764[2:whd in ⊢ (??%?);@in_bounds_true //;
     765|skip]
     766qed.
     767
     768theorem load_valid_access:
    771769  ∀m,chunk,psp,b,ofs,v.
    772770  load chunk m psp b ofs = Some ? v →
    773771  valid_access m chunk psp b ofs.
    774 #m;#chunk;#psp;#b;#ofs;#v;#H;
    775 ncases (load_inv … H);//;
    776 nqed.
     772#m #chunk #psp #b #ofs #v #H
     773cases (load_inv … H);//;
     774qed.
    777775
    778776(* Hint Resolve load_valid_access valid_access_load.*)
     
    780778(* ** Properties related to [store] *)
    781779
    782 nlemma valid_access_store:
     780lemma valid_access_store:
    783781  ∀m1,chunk,psp,b,ofs,v.
    784782  valid_access m1 chunk psp b ofs →
    785783  ∃m2. store chunk m1 psp b ofs v = Some ? m2.
    786 #m1;#chunk;#psp;#b;#ofs;#v;#H;
    787 @;
    788 ##[##2:napply in_bounds_true;//
    789 ##|##skip]
    790 nqed.
     784#m1 #chunk #psp #b #ofs #v #H
     785%
     786[2:@in_bounds_true //
     787|skip]
     788qed.
    791789
    792790(* section STORE *)
    793791
    794 nlemma low_bound_store:
     792lemma low_bound_store:
    795793  ∀chunk,m1,psp,b,ofs,v,m2.store chunk m1 psp b ofs v = Some ? m2 →
    796794  ∀b'.low_bound m2 b' = low_bound m1 b'.
    797 #chunk;#m1;#psp b ofs;#v;#m2;#STORE;
    798 #b';ncases (store_inv … STORE);
    799 #H1;#H2;nrewrite > H2;
    800 nwhd in ⊢ (??(?%?)?);nwhd in ⊢ (??%?);
    801 nwhd in ⊢ (??(?%)?);nlapply (eqZb_to_Prop b' b);
    802 ncases (eqZb b' b);nnormalize;//;
    803 nqed.
    804 
    805 nlemma nextblock_store :
     795#chunk #m1 #psp #b #ofs #v #m2 #STORE
     796#b' cases (store_inv … STORE)
     797#H1 #H2 >H2
     798whd in ⊢ (??(?%?)?) whd in ⊢ (??%?)
     799whd in ⊢ (??(?%)?) lapply (eqZb_to_Prop b' b)
     800cases (eqZb b' b) normalize //
     801qed.
     802
     803lemma nextblock_store :
    806804  ∀chunk,m1,psp,b,ofs,v,m2.store chunk m1 psp b ofs v = Some ? m2 →
    807805  nextblock m2 = nextblock m1.
    808 #chunk;#m1;#psp b ofs;#v;#m2;#STORE;
    809 ncases (store_inv … STORE);
    810 #Hvalid;#Heq;
    811 nrewrite > Heq;@;
    812 nqed.
    813 
    814 nlemma high_bound_store:
     806#chunk #m1 #psp #b #ofs #v #m2 #STORE
     807cases (store_inv … STORE);
     808#Hvalid #Heq
     809>Heq %
     810qed.
     811
     812lemma high_bound_store:
    815813  ∀chunk,m1,psp,b,ofs,v,m2.store chunk m1 psp b ofs v = Some ? m2 →
    816814  ∀b'. high_bound m2 b' = high_bound m1 b'.
    817 #chunk;#m1;#psp b ofs;#v;#m2;#STORE;
    818 #b';ncases (store_inv … STORE);
    819 #Hvalid;#H;
    820 nrewrite > H;
    821 nwhd in ⊢ (??(?%?)?);nwhd in ⊢ (??%?);
    822 nwhd in ⊢ (??(?%)?);nlapply (eqZb_to_Prop b' b);
    823 ncases (eqZb b' b);nnormalize;//;
    824 nqed.
    825 
    826 nlemma region_store:
     815#chunk #m1 #psp #b #ofs #v #m2 #STORE
     816#b' cases (store_inv … STORE);
     817#Hvalid #H
     818>H
     819whd in ⊢ (??(?%?)?);whd in ⊢ (??%?);
     820whd in ⊢ (??(?%)?);lapply (eqZb_to_Prop b' b);
     821cases (eqZb b' b);normalize;//;
     822qed.
     823
     824lemma region_store:
    827825  ∀chunk,m1,psp,b,ofs,v,m2.store chunk m1 psp b ofs v = Some ? m2 →
    828826  ∀b'. block_space m2 b' = block_space m1 b'.
    829 #chunk;#m1;#psp b ofs;#v;#m2;#STORE;
    830 #b';ncases (store_inv … STORE);
    831 #Hvalid;#H;
    832 nrewrite > H;
    833 nwhd in ⊢ (??(?%?)?);nwhd in ⊢ (??%?);
    834 nwhd in ⊢ (??(?%)?);nlapply (eqZb_to_Prop b' b);
    835 ncases (eqZb b' b);nnormalize;//;
    836 nqed.
    837 
    838 nlemma store_valid_block_1:
     827#chunk #m1 #psp #b #ofs #v #m2 #STORE
     828#b' cases (store_inv … STORE);
     829#Hvalid #H
     830>H
     831whd in ⊢ (??(?%?)?);whd in ⊢ (??%?);
     832whd in ⊢ (??(?%)?);lapply (eqZb_to_Prop b' b);
     833cases (eqZb b' b);normalize;//;
     834qed.
     835
     836lemma store_valid_block_1:
    839837  ∀chunk,m1,psp,b,ofs,v,m2.store chunk m1 psp b ofs v = Some ? m2 →
    840838  ∀b'. valid_block m1 b' → valid_block m2 b'.
    841 #chunk;#m1;#psp b ofs;#v;#m2;#STORE;
    842 #b';nwhd in ⊢ (% → %);#Hv;
    843 nrewrite > (nextblock_store … STORE);//;
    844 nqed.
    845 
    846 nlemma store_valid_block_2:
     839#chunk #m1 #psp #b #ofs #v #m2 #STORE
     840#b' whd in ⊢ (% → %);#Hv
     841>(nextblock_store … STORE) //;
     842qed.
     843
     844lemma store_valid_block_2:
    847845  ∀chunk,m1,psp,b,ofs,v,m2.store chunk m1 psp b ofs v = Some ? m2 →
    848846  ∀b'. valid_block m2 b' → valid_block m1 b'.
    849 #chunk;#m1;#psp b ofs;#v;#m2;#STORE;
    850 #b';nwhd in ⊢ (%→%);
    851 nrewrite > (nextblock_store … STORE);//;
    852 nqed.
     847#chunk #m1 #psp #b #ofs #v #m2 #STORE
     848#b' whd in ⊢ (%→%);
     849>(nextblock_store … STORE) //;
     850qed.
    853851
    854852(*Hint Resolve store_valid_block_1 store_valid_block_2: mem.*)
    855853
    856 nlemma store_valid_access_1:
     854lemma store_valid_access_1:
    857855  ∀chunk,m1,psp,b,ofs,v,m2.store chunk m1 psp b ofs v = Some ? m2 →
    858856  ∀chunk',psp',b',ofs'.
    859857  valid_access m1 chunk' psp' b' ofs' → valid_access m2 chunk' psp' b' ofs'.
    860 #chunk;#m1;#psp b ofs;#v;#m2;#STORE;
    861 #chunk';#psp';#b';#ofs';
     858#chunk #m1 #psp #b #ofs #v #m2 #STORE
     859#chunk' #psp' #b' #ofs'
    862860* Hv;
    863 #Hvb;#Hl;#Hr;#Halign;#Hptr;
    864 @;//;
    865 ##[napply (store_valid_block_1 … STORE);//
    866 ##|nrewrite > (low_bound_store … STORE …);//
    867 ##|nrewrite > (high_bound_store … STORE …);//
    868 ##|nrewrite > (region_store … STORE …);//]
    869 nqed.
    870 
    871 nlemma store_valid_access_2:
     861#Hvb #Hl #Hr #Halign #Hptr
     862% //;
     863[@(store_valid_block_1 … STORE) //
     864|>(low_bound_store … STORE …) //
     865|>(high_bound_store … STORE …) //
     866|>(region_store … STORE …) //]
     867qed.
     868
     869lemma store_valid_access_2:
    872870  ∀chunk,m1,psp,b,ofs,v,m2.store chunk m1 psp b ofs v = Some ? m2 →
    873871  ∀chunk',psp',b',ofs'.
    874872  valid_access m2 chunk' psp' b' ofs' → valid_access m1 chunk' psp' b' ofs'.
    875 #chunk;#m1;#psp b ofs;#v;#m2;#STORE;
    876 #chunk';#psp';#b';#ofs';
     873#chunk #m1 #psp #b #ofs #v #m2 #STORE
     874#chunk' #psp' #b' #ofs'
    877875* Hv;
    878 #Hvb;#Hl;#Hr;#Halign;#Hcompat;
    879 @;//;
    880 ##[napply (store_valid_block_2 … STORE);//
    881 ##|nrewrite < (low_bound_store … STORE …);//
    882 ##|nrewrite < (high_bound_store … STORE …);//
    883 ##|nrewrite < (region_store … STORE …);//]
    884 nqed.
    885 
    886 nlemma store_valid_access_3:
     876#Hvb #Hl #Hr #Halign #Hcompat
     877% //;
     878[@(store_valid_block_2 … STORE) //
     879|<(low_bound_store … STORE …) //
     880|<(high_bound_store … STORE …) //
     881|<(region_store … STORE …) //]
     882qed.
     883
     884lemma store_valid_access_3:
    887885  ∀chunk,m1,psp,b,ofs,v,m2.store chunk m1 psp b ofs v = Some ? m2 →
    888886  valid_access m1 chunk psp b ofs.
    889 #chunk;#m1;#psp b ofs;#v;#m2;#STORE;
    890 ncases (store_inv … STORE);//;
    891 nqed.
     887#chunk #m1 #psp #b #ofs #v #m2 #STORE
     888cases (store_inv … STORE);//;
     889qed.
    892890
    893891(*Hint Resolve store_valid_access_1 store_valid_access_2
    894892             store_valid_access_3: mem.*)
    895893
    896 nlemma load_compat_pointer:
     894lemma load_compat_pointer:
    897895  ∀chunk,m,psp,psp',b,ofs,v.
    898896  pointer_compat (block_space m b) psp' →
    899897  load chunk m psp b ofs = Some ? v →
    900898  load chunk m psp' b ofs = Some ? v.
    901 #chunk m psp psp' b ofs v Hcompat LOAD.
    902 nlapply (load_valid_access … LOAD); #Hvalid;
    903 ncut (valid_access m chunk psp' b ofs);
    904 ##[ @;nelim Hvalid; //;
    905 ##| #Hvalid';
    906     nrewrite < LOAD; nwhd in ⊢ (??%%);
    907     nrewrite > (in_bounds_true … (option val) ?? Hvalid);
    908     nrewrite > (in_bounds_true … (option val) ?? Hvalid');
     899#chunk #m #psp #psp' #b #ofs #v #Hcompat #LOAD
     900lapply (load_valid_access … LOAD); #Hvalid
     901cut (valid_access m chunk psp' b ofs);
     902[ % elim Hvalid; //;
     903| #Hvalid'
     904    <LOAD whd in ⊢ (??%%);
     905    >(in_bounds_true … (option val) ?? Hvalid)
     906    >(in_bounds_true … (option val) ?? Hvalid')
    909907    //
    910 ##] nqed.
     908] qed.
    911909
    912910(* Nonessential properties that may require arithmetic
    913 ntheorem load_store_similar:
     911theorem load_store_similar:
    914912  ∀chunk,m1,psp,b,ofs,v,m2.store chunk m1 psp b ofs v = Some ? m2 →
    915913  ∀chunk'.
    916914  size_chunk chunk' = size_chunk chunk →
    917915  load chunk' m2 psp b ofs = Some ? (load_result chunk' v).
    918 #chunk;#m1;#psp b ofs;#v;#m2;#STORE;
    919 #chunk';#Hsize;ncases (store_inv … STORE);
    920 #Hv;#Heq;
    921 nwhd in ⊢ (??%?);
     916#chunk #m1 #psp #b #ofs #v #m2 #STORE
     917#chunk' #Hsize cases (store_inv … STORE);
     918#Hv #Heq
     919whd in ⊢ (??%?);
    922920nrewrite > (in_bounds_true m2 chunk' psp b ofs ? (Some ? (load_result chunk' (getN (pred_size_chunk chunk') ofs (contents (blocks m2 b)))))
    923921               (None ?) ?);
    924 ##[nrewrite > Heq;
    925    nwhd in ⊢ (??(??(? ? (? ? ? (? (? % ?)))))?);
    926    nrewrite > (update_s ? b ? (blocks m1)); (* XXX  too many metas for my taste *)
    927    nrewrite > (? : pred_size_chunk chunk = pred_size_chunk chunk');
    928    ##[//;
    929    ##|nrewrite > (size_chunk_pred …) in Hsize;#Hsize;
    930       nrewrite > (size_chunk_pred …) in Hsize;#Hsize;
    931       napply injective_Z_of_nat;napply (injective_Zplus_r 1);//;##]
    932 ##|napply (store_valid_access_1 … STORE);
    933    ncases Hv;#H1;#H2;#H3;#H4;#H5;@;//;
    934    nrewrite > (align_chunk_compat … Hsize);//]
    935 nqed.
    936 
    937 ntheorem load_store_same:
     922[>Heq
     923   whd in ⊢ (??(??(? ? (? ? ? (? (? % ?)))))?);
     924   >(update_s ? b ? (blocks m1)) (* XXX  too many metas for my taste *)
     925   >(? : pred_size_chunk chunk = pred_size_chunk chunk')
     926   [//;
     927   |>(size_chunk_pred …) in Hsize #Hsize
     928      >(size_chunk_pred …) in Hsize #Hsize
     929      @injective_Z_of_nat @(injective_Zplus_r 1) //;]
     930|@(store_valid_access_1 … STORE)
     931   cases Hv;#H1 #H2 #H3 #H4 #H5 % //;
     932   >(align_chunk_compat … Hsize) //]
     933qed.
     934
     935theorem load_store_same:
    938936  ∀chunk,m1,psp,b,ofs,v,m2.store chunk m1 psp b ofs v = Some ? m2 →
    939937  load chunk m2 psp b ofs = Some ? (load_result chunk v).
    940 #chunk;#m1;#psp b ofs;#v;#m2;#STORE;
    941 napply load_store_similar;//;
    942 nqed.
     938#chunk #m1 #psp #b #ofs #v #m2 #STORE
     939@load_store_similar //;
     940qed.
    943941       
    944 ntheorem load_store_other:
     942theorem load_store_other:
    945943  ∀chunk,m1,psp,b,ofs,v,m2.store chunk m1 psp b ofs v = Some ? m2 →
    946944  ∀chunk',psp',b',ofs'.
     
    949947  ∨ ofs + size_chunk chunk ≤ ofs' →
    950948  load chunk' m2 psp' b' ofs' = load chunk' m1 psp' b' ofs'.
    951 #chunk;#m1;#psp b ofs;#v;#m2;#STORE;
    952 #chunk';#psp';#b';#ofs';#H;
    953 ncases (store_inv … STORE);
    954 #Hvalid;#Heq;nwhd in ⊢ (??%%);
    955 ncases (in_bounds m1 chunk' psp' b' ofs');
    956 ##[#Hvalid1;nrewrite > (in_bounds_true m2 chunk' psp' b' ofs' ? (Some ? ?) ??);
    957    ##[nwhd in ⊢ (???%); napply (eq_f … (Some val));napply (eq_f … (load_result chunk'));
    958       nrewrite > Heq;nwhd in ⊢ (??(???(? (? % ?)))?);
    959                      nwhd in ⊢ (??(???(? %))?);
    960       nlapply (eqZb_to_Prop b' b);ncases (eqZb b' b);
    961       nwhd in ⊢ (% → ?);
    962       ##[#Heq1;nrewrite > Heq1;nwhd in ⊢ (??(??? (? %))?);
    963          nrewrite > (size_chunk_pred …) in H;
    964          nrewrite > (size_chunk_pred …);#H;
    965          napply (getN_setN_other …);ncases H
    966          ##[*
    967             ##[#Hfalse;nelim Hfalse;#H1;nelim (H1 Heq1)
    968             ##|#H1;@2;(*H1*)napply daemon ##]
    969          ##|#H1;@;(*H1*)napply daemon ##]
    970       ##|#Hneq;@ ##]
    971    ##|napply (store_valid_access_1 … STORE);//##]
    972 ##|nwhd in ⊢ (? → ???%);nlapply (in_bounds m2 chunk' psp' b' ofs');
    973    #H1;ncases H1;
    974    ##[#H2;#H3;nlapply (store_valid_access_2 … STORE … H2);#Hfalse;
    975       ncases H3;#H4;nelim (H4 Hfalse)
    976    ##|#H2;#H3;@]
    977 ##]
    978 nqed.
    979 
    980 
    981 ntheorem load_store_overlap:
     949#chunk #m1 #psp #b #ofs #v #m2 #STORE
     950#chunk' #psp' #b' #ofs' #H
     951cases (store_inv … STORE);
     952#Hvalid #Heq whd in ⊢ (??%%);
     953cases (in_bounds m1 chunk' psp' b' ofs');
     954[#Hvalid1 >(in_bounds_true m2 chunk' psp' b' ofs' ? (Some ? ?) ??)
     955   [whd in ⊢ (???%); @(eq_f … (Some val)) @(eq_f … (load_result chunk'))
     956      >Heq whd in ⊢ (??(???(? (? % ?)))?);
     957                     whd in ⊢ (??(???(? %))?);
     958      lapply (eqZb_to_Prop b' b);cases (eqZb b' b);
     959      whd in ⊢ (% → ?);
     960      [#Heq1 >Heq1 whd in ⊢ (??(??? (? %))?);
     961         >(size_chunk_pred …) in H
     962         >(size_chunk_pred …) #H
     963         @(getN_setN_other …) cases H
     964         [*
     965            [#Hfalse elim Hfalse;#H1 elim (H1 Heq1)
     966            |#H1 %{2} (*H1*)napply daemon ]
     967         |#H1 % (*H1*)napply daemon ]
     968      |#Hneq @ ]
     969   |@(store_valid_access_1 … STORE) //]
     970|whd in ⊢ (? → ???%);lapply (in_bounds m2 chunk' psp' b' ofs');
     971   #H1 cases H1;
     972   [#H2 #H3 lapply (store_valid_access_2 … STORE … H2);#Hfalse
     973      cases H3;#H4 elim (H4 Hfalse)
     974   |#H2 #H3 @]
     975]
     976qed.
     977
     978
     979theorem load_store_overlap:
    982980  ∀chunk,m1,psp,b,ofs,v,m2.store chunk m1 psp b ofs v = Some ? m2 →
    983981  ∀chunk',ofs',v'. load chunk' m2 psp b ofs' = Some ? v' →
     
    986984  ofs' < ofs + size_chunk chunk →
    987985  v' = Vundef.
    988 #chunk;#m1;#psp b ofs;#v;#m2;#STORE;
    989 #chunk';#ofs';#v';#H;
    990 #H1;#H2;#H3;
    991 ncases (store_inv … STORE);
    992 ncases (load_inv … H);
    993 #Hvalid;#Heq;#Hvalid1;#Heq1;nrewrite > Heq;nrewrite > Heq1;
     986#chunk #m1 #psp #b #ofs #v #m2 #STORE
     987#chunk' #ofs' #v' #H
     988#H1 #H2 #H3
     989cases (store_inv … STORE);
     990cases (load_inv … H);
     991#Hvalid #Heq #Hvalid1 #Heq1 >Heq >Heq1
    994992nchange in ⊢ (??(??(???(?(?%?))))?) with (mk_mem ???);
    995 nrewrite > (update_s block_contents …);
    996 nrewrite > (getN_setN_overlap …);
    997 ##[ncases chunk';//
    998 ##|nrewrite > (size_chunk_pred …) in H2;(*arith*) napply daemon
    999 ##|nrewrite > (size_chunk_pred …) in H3;(*arith*) napply daemon
    1000 ##|napply sym_neq;//]
    1001 nqed.
    1002 
    1003 ntheorem load_store_overlap':
     993>(update_s block_contents …)
     994>(getN_setN_overlap …)
     995[cases chunk';//
     996|>(size_chunk_pred …) in H2 (*arith*) napply daemon
     997|>(size_chunk_pred …) in H3 (*arith*) napply daemon
     998|@sym_neq //]
     999qed.
     1000
     1001theorem load_store_overlap':
    10041002  ∀chunk,m1,psp,b,ofs,v,m2.store chunk m1 psp b ofs v = Some ? m2 →
    10051003  ∀chunk',ofs'.
     
    10091007  ofs' < ofs + size_chunk chunk →
    10101008  load chunk' m2 psp b ofs' = Some ? Vundef.
    1011 #chunk;#m1;#psp b ofs;#v;#m2;#STORE;
    1012 #chunk';#ofs';#Hvalid;#H;#H1;#H2;
    1013 ncut (∃v'.load chunk' m2 psp b ofs' = Some ? v')
    1014 ##[napply valid_access_load;
    1015    napply (store_valid_access_1 … STORE);//
    1016 ##|#H3;ncases H3;
    1017    #x;#Hx;nrewrite > Hx;napply (eq_f … (Some val));
    1018    napply (load_store_overlap … STORE … Hx);//;##]
    1019 nqed.
    1020 
    1021 ntheorem load_store_mismatch:
     1009#chunk #m1 #psp #b #ofs #v #m2 #STORE
     1010#chunk' #ofs' #Hvalid #H #H1 #H2
     1011cut (∃v'.load chunk' m2 psp b ofs' = Some ? v')
     1012[@valid_access_load
     1013   @(store_valid_access_1 … STORE) //
     1014|#H3 cases H3;
     1015   #x #Hx >Hx @(eq_f … (Some val))
     1016   @(load_store_overlap … STORE … Hx) //;]
     1017qed.
     1018
     1019theorem load_store_mismatch:
    10221020  ∀chunk,m1,psp,b,ofs,v,m2.store chunk m1 psp b ofs v = Some ? m2 →
    10231021  ∀chunk',v'.
     
    10251023  size_chunk chunk' ≠ size_chunk chunk →
    10261024  v' = Vundef.
    1027 #chunk;#m1;#psp b ofs;#v;#m2;#STORE;
    1028 #chunk';#v';#H;#H1;
    1029 ncases (store_inv … STORE);
    1030 ncases (load_inv … H);
    1031 #Hvalid;#H2;#Hvalid1;#H3;
    1032 nrewrite > H2;
     1025#chunk #m1 #psp #b #ofs #v #m2 #STORE
     1026#chunk' #v' #H #H1
     1027cases (store_inv … STORE);
     1028cases (load_inv … H);
     1029#Hvalid #H2 #Hvalid1 #H3
     1030>H2
    10331031nchange in H3:(???%) with (mk_mem ???);
    1034 nrewrite > H3;nrewrite > (update_s block_contents …);
    1035 nrewrite > (getN_setN_mismatch …);
    1036 ##[ncases chunk';//;
    1037 ##|nrewrite > (size_chunk_pred …) in H1;nrewrite > (size_chunk_pred …);
    1038    #H1;napply nmk;#Hfalse;nelim H1;#H4;napply H4;
    1039    napply (eq_f ?? (λx.1 + x) ???);//##]
    1040 nqed.
    1041 
    1042 ntheorem load_store_mismatch':
     1032>H3 >(update_s block_contents …)
     1033>(getN_setN_mismatch …)
     1034[cases chunk';//;
     1035|>(size_chunk_pred …) in H1 >(size_chunk_pred …)
     1036   #H1 @nmk #Hfalse elim H1;#H4 @H4
     1037   @(eq_f ?? (λx.1 + x) ???) //]
     1038qed.
     1039
     1040theorem load_store_mismatch':
    10431041  ∀chunk,m1,psp,b,ofs,v,m2.store chunk m1 psp b ofs v = Some ? m2 →
    10441042  ∀chunk'.
     
    10461044  size_chunk chunk' ≠ size_chunk chunk →
    10471045  load chunk' m2 psp b ofs = Some ? Vundef.
    1048 #chunk;#m1;#psp b ofs;#v;#m2;#STORE;
    1049 #chunk';#Hvalid;#Hsize;
    1050 ncut (∃v'.load chunk' m2 psp b ofs = Some ? v')
    1051 ##[napply (valid_access_load …);
     1046#chunk #m1 #psp #b #ofs #v #m2 #STORE
     1047#chunk' #Hvalid #Hsize
     1048cut (∃v'.load chunk' m2 psp b ofs = Some ? v')
     1049[@(valid_access_load …)
    10521050   napply
    10531051    (store_valid_access_1 … STORE);//
    1054 ##|*;#x;#Hx;nrewrite > Hx;napply (eq_f … (Some val));
    1055    napply (load_store_mismatch … STORE … Hsize);//;##]
    1056 nqed.
    1057 
    1058 ninductive load_store_cases
     1052|*;#x #Hx >Hx @(eq_f … (Some val))
     1053   @(load_store_mismatch … STORE … Hsize) //;]
     1054qed.
     1055
     1056inductive load_store_cases
    10591057      (chunk1: memory_chunk) (b1: block) (ofs1: Z)
    1060       (chunk2: memory_chunk) (b2: block) (ofs2: Z) : Type
     1058      (chunk2: memory_chunk) (b2: block) (ofs2: Z) : Type[0]
    10611059  | lsc_similar:
    10621060      b1 = b2 → ofs1 = ofs2 → size_chunk chunk1 = size_chunk chunk2 →
     
    10721070      load_store_cases chunk1 b1 ofs1 chunk2 b2 ofs2.
    10731071
    1074 ndefinition load_store_classification:
     1072definition load_store_classification:
    10751073  ∀chunk1,b1,ofs1,chunk2,b2,ofs2.
    10761074  load_store_cases chunk1 b1 ofs1 chunk2 b2 ofs2.
    1077 #chunk1;#b1;#ofs1;#chunk2;#b2;#ofs2;
    1078 ncases (decidable_eq_Z_Type b1 b2);#H;
    1079 ##[ncases (decidable_eq_Z_Type ofs1 ofs2);#H1;
    1080    ##[ncases (decidable_eq_Z_Type (size_chunk chunk1) (size_chunk chunk2));#H2
    1081       ##[napply lsc_similar;//;
    1082       ##|napply lsc_mismatch;//;##]
    1083    ##|nlapply (Z_compare_to_Prop (ofs2 + size_chunk chunk2) ofs1);
    1084       ncases (Z_compare (ofs2+size_chunk chunk2) ofs1);
    1085       ##[nchange with (Zlt ? ? → ?);#H2;
    1086          napply lsc_other;@;@2;(*trivial Zlt_to_Zle BUT the statement is strange*)
     1075#chunk1 #b1 #ofs1 #chunk2 #b2 #ofs2
     1076cases (decidable_eq_Z_Type b1 b2);#H
     1077[cases (decidable_eq_Z_Type ofs1 ofs2);#H1
     1078   [cases (decidable_eq_Z_Type (size_chunk chunk1) (size_chunk chunk2));#H2
     1079      [@lsc_similar //;
     1080      |@lsc_mismatch //;]
     1081   |lapply (Z_compare_to_Prop (ofs2 + size_chunk chunk2) ofs1);
     1082      cases (Z_compare (ofs2+size_chunk chunk2) ofs1);
     1083      [nchange with (Zlt ? ? → ?);#H2
     1084         @lsc_other % %{2} (*trivial Zlt_to_Zle BUT the statement is strange*)
    10871085         napply daemon
    1088       ##|nchange with (? = ? → ?);#H2;
    1089          napply lsc_other;@;@2;(*trivial eq_to_Zle not defined *) napply daemon
    1090       ##|nchange with (Zlt ? ? → ?);#H2;
    1091          nlapply (Z_compare_to_Prop (ofs1 + size_chunk chunk1) ofs2);
    1092          ncases (Z_compare (ofs1 + size_chunk chunk1) ofs2);
    1093          ##[nchange with (Zlt ? ? → ?);#H3;
    1094             napply lsc_other;@2;(*trivial as previously*) napply daemon
    1095          ##|nchange with (? = ? → ?);#H3;
    1096             napply lsc_other;@2;(*trivial as previously*) napply daemon
    1097          ##|nchange with (Zlt ? ? → ?);#H3;
    1098             napply lsc_overlap;//;##]
    1099       ##]
    1100    ##]
    1101 ##|napply lsc_other;@;@; (* XXX // doesn't spot this! *) napply H ##]
    1102 nqed.
    1103 
    1104 ntheorem load_store_characterization:
     1086      |nchange with (? = ? → ?);#H2
     1087         @lsc_other % %{2} (*trivial eq_to_Zle not defined *) napply daemon
     1088      |nchange with (Zlt ? ? → ?);#H2
     1089         lapply (Z_compare_to_Prop (ofs1 + size_chunk chunk1) ofs2);
     1090         cases (Z_compare (ofs1 + size_chunk chunk1) ofs2);
     1091         [nchange with (Zlt ? ? → ?);#H3
     1092            @lsc_other %{2} (*trivial as previously*) napply daemon
     1093         |nchange with (? = ? → ?);#H3
     1094            @lsc_other %{2} (*trivial as previously*) napply daemon
     1095         |nchange with (Zlt ? ? → ?);#H3
     1096            @lsc_overlap //;]
     1097      ]
     1098   ]
     1099|@lsc_other % % (* XXX // doesn't spot this! *) napply H ]
     1100qed.
     1101
     1102theorem load_store_characterization:
    11051103  ∀chunk,m1,psp,b,ofs,v,m2.store chunk m1 psp b ofs v = Some ? m2 →
    11061104  ∀chunk',psp',b',ofs'.
     
    11121110    | lsc_overlap _ _ _ _ ⇒ Some ? Vundef
    11131111    | lsc_mismatch _ _ _ ⇒ Some ? Vundef ].
    1114 #chunk;#m1;#psp b ofs;#v;#m2;#STORE;
    1115 #chunk';#psp';#b';#ofs';#Hvalid;
    1116 ncut (∃v'. load chunk' m2 psp' b' ofs' = Some ? v')
    1117 ##[napply valid_access_load;
    1118    napply (store_valid_access_1 … STORE … Hvalid);
    1119 ##|*;#x;#Hx;
    1120    ncases (load_store_classification chunk b ofs chunk' b' ofs')
    1121    ##[#H1;#H2;#H3;nwhd in ⊢ (???%);nrewrite < H1;nrewrite < H2;
    1122       napply (load_compat_pointer … psp);
    1123       ##[ nrewrite > (region_store … STORE b);
    1124           ncases Hvalid; //;
    1125       ##| napply (load_store_similar … STORE);//;
    1126       ##]
    1127    ##|#H1;napply (load_store_other … STORE);
    1128       ncases H1
    1129       ##[*
    1130          ##[#H2;@;@;napply sym_neq;//
    1131          ##|#H2;@;@2;//]
    1132       ##|#H2;@2;//]
    1133    ##|#H1;#H2;#H3;#H4; nlapply (load_compat_pointer … psp … Hx);
    1134      ##[ nrewrite > (region_store … STORE b');
    1135          nrewrite > H1; nelim (store_valid_access_3 … STORE); //
    1136      ##| nrewrite < H1 in ⊢ (% → ?);#Hx';
    1137          nrewrite < H1 in Hx;#Hx;nrewrite > Hx;
    1138       napply (eq_f … (Some val));napply (load_store_overlap … STORE … Hx');/2/;
    1139      ##]
    1140    ##|#H1;#H2;#H3;
    1141        nlapply (load_compat_pointer … psp … Hx);
    1142        ##[ nrewrite > (region_store … STORE b');
    1143            nrewrite > H1; nelim (store_valid_access_3 … STORE); //
    1144        ##| nrewrite < H1 in Hx ⊢ %; nrewrite < H2; #Hx Hx';
    1145            nrewrite > Hx;napply (eq_f … (Some val));
    1146            napply (load_store_mismatch … STORE … Hx');/2/
    1147        ##]
    1148    ##]
     1112#chunk #m1 #psp #b #ofs #v #m2 #STORE
     1113#chunk' #psp' #b' #ofs' #Hvalid
     1114cut (∃v'. load chunk' m2 psp' b' ofs' = Some ? v')
     1115[@valid_access_load
     1116   @(store_valid_access_1 … STORE … Hvalid)
     1117|*;#x #Hx
     1118   cases (load_store_classification chunk b ofs chunk' b' ofs')
     1119   [#H1 #H2 #H3 whd in ⊢ (???%);<H1 <H2
     1120      @(load_compat_pointer … psp)
     1121      [ >(region_store … STORE b)
     1122          cases Hvalid; //;
     1123      | @(load_store_similar … STORE) //;
     1124      ]
     1125   |#H1 @(load_store_other … STORE)
     1126      cases H1
     1127      [*
     1128         [#H2 % % @sym_neq //
     1129         |#H2 % %{2} //]
     1130      |#H2 %{2} //]
     1131   |#H1 #H2 #H3 #H4 lapply (load_compat_pointer … psp … Hx);
     1132     [ >(region_store … STORE b')
     1133         >H1 elim (store_valid_access_3 … STORE); //
     1134     | <H1 in ⊢ (% → ?) #Hx'
     1135         <H1 in Hx #Hx >Hx
     1136      @(eq_f … (Some val)) @(load_store_overlap … STORE … Hx') /2/;
     1137     ]
     1138   |#H1 #H2 #H3
     1139       lapply (load_compat_pointer … psp … Hx);
     1140       [ >(region_store … STORE b')
     1141           >H1 elim (store_valid_access_3 … STORE); //
     1142       | <H1 in Hx ⊢ % <H2 #Hx #Hx'
     1143           >Hx @(eq_f … (Some val))
     1144           @(load_store_mismatch … STORE … Hx') /2/
     1145       ]
     1146   ]
    11491147           
    1150 ##]
    1151 nqed.
    1152 
    1153 (*nlemma d : ∀a,b,c,d:nat.∀e:〈a,b〉 = 〈c,d〉. ∀P:(∀a,b,c,d,e.Prop).
     1148]
     1149qed.
     1150
     1151(*lemma d : ∀a,b,c,d:nat.∀e:〈a,b〉 = 〈c,d〉. ∀P:(∀a,b,c,d,e.Prop).
    11541152           P a b c d e → P a b a b (refl ??).
    1155 #a;#b;#c;#d;#e;#P;#H1;ndestruct;*)
     1153#a #b #c #d #e #P #H1 destruct;*)
    11561154
    11571155(*
     
    11651163*)
    11661164
    1167 ndefinition pairdisc ≝
    1168 λA,B.λx,y:pair A B.
     1165definition pairdisc ≝
     1166λA,B.λx,y:Prod A B.
    11691167match x with
    1170 [(mk_pair t0 t1) ⇒
     1168[(pair t0 t1) ⇒
    11711169match y with
    1172 [(mk_pair u0 u1) ⇒
     1170[(pair u0 u1) ⇒
    11731171  ∀P: Type[1].
    11741172  (∀e0: (eq A (R0 ? t0) u0).
    11751173   ∀e1: (eq (? u0 e0) (R1 ? t0 ? t1 u0 e0) u1).P) → P ] ].
    11761174
    1177 nlemma pairdisc_elim : ∀A,B,x,y.x = y → pairdisc A B x y.
    1178 #A;#B;#x;#y;#e;nrewrite > e;ncases y;
    1179 #a;#b;nnormalize;#P;#PH;napply PH;@;
    1180 nqed.
    1181 
    1182 nlemma nextblock_alloc:
     1175lemma pairdisc_elim : ∀A,B,x,y.x = y → pairdisc A B x y.
     1176#A #B #x #y #e >e cases y;
     1177#a #b normalize;#P #PH @PH %
     1178qed.
     1179
     1180lemma nextblock_alloc:
    11831181  ∀m1,lo,hi,bcl,m2,b.alloc m1 lo hi bcl = 〈m2,b〉 →
    11841182  nextblock m2 = Zsucc (nextblock m1).
    1185 #m1;#lo;#hi;#bcl;#m2;#b;#ALLOC;
    1186 nwhd in ALLOC:(??%%); ndestruct; //;
    1187 nqed.
    1188 
    1189 nlemma alloc_result:
     1183#m1 #lo #hi #bcl #m2 #b #ALLOC
     1184whd in ALLOC:(??%%); destruct; //;
     1185qed.
     1186
     1187lemma alloc_result:
    11901188  ∀m1,lo,hi,bcl,m2,b.alloc m1 lo hi bcl = 〈m2,b〉 →
    11911189  b = nextblock m1.
    1192 #m1;#lo;#hi;#bcl;#m2;#b;#ALLOC;
    1193 nwhd in ALLOC:(??%%); ndestruct; //;
    1194 nqed.
    1195 
    1196 
    1197 nlemma valid_block_alloc:
     1190#m1 #lo #hi #bcl #m2 #b #ALLOC
     1191whd in ALLOC:(??%%); destruct; //;
     1192qed.
     1193
     1194
     1195lemma valid_block_alloc:
    11981196  ∀m1,lo,hi,bcl,m2,b.alloc m1 lo hi bcl = 〈m2,b〉 →
    11991197  ∀b'. valid_block m1 b' → valid_block m2 b'.
    1200 #m1;#lo;#hi;#bcl;#m2;#b;#ALLOC;
    1201 #b'; nrewrite > (unfold_valid_block m1 b');
    1202 nrewrite > (unfold_valid_block m2 b');
    1203 nrewrite > (nextblock_alloc … ALLOC);
    1204 (* arith *) napply daemon;
    1205 nqed.
    1206 
    1207 nlemma fresh_block_alloc:
     1198#m1 #lo #hi #bcl #m2 #b #ALLOC
     1199#b' >(unfold_valid_block m1 b')
     1200>(unfold_valid_block m2 b')
     1201>(nextblock_alloc … ALLOC)
     1202(* arith *) @daemon
     1203qed.
     1204
     1205lemma fresh_block_alloc:
    12081206  ∀m1,lo,hi,bcl,m2,b.alloc m1 lo hi bcl = 〈m2,b〉 →
    12091207  ¬(valid_block m1 b).
    1210 #m1;#lo;#hi;#bcl;#m2;#b;#ALLOC;
    1211 nrewrite > (unfold_valid_block m1 b);
    1212 nrewrite > (alloc_result … ALLOC);
    1213 (* arith *) napply daemon;
    1214 nqed.
    1215 
    1216 nlemma valid_new_block:
     1208#m1 #lo #hi #bcl #m2 #b #ALLOC
     1209>(unfold_valid_block m1 b)
     1210>(alloc_result … ALLOC)
     1211(* arith *) @daemon
     1212qed.
     1213
     1214lemma valid_new_block:
    12171215  ∀m1,lo,hi,bcl,m2,b.alloc m1 lo hi bcl = 〈m2,b〉 →
    12181216  valid_block m2 b.
    1219 #m1;#lo;#hi;#bcl;#m2;#b;#ALLOC;
    1220 nrewrite > (unfold_valid_block m2 b);
    1221 nrewrite > (alloc_result … ALLOC);
    1222 nrewrite > (nextblock_alloc … ALLOC);
    1223 (* arith *) napply daemon;
    1224 nqed.
     1217#m1 #lo #hi #bcl #m2 #b #ALLOC
     1218>(unfold_valid_block m2 b)
     1219>(alloc_result … ALLOC)
     1220>(nextblock_alloc … ALLOC)
     1221(* arith *) @daemon
     1222qed.
    12251223
    12261224(*
     
    12281226*)
    12291227
    1230 nlemma valid_block_alloc_inv:
     1228lemma valid_block_alloc_inv:
    12311229  ∀m1,lo,hi,bcl,m2,b.alloc m1 lo hi bcl = 〈m2,b〉 →
    12321230  ∀b'. valid_block m2 b' → b' = b ∨ valid_block m1 b'.
    1233 #m1;#lo;#hi;#bcl;#m2;#b;#ALLOC;
    1234 #b';
    1235 nrewrite > (unfold_valid_block m2 b');
    1236 nrewrite > (unfold_valid_block m1 b');
    1237 nrewrite > (nextblock_alloc … ALLOC); #H;
    1238 nrewrite > (alloc_result … ALLOC);
    1239 (* arith *) napply daemon;
    1240 nqed.
    1241 
    1242 nlemma low_bound_alloc:
     1231#m1 #lo #hi #bcl #m2 #b #ALLOC
     1232#b'
     1233>(unfold_valid_block m2 b')
     1234>(unfold_valid_block m1 b')
     1235>(nextblock_alloc … ALLOC) #H
     1236>(alloc_result … ALLOC)
     1237(* arith *) @daemon
     1238qed.
     1239
     1240lemma low_bound_alloc:
    12431241  ∀m1,lo,hi,bcl,m2,b.alloc m1 lo hi bcl = 〈m2,b〉 →
    12441242  ∀b'. low_bound m2 b' = if eqZb b' b then lo else low_bound m1 b'.
    1245 #m1;#lo;#hi;#bcl;#m2;#b;#ALLOC;
    1246 nwhd in ALLOC:(??%%); ndestruct; #b';
    1247 nrewrite > (unfold_update block_contents ????);
    1248 ncases (eqZb b' (nextblock m1)); //;
    1249 nqed.
    1250 
    1251 nlemma low_bound_alloc_same:
     1243#m1 #lo #hi #bcl #m2 #b #ALLOC
     1244whd in ALLOC:(??%%); destruct; #b'
     1245>(unfold_update block_contents ????)
     1246cases (eqZb b' (nextblock m1)); //;
     1247qed.
     1248
     1249lemma low_bound_alloc_same:
    12521250  ∀m1,lo,hi,bcl,m2,b.alloc m1 lo hi bcl = 〈m2,b〉 →
    12531251  low_bound m2 b = lo.
    1254 #m1;#lo;#hi;#bcl;#m2;#b;#ALLOC;
    1255 nrewrite > (low_bound_alloc … ALLOC b);
    1256 nrewrite > (eqZb_z_z …);
     1252#m1 #lo #hi #bcl #m2 #b #ALLOC
     1253>(low_bound_alloc … ALLOC b)
     1254>(eqZb_z_z …)
    12571255//;
    1258 nqed.
    1259 
    1260 nlemma low_bound_alloc_other:
     1256qed.
     1257
     1258lemma low_bound_alloc_other:
    12611259  ∀m1,lo,hi,bcl,m2,b.alloc m1 lo hi bcl = 〈m2,b〉 →
    12621260  ∀b'. valid_block m1 b' → low_bound m2 b' = low_bound m1 b'.
    1263 #m1;#lo;#hi;#bcl;#m2;#b;#ALLOC;
    1264 #b'; nrewrite > (low_bound_alloc … ALLOC b');
    1265 napply eqZb_elim; #Hb;
    1266 ##[ nrewrite > Hb; #bad; napply False_ind; napply (absurd ? bad);
     1261#m1 #lo #hi #bcl #m2 #b #ALLOC
     1262#b' >(low_bound_alloc … ALLOC b')
     1263@eqZb_elim #Hb
     1264[ >Hb #bad @False_ind @(absurd ? bad)
    12671265    napply (fresh_block_alloc … ALLOC)
    1268 ##| //
    1269 ##] nqed.
    1270 
    1271 nlemma high_bound_alloc:
     1266| //
     1267] qed.
     1268
     1269lemma high_bound_alloc:
    12721270  ∀m1,lo,hi,bcl,m2,b.alloc m1 lo hi bcl = 〈m2,b〉 →
    12731271  ∀b'. high_bound m2 b' = if eqZb b' b then hi else high_bound m1 b'.
    1274 #m1;#lo;#hi;#bcl;#m2;#b;#ALLOC;
    1275 nwhd in ALLOC:(??%%); ndestruct; #b';
    1276 nrewrite > (unfold_update block_contents ????);
    1277 ncases (eqZb b' (nextblock m1)); //;
    1278 nqed.
    1279 
    1280 nlemma high_bound_alloc_same:
     1272#m1 #lo #hi #bcl #m2 #b #ALLOC
     1273whd in ALLOC:(??%%); destruct; #b'
     1274>(unfold_update block_contents ????)
     1275cases (eqZb b' (nextblock m1)); //;
     1276qed.
     1277
     1278lemma high_bound_alloc_same:
    12811279  ∀m1,lo,hi,bcl,m2,b.alloc m1 lo hi bcl = 〈m2,b〉 →
    12821280  high_bound m2 b = hi.
    1283 #m1;#lo;#hi;#bcl;#m2;#b;#ALLOC;
    1284 nrewrite > (high_bound_alloc … ALLOC b);
    1285 nrewrite > (eqZb_z_z …);
     1281#m1 #lo #hi #bcl #m2 #b #ALLOC
     1282>(high_bound_alloc … ALLOC b)
     1283>(eqZb_z_z …)
    12861284//;
    1287 nqed.
    1288 
    1289 nlemma high_bound_alloc_other:
     1285qed.
     1286
     1287lemma high_bound_alloc_other:
    12901288  ∀m1,lo,hi,bcl,m2,b.alloc m1 lo hi bcl = 〈m2,b〉 →
    12911289  ∀b'. valid_block m1 b' → high_bound m2 b' = high_bound m1 b'.
    1292 #m1;#lo;#hi;#bcl;#m2;#b;#ALLOC;
    1293 #b'; nrewrite > (high_bound_alloc … ALLOC b');
    1294 napply eqZb_elim; #Hb;
    1295 ##[ nrewrite > Hb; #bad; napply False_ind; napply (absurd ? bad);
     1290#m1 #lo #hi #bcl #m2 #b #ALLOC
     1291#b' >(high_bound_alloc … ALLOC b')
     1292@eqZb_elim #Hb
     1293[ >Hb #bad @False_ind @(absurd ? bad)
    12961294    napply (fresh_block_alloc … ALLOC)
    1297 ##| //
    1298 ##] nqed.
    1299 
    1300 nlemma class_alloc:
     1295| //
     1296] qed.
     1297
     1298lemma class_alloc:
    13011299  ∀m1,lo,hi,bcl,m2,b.alloc m1 lo hi bcl = 〈m2,b〉 →
    13021300  ∀b'.block_space m2 b' = if eqZb b' b then bcl else block_space m1 b'.
    1303 #m1;#lo;#hi;#bcl;#m2;#b;#ALLOC;
    1304 nwhd in ALLOC:(??%%); ndestruct; #b';
    1305 ncases (eqZb b' (nextblock m1)); //;
    1306 nqed.
    1307 
    1308 nlemma class_alloc_same:
     1301#m1 #lo #hi #bcl #m2 #b #ALLOC
     1302whd in ALLOC:(??%%); destruct; #b'
     1303cases (eqZb b' (nextblock m1)); //;
     1304qed.
     1305
     1306lemma class_alloc_same:
    13091307  ∀m1,lo,hi,bcl,m2,b.alloc m1 lo hi bcl = 〈m2,b〉 →
    13101308  block_space m2 b = bcl.
    1311 #m1;#lo;#hi;#bcl;#m2;#b;#ALLOC;
    1312 nwhd in ALLOC:(??%%); ndestruct;
    1313 nrewrite > (eqZb_z_z ?); //;
    1314 nqed.
    1315 
    1316 nlemma class_alloc_other:
     1309#m1 #lo #hi #bcl #m2 #b #ALLOC
     1310whd in ALLOC:(??%%); destruct;
     1311>(eqZb_z_z ?) //;
     1312qed.
     1313
     1314lemma class_alloc_other:
    13171315  ∀m1,lo,hi,bcl,m2,b.alloc m1 lo hi bcl = 〈m2,b〉 →
    13181316  ∀b'. valid_block m1 b' → block_space m2 b' = block_space m1 b'.
    1319 #m1;#lo;#hi;#bcl;#m2;#b;#ALLOC;
    1320 #b'; nrewrite > (class_alloc … ALLOC b');
    1321 napply eqZb_elim; #Hb;
    1322 ##[ nrewrite > Hb; #bad; napply False_ind; napply (absurd ? bad);
     1317#m1 #lo #hi #bcl #m2 #b #ALLOC
     1318#b' >(class_alloc … ALLOC b')
     1319@eqZb_elim #Hb
     1320[ >Hb #bad @False_ind @(absurd ? bad)
    13231321    napply (fresh_block_alloc … ALLOC)
    1324 ##| //
    1325 ##] nqed.
    1326 
    1327 nlemma valid_access_alloc_other:
     1322| //
     1323] qed.
     1324
     1325lemma valid_access_alloc_other:
    13281326  ∀m1,lo,hi,bcl,m2,b.alloc m1 lo hi bcl = 〈m2,b〉 →
    13291327  ∀chunk,psp,b',ofs.
    13301328  valid_access m1 chunk psp b' ofs →
    13311329  valid_access m2 chunk psp b' ofs.
    1332 #m1;#lo;#hi;#bcl;#m2;#b;#ALLOC;
    1333 #chunk;#psp;#b';#ofs;#H;
    1334 ncases H; #Hvalid; #Hlow; #Hhigh;#Halign;#Hcompat;
    1335 @;
    1336 ##[ napply (valid_block_alloc … ALLOC); //
    1337 ##| nrewrite > (low_bound_alloc_other … ALLOC b' Hvalid); //
    1338 ##| nrewrite > (high_bound_alloc_other … ALLOC b' Hvalid); //
    1339 ##| //
    1340 ##| nrewrite > (class_alloc_other … ALLOC b' Hvalid); //;
    1341 ##] nqed.
    1342 
    1343 nlemma valid_access_alloc_same:
     1330#m1 #lo #hi #bcl #m2 #b #ALLOC
     1331#chunk #psp #b' #ofs #H
     1332cases H; #Hvalid #Hlow #Hhigh #Halign #Hcompat
     1333%
     1334[ @(valid_block_alloc … ALLOC) //
     1335| >(low_bound_alloc_other … ALLOC b' Hvalid) //
     1336| >(high_bound_alloc_other … ALLOC b' Hvalid) //
     1337| //
     1338| >(class_alloc_other … ALLOC b' Hvalid) //;
     1339] qed.
     1340
     1341lemma valid_access_alloc_same:
    13441342  ∀m1,lo,hi,bcl,m2,b.alloc m1 lo hi bcl = 〈m2,b〉 →
    13451343  ∀chunk,psp,ofs.
     
    13471345  pointer_compat bcl psp →
    13481346  valid_access m2 chunk psp b ofs.
    1349 #m1;#lo;#hi;#bcl;#m2;#b;#ALLOC;
    1350 #chunk;#psp;#ofs; #Hlo; #Hhi; #Halign; #Hcompat;
    1351 @;
    1352 ##[ napply (valid_new_block … ALLOC)
    1353 ##| nrewrite > (low_bound_alloc_same … ALLOC); //
    1354 ##| nrewrite > (high_bound_alloc_same … ALLOC); //
    1355 ##| //
    1356 ##| nrewrite > (class_alloc_same … ALLOC); //
    1357 ##] nqed.
     1347#m1 #lo #hi #bcl #m2 #b #ALLOC
     1348#chunk #psp #ofs #Hlo #Hhi #Halign #Hcompat
     1349%
     1350[ napply (valid_new_block … ALLOC)
     1351| >(low_bound_alloc_same … ALLOC) //
     1352| >(high_bound_alloc_same … ALLOC) //
     1353| //
     1354| >(class_alloc_same … ALLOC) //
     1355] qed.
    13581356
    13591357(*
     
    13611359*)
    13621360
    1363 nlemma valid_access_alloc_inv:
     1361lemma valid_access_alloc_inv:
    13641362  ∀m1,lo,hi,bcl,m2,b.alloc m1 lo hi bcl = 〈m2,b〉 →
    13651363  ∀chunk,psp,b',ofs.
     
    13671365  valid_access m1 chunk psp b' ofs ∨
    13681366  (b' = b ∧ lo ≤ ofs ∧ (ofs + size_chunk chunk ≤ hi ∧ (align_chunk chunk ∣ ofs) ∧ pointer_compat bcl psp)).
    1369 #m1;#lo;#hi;#bcl;#m2;#b;#ALLOC;
    1370 #chunk;#psp;#b';#ofs;*;#Hblk;#Hlo;#Hhi;#Hal;#Hct;
    1371 nelim (valid_block_alloc_inv … ALLOC ? Hblk);#H;
    1372 ##[ nrewrite < H in ALLOC ⊢ %; #ALLOC';
    1373     nrewrite > (low_bound_alloc_same … ALLOC') in Hlo; #Hlo';
    1374     nrewrite > (high_bound_alloc_same … ALLOC') in Hhi; #Hhi';
    1375     nrewrite > (class_alloc_same … ALLOC') in Hct; #Hct;
    1376     @2; /4/;
    1377 ##| @1;@;//;
    1378   ##[ nrewrite > (low_bound_alloc_other … ALLOC ??) in Hlo; //
    1379   ##| nrewrite > (high_bound_alloc_other … ALLOC ??) in Hhi; //
    1380   ##| nrewrite > (class_alloc_other … ALLOC ??) in Hct; //
    1381   ##]
    1382 ##] nqed.
    1383 
    1384 ntheorem load_alloc_unchanged:
     1367#m1 #lo #hi #bcl #m2 #b #ALLOC
     1368#chunk #psp #b' #ofs *;#Hblk #Hlo #Hhi #Hal #Hct
     1369elim (valid_block_alloc_inv … ALLOC ? Hblk);#H
     1370[ <H in ALLOC ⊢ % #ALLOC'
     1371    >(low_bound_alloc_same … ALLOC') in Hlo #Hlo'
     1372    >(high_bound_alloc_same … ALLOC') in Hhi #Hhi'
     1373    >(class_alloc_same … ALLOC') in Hct #Hct
     1374    %{2} /4/;
     1375| %{1} % //;
     1376  [ >(low_bound_alloc_other … ALLOC ??) in Hlo //
     1377  | >(high_bound_alloc_other … ALLOC ??) in Hhi //
     1378  | >(class_alloc_other … ALLOC ??) in Hct //
     1379  ]
     1380] qed.
     1381
     1382theorem load_alloc_unchanged:
    13851383  ∀m1,lo,hi,bcl,m2,b.alloc m1 lo bcl hi = 〈m2,b〉 →
    13861384  ∀chunk,psp,b',ofs.
    13871385  valid_block m1 b' →
    13881386  load chunk m2 psp b' ofs = load chunk m1 psp b' ofs.
    1389 #m1;#lo;#hi;#bcl;#m2;#b;#ALLOC;
    1390 #chunk;#psp;#b';#ofs;#H;nwhd in ⊢ (??%%);
    1391 ncases (in_bounds m2 chunk psp b' ofs); #H';
    1392 ##[ nelim (valid_access_alloc_inv … ALLOC ???? H');
    1393   ##[ #H''; (* XXX: if there's no hint that the result type is an option then the rewrite fails with an odd type error
    1394   nrewrite > (in_bounds_true ???? ??? H''); *) nrewrite > (in_bounds_true … ? (option val) ?? H'');
    1395       nwhd in ⊢ (??%?); (* XXX: if you do this at the point below the proof term is ill-typed. *)
    1396       ncut (b' ≠ b);
    1397       ##[ napply (valid_not_valid_diff … H); napply (fresh_block_alloc … ALLOC);
    1398       ##| nwhd in ALLOC:(??%%); ndestruct;
    1399           nrewrite > (update_o block_contents ?????); /2/;
    1400       ##]
    1401   ##| *;*;#A;#B;#C; nrewrite < A in ALLOC ⊢ %; #ALLOC;
    1402       napply False_ind; napply (absurd ? H); napply (fresh_block_alloc … ALLOC)
    1403   ##]
    1404 ##| ncases (in_bounds m1 chunk psp b' ofs); #H''; nwhd in ⊢ (??%%); //;
    1405     napply False_ind; napply (absurd ? ? H'); napply (valid_access_alloc_other … ALLOC); //
    1406 ##] nqed.
     1387#m1 #lo #hi #bcl #m2 #b #ALLOC
     1388#chunk #psp #b' #ofs #H whd in ⊢ (??%%);
     1389cases (in_bounds m2 chunk psp b' ofs); #H'
     1390[ elim (valid_access_alloc_inv … ALLOC ???? H');
     1391  [ #H'' (* XXX: if there's no hint that the result type is an option then the rewrite fails with an odd type error
     1392  >(in_bounds_true ???? ??? H'') *) >(in_bounds_true … ? (option val) ?? H'')
     1393      whd in ⊢ (??%?); (* XXX: if you do this at the point below the proof term is ill-typed. *)
     1394      cut (b' ≠ b);
     1395      [ @(valid_not_valid_diff … H) @(fresh_block_alloc … ALLOC)
     1396      | whd in ALLOC:(??%%); destruct;
     1397          >(update_o block_contents ?????) /2/;
     1398      ]
     1399  | *;*;#A #B #C <A in ALLOC ⊢ % #ALLOC
     1400      @False_ind @(absurd ? H) napply (fresh_block_alloc … ALLOC)
     1401  ]
     1402| cases (in_bounds m1 chunk psp b' ofs); #H'' whd in ⊢ (??%%); //;
     1403    @False_ind @(absurd ? ? H') @(valid_access_alloc_other … ALLOC) //
     1404] qed.
    14071405 
    1408 ntheorem load_alloc_other:
     1406theorem load_alloc_other:
    14091407  ∀m1,lo,hi,bcl,m2,b.alloc m1 lo hi bcl = 〈m2,b〉 →
    14101408  ∀chunk,psp,b',ofs,v.
    14111409  load chunk m1 psp b' ofs = Some ? v →
    14121410  load chunk m2 psp b' ofs = Some ? v.
    1413 #m1;#lo;#hi;#bcl;#m2;#b;#ALLOC;
    1414 #chunk;#psp;#b';#ofs;#v;#H;
    1415 nrewrite < H; napply (load_alloc_unchanged … ALLOC ???); ncases (load_valid_access … H); //;
    1416 nqed.
    1417 
    1418 ntheorem load_alloc_same:
     1411#m1 #lo #hi #bcl #m2 #b #ALLOC
     1412#chunk #psp #b' #ofs #v #H
     1413<H @(load_alloc_unchanged … ALLOC ???) cases (load_valid_access … H); //;
     1414qed.
     1415
     1416theorem load_alloc_same:
    14191417  ∀m1,lo,hi,bcl,m2,b.alloc m1 lo hi bcl = 〈m2,b〉 →
    14201418  ∀chunk,psp,ofs,v.
    14211419  load chunk m2 psp b ofs = Some ? v →
    14221420  v = Vundef.
    1423 #m1;#lo;#hi;#bcl;#m2;#b;#ALLOC;
    1424 #chunk;#psp;#ofs;#v;#H;
    1425 nelim (load_inv … H); #H0; #H1; nrewrite > H1;
    1426  nwhd in ALLOC:(??%%); (* XXX ndestruct; ??? *) napply (pairdisc_elim … ALLOC);
    1427  nwhd in ⊢ (??%% → ?);#e0;nrewrite < e0 in ⊢ (%→?);
    1428  nwhd in ⊢ (??%% → ?);#e1;
    1429 nrewrite < e1; nrewrite < e0; nrewrite > (update_s ? ? (empty_block lo hi bcl) ?);
    1430 nnormalize; ncases chunk; //;
    1431 nqed.
    1432 
    1433 ntheorem load_alloc_same':
     1421#m1 #lo #hi #bcl #m2 #b #ALLOC
     1422#chunk #psp #ofs #v #H
     1423elim (load_inv … H); #H0 #H1 >H1
     1424 whd in ALLOC:(??%%); (* XXX destruct; ??? *) @(pairdisc_elim … ALLOC)
     1425 whd in ⊢ (??%% → ?);#e0 <e0 in ⊢ (%→?)
     1426 whd in ⊢ (??%% → ?);#e1
     1427<e1 <e0 >(update_s ? ? (empty_block lo hi bcl) ?)
     1428normalize; cases chunk; //;
     1429qed.
     1430
     1431theorem load_alloc_same':
    14341432  ∀m1,lo,hi,bcl,m2,b.alloc m1 lo hi bcl = 〈m2,b〉 →
    14351433  ∀chunk,psp,ofs.
     
    14371435  pointer_compat bcl psp →
    14381436  load chunk m2 psp b ofs = Some ? Vundef.
    1439 #m1;#lo;#hi;#bcl;#m2;#b;#ALLOC;
    1440 #chunk;#psp;#ofs;#Hlo;#Hhi;#Hal;#Hct;
    1441 ncut (∃v. load chunk m2 psp b ofs = Some ? v);
    1442 ##[ napply valid_access_load; @; //;
    1443   ##[ napply (valid_new_block … ALLOC);
    1444   ##| nrewrite > (low_bound_alloc_same … ALLOC); //
    1445   ##| nrewrite > (high_bound_alloc_same … ALLOC); //
    1446   ##| nrewrite > (class_alloc_same … ALLOC); //
    1447   ##]
    1448 ##| *; #v;#LOAD; nrewrite > LOAD; napply (eq_f … (Some val));
    1449     napply (load_alloc_same … ALLOC … LOAD);
    1450 ##] nqed.
     1437#m1 #lo #hi #bcl #m2 #b #ALLOC
     1438#chunk #psp #ofs #Hlo #Hhi #Hal #Hct
     1439cut (∃v. load chunk m2 psp b ofs = Some ? v);
     1440[ @valid_access_load % //;
     1441  [ @(valid_new_block … ALLOC)
     1442  | >(low_bound_alloc_same … ALLOC) //
     1443  | >(high_bound_alloc_same … ALLOC) //
     1444  | >(class_alloc_same … ALLOC) //
     1445  ]
     1446| *; #v #LOAD >LOAD @(eq_f … (Some val))
     1447    @(load_alloc_same … ALLOC … LOAD)
     1448] qed.
    14511449
    14521450(*
     
    14671465*)
    14681466
    1469 nlemma valid_block_free_1:
     1467lemma valid_block_free_1:
    14701468  ∀m,bf,b. valid_block m b → valid_block (free m bf) b.
    1471 nnormalize;//;
    1472 nqed.
    1473 
    1474 nlemma valid_block_free_2:
     1469normalize;//;
     1470qed.
     1471
     1472lemma valid_block_free_2:
    14751473  ∀m,bf,b. valid_block (free m bf) b → valid_block m b.
    1476 nnormalize;//;
    1477 nqed.
     1474normalize;//;
     1475qed.
    14781476
    14791477(*
     
    14811479*)
    14821480
    1483 nlemma low_bound_free:
     1481lemma low_bound_free:
    14841482  ∀m,bf,b. b ≠ bf -> low_bound (free m bf) b = low_bound m b.
    1485 #m;#bf;#b;#H;nwhd in ⊢ (??%%); nwhd in ⊢ (??(?(?%?))?);
    1486 nrewrite > (update_o block_contents …); //; napply sym_neq; //;
    1487 nqed.
    1488 
    1489 nlemma high_bound_free:
     1483#m #bf #b #H whd in ⊢ (??%%); whd in ⊢ (??(?(?%?))?);
     1484>(update_o block_contents …) //; @sym_neq //;
     1485qed.
     1486
     1487lemma high_bound_free:
    14901488  ∀m,bf,b. b ≠ bf → high_bound (free m bf) b = high_bound m b.
    1491 #m;#bf;#b;#H;nwhd in ⊢ (??%%); nwhd in ⊢ (??(?(?%?))?);
    1492 nrewrite > (update_o block_contents …); //; napply sym_neq; //;
    1493 nqed.
    1494 
    1495 nlemma low_bound_free_same:
     1489#m #bf #b #H whd in ⊢ (??%%); whd in ⊢ (??(?(?%?))?);
     1490>(update_o block_contents …) //; @sym_neq //;
     1491qed.
     1492
     1493lemma low_bound_free_same:
    14961494  ∀m,b. low_bound (free m b) b = 0.
    1497 #m;#b;nwhd in ⊢ (??%%); nwhd in ⊢ (??(?(?%?))?);
    1498 nrewrite > (update_s block_contents …); //;
    1499 nqed.
    1500 
    1501 nlemma high_bound_free_same:
     1495#m #b whd in ⊢ (??%%); whd in ⊢ (??(?(?%?))?);
     1496>(update_s block_contents …) //;
     1497qed.
     1498
     1499lemma high_bound_free_same:
    15021500  ∀m,b. high_bound (free m b) b = 0.
    1503 #m;#b;nwhd in ⊢ (??%%); nwhd in ⊢ (??(?(?%?))?);
    1504 nrewrite > (update_s block_contents …); //;
    1505 nqed.
    1506 
    1507 nlemma class_free:
     1501#m #b whd in ⊢ (??%%); whd in ⊢ (??(?(?%?))?);
     1502>(update_s block_contents …) //;
     1503qed.
     1504
     1505lemma class_free:
    15081506  ∀m,bf,b. b ≠ bf → block_space (free m bf) b = block_space m b.
    1509 #m;#bf;#b;#H;nwhd in ⊢ (??%%); nwhd in ⊢ (??(?(?%?))?);
    1510 nrewrite > (update_o block_contents …); //; napply sym_neq; //;
    1511 nqed.
    1512 
    1513 nlemma valid_access_free_1:
     1507#m #bf #b #H whd in ⊢ (??%%); whd in ⊢ (??(?(?%?))?);
     1508>(update_o block_contents …) //; @sym_neq //;
     1509qed.
     1510
     1511lemma valid_access_free_1:
    15141512  ∀m,bf,chunk,psp,b,ofs.
    15151513  valid_access m chunk psp b ofs → b ≠ bf →
    15161514  valid_access (free m bf) chunk psp b ofs.
    1517 #m;#bf;#chunk;#psp b ofs;*;#Hval;#Hlo;#Hhi;#Hal;#Hcompat;#Hneq;
    1518 @; //;
    1519 ##[ napply valid_block_free_1; //
    1520 ##| nrewrite > (low_bound_free … Hneq); //
    1521 ##| nrewrite > (high_bound_free … Hneq); //
    1522 ##| nrewrite > (class_free … Hneq); //
    1523 ##] nqed.
    1524 
    1525 nlemma valid_access_free_2:
     1515#m #bf #chunk #psp #b #ofs *;#Hval #Hlo #Hhi #Hal #Hcompat #Hneq
     1516% //;
     1517[ @valid_block_free_1 //
     1518| >(low_bound_free … Hneq) //
     1519| >(high_bound_free … Hneq) //
     1520| >(class_free … Hneq) //
     1521] qed.
     1522
     1523lemma valid_access_free_2:
    15261524  ∀m,psp,bf,chunk,ofs. ¬(valid_access (free m bf) chunk psp bf ofs).
    1527 #m;#psp;#bf;#chunk;#ofs; napply nmk; *; #Hval;#Hlo;#Hhi;#Hal;#Hct;
    1528 nwhd in Hlo:(?%?);nwhd in Hlo:(?(?(?%?))?); nrewrite > (update_s block_contents …) in Hlo;
    1529 nwhd in Hhi:(??%);nwhd in Hhi:(??(?(?%?))); nrewrite > (update_s block_contents …) in Hhi;
    1530 nwhd in ⊢ ((??%)→(?%?)→?); (* arith *) napply daemon;
    1531 nqed.
     1525#m #psp #bf #chunk #ofs @nmk *; #Hval #Hlo #Hhi #Hal #Hct
     1526whd in Hlo:(?%?);whd in Hlo:(?(?(?%?))?); >(update_s block_contents …) in Hlo
     1527whd in Hhi:(??%);whd in Hhi:(??(?(?%?))); >(update_s block_contents …) in Hhi
     1528whd in ⊢ ((??%)→(?%?)→?); (* arith *) @daemon
     1529qed.
    15321530
    15331531(*
     
    15351533*)
    15361534
    1537 nlemma valid_access_free_inv:
     1535lemma valid_access_free_inv:
    15381536  ∀m,bf,chunk,psp,b,ofs.
    15391537  valid_access (free m bf) chunk psp b ofs →
    15401538  valid_access m chunk psp b ofs ∧ b ≠ bf.
    1541 #m;#bf;#chunk;#psp b ofs; nelim (decidable_eq_Z_Type b bf);
    1542 ##[ #e; nrewrite > e;
    1543     #H; napply False_ind; napply (absurd ? H (valid_access_free_2 …));
    1544 ##| #ne; *; nrewrite > (low_bound_free … ne);
    1545     nrewrite > (high_bound_free … ne);
    1546     nrewrite > (class_free … ne);
    1547     #Hval; #Hlo; #Hhi; #Hal; #Hct;
    1548     @; ##[ @; /2/; ##| /2/ ##]
    1549 ##] nqed.
    1550 
    1551 ntheorem load_free:
     1539#m #bf #chunk #psp #b #ofs elim (decidable_eq_Z_Type b bf);
     1540[ #e >e
     1541    #H @False_ind @(absurd ? H (valid_access_free_2 …))
     1542| #ne *; >(low_bound_free … ne)
     1543    >(high_bound_free … ne)
     1544    >(class_free … ne)
     1545    #Hval #Hlo #Hhi #Hal #Hct
     1546    % [ % /2/; | /2/ ]
     1547] qed.
     1548
     1549theorem load_free:
    15521550  ∀m,bf,chunk,psp,b,ofs.
    15531551  b ≠ bf →
    15541552  load chunk (free m bf) psp b ofs = load chunk m psp b ofs.
    1555 #m;#bf;#chunk;#psp b ofs;#ne; nwhd in ⊢ (??%%);
    1556 nelim (in_bounds m chunk psp b ofs);
    1557 ##[ #Hval; nwhd in ⊢ (???%); nrewrite > (in_bounds_true ????? (option val) ???);
    1558   ##[ nwhd in ⊢ (??(??(??(???(?(?%?)))))?); nrewrite > (update_o block_contents …); //;
    1559       napply sym_neq; //
    1560   ##| napply valid_access_free_1; //; napply ne;
    1561   ##]
    1562 ##| nelim (in_bounds (free m bf) chunk psp b ofs); (* XXX just // used to work *) ##[ ##2: nnormalize; //; ##]
    1563     #H;#H'; napply False_ind; napply (absurd ? ? H');
    1564     nelim (valid_access_free_inv …H); //;
    1565 ##] nqed.
     1553#m #bf #chunk #psp #b #ofs #ne whd in ⊢ (??%%);
     1554elim (in_bounds m chunk psp b ofs);
     1555[ #Hval whd in ⊢ (???%); >(in_bounds_true ????? (option val) ???)
     1556  [ whd in ⊢ (??(??(??(???(?(?%?)))))?); >(update_o block_contents …) //;
     1557      @sym_neq //
     1558  | @valid_access_free_1 //; @ne
     1559  ]
     1560| elim (in_bounds (free m bf) chunk psp b ofs); (* XXX just // used to work *) [ 2: normalize; //; ]
     1561    #H #H' @False_ind @(absurd ? ? H')
     1562    elim (valid_access_free_inv …H); //;
     1563] qed.
    15661564
    15671565(*
     
    15711569(* ** Properties related to [free_list] *)
    15721570
    1573 nlemma valid_block_free_list_1:
     1571lemma valid_block_free_list_1:
    15741572  ∀bl,m,b. valid_block m b → valid_block (free_list m bl) b.
    1575 #bl;nelim bl;
    1576 ##[ #m;#b;#H; nwhd in ⊢ (?%?); //
    1577 ##| #h;#t;#IH;#m;#b;#H; nrewrite > (unfold_free_list m h t);
    1578     napply valid_block_free_1; napply IH; //
    1579 ##] nqed.
    1580 
    1581 nlemma valid_block_free_list_2:
     1573#bl elim bl;
     1574[ #m #b #H whd in ⊢ (?%?); //
     1575| #h #t #IH #m #b #H >(unfold_free_list m h t)
     1576    @valid_block_free_1 @IH //
     1577] qed.
     1578
     1579lemma valid_block_free_list_2:
    15821580  ∀bl,m,b. valid_block (free_list m bl) b → valid_block m b.
    1583 #bl; nelim bl;
    1584 ##[ #m;#b;#H; nwhd in H:(?%?); //
    1585 ##| #h;#t;#IH;#m;#b; nrewrite > (unfold_free_list m h t);#H;
    1586     napply IH; napply valid_block_free_2; //
    1587 ##] nqed.
    1588 
    1589 nlemma valid_access_free_list:
     1581#bl elim bl;
     1582[ #m #b #H whd in H:(?%?); //
     1583| #h #t #IH #m #b >(unfold_free_list m h t) #H
     1584    @IH @valid_block_free_2 //
     1585] qed.
     1586
     1587lemma valid_access_free_list:
    15901588  ∀chunk,psp,b,ofs,m,bl.
    15911589  valid_access m chunk psp b ofs → ¬in_list ? b bl →
    15921590  valid_access (free_list m bl) chunk psp b ofs.
    1593 #chunk; #psp b ofs; #m; #bl; nelim bl;
    1594 ##[ nwhd in ⊢ (?→?→(?%????)); //
    1595 ##| #h;#t;#IH;#H;#notin; nrewrite > (unfold_free_list m h t); napply valid_access_free_1;
    1596     ##[ napply IH; //; napply (not_to_not ??? notin); #Ht; napply (in_list_cons … Ht)
    1597     ##| napply nmk; #e; napply (absurd ?? notin); nrewrite > e; // ##]
    1598 ##] nqed.
    1599 
    1600 nlemma valid_access_free_list_inv:
     1591#chunk #psp #b #ofs #m #bl elim bl;
     1592[ whd in ⊢ (?→?→(?%????)); //
     1593| #h #t #IH #H #notin >(unfold_free_list m h t) @valid_access_free_1
     1594    [ @IH //; @(not_to_not ??? notin) #Ht napply (in_list_cons … Ht)
     1595    | @nmk #e @(absurd ?? notin) >e // ]
     1596] qed.
     1597
     1598lemma valid_access_free_list_inv:
    16011599  ∀chunk,psp,b,ofs,m,bl.
    16021600  valid_access (free_list m bl) chunk psp b ofs →
    16031601  ¬in_list ? b bl ∧ valid_access m chunk psp b ofs.
    1604 #chunk; #psp b ofs; #m; #bl; nelim bl;
    1605 ##[ nwhd in ⊢ ((?%????)→?); #H; @; //
    1606 ##| #h;#t;#IH; nrewrite > (unfold_free_list m h t); #H;
    1607     nelim (valid_access_free_inv … H); #H';#ne;
    1608     nelim (IH H'); #notin;#H''; @; //;
    1609     napply (not_to_not ??? notin); #Ht;
    1610     (* WTF? this is specialised to nat! napply (in_list_tail t b h); *) napply daemon
    1611 ##] nqed.
     1602#chunk #psp #b #ofs #m #bl elim bl;
     1603[ whd in ⊢ ((?%????)→?); #H % //
     1604| #h #t #IH >(unfold_free_list m h t) #H
     1605    elim (valid_access_free_inv … H); #H' #ne
     1606    elim (IH H'); #notin #H'' % //;
     1607    @(not_to_not ??? notin) #Ht
     1608    (* WTF? this is specialised to nat! @(in_list_tail t b h) *) napply daemon
     1609] qed.
    16121610
    16131611(* ** Properties related to pointer validity *)
    16141612
    1615 nlemma valid_pointer_valid_access:
     1613lemma valid_pointer_valid_access:
    16161614  ∀m,psp,b,ofs.
    16171615  valid_pointer m psp b ofs = true ↔ valid_access m Mint8unsigned psp b ofs.
    1618 #m;#psp b ofs;nwhd in ⊢ (?(??%?)?); @;
    1619 ##[ #H;
    1620     nlapply (andb_true_l … H); #H';
    1621     nlapply (andb_true_l … H'); #H'';
    1622     nlapply (andb_true_l … H''); #H1;
    1623     nlapply (andb_true_r … H''); #H2;
    1624     nlapply (andb_true_r … H'); #H3;
    1625     nlapply (andb_true_r … H); #H4;
    1626     @;
    1627     ##[ nrewrite > (unfold_valid_block m b); napply (Zltb_true_to_Zlt … H1)
    1628     ##| napply (Zleb_true_to_Zle … H2)
    1629     ##| nwhd in ⊢ (?(??%)?); (* arith, Zleb_true_to_Zle *) napply daemon
    1630     ##| ncases ofs; /2/;
    1631     ##| nwhd in H4:(??%?); nelim (pointer_compat_dec (block_space m b) psp) in H4;
    1632         ##[ //; ##| #Hn e; nwhd in e:(??%%); ndestruct ##]
    1633     ##]
    1634 ##| *; #Hval;#Hlo;#Hhi;#Hal;#Hct;
    1635     nrewrite > (Zlt_to_Zltb_true … Hval);
    1636     nrewrite > (Zle_to_Zleb_true … Hlo);
    1637     nwhd in Hhi:(?(??%)?); nrewrite > (Zlt_to_Zltb_true … ?);
    1638     ##[ nwhd in ⊢ (??%?); nelim (pointer_compat_dec (block_space m b) psp);
    1639       ##[ //;
    1640       ##| #Hct'; napply False_ind; napply (absurd … Hct Hct');
    1641       ##]
    1642     ##| (* arith *) napply daemon
    1643     ##]
    1644 ##]
    1645  nqed.
    1646 
    1647 ntheorem valid_pointer_alloc:
     1616#m #psp #b #ofs whd in ⊢ (?(??%?)?); %
     1617[ #H
     1618    lapply (andb_true_l … H); #H'
     1619    lapply (andb_true_l … H'); #H''
     1620    lapply (andb_true_l … H''); #H1
     1621    lapply (andb_true_r … H''); #H2
     1622    lapply (andb_true_r … H'); #H3
     1623    lapply (andb_true_r … H); #H4
     1624    %
     1625    [ >(unfold_valid_block m b) napply (Zltb_true_to_Zlt … H1)
     1626    | napply (Zleb_true_to_Zle … H2)
     1627    | whd in ⊢ (?(??%)?); (* arith, Zleb_true_to_Zle *) napply daemon
     1628    | cases ofs; /2/;
     1629    | whd in H4:(??%?); elim (pointer_compat_dec (block_space m b) psp) in H4;
     1630        [ //; | #Hn #e whd in e:(??%%); destruct ]
     1631    ]
     1632| *; #Hval #Hlo #Hhi #Hal #Hct
     1633    >(Zlt_to_Zltb_true … Hval)
     1634    >(Zle_to_Zleb_true … Hlo)
     1635    whd in Hhi:(?(??%)?); >(Zlt_to_Zltb_true … ?)
     1636    [ whd in ⊢ (??%?); elim (pointer_compat_dec (block_space m b) psp);
     1637      [ //;
     1638      | #Hct' @False_ind @(absurd … Hct Hct')
     1639      ]
     1640    | (* arith *) napply daemon
     1641    ]
     1642]
     1643 qed.
     1644
     1645theorem valid_pointer_alloc:
    16481646  ∀m1,m2: mem. ∀lo,hi: Z. ∀bcl,psp. ∀b,b': block. ∀ofs: Z.
    16491647  alloc m1 lo hi bcl = 〈m2, b'〉 →
    16501648  valid_pointer m1 psp b ofs = true →
    16511649  valid_pointer m2 psp b ofs = true.
    1652 #m1;#m2;#lo;#hi;#bcl psp;#b;#b';#ofs;#ALLOC;#VALID;
    1653 nlapply ((proj1 ?? (valid_pointer_valid_access ????)) VALID); #Hval;
    1654 napply (proj2 ?? (valid_pointer_valid_access ????));
    1655 napply (valid_access_alloc_other … ALLOC … Hval);
    1656 nqed.
    1657 
    1658 ntheorem valid_pointer_store:
     1650#m1 #m2 #lo #hi #bcl #psp #b #b' #ofs #ALLOC #VALID
     1651lapply ((proj1 ?? (valid_pointer_valid_access ????)) VALID); #Hval
     1652@(proj2 ?? (valid_pointer_valid_access ????))
     1653@(valid_access_alloc_other … ALLOC … Hval)
     1654qed.
     1655
     1656theorem valid_pointer_store:
    16591657  ∀chunk: memory_chunk. ∀m1,m2: mem.
    16601658  ∀psp,psp': region. ∀b,b': block. ∀ofs,ofs': Z. ∀v: val.
    16611659  store chunk m1 psp' b' ofs' v = Some ? m2 →
    16621660  valid_pointer m1 psp b ofs = true → valid_pointer m2 psp b ofs = true.
    1663 #chunk;#m1;#m2;#psp psp';#b;#b';#ofs;#ofs';#v;#STORE;#VALID;
    1664 nlapply ((proj1 ?? (valid_pointer_valid_access ????)) VALID); #Hval;
    1665 napply (proj2 ?? (valid_pointer_valid_access ????));
    1666 napply (store_valid_access_1 … STORE … Hval);
    1667 nqed.
     1661#chunk #m1 #m2 #psp #psp' #b #b' #ofs #ofs' #v #STORE #VALID
     1662lapply ((proj1 ?? (valid_pointer_valid_access ????)) VALID); #Hval
     1663@(proj2 ?? (valid_pointer_valid_access ????))
     1664@(store_valid_access_1 … STORE … Hval)
     1665qed.
    16681666
    16691667(* * * Generic injections between memory states. *)
     
    16711669(* Section GENERIC_INJECT. *)
    16721670
    1673 ndefinition meminj : Type ≝ block → option (block × Z).
     1671definition meminj : Type[0] ≝ block → option (block × Z).
    16741672(*
    16751673Variable val_inj: meminj -> val -> val -> Prop.
     
    16791677*)
    16801678
    1681 ndefinition mem_inj ≝ λval_inj.λmi: meminj. λm1,m2: mem.
     1679definition mem_inj ≝ λval_inj.λmi: meminj. λm1,m2: mem.
    16821680  ∀chunk, b1, ofs, v1, b2, delta.
    16831681  mi b1 = Some ? 〈b2, delta〉 →
     
    16861684
    16871685(* FIXME: another nunfold hack*)
    1688 nlemma unfold_mem_inj : ∀val_inj.∀mi: meminj. ∀m1,m2: mem.
     1686lemma unfold_mem_inj : ∀val_inj.∀mi: meminj. ∀m1,m2: mem.
    16891687  (mem_inj val_inj mi m1 m2) =
    16901688  (∀chunk, b1, ofs, v1, b2, delta.
     
    16921690  load chunk m1 b1 ofs = Some ? v1 →
    16931691  ∃v2. load chunk m2 b2 (ofs + delta) = Some ? v2 ∧ val_inj mi v1 v2).
    1694 //; nqed.
    1695 
    1696 nlemma valid_access_inj: ∀val_inj.
     1692//; qed.
     1693
     1694lemma valid_access_inj: ∀val_inj.
    16971695  ∀mi,m1,m2,chunk,b1,ofs,b2,delta.
    16981696  mi b1 = Some ? 〈b2, delta〉 →
     
    17001698  valid_access m1 chunk b1 ofs →
    17011699  valid_access m2 chunk b2 (ofs + delta).
    1702 #val_inj;
    1703 #mi;#m1;#m2;#chunk;#b1;#ofs;#b2;#delta;#H;#Hinj;#Hval;
    1704 ncut (∃v1. load chunk m1 b1 ofs = Some ? v1);
    1705 ##[ /2/;
    1706 ##| *;#v1;#LOAD1;
    1707     nelim (Hinj … H LOAD1);#v2;*;#LOAD2;#VCP;
     1700#val_inj
     1701#mi #m1 #m2 #chunk #b1 #ofs #b2 #delta #H #Hinj #Hval
     1702cut (∃v1. load chunk m1 b1 ofs = Some ? v1);
     1703[ /2/;
     1704| *;#v1 #LOAD1
     1705    elim (Hinj … H LOAD1);#v2 *;#LOAD2 #VCP
    17081706    /2/
    1709 ##] nqed.
     1707] qed.
    17101708
    17111709(*Hint Resolve valid_access_inj: mem.*)
    17121710*)
    1713 (* FIXME: can't use ndestruct below *)
    1714 nlemma grumpydestruct : ∀A,v. None A = Some A v → False.
    1715 #A;#v;#H;ndestruct;
    1716 nqed.
     1711(* FIXME: can't use destruct below *)
     1712lemma grumpydestruct : ∀A,v. None A = Some A v → False.
     1713#A #v #H destruct;
     1714qed.
    17171715(*
    1718 nlemma store_unmapped_inj: ∀val_inj.
     1716lemma store_unmapped_inj: ∀val_inj.
    17191717  ∀mi,m1,m2,psp,b,ofs,v,chunk,m1'.
    17201718  mem_inj val_inj mi m1 m2 →
     
    17221720  store chunk m1 psp b ofs v = Some ? m1' →
    17231721  mem_inj val_inj mi m1' m2.
    1724 #val_inj;
    1725 #mi;#m1;#m2;#psp b ofs;#v;#chunk;#m1';#Hinj;#Hmi;#Hstore;
    1726 nwhd; #chunk0;#b1;#ofs0;#v1;#b2;#delta; #Hmi0; #Hload;
    1727 ncut (load chunk0 m1 b1 ofs0 = Some ? v1);
    1728 ##[ nrewrite < Hload; napply sym_eq; napply (load_store_other … Hstore);
    1729     @1;@1; napply nmk; #eq; nrewrite > eq in Hmi0; nrewrite > Hmi; #H; ndestruct;
    1730 ##| #Hload'; napply (Hinj … Hmi0 Hload');
    1731 ##] nqed.
    1732 
    1733 nlemma store_outside_inj: ∀val_inj.
     1722#val_inj
     1723#mi #m1 #m2 #psp #b #ofs #v #chunk #m1' #Hinj #Hmi #Hstore
     1724whd; #chunk0 #b1 #ofs0 #v1 #b2 #delta #Hmi0 #Hload
     1725cut (load chunk0 m1 b1 ofs0 = Some ? v1);
     1726[ <Hload @sym_eq @(load_store_other … Hstore)
     1727    %{1} %{1} @nmk #eq >eq in Hmi0 >Hmi #H destruct;
     1728| #Hload' @(Hinj … Hmi0 Hload')
     1729] qed.
     1730
     1731lemma store_outside_inj: ∀val_inj.
    17341732  ∀mi,m1,m2,chunk,psp,b,ofs,v,m2'.
    17351733  mem_inj val_inj mi m1 m2 →
     
    17401738  store chunk m2 psp b ofs v = Some ? m2' →
    17411739  mem_inj val_inj mi m1 m2'.
    1742 #val_inj;
    1743 #mi;#m1;#m2;#chunk;#psp b ofs;#v;#m2';#Hinj;#Hbounds;#Hstore;
    1744 nwhd; #chunk0;#b1;#ofs0;#v1;#b2;#delta; #Hmi0; #Hload;
    1745 nlapply (Hinj … Hmi0 Hload);*;#v2;*;#LOAD2;#VINJ;
    1746 @ v2;@;//;
    1747 nrewrite < LOAD2; napply (load_store_other … Hstore);
    1748 nelim (decidable_eq_Z b2 b);
    1749 ##[ #Heq; nrewrite > Heq in Hmi0 LOAD2; #Hmi0;#LOAD2;
    1750     nlapply (Hbounds … Hmi0); #Hb;
    1751     ncut (valid_access m1 chunk0 b1 ofs0); /2/;
    1752     #Hv; nelim Hv; #Hv1; #Hlo1; #Hhi1; #Hal1;
    1753     nelim Hb; #Hb; ##[ @1;@2;(* arith *) napply daemon ##| @2;(* arith *) napply daemon ##]
    1754 ##| #ineq; @1; @1; napply ineq;
    1755 ##] nqed.
     1740#val_inj
     1741#mi #m1 #m2 #chunk #psp #b #ofs #v #m2' #Hinj #Hbounds #Hstore
     1742whd; #chunk0 #b1 #ofs0 #v1 #b2 #delta #Hmi0 #Hload
     1743lapply (Hinj … Hmi0 Hload);*;#v2 *;#LOAD2 #VINJ
     1744%{ v2} % //;
     1745<LOAD2 @(load_store_other … Hstore)
     1746elim (decidable_eq_Z b2 b);
     1747[ #Heq >Heq in Hmi0 LOAD2 #Hmi0 #LOAD2
     1748    lapply (Hbounds … Hmi0); #Hb
     1749    cut (valid_access m1 chunk0 b1 ofs0); /2/;
     1750    #Hv elim Hv; #Hv1 #Hlo1 #Hhi1 #Hal1
     1751    elim Hb; #Hb [ %{1} %{2} (* arith *) napply daemon | %{2} (* arith *) napply daemon ]
     1752| #ineq %{1} %{1} @ineq
     1753] qed.
    17561754
    17571755(* XXX: use Or rather than ∨ to bring resource usage under control. *)
    1758 ndefinition meminj_no_overlap ≝ λmi: meminj. λm: mem.
     1756definition meminj_no_overlap ≝ λmi: meminj. λm: mem.
    17591757  ∀b1,b1',delta1,b2,b2',delta2.
    17601758  b1 ≠ b2 →
     
    17681766*)
    17691767(* FIXME *)
    1770 nlemma grumpydestruct1 : ∀A,x1,x2. Some A x1 = Some A x2 → x1 = x2.
    1771 #A;#x1;#x2;#H;ndestruct;//;
    1772 nqed.
    1773 nlemma grumpydestruct2 : ∀A,B,x1,y1,x2,y2. Some (A×B) 〈x1,y1〉 = Some (A×B) 〈x2,y2〉 → x1 = x2 ∧ y1 = y2.
    1774 #A;#B;#x1;#y1;#x2;#y2;#H;ndestruct;/2/;
    1775 nqed.
     1768lemma grumpydestruct1 : ∀A,x1,x2. Some A x1 = Some A x2 → x1 = x2.
     1769#A #x1 #x2 #H destruct;//;
     1770qed.
     1771lemma grumpydestruct2 : ∀A,B,x1,y1,x2,y2. Some (A×B) 〈x1,y1〉 = Some (A×B) 〈x2,y2〉 → x1 = x2 ∧ y1 = y2.
     1772#A #B #x1 #y1 #x2 #y2 #H destruct;/2/;
     1773qed.
    17761774(*
    1777 nlemma store_mapped_inj: ∀val_inj.∀val_inj_undef:∀mi. val_inj mi Vundef Vundef.
     1775lemma store_mapped_inj: ∀val_inj.∀val_inj_undef:∀mi. val_inj mi Vundef Vundef.
    17781776  ∀mi,m1,m2,b1,ofs,b2,delta,v1,v2,chunk,m1'.
    17791777  mem_inj val_inj mi m1 m2 →
     
    17851783  ∃m2'.
    17861784  store chunk m2 b2 (ofs + delta) v2 = Some ? m2' ∧ mem_inj val_inj mi m1' m2'.
    1787 #val_inj;#val_inj_undef;
    1788 #mi;#m1;#m2;#b1;#ofs;#b2;#delta;#v1;#v2;#chunk;#m1';
    1789 #Hinj;#Hnoover;#Hb1;#STORE;#Hvalinj;
    1790 ncut (∃m2'.store chunk m2 b2 (ofs + delta) v2 = Some ? m2');
    1791 ##[ napply valid_access_store; napply (valid_access_inj ? mi ??????? Hb1 Hinj ?); (* XXX why do I have to give mi here? *) /2/
    1792 ##| *;#m2';#STORE2;
    1793     @ m2'; @; //;
    1794     nwhd; #chunk';#b1';#ofs';#v;#b2';#delta';#CP;#LOAD1;
    1795     ncut (valid_access m1 chunk' b1' ofs');
    1796     ##[ napply (store_valid_access_2 … STORE); napply (load_valid_access … LOAD1);
    1797     ##| #Hval;
    1798         nlapply (load_store_characterization … STORE … Hval);
    1799         nelim (load_store_classification chunk b1 ofs chunk' b1' ofs');
    1800         ##[ #e;#e0;#e1;#H; (* similar *)
    1801             nrewrite > e in Hb1; #Hb1;
    1802             nrewrite > CP in Hb1; #Hb1; (* XXX ndestruct expands proof state too much;*)
    1803             nelim (grumpydestruct2 ?????? Hb1);
    1804             #e2;#e3; nrewrite < e0; nrewrite > e2; nrewrite > e3;
    1805             @ (load_result chunk' v2);@;
    1806             ##[ napply (load_store_similar … STORE2); //
    1807             ##| nrewrite > LOAD1 in H; #H; nwhd in H:(??%%); ndestruct;
    1808                 napply Hvalinj; //;
    1809             ##]
    1810          ##| #Hdis; #H; (* disjoint *)
    1811              nrewrite > LOAD1 in H; #H;
    1812              nlapply (Hinj … CP ?); ##[ napply sym_eq; napply H; ##| ##*: ##]
    1813              *;#v2';*;#LOAD2;#VCP;
    1814              @ v2'; @; //;
    1815              nrewrite < LOAD2; napply (load_store_other … STORE2);
    1816              nelim (decidable_eq_Z b1 b1'); #eb1;
    1817              ##[ nrewrite < eb1 in CP; #CP; nrewrite > CP in Hb1; #eb2d;
    1818                  nelim (grumpydestruct2 ?????? eb2d); #eb2; #ed;
    1819                  nelim Hdis; ##[ #Hdis; nelim Hdis;
    1820                                ##[ #eb1'; napply False_ind; napply (absurd ? eb1 eb1');
    1821                                ##| #Hdis;@1;@2;(* arith *) napply daemon
    1822                                ##] ##| #Hdis;@2;(* arith *) napply daemon ##]
    1823              ##| ncut (valid_access m1 chunk b1 ofs); /2/; #Hval';
    1824                  nlapply (Hnoover … eb1 Hb1 CP);
    1825                  #Ha; nelim Ha; #Ha;
    1826                  ##[ nelim Ha; #Ha;
    1827                  ##[ nelim Ha; #Ha;
    1828                  ##[ @1;@1;/2/
    1829                  ##| nelim Hval'; nlapply (size_chunk_pos chunk); (* arith *) napply daemon ##]
    1830                  ##| nelim Hval; nlapply (size_chunk_pos chunk'); (* arith *) napply daemon ##]
    1831                  ##| nelim Hval'; nelim Hval;  (* arith *) napply daemon ##]
    1832              ##]
    1833          ##| #eb1;#Hofs1;#Hofs2;#Hofs3;#H; (* overlapping *)
    1834              nrewrite < eb1 in CP; #CP; nrewrite > CP in Hb1; #eb2d;
    1835              nelim (grumpydestruct2 ?????? eb2d); #eb2; #ed;
    1836              ncut (∃v2'. load chunk' m2' b2 (ofs' + delta) = Some ? v2');
    1837              ##[ napply valid_access_load; napply (store_valid_access_1 … STORE2); napply (valid_access_inj … Hinj Hval); nrewrite > eb1; //
    1838              ##| *;#v2';#LOAD2';
    1839                  ncut (v2' = Vundef); ##[ napply (load_store_overlap … STORE2 … LOAD2'); (* arith *) napply daemon ##| ##]
    1840                  #ev2'; @ v2'; @;//;
    1841                  nrewrite > LOAD1 in H;#H; nwhd in H:(??%%); nrewrite > (grumpydestruct1 … H);
    1842                  nrewrite > ev2';
    1843                  napply val_inj_undef; ##]
    1844          ##| #eb1;#Hofs;nrewrite < Hofs in Hval LOAD1 ⊢ %;#Hval;#LOAD1;#Hsize;#H; (* overlapping *)
     1785#val_inj #val_inj_undef
     1786#mi #m1 #m2 #b1 #ofs #b2 #delta #v1 #v2 #chunk #m1'
     1787#Hinj #Hnoover #Hb1 #STORE #Hvalinj
     1788cut (∃m2'.store chunk m2 b2 (ofs + delta) v2 = Some ? m2');
     1789[ @valid_access_store @(valid_access_inj ? mi ??????? Hb1 Hinj ?) (* XXX why do I have to give mi here? *) /2/
     1790| *;#m2' #STORE2
     1791    %{ m2'} % //;
     1792    whd; #chunk' #b1' #ofs' #v #b2' #delta' #CP #LOAD1
     1793    cut (valid_access m1 chunk' b1' ofs');
     1794    [ @(store_valid_access_2 … STORE) @(load_valid_access … LOAD1)
     1795    | #Hval
     1796        lapply (load_store_characterization … STORE … Hval);
     1797        elim (load_store_classification chunk b1 ofs chunk' b1' ofs');
     1798        [ #e #e0 #e1 #H (* similar *)
     1799            >e in Hb1 #Hb1
     1800            >CP in Hb1 #Hb1 (* XXX destruct expands proof state too much;*)
     1801            elim (grumpydestruct2 ?????? Hb1);
     1802            #e2 #e3 <e0 >e2 >e3
     1803            %{ (load_result chunk' v2)} %
     1804            [ @(load_store_similar … STORE2) //
     1805            | >LOAD1 in H #H whd in H:(??%%); destruct;
     1806                @Hvalinj //;
     1807            ]
     1808         | #Hdis #H (* disjoint *)
     1809             >LOAD1 in H #H
     1810             lapply (Hinj … CP ?); [ @sym_eq @H | *: ]
     1811             *;#v2' *;#LOAD2 #VCP
     1812             %{ v2'} % //;
     1813             <LOAD2 @(load_store_other … STORE2)
     1814             elim (decidable_eq_Z b1 b1'); #eb1
     1815             [ <eb1 in CP #CP >CP in Hb1 #eb2d
     1816                 elim (grumpydestruct2 ?????? eb2d); #eb2 #ed
     1817                 elim Hdis; [ #Hdis elim Hdis;
     1818                               [ #eb1' @False_ind @(absurd ? eb1 eb1')
     1819                               | #Hdis %{1} %{2} (* arith *) napply daemon
     1820                               ] | #Hdis %{2} (* arith *) napply daemon ]
     1821             | cut (valid_access m1 chunk b1 ofs); /2/; #Hval'
     1822                 lapply (Hnoover … eb1 Hb1 CP);
     1823                 #Ha elim Ha; #Ha
     1824                 [ elim Ha; #Ha
     1825                 [ elim Ha; #Ha
     1826                 [ %{1} %{1} /2/
     1827                 | elim Hval'; lapply (size_chunk_pos chunk); (* arith *) napply daemon ]
     1828                 | elim Hval; lapply (size_chunk_pos chunk'); (* arith *) napply daemon ]
     1829                 | elim Hval'; elim Hval;  (* arith *) napply daemon ]
     1830             ]
     1831         | #eb1 #Hofs1 #Hofs2 #Hofs3 #H (* overlapping *)
     1832             <eb1 in CP #CP >CP in Hb1 #eb2d
     1833             elim (grumpydestruct2 ?????? eb2d); #eb2 #ed
     1834             cut (∃v2'. load chunk' m2' b2 (ofs' + delta) = Some ? v2');
     1835             [ @valid_access_load @(store_valid_access_1 … STORE2) @(valid_access_inj … Hinj Hval) >eb1 //
     1836             | *;#v2' #LOAD2'
     1837                 cut (v2' = Vundef); [ @(load_store_overlap … STORE2 … LOAD2') (* arith *) napply daemon | ]
     1838                 #ev2' %{ v2'} % //;
     1839                 >LOAD1 in H #H whd in H:(??%%); >(grumpydestruct1 … H)
     1840                 >ev2'
     1841                 @val_inj_undef ]
     1842         | #eb1 #Hofs <Hofs in Hval LOAD1 ⊢ % #Hval #LOAD1 #Hsize #H (* overlapping *)
    18451843             
    1846              nrewrite < eb1 in CP; #CP; nrewrite > CP in Hb1; #eb2d;
    1847              nelim (grumpydestruct2 ?????? eb2d); #eb2; #ed;
    1848              ncut (∃v2'. load chunk' m2' b2 (ofs + delta) = Some ? v2');
    1849              ##[ napply valid_access_load; napply (store_valid_access_1 … STORE2); napply (valid_access_inj … Hinj Hval); nrewrite > eb1; //
    1850              ##| *;#v2';#LOAD2';
    1851                  ncut (v2' = Vundef); ##[ napply (load_store_mismatch … STORE2 … LOAD2' ?); napply sym_neq;// ##| ##]
    1852                  #ev2'; @ v2'; @;//;
    1853                  nrewrite > LOAD1 in H;#H; nwhd in H:(??%%); nrewrite > (grumpydestruct1 … H);
    1854                  nrewrite > ev2';
    1855                  napply val_inj_undef; ##]
    1856          ##]
    1857      ##]
    1858 ##] nqed.
    1859 
    1860 ndefinition inj_offset_aligned ≝ λdelta: Z. λsize: Z.
     1844             <eb1 in CP #CP >CP in Hb1 #eb2d
     1845             elim (grumpydestruct2 ?????? eb2d); #eb2 #ed
     1846             cut (∃v2'. load chunk' m2' b2 (ofs + delta) = Some ? v2');
     1847             [ @valid_access_load @(store_valid_access_1 … STORE2) @(valid_access_inj … Hinj Hval) >eb1 //
     1848             | *;#v2' #LOAD2'
     1849                 cut (v2' = Vundef); [ @(load_store_mismatch … STORE2 … LOAD2' ?) @sym_neq // | ]
     1850                 #ev2' %{ v2'} % //;
     1851                 >LOAD1 in H #H whd in H:(??%%); >(grumpydestruct1 … H)
     1852                 >ev2'
     1853                 @val_inj_undef ]
     1854         ]
     1855     ]
     1856] qed.
     1857
     1858definition inj_offset_aligned ≝ λdelta: Z. λsize: Z.
    18611859  ∀chunk. size_chunk chunk ≤ size → (align_chunk chunk ∣ delta).
    18621860
    1863 nlemma alloc_parallel_inj: ∀val_inj.∀val_inj_undef:∀mi. val_inj mi Vundef Vundef.
     1861lemma alloc_parallel_inj: ∀val_inj.∀val_inj_undef:∀mi. val_inj mi Vundef Vundef.
    18641862  ∀mi,m1,m2,lo1,hi1,m1',b1,lo2,hi2,m2',b2,delta.
    18651863  mem_inj val_inj mi m1 m2 →
     
    18701868  inj_offset_aligned delta (hi1 - lo1) →
    18711869  mem_inj val_inj mi m1' m2'.
    1872 #val_inj;#val_inj_undef;
    1873 #mi;#m1;#m2;#lo1;#hi1;#m1';#b1;#lo2;#hi2;#m2';#b2;#delta;
    1874 #Hinj;#ALLOC1;#ALLOC2;#Hbinj;#Hlo;#Hhi;#Hal;
    1875 nwhd; #chunk;#b1';#ofs;#v;#b2';#delta';#Hbinj';#LOAD;
    1876 nlapply (valid_access_alloc_inv … m1 … ALLOC1 chunk b1' ofs ?); /2/;
     1870#val_inj #val_inj_undef
     1871#mi #m1 #m2 #lo1 #hi1 #m1' #b1 #lo2 #hi2 #m2' #b2 #delta
     1872#Hinj #ALLOC1 #ALLOC2 #Hbinj #Hlo #Hhi #Hal
     1873whd; #chunk #b1' #ofs #v #b2' #delta' #Hbinj' #LOAD
     1874lapply (valid_access_alloc_inv … m1 … ALLOC1 chunk b1' ofs ?); /2/;
    18771875*;
    1878 ##[ #A;
    1879     ncut (load chunk m1 b1' ofs = Some ? v);
    1880     ##[ nrewrite < LOAD; napply sym_eq; napply (load_alloc_unchanged … ALLOC1); /2/; ##]
    1881     #LOAD0; nlapply (Hinj … Hbinj' LOAD0); *;#v2;*;#LOAD2;#VINJ;
    1882     @ v2; @;
    1883     ##[ nrewrite < LOAD2; napply (load_alloc_unchanged … ALLOC2);
    1884         napply valid_access_valid_block; ##[ ##3: napply load_valid_access; ##]
     1876[ #A
     1877    cut (load chunk m1 b1' ofs = Some ? v);
     1878    [ <LOAD @sym_eq @(load_alloc_unchanged … ALLOC1) /2/; ]
     1879    #LOAD0 lapply (Hinj … Hbinj' LOAD0); *;#v2 *;#LOAD2 #VINJ
     1880    %{ v2} %
     1881    [ <LOAD2 @(load_alloc_unchanged … ALLOC2)
     1882        @valid_access_valid_block [ 3: @load_valid_access ]
    18851883        //
    1886     ##| //
    1887     ##]
    1888 ##| *;*;#A;#B;#C;
    1889     nrewrite > A in Hbinj' LOAD; #Hbinj';#LOAD;
    1890     nrewrite > Hbinj in Hbinj'; #Hbinj'; nelim (grumpydestruct2 ?????? Hbinj');
    1891     #eb2;#edelta; nrewrite < eb2; nrewrite < edelta;
    1892     ncut (v = Vundef); ##[ napply (load_alloc_same … ALLOC1 … LOAD); ##]
    1893     #ev; nrewrite > ev;
    1894     ncut (∃v2. load chunk m2' b2 (ofs + delta) = Some ? v2);
    1895     ##[ napply valid_access_load;
    1896         napply (valid_access_alloc_same … ALLOC2);
    1897         ##[ ##1,2: (*arith*) napply daemon;
    1898         ##| (* arith using Hal *) napply daemon
    1899         ##] ##]
    1900     *;#v2;#LOAD2;
    1901     ncut (v2 = Vundef); ##[ napply (load_alloc_same … ALLOC2 … LOAD2) ##]
    1902     #ev2; nrewrite > ev2;
    1903     @ Vundef; @; //;
    1904 ##] nqed.
    1905 
    1906 nlemma alloc_right_inj: ∀val_inj.
     1884    | //
     1885    ]
     1886| *;*;#A #B #C
     1887    >A in Hbinj' LOAD #Hbinj' #LOAD
     1888    >Hbinj in Hbinj' #Hbinj' elim (grumpydestruct2 ?????? Hbinj');
     1889    #eb2 #edelta <eb2 <edelta
     1890    cut (v = Vundef); [ @(load_alloc_same … ALLOC1 … LOAD) ]
     1891    #ev >ev
     1892    cut (∃v2. load chunk m2' b2 (ofs + delta) = Some ? v2);
     1893    [ @valid_access_load
     1894        @(valid_access_alloc_same … ALLOC2)
     1895        [ 1,2: (*arith*) @daemon
     1896        | (* arith using Hal *) napply daemon
     1897        ] ]
     1898    *;#v2 #LOAD2
     1899    cut (v2 = Vundef); [ napply (load_alloc_same … ALLOC2 … LOAD2) ]
     1900    #ev2 >ev2
     1901    %{ Vundef} % //;
     1902] qed.
     1903
     1904lemma alloc_right_inj: ∀val_inj.
    19071905  ∀mi,m1,m2,lo,hi,b2,m2'.
    19081906  mem_inj val_inj mi m1 m2 →
    19091907  alloc m2 lo hi = 〈m2', b2〉 →
    19101908  mem_inj val_inj mi m1 m2'.
    1911 #val_inj;
    1912 #mi;#m1;#m2;#lo;#hi;#b2;#m2';
    1913 #Hinj;#ALLOC;
    1914 nwhd; #chunk; #b1; #ofs; #v1; #b2'; #delta; #Hbinj; #LOAD;
    1915 nlapply (Hinj … Hbinj LOAD); *; #v2;*;#LOAD2;#VINJ;
    1916 @ v2; @; //;
    1917 ncut (valid_block m2 b2');
    1918   ##[ napply (valid_access_valid_block ? chunk ? (ofs + delta)); /2/ ##]
    1919 #Hval;
    1920 nrewrite < LOAD2; napply (load_alloc_unchanged … ALLOC … Hval);
    1921 nqed.
     1909#val_inj
     1910#mi #m1 #m2 #lo #hi #b2 #m2'
     1911#Hinj #ALLOC
     1912whd; #chunk #b1 #ofs #v1 #b2' #delta #Hbinj #LOAD
     1913lapply (Hinj … Hbinj LOAD); *; #v2 *;#LOAD2 #VINJ
     1914%{ v2} % //;
     1915cut (valid_block m2 b2');
     1916  [ @(valid_access_valid_block ? chunk ? (ofs + delta)) /2/ ]
     1917#Hval
     1918<LOAD2 @(load_alloc_unchanged … ALLOC … Hval)
     1919qed.
    19221920
    19231921(*
     
    19261924*)
    19271925
    1928 nlemma alloc_left_unmapped_inj: ∀val_inj.
     1926lemma alloc_left_unmapped_inj: ∀val_inj.
    19291927  ∀mi,m1,m2,lo,hi,b1,m1'.
    19301928  mem_inj val_inj mi m1 m2 →
     
    19321930  mi b1 = None ? →
    19331931  mem_inj val_inj mi m1' m2.
    1934 #val_inj;
    1935 #mi;#m1;#m2;#lo;#hi;#b1;#m1';
    1936 #Hinj;#ALLOC;#Hbinj;
    1937 nwhd;  #chunk; #b1'; #ofs; #v1; #b2'; #delta; #Hbinj'; #LOAD;
    1938 nlapply (valid_access_alloc_inv … m1 … ALLOC chunk b1' ofs ?); /2/;
     1932#val_inj
     1933#mi #m1 #m2 #lo #hi #b1 #m1'
     1934#Hinj #ALLOC #Hbinj
     1935whd;  #chunk #b1' #ofs #v1 #b2' #delta #Hbinj' #LOAD
     1936lapply (valid_access_alloc_inv … m1 … ALLOC chunk b1' ofs ?); /2/;
    19391937*;
    1940 ##[ #A;
    1941   napply (Hinj … Hbinj' );
    1942   nrewrite < LOAD; napply sym_eq; napply (load_alloc_unchanged … ALLOC); /2/;
    1943 ##| *;*;#A;#B;#C;
    1944   nrewrite > A in Hbinj' LOAD; #Hbinj'; #LOAD;
    1945   nrewrite > Hbinj in Hbinj'; #bad; ndestruct;
    1946 ##] nqed.
    1947 
    1948 nlemma alloc_left_mapped_inj: ∀val_inj.∀val_inj_undef_any:∀mi,v. val_inj mi Vundef v.
     1938[ #A
     1939  @(Hinj … Hbinj' )
     1940  <LOAD @sym_eq @(load_alloc_unchanged … ALLOC) /2/;
     1941| *;*;#A #B #C
     1942  >A in Hbinj' LOAD #Hbinj' #LOAD
     1943  >Hbinj in Hbinj' #bad destruct;
     1944] qed.
     1945
     1946lemma alloc_left_mapped_inj: ∀val_inj.∀val_inj_undef_any:∀mi,v. val_inj mi Vundef v.
    19491947  ∀mi,m1,m2,lo,hi,b1,m1',b2,delta.
    19501948  mem_inj val_inj mi m1 m2 →
     
    19551953  inj_offset_aligned delta (hi - lo) →
    19561954  mem_inj val_inj mi m1' m2.
    1957 #val_inj;#val_inj_undef_any;
    1958 #mi;#m1;#m2;#lo;#hi;#b1;#m1';#b2;#delta;
    1959 #Hinj;#ALLOC;#Hbinj;#Hval;#Hlo;#Hhi;#Hal;
    1960 nwhd; #chunk; #b1'; #ofs; #v1; #b2'; #delta'; #Hbinj'; #LOAD;
    1961 nlapply (valid_access_alloc_inv … m1 … ALLOC chunk b1' ofs ?); /2/;
     1955#val_inj #val_inj_undef_any
     1956#mi #m1 #m2 #lo #hi #b1 #m1' #b2 #delta
     1957#Hinj #ALLOC #Hbinj #Hval #Hlo #Hhi #Hal
     1958whd; #chunk #b1' #ofs #v1 #b2' #delta' #Hbinj' #LOAD
     1959lapply (valid_access_alloc_inv … m1 … ALLOC chunk b1' ofs ?); /2/;
    19621960*;
    1963 ##[ #A;
    1964     napply (Hinj … Hbinj');
    1965     nrewrite < LOAD; napply sym_eq; napply (load_alloc_unchanged … ALLOC); /2/;
    1966 ##| *;*;#A;#B;*;#C;#D;
    1967     nrewrite > A in Hbinj' LOAD; #Hbinj'; #LOAD; nrewrite > Hbinj in Hbinj';
    1968     #Hbinj'; (* XXX ndestruct normalizes too much here *) nelim (grumpydestruct2 ?????? Hbinj'); #eb2; #edelta;
    1969     nrewrite < eb2; nrewrite < edelta;
    1970     ncut (v1 = Vundef); ##[ napply (load_alloc_same … ALLOC … LOAD) ##]
    1971     #ev1; nrewrite > ev1;
    1972     ncut (∃v2. load chunk m2 b2 (ofs + delta) = Some ? v2);
    1973     ##[ napply valid_access_load; @; //;
    1974       ##[ (* arith *) napply daemon
    1975       ##| (* arith *) napply daemon
    1976       ##| (* arith *) napply daemon
    1977       ##]
    1978     ##]
    1979     *;#v2;#LOAD2; @ v2; @; //;
    1980 ##] nqed.
    1981 
    1982 nlemma free_parallel_inj: ∀val_inj.
     1961[ #A
     1962    @(Hinj … Hbinj')
     1963    <LOAD @sym_eq @(load_alloc_unchanged … ALLOC) /2/;
     1964| *;*;#A #B *;#C #D
     1965    >A in Hbinj' LOAD #Hbinj' #LOAD >Hbinj in Hbinj'
     1966    #Hbinj' (* XXX destruct normalizes too much here *) elim (grumpydestruct2 ?????? Hbinj'); #eb2 #edelta
     1967    <eb2 <edelta
     1968    cut (v1 = Vundef); [ napply (load_alloc_same … ALLOC … LOAD) ]
     1969    #ev1 >ev1
     1970    cut (∃v2. load chunk m2 b2 (ofs + delta) = Some ? v2);
     1971    [ @valid_access_load % //;
     1972      [ (* arith *) napply daemon
     1973      | (* arith *) napply daemon
     1974      | (* arith *) napply daemon
     1975      ]
     1976    ]
     1977    *;#v2 #LOAD2 %{ v2} % //;
     1978] qed.
     1979
     1980lemma free_parallel_inj: ∀val_inj.
    19831981  ∀mi,m1,m2,b1,b2,delta.
    19841982  mem_inj val_inj mi m1 m2 →
     
    19861984  (∀b,delta'. mi b = Some ? 〈b2, delta'〉 → b = b1) →
    19871985  mem_inj val_inj mi (free m1 b1) (free m2 b2).
    1988 #val_inj;
    1989 #mi;#m1;#m2;#b1;#b2;#delta; #Hinj;#Hb1inj;#Hbinj;
    1990 nwhd; #chunk; #b1'; #ofs; #v1; #b2'; #delta'; #Hbinj'; #LOAD;
    1991 nlapply (valid_access_free_inv … (load_valid_access … LOAD)); *; #A;#B;
    1992 ncut (load chunk m1 b1' ofs = Some ? v1);
    1993 ##[ nrewrite < LOAD; napply sym_eq; napply load_free; napply B ##] #LOAD';
    1994 nelim (Hinj … Hbinj' LOAD'); #v2;*;#LOAD2;#INJ;
    1995 @ v2;@;
    1996 ##[ nrewrite < LOAD2; napply load_free;
    1997     napply nmk; #e; napply (absurd ?? B);
    1998     nrewrite > e in Hbinj'; #Hbinj'; napply (Hbinj ?? Hbinj');
    1999 ##| //
    2000 ##] nqed.
    2001 
    2002 nlemma free_left_inj: ∀val_inj.
     1986#val_inj
     1987#mi #m1 #m2 #b1 #b2 #delta #Hinj #Hb1inj #Hbinj
     1988whd; #chunk #b1' #ofs #v1 #b2' #delta' #Hbinj' #LOAD
     1989lapply (valid_access_free_inv … (load_valid_access … LOAD)); *; #A #B
     1990cut (load chunk m1 b1' ofs = Some ? v1);
     1991[ <LOAD @sym_eq @load_free @B ] #LOAD'
     1992elim (Hinj … Hbinj' LOAD'); #v2 *;#LOAD2 #INJ
     1993%{ v2} %
     1994[ <LOAD2 @load_free
     1995    @nmk #e @(absurd ?? B)
     1996    >e in Hbinj' #Hbinj' @(Hbinj ?? Hbinj')
     1997| //
     1998] qed.
     1999
     2000lemma free_left_inj: ∀val_inj.
    20032001  ∀mi,m1,m2,b1.
    20042002  mem_inj val_inj mi m1 m2 →
    20052003  mem_inj val_inj mi (free m1 b1) m2.
    2006 #val_inj;#mi;#m1;#m2;#b1;#Hinj;
    2007 nwhd; #chunk; #b1'; #ofs; #v1; #b2'; #delta'; #Hbinj'; #LOAD;
    2008 nlapply (valid_access_free_inv … (load_valid_access … LOAD)); *; #A;#B;
    2009 napply (Hinj … Hbinj');
    2010 nrewrite < LOAD; napply sym_eq; napply load_free; napply B;
    2011 nqed.
    2012 
    2013 nlemma free_list_left_inj: ∀val_inj.
     2004#val_inj #mi #m1 #m2 #b1 #Hinj
     2005whd; #chunk #b1' #ofs #v1 #b2' #delta' #Hbinj' #LOAD
     2006lapply (valid_access_free_inv … (load_valid_access … LOAD)); *; #A #B
     2007@(Hinj … Hbinj')
     2008<LOAD @sym_eq @load_free @B
     2009qed.
     2010
     2011lemma free_list_left_inj: ∀val_inj.
    20142012  ∀mi,bl,m1,m2.
    20152013  mem_inj val_inj mi m1 m2 →
    20162014  mem_inj val_inj mi (free_list m1 bl) m2.
    2017 #val_inj;#mi;#bl;nelim bl;
    2018 ##[ nwhd in ⊢ (?→?→?→???%?); //
    2019 ##| #h;#t;#IH; #m1;#m2;#H; nrewrite > (unfold_free_list m1 h t);
    2020     napply free_left_inj; napply IH; //
    2021 ##] nqed.
    2022 
    2023 nlemma free_right_inj: ∀val_inj.
     2015#val_inj #mi #bl elim bl;
     2016[ whd in ⊢ (?→?→?→???%?); //
     2017| #h #t #IH #m1 #m2 #H >(unfold_free_list m1 h t)
     2018    @free_left_inj @IH //
     2019] qed.
     2020
     2021lemma free_right_inj: ∀val_inj.
    20242022  ∀mi,m1,m2,b2.
    20252023  mem_inj val_inj mi m1 m2 →
     
    20272025   mi b1 = Some ? 〈b2, delta〉 → ¬(valid_access m1 chunk b1 ofs)) →
    20282026  mem_inj val_inj mi m1 (free m2 b2).
    2029 #val_inj;#mi;#m1;#m2;#b2; #Hinj; #Hinval;
    2030 nwhd; #chunk; #b1'; #ofs; #v1; #b2'; #delta'; #Hbinj'; #LOAD;
    2031 ncut (b2' ≠ b2);
    2032 ##[ napply nmk; #e; nrewrite > e in Hbinj'; #Hbinj';
    2033     napply (absurd ?? (Hinval … Hbinj')); napply (load_valid_access … LOAD); ##]
    2034 #ne; nlapply (Hinj … Hbinj' LOAD); *;#v2;*;#LOAD2;#INJ;
    2035 @ v2; @; //;
    2036 nrewrite < LOAD2; napply load_free; napply ne;
    2037 nqed.
    2038 
    2039 nlemma valid_pointer_inj: ∀val_inj.
     2027#val_inj #mi #m1 #m2 #b2 #Hinj #Hinval
     2028whd; #chunk #b1' #ofs #v1 #b2' #delta' #Hbinj' #LOAD
     2029cut (b2' ≠ b2);
     2030[ @nmk #e >e in Hbinj' #Hbinj'
     2031    @(absurd ?? (Hinval … Hbinj')) @(load_valid_access … LOAD) ]
     2032#ne lapply (Hinj … Hbinj' LOAD); *;#v2 *;#LOAD2 #INJ
     2033%{ v2} % //;
     2034<LOAD2 @load_free @ne
     2035qed.
     2036
     2037lemma valid_pointer_inj: ∀val_inj.
    20402038  ∀mi,m1,m2,b1,ofs,b2,delta.
    20412039  mi b1 = Some ? 〈b2, delta〉 →
     
    20432041  valid_pointer m1 b1 ofs = true →
    20442042  valid_pointer m2 b2 (ofs + delta) = true.
    2045 #val_inj;#mi;#m1;#m2;#b1;#ofs;#b2;#delta;#Hbinj;#Hinj;#VALID;
    2046 nlapply ((proj1 ?? (valid_pointer_valid_access ???)) VALID); #Hval;
    2047 napply (proj2 ?? (valid_pointer_valid_access ???));
    2048 napply (valid_access_inj … Hval); //;
    2049 nqed.
     2043#val_inj #mi #m1 #m2 #b1 #ofs #b2 #delta #Hbinj #Hinj #VALID
     2044lapply ((proj1 ?? (valid_pointer_valid_access ???)) VALID); #Hval
     2045@(proj2 ?? (valid_pointer_valid_access ???))
     2046@(valid_access_inj … Hval) //;
     2047qed.
    20502048
    20512049(*
     
    20592057  same contents for block offsets that are valid in [m1]. *)
    20602058
    2061 ndefinition inject_id : meminj ≝ λb. Some ? 〈b, OZ〉.
    2062 
    2063 ndefinition val_inj_id ≝ λmi: meminj. λv1,v2: val. v1 = v2.
    2064 
    2065 ndefinition extends ≝ λm1,m2: mem.
     2059definition inject_id : meminj ≝ λb. Some ? 〈b, OZ〉.
     2060
     2061definition val_inj_id ≝ λmi: meminj. λv1,v2: val. v1 = v2.
     2062
     2063definition extends ≝ λm1,m2: mem.
    20662064  nextblock m1 = nextblock m2 ∧ mem_inj val_inj_id inject_id m1 m2.
    20672065
    2068 ntheorem extends_refl:
     2066theorem extends_refl:
    20692067  ∀m: mem. extends m m.
    2070 #m;@;//;
    2071 nwhd; #chunk;#b1;#ofs;#v1;#b2;#delta;nnormalize in ⊢ (%→?);#H;
    2072 (* XXX: ndestruct makes the goal unreadable *) nelim (grumpydestruct2 ?????? H); #eb1;#edelta;#LOAD;
    2073 @ v1; @;
    2074 ##[ nrewrite < edelta; nrewrite > (Zplus_z_OZ ofs); //;
    2075 ##| //
    2076 ##] nqed.
    2077 
    2078 ntheorem alloc_extends:
     2068#m % //;
     2069whd; #chunk #b1 #ofs #v1 #b2 #delta normalize in ⊢ (%→?);#H
     2070(* XXX: destruct makes the goal unreadable *) elim (grumpydestruct2 ?????? H); #eb1 #edelta #LOAD
     2071%{ v1} %
     2072[ <edelta >(Zplus_z_OZ ofs) //;
     2073| //
     2074] qed.
     2075
     2076theorem alloc_extends:
    20792077  ∀m1,m2,m1',m2': mem. ∀lo1,hi1,lo2,hi2: Z. ∀b1,b2: block.
    20802078  extends m1 m2 →
     
    20832081  alloc m2 lo2 hi2 = 〈m2', b2〉 →
    20842082  b1 = b2 ∧ extends m1' m2'.
    2085 #m1;#m2;#m1';#m2';#lo1;#hi1;#lo2;#hi2;#b1;#b2;
    2086 *;#Hnext;#Hinj;#Hlo;#Hhi;#ALLOC1;#ALLOC2;
    2087 ncut (b1 = b2);
    2088 ##[ napply (transitive_eq … (nextblock m1)); ##[ napply (alloc_result … ALLOC1);
    2089     ##| napply sym_eq; nrewrite > Hnext; napply (alloc_result … ALLOC2) ##] ##]
    2090 #eb; nrewrite < eb in ALLOC2 ⊢ %; #ALLOC2; @; //; @;
    2091 ##[ nrewrite > (nextblock_alloc … ALLOC1);
    2092     nrewrite > (nextblock_alloc … ALLOC2);
     2083#m1 #m2 #m1' #m2' #lo1 #hi1 #lo2 #hi2 #b1 #b2
     2084*;#Hnext #Hinj #Hlo #Hhi #ALLOC1 #ALLOC2
     2085cut (b1 = b2);
     2086[ @(transitive_eq … (nextblock m1)) [ @(alloc_result … ALLOC1)
     2087    | @sym_eq >Hnext napply (alloc_result … ALLOC2) ] ]
     2088#eb <eb in ALLOC2 ⊢ % #ALLOC2 % //; %
     2089[ >(nextblock_alloc … ALLOC1)
     2090    >(nextblock_alloc … ALLOC2)
    20932091    //;
    2094 ##| napply (alloc_parallel_inj ??????????????? ALLOC1 ALLOC2 ????);
    2095   ##[ ##1,4: nnormalize; //;
    2096   ##| ##3,5,6: //
    2097   ##| ##7: nwhd; #chunk;#Hsize; (* divides 0 *) napply daemon
    2098   ##]
    2099 ##] nqed.
    2100 
    2101 ntheorem free_extends:
     2092| @(alloc_parallel_inj ??????????????? ALLOC1 ALLOC2 ????)
     2093  [ 1,4: normalize; //;
     2094  | 3,5,6: //
     2095  | 7: whd; #chunk #Hsize (* divides 0 *) napply daemon
     2096  ]
     2097] qed.
     2098
     2099theorem free_extends:
    21022100  ∀m1,m2: mem. ∀b: block.
    21032101  extends m1 m2 →
    21042102  extends (free m1 b) (free m2 b).
    2105 #m1;#m2;#b;*;#Hnext;#Hinj; @;
    2106 ##[ nnormalize; //;
    2107 ##| napply (free_parallel_inj … Hinj);
    2108   ##[ ##2: //;
    2109   ##| ##3: nnormalize; #b';#delta;#ee; ndestruct; //
    2110   ##]
    2111 ##] nqed.
    2112 
    2113 ntheorem load_extends:
     2103#m1 #m2 #b *;#Hnext #Hinj %
     2104[ normalize; //;
     2105| @(free_parallel_inj … Hinj)
     2106  [ 2: //;
     2107  | 3: normalize; #b' #delta #ee destruct; //
     2108  ]
     2109] qed.
     2110
     2111theorem load_extends:
    21142112  ∀chunk: memory_chunk. ∀m1,m2: mem. ∀b: block. ∀ofs: Z. ∀v: val.
    21152113  extends m1 m2 →
    21162114  load chunk m1 psp b ofs = Some ? v →
    21172115  load chunk m2 psp b ofs = Some ? v.
    2118 #chunk;#m1;#m2;#psp b ofs;#v;
    2119 *;#Hnext;#Hinj;#LOAD;
    2120 nlapply (Hinj … LOAD); ##[ nnormalize; // ##| ##2,3: ##]
    2121 *;#v2;*; nrewrite > (Zplus_z_OZ ofs); #LOAD2;#EQ;nwhd in EQ;
     2116#chunk #m1 #m2 #psp #b #ofs #v
     2117*;#Hnext #Hinj #LOAD
     2118lapply (Hinj … LOAD); [ normalize; // | 2,3: ]
     2119*;#v2 *; >(Zplus_z_OZ ofs) #LOAD2 #EQ whd in EQ;
    21222120//;
    2123 nqed.
    2124 
    2125 ntheorem store_within_extends:
     2121qed.
     2122
     2123theorem store_within_extends:
    21262124  ∀chunk: memory_chunk. ∀m1,m2,m1': mem. ∀b: block. ∀ofs: Z. ∀v: val.
    21272125  extends m1 m2 →
    21282126  store chunk m1 psp b ofs v = Some ? m1' →
    21292127  ∃m2'. store chunk m2 psp b ofs v = Some ? m2' ∧ extends m1' m2'.
    2130 #chunk;#m1;#m2;#m1';#b;#ofs;#v;*;#Hnext;#Hinj;#STORE1;
    2131 nlapply (store_mapped_inj … Hinj ?? STORE1 ?);
    2132 ##[ ##1,2,7: nnormalize; //
    2133 ##| (* TODO: unfolding, etc ought to tidy this up *)
    2134     nwhd; #b1;#b1';#delta1;#b2;#b2';#delta2;#neb;#Hinj1;#Hinj2;
    2135     nnormalize in Hinj1 Hinj2; @1; @1; @1; ndestruct; //
    2136 ##| ##4,5,6: ##skip
    2137 ##]
    2138 *;#m2';*;#STORE;#MINJ;
    2139 @ m2'; @; nrewrite > (Zplus_z_OZ ofs) in STORE; #STORE; //;
    2140 @;
    2141 ##[ nrewrite > (nextblock_store … STORE1);
    2142     nrewrite > (nextblock_store … STORE);
     2128#chunk #m1 #m2 #m1' #b #ofs #v *;#Hnext #Hinj #STORE1
     2129lapply (store_mapped_inj … Hinj ?? STORE1 ?);
     2130[ 1,2,7: normalize; //
     2131| (* TODO: unfolding, etc ought to tidy this up *)
     2132    whd; #b1 #b1' #delta1 #b2 #b2' #delta2 #neb #Hinj1 #Hinj2
     2133    normalize in Hinj1 Hinj2; %{1} %{1} %{1} destruct; //
     2134| 4,5,6: ##skip
     2135]
     2136*;#m2' *;#STORE #MINJ
     2137%{ m2'} % >(Zplus_z_OZ ofs) in STORE #STORE //;
     2138%
     2139[ >(nextblock_store … STORE1)
     2140    >(nextblock_store … STORE)
    21432141    //
    2144 ##| //
    2145 ##] nqed.
    2146 
    2147 ntheorem store_outside_extends:
     2142| //
     2143] qed.
     2144
     2145theorem store_outside_extends:
    21482146  ∀chunk: memory_chunk. ∀m1,m2,m2': mem. ∀b: block. ∀ofs: Z. ∀v: val.
    21492147  extends m1 m2 →
     
    21512149  store chunk m2 psp b ofs v = Some ? m2' →
    21522150  extends m1 m2'.
    2153 #chunk;#m1;#m2;#m2';#b;#ofs;#v;*;#Hnext;#Hinj;#Houtside;#STORE; @;
    2154 ##[ nrewrite > (nextblock_store … STORE); //
    2155 ##| napply (store_outside_inj … STORE); //;
    2156     #b';#delta;#einj;nnormalize in einj; ndestruct;
    2157     nelim Houtside;
    2158     ##[ #lo;@ 2; nrewrite > (Zplus_z_OZ ?); /2/
    2159     ##| #hi;@ 1;  nrewrite > (Zplus_z_OZ ?); /2/
    2160     ##]
    2161 ##] nqed.
    2162 
    2163 ntheorem valid_pointer_extends:
     2151#chunk #m1 #m2 #m2' #b #ofs #v *;#Hnext #Hinj #Houtside #STORE %
     2152[ >(nextblock_store … STORE) //
     2153| @(store_outside_inj … STORE) //;
     2154    #b' #delta #einj normalize in einj; destruct;
     2155    elim Houtside;
     2156    [ #lo %{ 2} >(Zplus_z_OZ ?) /2/
     2157    | #hi %{ 1}  >(Zplus_z_OZ ?) /2/
     2158    ]
     2159] qed.
     2160
     2161theorem valid_pointer_extends:
    21642162  ∀m1,m2,b,ofs.
    21652163  extends m1 m2 → valid_pointer m1 psp b ofs = true →
    21662164  valid_pointer m2 psp b ofs = true.
    2167 #m1;#m2;#b;#ofs;*;#Hnext;#Hinj;#VALID;
    2168 nrewrite < (Zplus_z_OZ ofs);
    2169 napply (valid_pointer_inj … Hinj VALID); //;
    2170 nqed.
     2165#m1 #m2 #b #ofs *;#Hnext #Hinj #VALID
     2166<(Zplus_z_OZ ofs)
     2167@(valid_pointer_inj … Hinj VALID) //;
     2168qed.
    21712169
    21722170
     
    21772175  the value [v2] read in [m2], that is, either [v1 = v2] or [v1 = Vundef]. *)
    21782176
    2179 ndefinition val_inj_lessdef ≝ λmi: meminj. λv1,v2: val.
     2177definition val_inj_lessdef ≝ λmi: meminj. λv1,v2: val.
    21802178  Val_lessdef v1 v2.
    21812179
    2182 ndefinition lessdef ≝ λm1,m2: mem.
     2180definition lessdef ≝ λm1,m2: mem.
    21832181  nextblock m1 = nextblock m2 ∧
    21842182  mem_inj val_inj_lessdef inject_id m1 m2.
    21852183
    2186 nlemma lessdef_refl:
     2184lemma lessdef_refl:
    21872185  ∀m. lessdef m m.
    2188 #m; @; //;
    2189 nwhd; #chunk;#b1;#ofs;#v1;#b2;#delta;#H;#LOAD;
    2190 nwhd in H:(??%?); nelim (grumpydestruct2 ?????? H); #eb1; #edelta;
    2191 @ v1; @; //;
    2192 nqed.
    2193 
    2194 nlemma load_lessdef:
     2186#m % //;
     2187whd; #chunk #b1 #ofs #v1 #b2 #delta #H #LOAD
     2188whd in H:(??%?); elim (grumpydestruct2 ?????? H); #eb1 #edelta
     2189%{ v1} % //;
     2190qed.
     2191
     2192lemma load_lessdef:
    21952193  ∀m1,m2,chunk,b,ofs,v1.
    21962194  lessdef m1 m2 → load chunk m1 psp b ofs = Some ? v1 →
    21972195  ∃v2. load chunk m2 psp b ofs = Some ? v2 ∧ Val_lessdef v1 v2.
    2198 #m1;#m2;#chunk;#b;#ofs;#v1;*;#Hnext;#Hinj;#LOAD0;
    2199 nlapply (Hinj … LOAD0); ##[ nwhd in ⊢ (??%?); // ##| ##2,3:##skip ##]
    2200 *;#v2;*;#LOAD;#INJ; @ v2; @;//;
    2201 nqed.
    2202 
    2203 nlemma loadv_lessdef:
     2196#m1 #m2 #chunk #b #ofs #v1 *;#Hnext #Hinj #LOAD0
     2197lapply (Hinj … LOAD0); [ whd in ⊢ (??%?); // | 2,3:##skip ]
     2198*;#v2 *;#LOAD #INJ %{ v2} % //;
     2199qed.
     2200
     2201lemma loadv_lessdef:
    22042202  ∀m1,m2,chunk,addr1,addr2,v1.
    22052203  lessdef m1 m2 → Val_lessdef addr1 addr2 →
    22062204  loadv chunk m1 addr1 = Some ? v1 →
    22072205  ∃v2. loadv chunk m2 addr2 = Some ? v2 ∧ Val_lessdef v1 v2.
    2208 #m1;#m2;#chunk;#addr1;#addr2;#v1;#H;#H0;#LOAD;
    2209 ninversion H0;
    2210 ##[ #v; #e1;#e2; nrewrite > e1 in LOAD; ncases v;
    2211     ##[ nwhd in ⊢ ((??%?)→?); #H'; ndestruct;
    2212     ##| ##2,3: #v'; nwhd in ⊢ ((??%?)→?); #H'; ndestruct;
    2213     ##| #b';#off; napply load_lessdef; //
    2214     ##]
    2215 ##| #v;#e;nrewrite > e in LOAD; #LOAD; nwhd in LOAD:(??%?); ndestruct;
    2216 ##] nqed.
    2217 
    2218 nlemma store_lessdef:
     2206#m1 #m2 #chunk #addr1 #addr2 #v1 #H #H0 #LOAD
     2207inversion H0;
     2208[ #v #e1 #e2 >e1 in LOAD cases v;
     2209    [ whd in ⊢ ((??%?)→?); #H' destruct;
     2210    | 2,3: #v' whd in ⊢ ((??%?)→?); #H' destruct;
     2211    | #b' #off @load_lessdef //
     2212    ]
     2213| #v #e >e in LOAD #LOAD whd in LOAD:(??%?); destruct;
     2214] qed.
     2215
     2216lemma store_lessdef:
    22192217  ∀m1,m2,chunk,b,ofs,v1,v2,m1'.
    22202218  lessdef m1 m2 → Val_lessdef v1 v2 →
    22212219  store chunk m1 psp b ofs v1 = Some ? m1' →
    22222220  ∃m2'. store chunk m2 psp b ofs v2 = Some ? m2' ∧ lessdef m1' m2'.
    2223 #m1;#m2;#chunk;#b;#ofs;#v1;#v2;#m1';
    2224 *;#Hnext;#Hinj;#Hvless;#STORE0;
    2225 nlapply (store_mapped_inj … Hinj … STORE0 ?);
    2226 ##[ #chunk';#Hsize;nwhd;napply load_result_lessdef;napply Hvless
    2227 ##| nwhd in ⊢ (??%?); //
    2228 ##| nwhd; #b1;#b1';#delta1;#b2;#b2';#delta2;#neq;
    2229     nwhd in ⊢ ((??%?)→(??%?)→?); #e1; #e2; ndestruct;
    2230     @;@;@;//
    2231 ##| ##7: #mi; nwhd; //;
    2232 ##| ##8: *;#m2';*;#STORE;#MINJ;
    2233          @ m2';@; /2/;
    2234          @;
    2235          nrewrite > (nextblock_store … STORE0);
    2236          nrewrite > (nextblock_store … STORE);
     2221#m1 #m2 #chunk #b #ofs #v1 #v2 #m1'
     2222*;#Hnext #Hinj #Hvless #STORE0
     2223lapply (store_mapped_inj … Hinj … STORE0 ?);
     2224[ #chunk' #Hsize whd;@load_result_lessdef napply Hvless
     2225| whd in ⊢ (??%?); //
     2226| whd; #b1 #b1' #delta1 #b2 #b2' #delta2 #neq
     2227    whd in ⊢ ((??%?)→(??%?)→?); #e1 #e2 destruct;
     2228    % % % //
     2229| 7: #mi whd; //;
     2230| 8: *;#m2' *;#STORE #MINJ
     2231         %{ m2'} % /2/;
     2232         %
     2233         >(nextblock_store … STORE0)
     2234         >(nextblock_store … STORE)
    22372235         //;
    2238 ##] nqed.
    2239 
    2240 nlemma storev_lessdef:
     2236] qed.
     2237
     2238lemma storev_lessdef:
    22412239  ∀m1,m2,chunk,addr1,v1,addr2,v2,m1'.
    22422240  lessdef m1 m2 → Val_lessdef addr1 addr2 → Val_lessdef v1 v2 →
    22432241  storev chunk m1 addr1 v1 = Some ? m1' →
    22442242  ∃m2'. storev chunk m2 addr2 v2 = Some ? m2' ∧ lessdef m1' m2'.
    2245 #m1;#m2;#chunk;#addr1;#v1;#addr2;#v2;#m1';
    2246 #Hmless;#Haless;#Hvless;#STORE;
    2247 ninversion Haless;
    2248 ##[ #v; #e1;#e2; nrewrite > e1 in STORE; ncases v;
    2249     ##[ nwhd in ⊢ ((??%?)→?); #H'; napply False_ind; ndestruct;
    2250     ##| ##2,3: #v'; nwhd in ⊢ ((??%?)→?); #H'; ndestruct;
    2251     ##| #b';#off; napply store_lessdef; //
    2252     ##]
    2253 ##| #v;#e;nrewrite > e in STORE; #STORE; nwhd in STORE:(??%?); ndestruct
    2254 ##] nqed.
    2255 
    2256 nlemma alloc_lessdef:
     2243#m1 #m2 #chunk #addr1 #v1 #addr2 #v2 #m1'
     2244#Hmless #Haless #Hvless #STORE
     2245inversion Haless;
     2246[ #v #e1 #e2 >e1 in STORE cases v;
     2247    [ whd in ⊢ ((??%?)→?); #H' @False_ind destruct;
     2248    | 2,3: #v' whd in ⊢ ((??%?)→?); #H' destruct;
     2249    | #b' #off @store_lessdef //
     2250    ]
     2251| #v #e >e in STORE #STORE whd in STORE:(??%?); destruct
     2252] qed.
     2253
     2254lemma alloc_lessdef:
    22572255  ∀m1,m2,lo,hi,b1,m1',b2,m2'.
    22582256  lessdef m1 m2 → alloc m1 lo hi = 〈m1', b1〉 → alloc m2 lo hi = 〈m2', b2〉 →
    22592257  b1 = b2 ∧ lessdef m1' m2'.
    2260 #m1;#m2;#lo;#hi;#b1;#m1';#b2;#m2';
    2261 *;#Hnext;#Hinj;#ALLOC1;#ALLOC2;
    2262 ncut (b1 = b2);
    2263 ##[ nrewrite > (alloc_result … ALLOC1); nrewrite > (alloc_result … ALLOC2); //
    2264 ##]
    2265 #e; nrewrite < e in ALLOC2 ⊢ %; #ALLOC2; @; //;
    2266 @;
    2267 ##[ nrewrite > (nextblock_alloc … ALLOC1);
    2268     nrewrite > (nextblock_alloc … ALLOC2);
     2258#m1 #m2 #lo #hi #b1 #m1' #b2 #m2'
     2259*;#Hnext #Hinj #ALLOC1 #ALLOC2
     2260cut (b1 = b2);
     2261[ >(alloc_result … ALLOC1) >(alloc_result … ALLOC2) //
     2262]
     2263#e <e in ALLOC2 ⊢ % #ALLOC2 % //;
     2264%
     2265[ >(nextblock_alloc … ALLOC1)
     2266    >(nextblock_alloc … ALLOC2)
    22692267    //
    2270 ##| napply (alloc_parallel_inj … Hinj ALLOC1 ALLOC2);
    2271 ##[ //
    2272 ##| ##3: nwhd in ⊢ (??%?); //
    2273 ##| ##4,5: //;
    2274 ##| ##6: nwhd; #chunk;#_; ncases chunk;//;
    2275 ##] nqed.
    2276 
    2277 nlemma free_lessdef:
     2268| @(alloc_parallel_inj … Hinj ALLOC1 ALLOC2)
     2269[ //
     2270| 3: whd in ⊢ (??%?); //
     2271| 4,5: //;
     2272| 6: whd; #chunk #_ cases chunk;//;
     2273] qed.
     2274
     2275lemma free_lessdef:
    22782276  ∀m1,m2,b. lessdef m1 m2 → lessdef (free m1 b) (free m2 b).
    2279 #m1;#m2;#b;*;#Hnext;#Hinj; @;
    2280 ##[ nwhd in ⊢ (??%%); //
    2281 ##| napply (free_parallel_inj … Hinj); //;
    2282     #b';#delta;#H; nwhd in H:(??%?); nelim (grumpydestruct2 ?????? H); //
    2283 ##] nqed.
    2284 
    2285 nlemma free_left_lessdef:
     2277#m1 #m2 #b *;#Hnext #Hinj %
     2278[ whd in ⊢ (??%%); //
     2279| @(free_parallel_inj … Hinj) //;
     2280    #b' #delta #H whd in H:(??%?); elim (grumpydestruct2 ?????? H); //
     2281] qed.
     2282
     2283lemma free_left_lessdef:
    22862284  ∀m1,m2,b.
    22872285  lessdef m1 m2 → lessdef (free m1 b) m2.
    2288 #m1;#m2;#b;*;#Hnext;#Hinj;@;
    2289 nrewrite < Hnext; //;
    2290 napply free_left_inj; //;
    2291 nqed.
    2292 
    2293 nlemma free_right_lessdef:
     2286#m1 #m2 #b *;#Hnext #Hinj %
     2287<Hnext //;
     2288@free_left_inj //;
     2289qed.
     2290
     2291lemma free_right_lessdef:
    22942292  ∀m1,m2,b.
    22952293  lessdef m1 m2 → low_bound m1 b ≥ high_bound m1 b →
    22962294  lessdef m1 (free m2 b).
    2297 #m1;#m2;#b;*;#Hnext;#Hinj;#Hbounds;
    2298 @; nrewrite > Hnext; //;
    2299 napply free_right_inj; //;
    2300 #b1;#delta;#chunk;#ofs;#H; nwhd in H:(??%?); ndestruct;
    2301 napply nmk; *; #H1;#H2;#H3;#H4;
    2302 (* arith H2 and H3 contradict Hbounds. *) napply daemon;
    2303 nqed.
    2304 
    2305 nlemma valid_block_lessdef:
     2295#m1 #m2 #b *;#Hnext #Hinj #Hbounds
     2296% >Hnext //;
     2297@free_right_inj //;
     2298#b1 #delta #chunk #ofs #H whd in H:(??%?); destruct;
     2299@nmk *; #H1 #H2 #H3 #H4
     2300(* arith H2 and H3 contradict Hbounds. *) @daemon
     2301qed.
     2302
     2303lemma valid_block_lessdef:
    23062304  ∀m1,m2,b. lessdef m1 m2 → valid_block m1 b → valid_block m2 b.
    2307 #m1;#m2;#b;*;#Hnext;#Hinj;
    2308  nrewrite > (unfold_valid_block …); nrewrite > (unfold_valid_block m2 b);
    2309  //; nqed.
    2310 
    2311 nlemma valid_pointer_lessdef:
     2305#m1 #m2 #b *;#Hnext #Hinj
     2306 >(unfold_valid_block …) >(unfold_valid_block m2 b)
     2307 //; qed.
     2308
     2309lemma valid_pointer_lessdef:
    23122310  ∀m1,m2,b,ofs.
    23132311  lessdef m1 m2 → valid_pointer m1 psp b ofs = true → valid_pointer m2 psp b ofs = true.
    2314 #m1;#m2;#b;#ofs;*;#Hnext;#Hinj;#VALID;
    2315 nrewrite < (Zplus_z_OZ ofs); napply (valid_pointer_inj … Hinj VALID); //;
    2316 nqed.
     2312#m1 #m2 #b #ofs *;#Hnext #Hinj #VALID
     2313<(Zplus_z_OZ ofs) @(valid_pointer_inj … Hinj VALID) //;
     2314qed.
    23172315
    23182316
     
    23312329  as prescribed by the memory injection. *)
    23322330
    2333 ninductive val_inject (mi: meminj): val → val → Prop :=
     2331inductive val_inject (mi: meminj): val → val → Prop :=
    23342332  | val_inject_int:
    23352333      ∀i. val_inject mi (Vint i) (Vint i)
     
    23472345             val_inject_undef.
    23482346*)
    2349 ninductive val_list_inject (mi: meminj): list val → list val→ Prop:=
     2347inductive val_list_inject (mi: meminj): list val → list val→ Prop:=
    23502348  | val_nil_inject :
    23512349      val_list_inject mi (nil ?) (nil ?)
     
    23672365*)
    23682366
    2369 nrecord mem_inject (f: meminj) (m1,m2: mem) : Prop ≝
     2367record mem_inject (f: meminj) (m1,m2: mem) : Prop ≝
    23702368  {
    23712369    mi_inj:
     
    23912389  during address computations. *)
    23922390
    2393 nlemma address_inject:
     2391lemma address_inject:
    23942392  ∀f,m1,m2,chunk,b1,ofs1,b2,delta.
    23952393  mem_inject f m1 m2 →
     
    23972395  f b1 = Some ? 〈b2, delta〉 →
    23982396  signed (add ofs1 (repr delta)) = signed ofs1 + delta.
    2399 #f;#m1;#m2;#chunk;#b1;#ofs1;#b2;#delta;
    2400 *;#mi_inj;#mi_freeblocks;#mi_mappedblock;#mi_no_overlap;#mi_range_1;#mi_range_2;
    2401 #Hvalid;#Hb1inj;
    2402 nelim (mi_range_2 ??? Hb1inj);
    2403 ##[ (* delta = 0 *)
    2404     #edelta; nrewrite > edelta;
    2405     nrewrite > (?:repr O = zero); ##[ ##2: // ##]
    2406     nrewrite > (add_zero ?);
    2407     nrewrite > (Zplus_z_OZ …);
     2397#f #m1 #m2 #chunk #b1 #ofs1 #b2 #delta
     2398*;#mi_inj #mi_freeblocks #mi_mappedblock #mi_no_overlap #mi_range_1 #mi_range_2
     2399#Hvalid #Hb1inj
     2400elim (mi_range_2 ??? Hb1inj);
     2401[ (* delta = 0 *)
     2402    #edelta >edelta
     2403    >(?:repr O = zero) [ 2: // ]
     2404    >(add_zero ?)
     2405    >(Zplus_z_OZ …)
    24082406    //;
    2409 ##| (* delta ≠ 0 *)
    2410     #Hrange; nrewrite > (add_signed ??);
    2411     nrewrite > (signed_repr delta ?);
    2412     ##[ nrewrite > (signed_repr ??);
    2413       ##[ //
    2414       ##| ncut (valid_access m2 chunk b2 (signed ofs1 + delta));
    2415         ##[ napply (valid_access_inj … Hvalid); //;
    2416         ##| *; #_; #Hlo; #Hhi; #_; (* arith *) napply daemon
    2417         ##]
    2418       ##]
    2419     ##| /2/
    2420     ##]
    2421 ##] nqed.
    2422 
    2423 nlemma valid_pointer_inject_no_overflow:
     2407| (* delta ≠ 0 *)
     2408    #Hrange >(add_signed ??)
     2409    >(signed_repr delta ?)
     2410    [ >(signed_repr ??)
     2411      [ //
     2412      | cut (valid_access m2 chunk b2 (signed ofs1 + delta));
     2413        [ @(valid_access_inj … Hvalid) //;
     2414        | *; #_ #Hlo #Hhi #_ (* arith *) napply daemon
     2415        ]
     2416      ]
     2417    | /2/
     2418    ]
     2419] qed.
     2420
     2421lemma valid_pointer_inject_no_overflow:
    24242422  ∀f,m1,m2,b,ofs,b',x.
    24252423  mem_inject f m1 m2 →
     
    24272425  f b = Some ? 〈b', x〉 →
    24282426  min_signed ≤ signed ofs + signed (repr x) ∧ signed ofs + signed (repr x) ≤ max_signed.
    2429 #f;#m1;#m2;#b;#ofs;#b';#x;
    2430 *;#mi_inj;#mi_freeblocks;#mi_mappedblock;#mi_no_overlap;#mi_range_1;#mi_range_2;
    2431 #Hvalid;#Hb1inj;
    2432 nlapply ((proj1 ?? (valid_pointer_valid_access ???)) Hvalid); #Hvalid';
    2433 ncut (valid_access m2 Mint8unsigned b' (signed ofs + x));
    2434 ##[ napply (valid_access_inj … Hvalid'); // ##]
    2435 *; nrewrite > (?:size_chunk Mint8unsigned = 1); ##[ ##2: // ##] #_; #Hlo; #Hhi; #_;
    2436 nrewrite > (signed_repr ??); ##[ ##2: /2/; ##]
    2437 nlapply (mi_range_2 … Hb1inj); *;
    2438 ##[ #ex; nrewrite > ex; nrewrite > (Zplus_z_OZ ?); napply signed_range;
    2439 ##| (* arith *) napply daemon
    2440 ##] nqed.
    2441 
    2442 (* XXX: should use ndestruct, but reduces large definitions *)
    2443 nremark vptr_eq: ∀b,b',i,i'. Vptr b i = Vptr b' i' → b = b' ∧ i = i'.
    2444 #b b' i i' e; ndestruct; /2/; nqed.
    2445 
    2446 nlemma valid_pointer_inject:
     2427#f #m1 #m2 #b #ofs #b' #x
     2428*;#mi_inj #mi_freeblocks #mi_mappedblock #mi_no_overlap #mi_range_1 #mi_range_2
     2429#Hvalid #Hb1inj
     2430lapply ((proj1 ?? (valid_pointer_valid_access ???)) Hvalid); #Hvalid'
     2431cut (valid_access m2 Mint8unsigned b' (signed ofs + x));
     2432[ @(valid_access_inj … Hvalid') // ]
     2433*; >(?:size_chunk Mint8unsigned = 1) [ 2: // ] #_ #Hlo #Hhi #_
     2434>(signed_repr ??) [ 2: /2/; ]
     2435lapply (mi_range_2 … Hb1inj); *;
     2436[ #ex >ex >(Zplus_z_OZ ?) @signed_range
     2437| (* arith *) napply daemon
     2438] qed.
     2439
     2440(* XXX: should use destruct, but reduces large definitions *)
     2441lemma vptr_eq: ∀b,b',i,i'. Vptr b i = Vptr b' i' → b = b' ∧ i = i'.
     2442#b #b' #i #i' #e destruct; /2/; qed.
     2443
     2444lemma valid_pointer_inject:
    24472445  ∀f,m1,m2,b,ofs,b',ofs'.
    24482446  mem_inject f m1 m2 →
     
    24502448  val_inject f (Vptr psp b ofs) (Vptr b' ofs') →
    24512449  valid_pointer m2 b' (signed ofs') = true.
    2452 #f;#m1;#m2;#b;#ofs;#b';#ofs';
    2453 #Hinj; #Hvalid; #Hvinj; ninversion Hvinj;
    2454 ##[ ##1,2,4: #x;#H;ndestruct; ##]
    2455 #b0;#i;#b0';#i';#delta;#Hb;#Hi';#eptr;#eptr';
    2456 nrewrite < (proj1 … (vptr_eq ???? eptr)) in Hb; nrewrite < (proj1 … (vptr_eq ???? eptr'));
    2457 nrewrite < (proj2 … (vptr_eq ???? eptr)) in Hi'; nrewrite < (proj2 … (vptr_eq ???? eptr'));
    2458   #Hofs; #Hbinj;
    2459 nrewrite > Hofs;
    2460 nlapply (valid_pointer_inject_no_overflow … Hinj Hvalid Hbinj); #NOOV;
    2461 nelim Hinj;#mi_inj;#mi_freeblocks;#mi_mappedblock;#mi_no_overlap;#mi_range_1;#mi_range_2;
    2462 nrewrite > (add_signed ??); nrewrite > (signed_repr ??); //;
    2463 nrewrite > (signed_repr ??); /2/;
    2464 napply (valid_pointer_inj … mi_inj Hvalid); //;
    2465 nqed.
    2466 
    2467 nlemma different_pointers_inject:
     2450#f #m1 #m2 #b #ofs #b' #ofs'
     2451#Hinj #Hvalid #Hvinj inversion Hvinj;
     2452[ 1,2,4: #x #H destruct; ]
     2453#b0 #i #b0' #i' #delta #Hb #Hi' #eptr #eptr'
     2454<(proj1 … (vptr_eq ???? eptr)) in Hb <(proj1 … (vptr_eq ???? eptr'))
     2455<(proj2 … (vptr_eq ???? eptr)) in Hi' <(proj2 … (vptr_eq ???? eptr'))
     2456  #Hofs #Hbinj
     2457>Hofs
     2458lapply (valid_pointer_inject_no_overflow … Hinj Hvalid Hbinj); #NOOV
     2459elim Hinj;#mi_inj #mi_freeblocks #mi_mappedblock #mi_no_overlap #mi_range_1 #mi_range_2
     2460>(add_signed ??) >(signed_repr ??) //;
     2461>(signed_repr ??) /2/;
     2462@(valid_pointer_inj … mi_inj Hvalid) //;
     2463qed.
     2464
     2465lemma different_pointers_inject:
    24682466  ∀f,m,m',b1,ofs1,b2,ofs2,b1',delta1,b2',delta2.
    24692467  mem_inject f m m' →
     
    24762474  signed (add ofs1 (repr delta1)) ≠
    24772475  signed (add ofs2 (repr delta2)).
    2478 #f;#m;#m';#b1;#ofs1;#b2;#ofs2;#b1';#delta1;#b2';#delta2;
    2479 #Hinj;#neb;#Hval1;#Hval2;#Hf1;#Hf2;
    2480 nlapply ((proj1 ?? (valid_pointer_valid_access …)) Hval1); #Hval1';
    2481 nlapply ((proj1 ?? (valid_pointer_valid_access …)) Hval2); #Hval2';
    2482 nrewrite > (address_inject … Hinj Hval1' Hf1);
    2483 nrewrite > (address_inject … Hinj Hval2' Hf2);
    2484 nelim Hval1'; #Hbval; #Hlo; #Hhi;#Hal; nwhd in Hhi:(?(??%)?);
    2485 nelim Hval2'; #Hbval2; #Hlo2; #Hhi2;#Hal2; nwhd in Hhi2:(?(??%)?);
    2486 nlapply (mi_no_overlap ??? Hinj … Hf1 Hf2 …); //;
    2487 *; ##[
    2488 *; ##[
    2489 *; ##[ /2/;
    2490    ##| (* arith contradiction *) napply daemon ##]
    2491    ##| (* arith contradiction *) napply daemon ##]
    2492    ##| *; ##[ #H;@2; (* arith *) napply daemon
    2493           ##| #H;@2; (* arith *) napply daemon  ##] ##]
    2494 nqed.
     2476#f #m #m' #b1 #ofs1 #b2 #ofs2 #b1' #delta1 #b2' #delta2
     2477#Hinj #neb #Hval1 #Hval2 #Hf1 #Hf2
     2478lapply ((proj1 ?? (valid_pointer_valid_access …)) Hval1); #Hval1'
     2479lapply ((proj1 ?? (valid_pointer_valid_access …)) Hval2); #Hval2'
     2480>(address_inject … Hinj Hval1' Hf1)
     2481>(address_inject … Hinj Hval2' Hf2)
     2482elim Hval1'; #Hbval #Hlo #Hhi #Hal whd in Hhi:(?(??%)?);
     2483elim Hval2'; #Hbval2 #Hlo2 #Hhi2 #Hal2 whd in Hhi2:(?(??%)?);
     2484lapply (mi_no_overlap ??? Hinj … Hf1 Hf2 …); //;
     2485*; [
     2486*; [
     2487*; [ /2/;
     2488   | (* arith contradiction *) napply daemon ]
     2489   | (* arith contradiction *) napply daemon ]
     2490   | *; [ #H %{2} (* arith *) napply daemon
     2491          | #H %{2} (* arith *) napply daemon  ] ]
     2492qed.
    24952493
    24962494(* Relation between injections and loads. *)
    24972495
    2498 nlemma load_inject:
     2496lemma load_inject:
    24992497  ∀f,m1,m2,chunk,b1,ofs,b2,delta,v1.
    25002498  mem_inject f m1 m2 →
     
    25022500  f b1 = Some ? 〈b2, delta〉 →
    25032501  ∃v2. load chunk m2 b2 (ofs + delta) = Some ? v2 ∧ val_inject f v1 v2.
    2504 #f;#m1;#m2;#chunk;#b1;#ofs;#b2;#delta;#v1;
    2505 *;#mi_inj;#mi_freeblocks;#mi_mappedblock;#mi_no_overlap;#mi_range_1;#mi_range_2;
    2506 #LOAD;#Hbinj;
    2507 napply mi_inj; //;
    2508 nqed.
    2509 
    2510 nlemma loadv_inject:
     2502#f #m1 #m2 #chunk #b1 #ofs #b2 #delta #v1
     2503*;#mi_inj #mi_freeblocks #mi_mappedblock #mi_no_overlap #mi_range_1 #mi_range_2
     2504#LOAD #Hbinj
     2505@mi_inj //;
     2506qed.
     2507
     2508lemma loadv_inject:
    25112509  ∀f,m1,m2,chunk,a1,a2,v1.
    25122510  mem_inject f m1 m2 →
     
    25142512  val_inject f a1 a2 →
    25152513  ∃v2. loadv chunk m2 a2 = Some ? v2 ∧ val_inject f v1 v2.
    2516 #f;#m1;#m2;#chunk;#a1;#a2;#v1;
    2517 #Hinj;#LOADV;#Hvinj; ninversion Hvinj;
    2518 ##[ ##1,2,4: #x;#ex;#ex'; napply False_ind; ndestruct; ##]
    2519 #b;#ofs;#b';#ofs';#delta;#Hbinj;#Hofs;#ea1;#ea2;
    2520 nrewrite > ea1 in LOADV; #LOADV;
    2521 nlapply (load_inject … Hinj LOADV … Hbinj); *; #v2; *; #LOAD; #INJ;
    2522 @ v2; @; //; nrewrite > Hofs;
    2523 nrewrite < (?:signed (add ofs (repr delta)) = signed ofs + delta) in LOAD;
    2524 ##[ #H; napply H; (* XXX: used to work with /2/ *)
    2525 ##| napply (address_inject … chunk … Hinj ? Hbinj); napply (load_valid_access …);
    2526     ##[ ##2: napply LOADV; ##]
    2527 ##] nqed.
     2514#f #m1 #m2 #chunk #a1 #a2 #v1
     2515#Hinj #LOADV #Hvinj inversion Hvinj;
     2516[ 1,2,4: #x #ex #ex' @False_ind destruct; ]
     2517#b #ofs #b' #ofs' #delta #Hbinj #Hofs #ea1 #ea2
     2518>ea1 in LOADV #LOADV
     2519lapply (load_inject … Hinj LOADV … Hbinj); *; #v2 *; #LOAD #INJ
     2520%{ v2} % //; >Hofs
     2521<(?:signed (add ofs (repr delta)) = signed ofs + delta) in LOAD
     2522[ #H @H (* XXX: used to work with /2/ *)
     2523| @(address_inject … chunk … Hinj ? Hbinj) @(load_valid_access …)
     2524    [ 2: @LOADV ]
     2525] qed.
    25282526
    25292527(* Relation between injections and stores. *)
    25302528
    2531 ninductive val_content_inject (f: meminj): memory_chunk → val → val → Prop ≝
     2529inductive val_content_inject (f: meminj): memory_chunk → val → val → Prop ≝
    25322530  | val_content_inject_base:
    25332531      ∀chunk,v1,v2.
     
    25512549(*Hint Resolve val_content_inject_base.*)
    25522550
    2553 nlemma load_result_inject:
     2551lemma load_result_inject:
    25542552  ∀f,chunk,v1,v2,chunk'.
    25552553  val_content_inject f chunk v1 v2 →
    25562554  size_chunk chunk = size_chunk chunk' →
    25572555  val_inject f (load_result chunk' v1) (load_result chunk' v2).
    2558 #f;#chunk;#v1;#v2;#chunk';
    2559 #Hvci; ninversion Hvci;
    2560 ##[ #chunk'';#v1';#v2';#Hvinj;#_;#_;#_;#Hsize; ninversion Hvinj;
    2561   ##[ ncases chunk'; #i;#_;#_; ##[ ##1,2,3,4,5: @ ##| ##6,7: @4 ##]
    2562   ##| ncases chunk'; #f;#_;#_; ##[ ##1,2,3,4,5: @4 ##| ##6,7: @2 ##]
    2563   ##| ncases chunk'; #b1;#ofs1;#b2;#ofs2;#delta;#Hmap;#Hofs;#_;#_; ##[ ##5: @3; // ##| ##*: @4 ##]
    2564   ##| ncases chunk'; #v;#_;#_; @4;
    2565   ##]
     2556#f #chunk #v1 #v2 #chunk'
     2557#Hvci inversion Hvci;
     2558[ #chunk'' #v1' #v2' #Hvinj #_ #_ #_ #Hsize inversion Hvinj;
     2559  [ cases chunk'; #i #_ #_ [ 1,2,3,4,5: @ | 6,7: @4 ]
     2560  | cases chunk'; #f #_ #_ [ 1,2,3,4,5: @4 | 6,7: @2 ]
     2561  | cases chunk'; #b1 #ofs1 #b2 #ofs2 #delta #Hmap #Hofs #_ #_ [ 5: %{3} // | *: @4 ]
     2562  | cases chunk'; #v #_ #_ %{4}
     2563  ]
    25662564(* FIXME: the next two cases are very similar *)
    2567 ##| #chunk'';#i;#i';*;#echunk;nrewrite > echunk;#Hz;#_;#_;#_;
    2568     nelim chunk'; nwhd in ⊢ ((??%%)→?); #Hsize; ndestruct;
    2569     ##[ ##2,4: nwhd in ⊢ (??%%); nrewrite > Hz; @
    2570     ##| ##1,3: nwhd in ⊢ (??%%); nrewrite > (sign_ext_equal_if_zero_equal … Hz);
    2571         @; ##[ ##1,3: napply I; ##| ##2,4: napply leb_true_to_le; @; ##]
    2572     ##]
    2573 ##| #chunk'';#i;#i';*;#echunk;nrewrite > echunk;#Hz;#_;#_;#_;
    2574     nelim chunk'; nwhd in ⊢ ((??%%)→?); #Hsize; ndestruct;
    2575     ##[ ##2,4: nwhd in ⊢ (??%%); nrewrite > Hz; @
    2576     ##| ##1,3: nwhd in ⊢ (??%%); nrewrite > (sign_ext_equal_if_zero_equal … Hz);
    2577         @; ##[ ##1,3: napply I; ##| ##2,4: napply leb_true_to_le; @; ##]
    2578     ##]
    2579 
    2580 ##| #f;#f';#float;#echunk;nrewrite > echunk;#_;#_;
    2581     nelim chunk'; nwhd in ⊢ ((??%%)→?); #Hsize; ndestruct;
    2582     ##[ @4; ##| nrewrite > float; @2 ##]
    2583 ##] nqed.
    2584 
    2585 nlemma store_mapped_inject_1 :
     2565| #chunk'' #i #i' *;#echunk >echunk #Hz #_ #_ #_
     2566    elim chunk'; whd in ⊢ ((??%%)→?); #Hsize destruct;
     2567    [ 2,4: whd in ⊢ (??%%); >Hz @
     2568    | 1,3: whd in ⊢ (??%%); >(sign_ext_equal_if_zero_equal … Hz)
     2569        % [ 1,3: @I | 2,4: @leb_true_to_le % ]
     2570    ]
     2571| #chunk'' #i #i' *;#echunk >echunk #Hz #_ #_ #_
     2572    elim chunk'; whd in ⊢ ((??%%)→?); #Hsize destruct;
     2573    [ 2,4: whd in ⊢ (??%%); >Hz @
     2574    | 1,3: whd in ⊢ (??%%); >(sign_ext_equal_if_zero_equal … Hz)
     2575        % [ 1,3: @I | 2,4: @leb_true_to_le % ]
     2576    ]
     2577
     2578| #f #f' #float #echunk >echunk #_ #_
     2579    elim chunk'; whd in ⊢ ((??%%)→?); #Hsize destruct;
     2580    [ %{4} | >float @2 ]
     2581] qed.
     2582
     2583lemma store_mapped_inject_1 :
    25862584  ∀f,chunk,m1,b1,ofs,v1,n1,m2,b2,delta,v2.
    25872585  mem_inject f m1 m2 →
     
    25922590    store chunk m2 b2 (ofs + delta) v2 = Some ? n2
    25932591    ∧ mem_inject f n1 n2.
    2594 #f;#chunk;#m1;#b1;#ofs;#v1;#n1;#m2;#b2;#delta;#v2;
    2595 *;#mi_inj;#mi_freeblocks;#mi_mappedblock;#mi_no_overlap;#mi_range_1;#mi_range_2;
    2596 #STORE1; #INJb1; #Hvcinj;
    2597 nlapply (store_mapped_inj … mi_inj mi_no_overlap INJb1 STORE1 ?); //;
    2598 ##[ #chunk';#Hchunksize;napply (load_result_inject … chunk …);//;
    2599 ##| ##skip ##]
    2600 *;#n2;*;#STORE;#MINJ;
    2601 @ n2; @; //; @;
    2602 ##[ (* inj *) //
    2603 ##| (* freeblocks *) #b;#notvalid; napply mi_freeblocks;
    2604     napply (not_to_not ??? notvalid); napply (store_valid_block_1 … STORE1);
    2605 ##| (* mappedblocks *) #b;#b';#delta';#INJb';napply (store_valid_block_1 … STORE);
     2592#f #chunk #m1 #b1 #ofs #v1 #n1 #m2 #b2 #delta #v2
     2593*;#mi_inj #mi_freeblocks #mi_mappedblock #mi_no_overlap #mi_range_1 #mi_range_2
     2594#STORE1 #INJb1 #Hvcinj
     2595lapply (store_mapped_inj … mi_inj mi_no_overlap INJb1 STORE1 ?); //;
     2596[ #chunk' #Hchunksize @(load_result_inject … chunk …) //;
     2597| ##skip ]
     2598*;#n2 *;#STORE #MINJ
     2599%{ n2} % //; %
     2600[ (* inj *) //
     2601| (* freeblocks *) #b #notvalid @mi_freeblocks
     2602    @(not_to_not ??? notvalid) @(store_valid_block_1 … STORE1)
     2603| (* mappedblocks *) #b #b' #delta' #INJb' @(store_valid_block_1 … STORE)
    26062604    /2/;
    2607 ##| (* no_overlap *) nwhd; #b1';#b1'';#delta1';#b2';#b2'';#delta2';#neqb';
    2608     #fb1';#fb2';
    2609     nrewrite > (low_bound_store … STORE1 ?);  nrewrite > (low_bound_store … STORE1 ?);
    2610     nrewrite > (high_bound_store … STORE1 ?);  nrewrite > (high_bound_store … STORE1 ?);
    2611     napply mi_no_overlap; //;
    2612 ##| (* range *) /2/;
    2613 ##| (* range 2 *) #b;#b';#delta';#INJb;
    2614     nrewrite > (low_bound_store … STORE ?);
    2615     nrewrite > (high_bound_store … STORE ?);
    2616     napply mi_range_2; //;
    2617 ##] nqed.
    2618 
    2619 nlemma store_mapped_inject:
     2605| (* no_overlap *) whd; #b1' #b1'' #delta1' #b2' #b2'' #delta2' #neqb'
     2606    #fb1' #fb2'
     2607    >(low_bound_store … STORE1 ?)  >(low_bound_store … STORE1 ?)
     2608    >(high_bound_store … STORE1 ?)  >(high_bound_store … STORE1 ?)
     2609    @mi_no_overlap //;
     2610| (* range *) /2/;
     2611| (* range 2 *) #b #b' #delta' #INJb
     2612    >(low_bound_store … STORE ?)
     2613    >(high_bound_store … STORE ?)
     2614    @mi_range_2 //;
     2615] qed.
     2616
     2617lemma store_mapped_inject:
    26202618  ∀f,chunk,m1,b1,ofs,v1,n1,m2,b2,delta,v2.
    26212619  mem_inject f m1 m2 →
     
    26262624    store chunk m2 b2 (ofs + delta) v2 = Some ? n2
    26272625    ∧ mem_inject f n1 n2.
    2628 #f;#chunk;#m1;#b1;#ofs;#v1;#n1;#m2;#b2;#delta;#v2;
    2629 #MINJ;#STORE;#INJb1;#Hvalinj;napply (store_mapped_inject_1 … STORE);//;
    2630 napply val_content_inject_base;//;
    2631 nqed.
    2632 
    2633 nlemma store_unmapped_inject:
     2626#f #chunk #m1 #b1 #ofs #v1 #n1 #m2 #b2 #delta #v2
     2627#MINJ #STORE #INJb1 #Hvalinj @(store_mapped_inject_1 … STORE) //;
     2628@val_content_inject_base //;
     2629qed.
     2630
     2631lemma store_unmapped_inject:
    26342632  ∀f,chunk,m1,b1,ofs,v1,n1,m2.
    26352633  mem_inject f m1 m2 →
     
    26372635  f b1 = None ? →
    26382636  mem_inject f n1 m2.
    2639 #f;#chunk;#m1;#b1;#ofs;#v1;#n1;#m2;
    2640 *;#mi_inj;#mi_freeblocks;#mi_mappedblock;#mi_no_overlap;#mi_range_1;#mi_range_2;
    2641 #STORE;#INJb1;@;
    2642 ##[ (* inj *) napply (store_unmapped_inj … STORE); //
    2643 ##| (* freeblocks *) #b;#notvalid; napply mi_freeblocks;
    2644     napply (not_to_not ??? notvalid); napply (store_valid_block_1 … STORE);
    2645 ##| (* mappedblocks *) #b;#b';#delta;#INJb; napply mi_mappedblock; //;
    2646 ##| (* no_overlap *) nwhd; #b1';#b1'';#delta1';#b2';#b2'';#delta2';#neqb';
    2647     #fb1';#fb2';
    2648     nrewrite > (low_bound_store … STORE ?);  nrewrite > (low_bound_store … STORE ?);
    2649     nrewrite > (high_bound_store … STORE ?);  nrewrite > (high_bound_store … STORE ?);
    2650     napply mi_no_overlap; //;
    2651 ##| (* range *) /2/
    2652 ##| /2/
    2653 ##] nqed.
    2654 
    2655 nlemma storev_mapped_inject_1:
     2637#f #chunk #m1 #b1 #ofs #v1 #n1 #m2
     2638*;#mi_inj #mi_freeblocks #mi_mappedblock #mi_no_overlap #mi_range_1 #mi_range_2
     2639#STORE #INJb1 %
     2640[ (* inj *) @(store_unmapped_inj … STORE) //
     2641| (* freeblocks *) #b #notvalid @mi_freeblocks
     2642    @(not_to_not ??? notvalid) @(store_valid_block_1 … STORE)
     2643| (* mappedblocks *) #b #b' #delta #INJb @mi_mappedblock //;
     2644| (* no_overlap *) whd; #b1' #b1'' #delta1' #b2' #b2'' #delta2' #neqb'
     2645    #fb1' #fb2'
     2646    >(low_bound_store … STORE ?)  >(low_bound_store … STORE ?)
     2647    >(high_bound_store … STORE ?)  >(high_bound_store … STORE ?)
     2648    @mi_no_overlap //;
     2649| (* range *) /2/
     2650| /2/
     2651] qed.
     2652
     2653lemma storev_mapped_inject_1:
    26562654  ∀f,chunk,m1,a1,v1,n1,m2,a2,v2.
    26572655  mem_inject f m1 m2 →
     
    26612659  ∃n2.
    26622660    storev chunk m2 a2 v2 = Some ? n2 ∧ mem_inject f n1 n2.
    2663 #f;#chunk;#m1;#a1;#v1;#n1;#m2;#a2;#v2;
    2664 #MINJ;#STORE;#Hvinj;#Hvcinj;
    2665 ninversion Hvinj;
    2666 ##[ ##1,2,4:#x;#ex1;#ex2;nrewrite > ex1 in STORE; nwhd in ⊢ ((??%?)→?); #H;
    2667     napply False_ind; ndestruct; ##]
    2668 #b;#ofs;#b';#ofs';#delta;#INJb;#Hofs;#ea1;#ea2;
    2669 nrewrite > Hofs; nrewrite > ea1 in STORE; #STORE;
    2670 nlapply (store_mapped_inject_1 … MINJ STORE … INJb Hvcinj);
    2671 nrewrite < (?:signed (add ofs (repr delta)) = signed ofs + delta); //;
    2672 napply (address_inject … chunk … MINJ ? INJb);
    2673 napply (store_valid_access_3 … STORE);
    2674 nqed.
    2675 
    2676 nlemma storev_mapped_inject:
     2661#f #chunk #m1 #a1 #v1 #n1 #m2 #a2 #v2
     2662#MINJ #STORE #Hvinj #Hvcinj
     2663inversion Hvinj;
     2664[ 1,2,4:#x #ex1 #ex2 >ex1 in STORE whd in ⊢ ((??%?)→?); #H
     2665    @False_ind destruct; ]
     2666#b #ofs #b' #ofs' #delta #INJb #Hofs #ea1 #ea2
     2667>Hofs >ea1 in STORE #STORE
     2668lapply (store_mapped_inject_1 … MINJ STORE … INJb Hvcinj);
     2669<(?:signed (add ofs (repr delta)) = signed ofs + delta) //;
     2670@(address_inject … chunk … MINJ ? INJb)
     2671@(store_valid_access_3 … STORE)
     2672qed.
     2673
     2674lemma storev_mapped_inject:
    26772675  ∀f,chunk,m1,a1,v1,n1,m2,a2,v2.
    26782676  mem_inject f m1 m2 →
     
    26822680  ∃n2.
    26832681    storev chunk m2 a2 v2 = Some ? n2 ∧ mem_inject f n1 n2.
    2684 #f;#chunk;#m1;#a1;#v1;#n1;#m2;#a2;#v2; #MINJ;#STOREV;#Hvinj;#Hvinj';
    2685 napply (storev_mapped_inject_1 … STOREV); /2/;
    2686 nqed.
     2682#f #chunk #m1 #a1 #v1 #n1 #m2 #a2 #v2 #MINJ #STOREV #Hvinj #Hvinj'
     2683@(storev_mapped_inject_1 … STOREV) /2/;
     2684qed.
    26872685
    26882686(* Relation between injections and [free] *)
    26892687
    2690 nlemma meminj_no_overlap_free:
     2688lemma meminj_no_overlap_free:
    26912689  ∀mi,m,b.
    26922690  meminj_no_overlap mi m →
    26932691  meminj_no_overlap mi (free m b).
    2694 #mi;#m;#b;#H;nwhd;#b1;#b1';#delta1;#b2;#b2';#delta2;#Hne;#mi1;#mi2;
    2695 ncut (low_bound (free m b) b ≥ high_bound (free m b) b);
    2696 ##[ nrewrite > (low_bound_free_same …); nrewrite > (high_bound_free_same …);// ##]
    2697 #Hbounds;
    2698 ncases (decidable_eq_Z b1 b);#e1; ##[ nrewrite > e1 in Hne mi1 ⊢ %;#Hne;#mi1;##]
    2699 ncases (decidable_eq_Z b2 b);#e2; ##[ ##1,3: nrewrite > e2 in Hne mi2 ⊢ %;#Hne;#mi2;##]
    2700 ##[ napply False_ind; nelim Hne; /2/
    2701 ##| @;@2;//;
    2702 ##| @;@;@2;//
    2703 ##| nrewrite > (low_bound_free …);//; nrewrite > (low_bound_free …);//;
    2704     nrewrite > (high_bound_free …);//; nrewrite > (high_bound_free …);//;
     2692#mi #m #b #H whd;#b1 #b1' #delta1 #b2 #b2' #delta2 #Hne #mi1 #mi2
     2693cut (low_bound (free m b) b ≥ high_bound (free m b) b);
     2694[ >(low_bound_free_same …) >(high_bound_free_same …) // ]
     2695#Hbounds
     2696cases (decidable_eq_Z b1 b);#e1 [ >e1 in Hne mi1 ⊢ % #Hne #mi1 ]
     2697cases (decidable_eq_Z b2 b);#e2 [ 1,3: >e2 in Hne mi2 ⊢ % #Hne #mi2 ]
     2698[ @False_ind elim Hne; /2/
     2699| % %{2} //;
     2700| % % %{2} //
     2701| >(low_bound_free …) //; >(low_bound_free …) //;
     2702    >(high_bound_free …) //; >(high_bound_free …) //;
    27052703    /2/;
    2706 ##] nqed.
    2707 
    2708 nlemma meminj_no_overlap_free_list:
     2704] qed.
     2705
     2706lemma meminj_no_overlap_free_list:
    27092707  ∀mi,m,bl.
    27102708  meminj_no_overlap mi m →
    27112709  meminj_no_overlap mi (free_list m bl).
    2712 #mi;#m;#bl; nelim bl;
    2713 ##[ #H; nwhd in ⊢ (??%); //
    2714 ##| #h;#t; #IH; #H; napply meminj_no_overlap_free; napply IH; //
    2715 ##] nqed.
    2716 
    2717 nlemma free_inject:
     2710#mi #m #bl elim bl;
     2711[ #H whd in ⊢ (??%); //
     2712| #h #t #IH #H @meminj_no_overlap_free @IH //
     2713] qed.
     2714
     2715lemma free_inject:
    27182716  ∀f,m1,m2,l,b.
    27192717  (∀b1,delta. f b1 = Some ? 〈b, delta〉 → in_list ? b1 l) →
    27202718  mem_inject f m1 m2 →
    27212719  mem_inject f (free_list m1 l) (free m2 b).
    2722 #f;#m1;#m2;#l;#b;#mappedin;
    2723 *;#mi_inj;#mi_freeblocks;#mi_mappedblock;#mi_no_overlap;#mi_range_1;#mi_range_2;
    2724 @;
    2725 ##[ (* inj *)
    2726     napply free_right_inj; ##[ napply free_list_left_inj; //; ##]
    2727     #b1;#delta;#chunk;#ofs;#INJb1; napply nmk; #Hvalid;
    2728     nelim (valid_access_free_list_inv … Hvalid); #b1ni; #Haccess;
    2729     napply (absurd ? (mappedin ?? INJb1) b1ni);
    2730 ##| (* freeblocks *)
    2731     #b';#notvalid; napply mi_freeblocks; napply (not_to_not ??? notvalid);
    2732     #H; napply valid_block_free_list_1; //
    2733 ##| (* mappedblocks *)
    2734     #b1;#b1';#delta;#INJb1; napply valid_block_free_1; /2/
    2735 ##| (* overlap *)
    2736     napply meminj_no_overlap_free_list; //
    2737 ##| (* range *)
     2720#f #m1 #m2 #l #b #mappedin
     2721*;#mi_inj #mi_freeblocks #mi_mappedblock #mi_no_overlap #mi_range_1 #mi_range_2
     2722%
     2723[ (* inj *)
     2724    @free_right_inj [ @free_list_left_inj //; ]
     2725    #b1 #delta #chunk #ofs #INJb1 @nmk #Hvalid
     2726    elim (valid_access_free_list_inv … Hvalid); #b1ni #Haccess
     2727    @(absurd ? (mappedin ?? INJb1) b1ni)
     2728| (* freeblocks *)
     2729    #b' #notvalid @mi_freeblocks @(not_to_not ??? notvalid)
     2730    #H @valid_block_free_list_1 //
     2731| (* mappedblocks *)
     2732    #b1 #b1' #delta #INJb1 @valid_block_free_1 /2/
     2733| (* overlap *)
     2734    @meminj_no_overlap_free_list //
     2735| (* range *)
    27382736    /2/
    2739 ##| #b1;#b2;#delta;#INJb1; ncases (decidable_eq_Z b2 b); #eb;
    2740     ##[ nrewrite > eb;
    2741         nrewrite > (low_bound_free_same ??); nrewrite > (high_bound_free_same ??);
    2742         @2; (* arith *) napply daemon
    2743     ##| nrewrite > (low_bound_free …); //; nrewrite > (high_bound_free …); /2/;
    2744     ##]
    2745 ##] nqed.
     2737| #b1 #b2 #delta #INJb1 cases (decidable_eq_Z b2 b); #eb
     2738    [ >eb
     2739        >(low_bound_free_same ??) >(high_bound_free_same ??)
     2740        %{2} (* arith *) napply daemon
     2741    | >(low_bound_free …) //; >(high_bound_free …) /2/;
     2742    ]
     2743] qed.
    27462744
    27472745(* Monotonicity properties of memory injections. *)
    27482746
    2749 ndefinition inject_incr : meminj → meminj → Prop ≝ λf1,f2.
     2747definition inject_incr : meminj → meminj → Prop ≝ λf1,f2.
    27502748  ∀b. f1 b = f2 b ∨ f1 b = None ?.
    27512749
    2752 nlemma inject_incr_refl :
     2750lemma inject_incr_refl :
    27532751   ∀f. inject_incr f f .
    2754 #f;nwhd;#b;@;//; nqed.
    2755 
    2756 nlemma inject_incr_trans :
     2752#f whd;#b % //; qed.
     2753
     2754lemma inject_incr_trans :
    27572755  ∀f1,f2,f3.
    27582756  inject_incr f1 f2 → inject_incr f2 f3 → inject_incr f1 f3 .
    2759 #f1;#f2;#f3;nwhd in ⊢ (%→%→%);#H1;#H2;#b;
    2760 nelim (H1 b); nelim (H2 b); /2/; nqed.
    2761 
    2762 nlemma val_inject_incr:
     2757#f1 #f2 #f3 whd in ⊢ (%→%→%);#H1 #H2 #b
     2758elim (H1 b); elim (H2 b); /2/; qed.
     2759
     2760lemma val_inject_incr:
    27632761  ∀f1,f2,v,v'.
    27642762  inject_incr f1 f2 →
    27652763  val_inject f1 v v' →
    27662764  val_inject f2 v v'.
    2767 #f1;#f2;#v;#v';#Hincr;#Hvinj;
    2768 ninversion Hvinj;
    2769 ##[ ##1,2,4: #x;#_;#_; //;
    2770 ##|#b;#ofs;#b';#ofs';#delta; #INJb; #Hofs; #_;#_;
    2771 nelim (Hincr b); #H;
    2772 ##[ napply (val_inject_ptr ??????? Hofs); /2/;
    2773 ##| napply False_ind; nrewrite > INJb in H; #H; ndestruct;
    2774 ##] nqed.
    2775 
    2776 nlemma val_list_inject_incr:
     2765#f1 #f2 #v #v' #Hincr #Hvinj
     2766inversion Hvinj;
     2767[ 1,2,4: #x #_ #_ //;
     2768|#b #ofs #b' #ofs' #delta #INJb #Hofs #_ #_
     2769elim (Hincr b); #H
     2770[ @(val_inject_ptr ??????? Hofs) /2/;
     2771| @False_ind >INJb in H #H destruct;
     2772] qed.
     2773
     2774lemma val_list_inject_incr:
    27772775  ∀f1,f2,vl,vl'.
    27782776  inject_incr f1 f2 → val_list_inject f1 vl vl' →
    27792777  val_list_inject f2 vl vl'.
    2780 #f1;#f2;#vl;nelim vl;
    2781 ##[ #vl'; #Hincr; #H; ninversion H; //; #v;#v';#l;#l0;#_;#_;#_; #H; ndestruct;
    2782 ##| #h;#t;#IH;#vl';#Hincr;#H1; ninversion H1;
    2783   ##[ #H; ndestruct
    2784   ##| #h';#h'';#t';#t''; #Hinj1; #Hintt; #_; #e1; #e2; ndestruct;
    2785       @2;/2/; napply IH; //; napply Hincr;
    2786   ##]
    2787 ##] nqed.
     2778#f1 #f2 #vl elim vl;
     2779[ #vl' #Hincr #H inversion H; //; #v #v' #l #l0 #_ #_ #_ #H destruct;
     2780| #h #t #IH #vl' #Hincr #H1 inversion H1;
     2781  [ #H destruct
     2782  | #h' #h'' #t' #t'' #Hinj1 #Hintt #_ #e1 #e2 destruct;
     2783      %{2} /2/; @IH //; @Hincr
     2784  ]
     2785] qed.
    27882786
    27892787(*
     
    27932791(* Properties of injections and allocations. *)
    27942792
    2795 ndefinition extend_inject ≝
     2793definition extend_inject ≝
    27962794       λb: block. λx: option (block × Z). λf: meminj.
    27972795  λb': block. if eqZb b' b then x else f b'.
    27982796
    2799 nlemma extend_inject_incr:
     2797lemma extend_inject_incr:
    28002798  ∀f,b,x.
    28012799  f b = None ? →
    28022800  inject_incr f (extend_inject b x f).
    2803 #f;#b;#x;#INJb;nwhd;#b'; nwhd in ⊢ (?(???%)?);
    2804 napply (eqZb_elim b' b); #eb; /2/;
    2805 nqed.
    2806 
    2807 nlemma alloc_right_inject:
     2801#f #b #x #INJb whd;#b' whd in ⊢ (?(???%)?);
     2802@(eqZb_elim b' b) #eb /2/;
     2803qed.
     2804
     2805lemma alloc_right_inject:
    28082806  ∀f,m1,m2,lo,hi,m2',b.
    28092807  mem_inject f m1 m2 →
    28102808  alloc m2 lo hi = 〈m2', b〉 →
    28112809  mem_inject f m1 m2'.
    2812 #f;#m1;#m2;#lo;#hi;#m2';#b;
    2813 *;#mi_inj;#mi_freeblocks;#mi_mappedblock;#mi_no_overlap;#mi_range_1;#mi_range_2;
    2814 #ALLOC; @;
    2815 ##[ napply (alloc_right_inj … ALLOC); //;
    2816 ##| /2/;
    2817 ##| #b1;#b2;#delta;#INJb1; napply (valid_block_alloc … ALLOC); /2/;
    2818 ##| //;
    2819 ##| /2/;
    2820 ##|#b1;#b2;#delta;#INJb1; nrewrite > (?:low_bound m2' b2 = low_bound m2 b2);
    2821    ##[ nrewrite > (?:high_bound m2' b2 = high_bound m2 b2); /2/;
    2822        napply high_bound_alloc_other; /2/;
    2823    ##| napply low_bound_alloc_other; /2/
    2824    ##]
    2825 ##] nqed.
    2826 
    2827 nlemma alloc_unmapped_inject:
     2810#f #m1 #m2 #lo #hi #m2' #b
     2811*;#mi_inj #mi_freeblocks #mi_mappedblock #mi_no_overlap #mi_range_1 #mi_range_2
     2812#ALLOC %
     2813[ @(alloc_right_inj … ALLOC) //;
     2814| /2/;
     2815| #b1 #b2 #delta #INJb1 @(valid_block_alloc … ALLOC) /2/;
     2816| //;
     2817| /2/;
     2818|#b1 #b2 #delta #INJb1 >(?:low_bound m2' b2 = low_bound m2 b2)
     2819   [ >(?:high_bound m2' b2 = high_bound m2 b2) /2/;
     2820       @high_bound_alloc_other /2/;
     2821   | @low_bound_alloc_other /2/
     2822   ]
     2823] qed.
     2824
     2825lemma alloc_unmapped_inject:
    28282826  ∀f,m1,m2,lo,hi,m1',b.
    28292827  mem_inject f m1 m2 →
     
    28312829  mem_inject (extend_inject b (None ?) f) m1' m2 ∧
    28322830  inject_incr f (extend_inject b (None ?) f).
    2833 #f;#m1;#m2;#lo;#hi;#m1';#b;
    2834 *;#mi_inj;#mi_freeblocks;#mi_mappedblock;#mi_no_overlap;#mi_range_1;#mi_range_2;
    2835 #ALLOC;
    2836 ncut (inject_incr f (extend_inject b (None ?) f));
    2837 ##[ napply extend_inject_incr; napply mi_freeblocks; /2/; ##]
    2838 #Hinject_incr; @; //; @;
    2839 ##[ (* inj *)
    2840     napply (alloc_left_unmapped_inj … ALLOC);
    2841     ##[ ##2: nwhd in ⊢ (??%?); nrewrite > (eqZb_z_z …); /2/; ##]
    2842     nwhd; #chunk;#b1;#ofs;#v1;#b2;#delta;
    2843     nwhd in ⊢ ((??%?)→?→?); napply eqZb_elim; #e; nwhd in ⊢ ((??%?)→?→?);
    2844     #Hextend;#LOAD;
    2845     ##[ ndestruct;
    2846     ##| nlapply (mi_inj … Hextend LOAD); *; #v2; *; #LOAD2; #VINJ;
    2847     @ v2; @; //;
    2848     napply val_inject_incr; //;
    2849     ##]
    2850 ##| (* freeblocks *)
    2851     #b';#Hinvalid; nwhd in ⊢ (??%?); napply (eqZb_elim b' b); //;
    2852     #neb; napply mi_freeblocks; napply (not_to_not ??? Hinvalid);
    2853     napply valid_block_alloc; //;
    2854 ##| (* mappedblocks *)
    2855     #b1;#b2;#delta; nwhd in ⊢ (??%?→?); napply (eqZb_elim b1 b); #eb;
    2856     ##[ #H; ndestruct;
    2857     ##| #H; napply (mi_mappedblock … H);
    2858     ##]
    2859 ##| (* overlap *)
    2860     nwhd; #b1;#b1';#delta1;#b2;#b2';#delta2; #neb1; nwhd in ⊢ (??%?→??%?→?);
    2861     nrewrite > (low_bound_alloc … ALLOC ?); nrewrite > (low_bound_alloc … ALLOC ?);
    2862     nrewrite > (high_bound_alloc … ALLOC ?); nrewrite > (high_bound_alloc … ALLOC ?);
    2863     nlapply (eqZb_to_Prop b1 b); nelim (eqZb b1 b); #e; #INJb1;
    2864     ##[ ndestruct
    2865     ##| nlapply (eqZb_to_Prop b2 b); nelim (eqZb b2 b); #e2; #INJb2;
    2866       ##[ ndestruct
    2867       ##| napply mi_no_overlap; /2/;
    2868       ##]
    2869     ##]
    2870 ##| (* range *)
    2871     #b1;#b2;#delta; nwhd in ⊢ (??%?→?);
    2872     nlapply (eqZb_to_Prop b1 b); nelim (eqZb b1 b); #e; #INJb1;
    2873     ##[ ndestruct
    2874     ##| napply (mi_range_1 … INJb1);
    2875     ##]
    2876 ##| #b1;#b2;#delta; nwhd in ⊢ (??%?→?);
    2877     nlapply (eqZb_to_Prop b1 b); nelim (eqZb b1 b); #e; #INJb1;
    2878     ##[  ndestruct
    2879     ##| napply (mi_range_2 … INJb1);
    2880     ##]
    2881 ##] nqed.
    2882 
    2883 nlemma alloc_mapped_inject:
     2831#f #m1 #m2 #lo #hi #m1' #b
     2832*;#mi_inj #mi_freeblocks #mi_mappedblock #mi_no_overlap #mi_range_1 #mi_range_2
     2833#ALLOC
     2834cut (inject_incr f (extend_inject b (None ?) f));
     2835[ @extend_inject_incr @mi_freeblocks /2/; ]
     2836#Hinject_incr % //; %
     2837[ (* inj *)
     2838    @(alloc_left_unmapped_inj … ALLOC)
     2839    [ 2: whd in ⊢ (??%?); >(eqZb_z_z …) /2/; ]
     2840    whd; #chunk #b1 #ofs #v1 #b2 #delta
     2841    whd in ⊢ ((??%?)→?→?); @eqZb_elim #e whd in ⊢ ((??%?)→?→?);
     2842    #Hextend #LOAD
     2843    [ destruct;
     2844    | lapply (mi_inj … Hextend LOAD); *; #v2 *; #LOAD2 #VINJ
     2845    %{ v2} % //;
     2846    @val_inject_incr //;
     2847    ]
     2848| (* freeblocks *)
     2849    #b' #Hinvalid whd in ⊢ (??%?); @(eqZb_elim b' b) //;
     2850    #neb @mi_freeblocks @(not_to_not ??? Hinvalid)
     2851    @valid_block_alloc //;
     2852| (* mappedblocks *)
     2853    #b1 #b2 #delta whd in ⊢ (??%?→?); @(eqZb_elim b1 b) #eb
     2854    [ #H destruct;
     2855    | #H @(mi_mappedblock … H)
     2856    ]
     2857| (* overlap *)
     2858    whd; #b1 #b1' #delta1 #b2 #b2' #delta2 #neb1 whd in ⊢ (??%?→??%?→?);
     2859    >(low_bound_alloc … ALLOC ?) >(low_bound_alloc … ALLOC ?)
     2860    >(high_bound_alloc … ALLOC ?) >(high_bound_alloc … ALLOC ?)
     2861    lapply (eqZb_to_Prop b1 b); elim (eqZb b1 b); #e #INJb1
     2862    [ destruct
     2863    | lapply (eqZb_to_Prop b2 b); elim (eqZb b2 b); #e2 #INJb2
     2864      [ destruct
     2865      | @mi_no_overlap /2/;
     2866      ]
     2867    ]
     2868| (* range *)
     2869    #b1 #b2 #delta whd in ⊢ (??%?→?);
     2870    lapply (eqZb_to_Prop b1 b); elim (eqZb b1 b); #e #INJb1
     2871    [ destruct
     2872    | @(mi_range_1 … INJb1)
     2873    ]
     2874| #b1 #b2 #delta whd in ⊢ (??%?→?);
     2875    lapply (eqZb_to_Prop b1 b); elim (eqZb b1 b); #e #INJb1
     2876    destruct
     2877    | @(mi_range_2 … INJb1)
     2878    ]
     2879] qed.
     2880
     2881lemma alloc_mapped_inject:
    28842882  ∀f,m1,m2,lo,hi,m1',b,b',ofs.
    28852883  mem_inject f m1 m2 →
     
    28982896  mem_inject (extend_inject b (Some ? 〈b', ofs〉) f) m1' m2 ∧
    28992897  inject_incr f (extend_inject b (Some ? 〈b', ofs〉) f).
    2900 #f;#m1;#m2;#lo;#hi;#m1';#b;#b';#ofs;
    2901 *;#mi_inj;#mi_freeblocks;#mi_mappedblock;#mi_no_overlap;#mi_range_1;#mi_range_2;
    2902 #ALLOC;#validb';#rangeofs;#rangelo;#rangehi;#boundlo;#boundhi;#injaligned;#boundmapped;
    2903 ncut (inject_incr f (extend_inject b (Some ? 〈b', ofs〉) f));
    2904 ##[ napply extend_inject_incr; napply mi_freeblocks; /2/; ##]
    2905 #Hincr; @; //; @;
    2906 ##[ (* inj *)
    2907     napply (alloc_left_mapped_inj … ALLOC … validb' boundlo boundhi); /2/;
    2908     ##[ ##2:nwhd in ⊢ (??%?); nrewrite > (eqZb_z_z …); /2/; ##]
    2909     nwhd; #chunk;#b1;#ofs';#v1;#b2;#delta;#Hextend;#LOAD;
    2910     nwhd in Hextend:(??%?); nrewrite > (eqZb_false b1 b ?) in Hextend;
    2911     ##[ #Hextend; nlapply (mi_inj … Hextend LOAD);
    2912         *; #v2; *; #LOAD2; #VINJ;
    2913     @ v2; @; //;
    2914     napply val_inject_incr; //;
    2915     ##| napply (valid_not_valid_diff m1); /2/;
    2916         napply (valid_access_valid_block … chunk … ofs'); /2/;
    2917     ##]
    2918 ##| (* freeblocks *)
    2919     #b';#Hinvalid; nwhd in ⊢ (??%?); nrewrite > (eqZb_false b' b ?);
    2920     ##[ napply mi_freeblocks; napply (not_to_not ??? Hinvalid);
    2921     napply valid_block_alloc; //;
    2922     ##| napply sym_neq; napply (valid_not_valid_diff m1'); //;
    2923         napply (valid_new_block … ALLOC);
    2924     ##]
    2925 ##| (* mappedblocks *)
    2926     #b1;#b2;#delta; nwhd in ⊢ (??%?→?); napply (eqZb_elim b1 b); #eb;#einj;
    2927     ##[ ndestruct; //;
    2928     ##| napply (mi_mappedblock … einj);
    2929     ##]
    2930 ##| (* overlap *)
    2931     nwhd; #b1;#b1';#delta1;#b2;#b2';#delta2; #neb1; nwhd in ⊢ (??%?→??%?→?);
    2932     nrewrite > (low_bound_alloc … ALLOC ?); nrewrite > (low_bound_alloc … ALLOC ?);
    2933     nrewrite > (high_bound_alloc … ALLOC ?); nrewrite > (high_bound_alloc … ALLOC ?);
    2934     nlapply (eqZb_to_Prop b1 b); nelim (eqZb b1 b); #e; #INJb1;
    2935     ##[ nelim (grumpydestruct2 ?????? INJb1); #eb1';#eofs1 ##]
    2936     nlapply (eqZb_to_Prop b2 b); nelim (eqZb b2 b); #e2; #INJb2;
    2937     ##[ nelim (grumpydestruct2 ?????? INJb2); #eb2';#eofs2 ##]
    2938     ##[ napply False_ind; nrewrite > e in neb1; nrewrite > e2; /2/;
    2939     ##| nelim (decidable_eq_Z b1' b2'); #e';
    2940         ##[ nrewrite < e' in INJb2 ⊢ %; nrewrite < eb1'; nrewrite < eofs1; #INJb2; nlapply (boundmapped … INJb2);
    2941             *; #H; @2; ##[ @2 ##| @1 ##] napply H;
    2942         ##| @1;@1;@1; napply e'
    2943         ##]
    2944     ##| nelim (decidable_eq_Z b1' b2'); #e';
    2945         ##[ nrewrite < e' in INJb2 ⊢ %; #INJb2; nelim (grumpydestruct2 ?????? INJb2); #eb'; #eofs; nrewrite < eb' in INJb1; nrewrite < eofs; #INJb1; nlapply (boundmapped … INJb1);
    2946             *; #H; @2; ##[ @1; /2/ ##| @2; napply H; ##]
    2947         ##| @1;@1;@1; napply e'
    2948         ##]
    2949     ##| napply mi_no_overlap; /2/;
    2950     ##]
    2951 ##| (* range *)
    2952     #b1;#b2;#delta; nwhd in ⊢ (??%?→?);
    2953     nlapply (eqZb_to_Prop b1 b); nelim (eqZb b1 b); #e; #INJb1;
    2954     ##[ ndestruct; /2/;
    2955     ##| napply (mi_range_1 … INJb1);
    2956     ##]
    2957 ##| #b1;#b2;#delta; nwhd in ⊢ (??%?→?);
    2958     nlapply (eqZb_to_Prop b1 b); nelim (eqZb b1 b); #e; #INJb1;
    2959     ##[ ndestruct; @2;@;/2/;
    2960     ##| napply (mi_range_2 … INJb1);
    2961     ##]
    2962 ##] nqed.
    2963 
    2964 nlemma alloc_parallel_inject:
     2898#f #m1 #m2 #lo #hi #m1' #b #b' #ofs
     2899*;#mi_inj #mi_freeblocks #mi_mappedblock #mi_no_overlap #mi_range_1 #mi_range_2
     2900#ALLOC #validb' #rangeofs #rangelo #rangehi #boundlo #boundhi #injaligned #boundmapped
     2901cut (inject_incr f (extend_inject b (Some ? 〈b', ofs〉) f));
     2902[ @extend_inject_incr @mi_freeblocks /2/; ]
     2903#Hincr % //; %
     2904[ (* inj *)
     2905    @(alloc_left_mapped_inj … ALLOC … validb' boundlo boundhi) /2/;
     2906    [ 2:whd in ⊢ (??%?); >(eqZb_z_z …) /2/; ]
     2907    whd; #chunk #b1 #ofs' #v1 #b2 #delta #Hextend #LOAD
     2908    whd in Hextend:(??%?); >(eqZb_false b1 b ?) in Hextend
     2909    [ #Hextend lapply (mi_inj … Hextend LOAD);
     2910        *; #v2 *; #LOAD2 #VINJ
     2911    %{ v2} % //;
     2912    @val_inject_incr //;
     2913    | @(valid_not_valid_diff m1) /2/;
     2914        @(valid_access_valid_block … chunk … ofs') /2/;
     2915    ]
     2916| (* freeblocks *)
     2917    #b' #Hinvalid whd in ⊢ (??%?); >(eqZb_false b' b ?)
     2918    [ @mi_freeblocks @(not_to_not ??? Hinvalid)
     2919    @valid_block_alloc //;
     2920    | @sym_neq @(valid_not_valid_diff m1') //;
     2921        @(valid_new_block … ALLOC)
     2922    ]
     2923| (* mappedblocks *)
     2924    #b1 #b2 #delta whd in ⊢ (??%?→?); @(eqZb_elim b1 b) #eb #einj
     2925    [ destruct; //;
     2926    | @(mi_mappedblock … einj)
     2927    ]
     2928| (* overlap *)
     2929    whd; #b1 #b1' #delta1 #b2 #b2' #delta2 #neb1 whd in ⊢ (??%?→??%?→?);
     2930    >(low_bound_alloc … ALLOC ?) >(low_bound_alloc … ALLOC ?)
     2931    >(high_bound_alloc … ALLOC ?) >(high_bound_alloc … ALLOC ?)
     2932    lapply (eqZb_to_Prop b1 b); elim (eqZb b1 b); #e #INJb1
     2933    [ elim (grumpydestruct2 ?????? INJb1); #eb1' #eofs1 ]
     2934    lapply (eqZb_to_Prop b2 b); elim (eqZb b2 b); #e2 #INJb2
     2935    [ elim (grumpydestruct2 ?????? INJb2); #eb2' #eofs2 ]
     2936    [ @False_ind >e in neb1 >e2 /2/;
     2937    | elim (decidable_eq_Z b1' b2'); #e'
     2938        [ <e' in INJb2 ⊢ % <eb1' <eofs1 #INJb2 lapply (boundmapped … INJb2);
     2939            *; #H %{2} [ %{2 | @1 ] napply H}
     2940        | %{1} %{1} %{1} napply e'
     2941        ]
     2942    | elim (decidable_eq_Z b1' b2'); #e'
     2943        [ <e' in INJb2 ⊢ % #INJb2 elim (grumpydestruct2 ?????? INJb2); #eb' #eofs <eb' in INJb1 <eofs #INJb1 lapply (boundmapped … INJb1);
     2944            *; #H %{2} [ %{1} /2/ | %{2} @H ]
     2945        | %{1} %{1} %{1} napply e'
     2946        ]
     2947    | @mi_no_overlap /2/;
     2948    ]
     2949| (* range *)
     2950    #b1 #b2 #delta whd in ⊢ (??%?→?);
     2951    lapply (eqZb_to_Prop b1 b); elim (eqZb b1 b); #e #INJb1
     2952    [ destruct; /2/;
     2953    | @(mi_range_1 … INJb1)
     2954    ]
     2955| #b1 #b2 #delta whd in ⊢ (??%?→?);
     2956    lapply (eqZb_to_Prop b1 b); elim (eqZb b1 b); #e #INJb1
     2957    [ destruct; %{2} % /2/;
     2958    | @(mi_range_2 … INJb1)
     2959    ]
     2960] qed.
     2961
     2962lemma alloc_parallel_inject:
    29652963  ∀f,m1,m2,lo,hi,m1',m2',b1,b2.
    29662964  mem_inject f m1 m2 →
     
    29702968  mem_inject (extend_inject b1 (Some ? 〈b2, OZ〉) f) m1' m2' ∧
    29712969  inject_incr f (extend_inject b1 (Some ? 〈b2, OZ〉) f).
    2972 #f;#m1;#m2;#lo;#hi;#m1';#m2';#b1;#b2;
    2973 #Hminj;#ALLOC1;#ALLOC2;#Hlo;#Hhi;
    2974 napply (alloc_mapped_inject … ALLOC1); /2/;
    2975 ##[ napply (alloc_right_inject … Hminj ALLOC2);
    2976 ##| nrewrite > (low_bound_alloc_same … ALLOC2); //
    2977 ##| nrewrite > (high_bound_alloc_same … ALLOC2); //
    2978 ##| nrewrite > (low_bound_alloc_same … ALLOC2); //
    2979 ##| nrewrite > (high_bound_alloc_same … ALLOC2); //
    2980 ##| nwhd; (* arith *) napply daemon
    2981 ##| #b;#ofs;#INJb0; napply False_ind;
    2982     nelim Hminj;#mi_inj;#mi_freeblocks;#mi_mappedblock;#mi_no_overlap;#mi_range_1;#mi_range_2;
    2983     nlapply (mi_mappedblock … INJb0);
    2984     #H; napply (absurd ? H ?); /2/;
    2985 ##] nqed.
    2986 
    2987 ndefinition meminj_init ≝ λm: mem.
     2970#f #m1 #m2 #lo #hi #m1' #m2' #b1 #b2
     2971#Hminj #ALLOC1 #ALLOC2 #Hlo #Hhi
     2972@(alloc_mapped_inject … ALLOC1) /2/;
     2973[ @(alloc_right_inject … Hminj ALLOC2)
     2974| >(low_bound_alloc_same … ALLOC2) //
     2975| >(high_bound_alloc_same … ALLOC2) //
     2976| >(low_bound_alloc_same … ALLOC2) //
     2977| >(high_bound_alloc_same … ALLOC2) //
     2978| whd; (* arith *) napply daemon
     2979| #b #ofs #INJb0 @False_ind
     2980    elim Hminj;#mi_inj #mi_freeblocks #mi_mappedblock #mi_no_overlap #mi_range_1 #mi_range_2
     2981    lapply (mi_mappedblock … INJb0);
     2982    #H @(absurd ? H ?) /2/;
     2983] qed.
     2984
     2985definition meminj_init ≝ λm: mem.
    29882986  λb: block. if Zltb b (nextblock m) then Some ? 〈b, OZ〉 else None ?.
    29892987
    2990 ndefinition mem_inject_neutral ≝ λm: mem.
     2988definition mem_inject_neutral ≝ λm: mem.
    29912989  ∀f,chunk,b,ofs,v.
    29922990  load chunk m b ofs = Some ? v → val_inject f v v.
    29932991
    2994 nlemma init_inject:
     2992lemma init_inject:
    29952993  ∀m.
    29962994  mem_inject_neutral m →
    29972995  mem_inject (meminj_init m) m m.
    2998 #m;#neutral;@;
    2999 ##[ (* inj *)
    3000     nwhd; #chunk;#b1;#ofs;#v1;#b2;#delta; nwhd in ⊢ (??%?→?→?);
    3001     napply Zltb_elim_Type0; #ltb1; ##[
    3002     #H; nelim (grumpydestruct2 ?????? H); #eb1; #edelta;
    3003     nrewrite < eb1; nrewrite < edelta; #LOAD; @v1; @; //;
    3004     napply neutral; //;
    3005     ##| #H;nwhd in H:(??%?); ndestruct;
    3006     ##]
    3007 ##| (* free blocks *)
    3008     #b;nrewrite > (unfold_valid_block …); nwhd in ⊢ (?→??%?); #notvalid;
    3009     napply Zltb_elim_Type0; #ltb1;
    3010     ##[ napply False_ind; napply (absurd ? ltb1 notvalid)
    3011     ##| //
    3012     ##]
    3013 ##| (* mapped blocks *)
    3014     #b;#b';#delta;nwhd in ⊢ (??%?→?); nrewrite > (unfold_valid_block …);
    3015     napply Zltb_elim_Type0; #ltb;
    3016     #H; nwhd in H:(??%?); ndestruct; //
    3017 ##| (* overlap *)
    3018     nwhd; #b1;#b1';#delta1;#b2;#b2';#delta2;#neb1; nwhd in ⊢(??%?→??%?→?);
    3019     napply Zltb_elim_Type0; #ltb1;
    3020     ##[ #H; nwhd in H:(??%?); ndestruct;
    3021         napply Zltb_elim_Type0; #ltb2;
    3022         #H2; nwhd in H2:(??%?); ndestruct; @;@;@;/2/;
    3023     ##| #H; nwhd in H:(??%?); ndestruct;
    3024     ##]
    3025 ##| (* range *)
    3026     #b;#b';#delta;nwhd in ⊢ (??%?→?);
    3027     napply Zltb_elim_Type0; #ltb;
    3028     ##[ #H; nelim (grumpydestruct2 ?????? H); #eb; #edelta; nrewrite < edelta;
     2996#m #neutral %
     2997[ (* inj *)
     2998    whd; #chunk #b1 #ofs #v1 #b2 #delta whd in ⊢ (??%?→?→?);
     2999    @Zltb_elim_Type0 #ltb1 [
     3000    #H elim (grumpydestruct2 ?????? H); #eb1 #edelta
     3001    <eb1 <edelta #LOAD %{v1} % //;
     3002    @neutral //;
     3003    | #H whd in H:(??%?); destruct;
     3004    ]
     3005| (* free blocks *)
     3006    #b >(unfold_valid_block …) whd in ⊢ (?→??%?); #notvalid
     3007    @Zltb_elim_Type0 #ltb1
     3008    [ @False_ind napply (absurd ? ltb1 notvalid)
     3009    | //
     3010    ]
     3011| (* mapped blocks *)
     3012    #b #b' #delta whd in ⊢ (??%?→?); >(unfold_valid_block …)
     3013    @Zltb_elim_Type0 #ltb
     3014    #H whd in H:(??%?); destruct; //
     3015| (* overlap *)
     3016    whd; #b1 #b1' #delta1 #b2 #b2' #delta2 #neb1 whd in ⊢(??%?→??%?→?);
     3017    @Zltb_elim_Type0 #ltb1
     3018    [ #H whd in H:(??%?); destruct;
     3019        @Zltb_elim_Type0 #ltb2
     3020        #H2 whd in H2:(??%?); destruct; % % % /2/;
     3021    | #H whd in H:(??%?); destruct;
     3022    ]
     3023| (* range *)
     3024    #b #b' #delta whd in ⊢ (??%?→?);
     3025    @Zltb_elim_Type0 #ltb
     3026    [ #H elim (grumpydestruct2 ?????? H); #eb #edelta <edelta
    30293027        (* FIXME: should be in integers.ma *) napply daemon
    3030     ##| #H; nwhd in H:(??%?); ndestruct;
    3031     ##]
    3032 ##| (* range *)
    3033     #b;#b';#delta;nwhd in ⊢ (??%?→?);
    3034     napply Zltb_elim_Type0; #ltb;
    3035     ##[ #H; nelim (grumpydestruct2 ?????? H); #eb; #edelta; nrewrite < edelta;
     3028    | #H whd in H:(??%?); destruct;
     3029    ]
     3030| (* range *)
     3031    #b #b' #delta whd in ⊢ (??%?→?);
     3032    @Zltb_elim_Type0 #ltb
     3033    [ #H elim (grumpydestruct2 ?????? H); #eb #edelta <edelta
    30363034        (* FIXME: should be in integers.ma *) napply daemon
    3037     ##| #H; nwhd in H:(??%?); ndestruct;
    3038     ##]
    3039 ##] nqed.
    3040 
    3041 nremark getN_setN_inject:
     3035    | #H whd in H:(??%?); destruct;
     3036    ]
     3037] qed.
     3038
     3039lemma getN_setN_inject:
    30423040  ∀f,m,v,n1,p1,n2,p2.
    30433041  val_inject f (getN n2 p2 m) (getN n2 p2 m) →
     
    30453043  val_inject f (getN n2 p2 (setN n1 p1 v m))
    30463044               (getN n2 p2 (setN n1 p1 v m)).
    3047 #f;#m;#v;#n1;#p1;#n2;#p2;#injget;#injv;
    3048 ncases (getN_setN_characterization m v n1 p1 n2 p2);##[ * ##] #A;
    3049 nrewrite > A; //;
    3050 nqed.
     3045#f #m #v #n1 #p1 #n2 #p2 #injget #injv
     3046cases (getN_setN_characterization m v n1 p1 n2 p2);[ * ] #A
     3047>A //;
     3048qed.
    30513049             
    3052 nremark getN_contents_init_data_inject:
     3050lemma getN_contents_init_data_inject:
    30533051  ∀f,n,ofs,id,pos.
    30543052  val_inject f (getN n ofs (contents_init_data pos id))
    30553053               (getN n ofs (contents_init_data pos id)).
    3056 #f;#n;#ofs;#id;nelim id;
    3057 ##[ #pos; nrewrite > (getN_init …); //
    3058 ##| #h;#t;#IH;#pos; ncases h;
    3059 ##[ ##1,2,3,4,5: #x; napply getN_setN_inject; //
    3060 ##| ##6,8: #x; napply IH ##| #x;#y;napply IH ##] (* XXX // doesn't work? *)
    3061 nqed.
    3062 
    3063 nlemma alloc_init_data_neutral:
     3054#f #n #ofs #id elim id;
     3055[ #pos >(getN_init …) //
     3056| #h #t #IH #pos cases h;
     3057[ 1,2,3,4,5: #x @getN_setN_inject //
     3058| 6,8: #x @IH | #x #y napply IH ] (* XXX // doesn't work? *)
     3059qed.
     3060
     3061lemma alloc_init_data_neutral:
    30643062  ∀m,id,m',b.
    30653063  mem_inject_neutral m →
    30663064  alloc_init_data m id = 〈m', b〉 →
    30673065  mem_inject_neutral m'.
    3068 #m;#id;#m';#b;#Hneutral;#INIT; nwhd in INIT:(??%?); (* XXX: ndestruct makes a bit of a mess *)
    3069 napply (pairdisc_elim … INIT);
    3070 nwhd in ⊢ (??%% → ?);#B;nrewrite < B in ⊢ (??%% → ?);
    3071 nwhd in ⊢ (??%% → ?);#A;
    3072 nwhd; #f;#chunk;#b';#ofs;#v; #LOAD;
    3073 nlapply (load_inv … LOAD); *; #C; #D;
    3074 nrewrite < B in D; nrewrite > A;
    3075 nrewrite > (unfold_update block_contents …); napply eqZb_elim;
    3076 ##[ #eb'; #D; nwhd in D:(???(??(???%))); nrewrite > D;
    3077     napply (load_result_inject … chunk); //; @;
    3078     napply getN_contents_init_data_inject;
    3079 ##| #neb'; #D; napply (Hneutral ? chunk b' ofs ??); nwhd in ⊢ (??%?);
    3080     nrewrite > (in_bounds_true m chunk b' ofs (option ?) …);
    3081     ##[ nrewrite < D; //
    3082     ##| nelim C; #Cval;#Clo;#Chi;#Cal; @;
    3083     ##[ nrewrite > (unfold_valid_block …);
    3084         nrewrite > (unfold_valid_block …) in Cval; nrewrite < B;
     3066#m #id #m' #b #Hneutral #INIT whd in INIT:(??%?); (* XXX: destruct makes a bit of a mess *)
     3067@(pairdisc_elim … INIT)
     3068whd in ⊢ (??%% → ?);#B <B in ⊢ (??%% → ?)
     3069whd in ⊢ (??%% → ?);#A
     3070whd; #f #chunk #b' #ofs #v #LOAD
     3071lapply (load_inv … LOAD); *; #C #D
     3072<B in D >A
     3073>(unfold_update block_contents …) @eqZb_elim
     3074[ #eb' #D whd in D:(???(??(???%))); >D
     3075    @(load_result_inject … chunk) //; %
     3076    @getN_contents_init_data_inject
     3077| #neb' #D @(Hneutral ? chunk b' ofs ??) whd in ⊢ (??%?);
     3078    >(in_bounds_true m chunk b' ofs (option ?) …)
     3079    [ <D //
     3080    | elim C; #Cval #Clo #Chi #Cal %
     3081    [ >(unfold_valid_block …)
     3082        >(unfold_valid_block …) in Cval <B
    30853083        (* arith using neb' *) napply daemon
    3086     ##| nrewrite > (?:low_bound m b' = low_bound m' b'); //;
    3087         nwhd in ⊢ (??%%); nrewrite < B; nrewrite > A;
    3088         nrewrite > (update_o block_contents …); //; napply sym_neq; //;
    3089     ##| nrewrite > (?:high_bound m b' = high_bound m' b'); //;
    3090         nwhd in ⊢ (??%%); nrewrite < B; nrewrite > A;
    3091         nrewrite > (update_o block_contents …); //; napply sym_neq; //;
    3092     ##| //;
    3093     ##]
    3094 ##] nqed.
     3084    | >(?:low_bound m b' = low_bound m' b') //;
     3085        whd in ⊢ (??%%); <B >A
     3086        >(update_o block_contents …) //; @sym_neq //;
     3087    | >(?:high_bound m b' = high_bound m' b') //;
     3088        whd in ⊢ (??%%); <B >A
     3089        >(update_o block_contents …) //; @sym_neq //;
     3090    | //;
     3091    ]
     3092] qed.
    30953093
    30963094
     
    31003098  each source block injects in a distinct target block. *)
    31013099
    3102 ndefinition memshift ≝ block → option Z.
    3103 
    3104 ndefinition meminj_of_shift : memshift → meminj ≝ λmi: memshift.
     3100definition memshift ≝ block → option Z.
     3101
     3102definition meminj_of_shift : memshift → meminj ≝ λmi: memshift.
    31053103  λb. match mi b with [ None ⇒ None ? | Some x ⇒ Some ? 〈b, x〉 ].
    31063104
    3107 ndefinition val_shift ≝ λmi: memshift. λv1,v2: val.
     3105definition val_shift ≝ λmi: memshift. λv1,v2: val.
    31083106  val_inject (meminj_of_shift mi) v1 v2.
    31093107
    3110 nrecord mem_shift (f: memshift) (m1,m2: mem) : Prop :=
     3108record mem_shift (f: memshift) (m1,m2: mem) : Prop :=
    31113109  {
    31123110    ms_inj:
     
    31293127  during address computations. *)
    31303128
    3131 nlemma address_shift:
     3129lemma address_shift:
    31323130  ∀f,m1,m2,chunk,b,ofs1,delta.
    31333131  mem_shift f m1 m2 →
     
    31353133  f b = Some ? delta →
    31363134  signed (add ofs1 (repr delta)) = signed ofs1 + delta.
    3137 #f;#m1;#m2;#chunk;#b;#ofs1;#delta;
    3138 *;#ms_inj;#ms_samedomain;#ms_domain;#ms_range_1;#ms_range_2;#Hvalid_access;#INJb;
    3139 nelim (ms_range_2 … INJb); #Hlo;#Hhi;
    3140 nrewrite > (add_signed …);
    3141 nrewrite > (signed_repr …); nrewrite > (signed_repr …); /2/;
    3142 ncut (valid_access m2 chunk b (signed ofs1 + delta));
    3143 ##[ napply (valid_access_inj ? (meminj_of_shift f) … ms_inj Hvalid_access);
    3144     nwhd in ⊢ (??%?); nrewrite > INJb; // ##]
    3145 *; (* arith *) napply daemon;
    3146 nqed.
    3147 
    3148 nlemma valid_pointer_shift_no_overflow:
     3135#f #m1 #m2 #chunk #b #ofs1 #delta
     3136*;#ms_inj #ms_samedomain #ms_domain #ms_range_1 #ms_range_2 #Hvalid_access #INJb
     3137elim (ms_range_2 … INJb); #Hlo #Hhi
     3138>(add_signed …)
     3139>(signed_repr …) >(signed_repr …) /2/;
     3140cut (valid_access m2 chunk b (signed ofs1 + delta));
     3141[ @(valid_access_inj ? (meminj_of_shift f) … ms_inj Hvalid_access)
     3142    whd in ⊢ (??%?); >INJb // ]
     3143*; (* arith *) @daemon
     3144qed.
     3145
     3146lemma valid_pointer_shift_no_overflow:
    31493147  ∀f,m1,m2,b,ofs,x.
    31503148  mem_shift f m1 m2 →
     
    31523150  f b = Some ? x →
    31533151  min_signed ≤ signed ofs + signed (repr x) ∧ signed ofs + signed (repr x) ≤ max_signed.
    3154 #f;#m1;#m2;#b;#ofs;#x;
    3155 *;#ms_inj;#ms_samedomain;#ms_domain;#ms_range_1;#ms_range_2;
    3156 #VALID;#INJb;
    3157 nlapply (proj1 ?? (valid_pointer_valid_access …) VALID); #Hvalid_access;
    3158 ncut (valid_access m2 Mint8unsigned b (signed ofs + x));
    3159 ##[ napply (valid_access_inj … ms_inj Hvalid_access);
    3160     nwhd in ⊢ (??%?); nrewrite > INJb; // ##]
    3161 *;#Hvalid_block;#Hlo;#Hhi;#Hal; nwhd in Hhi:(?(??%)?);
    3162 nrewrite > (signed_repr …); /2/;
    3163 nlapply (ms_range_2 … INJb);*;#A;#B;
    3164 (* arith *) napply daemon;
    3165 nqed.
    3166 
    3167 (* FIXME to get around ndestruct problems *)
    3168 nlemma vptr_eq_1 : ∀b,b',ofs,ofs'. Vptr b ofs = Vptr b' ofs' → b = b'.
    3169 #b;#b';#ofs;#ofs';#H;ndestruct;//;
    3170 nqed.
    3171 nlemma vptr_eq_2 : ∀b,b',ofs,ofs'. Vptr b ofs = Vptr b' ofs' → ofs = ofs'.
    3172 #b;#b';#ofs;#ofs';#H;ndestruct;//;
    3173 nqed.
    3174 
    3175 nlemma valid_pointer_shift:
     3152#f #m1 #m2 #b #ofs #x
     3153*;#ms_inj #ms_samedomain #ms_domain #ms_range_1 #ms_range_2
     3154#VALID #INJb
     3155lapply (proj1 ?? (valid_pointer_valid_access …) VALID); #Hvalid_access
     3156cut (valid_access m2 Mint8unsigned b (signed ofs + x));
     3157[ @(valid_access_inj … ms_inj Hvalid_access)
     3158    whd in ⊢ (??%?); >INJb // ]
     3159*;#Hvalid_block #Hlo #Hhi #Hal whd in Hhi:(?(??%)?);
     3160>(signed_repr …) /2/;
     3161lapply (ms_range_2 … INJb);*;#A #B
     3162(* arith *) @daemon
     3163qed.
     3164
     3165(* FIXME to get around destruct problems *)
     3166lemma vptr_eq_1 : ∀b,b',ofs,ofs'. Vptr b ofs = Vptr b' ofs' → b = b'.
     3167#b #b' #ofs #ofs' #H destruct;//;
     3168qed.
     3169lemma vptr_eq_2 : ∀b,b',ofs,ofs'. Vptr b ofs = Vptr b' ofs' → ofs = ofs'.
     3170#b #b' #ofs #ofs' #H destruct;//;
     3171qed.
     3172
     3173lemma valid_pointer_shift:
    31763174  ∀f,m1,m2,b,ofs,b',ofs'.
    31773175  mem_shift f m1 m2 →
     
    31793177  val_shift f (Vptr b ofs) (Vptr b' ofs') →
    31803178  valid_pointer m2 b' (signed ofs') = true.
    3181 #f;#m1;#m2;#b;#ofs;#b';#ofs';#Hmem_shift;#VALID;#Hval_shift;
    3182 nwhd in Hval_shift; ninversion Hval_shift;
    3183 ##[ ##1,2,4: #a; #H; ndestruct; ##]
    3184 #b1;#ofs1;#b2;#ofs2;#delta;#INJb1;#Hofs;#eb1;#eb2;
    3185 nrewrite < (vptr_eq_1 … eb1) in INJb1; nrewrite < (vptr_eq_1 … eb2); #INJb';
    3186 nrewrite < (vptr_eq_2 … eb1) in Hofs; nrewrite < (vptr_eq_2 … eb2); #Hofs; nrewrite > Hofs;
    3187 ncut (f b = Some ? delta);
    3188 ##[ nwhd in INJb':(??%?); ncases (f b) in INJb' ⊢ %;
    3189   ##[ #H; napply (False_ind … (grumpydestruct … H)); ##| #delta'; #H; nelim (grumpydestruct2 ?????? H); // ##]
    3190 ##] #INJb;
    3191 nlapply (valid_pointer_shift_no_overflow … VALID INJb); //; #NOOV;
    3192 nelim Hmem_shift;#ms_inj;#ms_samedomain;#ms_domain;#ms_range_1;#ms_range_2;
    3193 nrewrite > (add_signed …); nrewrite > (signed_repr …); //;
    3194 nrewrite > (signed_repr …); /2/;
    3195 napply (valid_pointer_inj … VALID); /2/;
    3196 nqed.
     3179#f #m1 #m2 #b #ofs #b' #ofs' #Hmem_shift #VALID #Hval_shift
     3180whd in Hval_shift; inversion Hval_shift;
     3181[ 1,2,4: #a #H destruct; ]
     3182#b1 #ofs1 #b2 #ofs2 #delta #INJb1 #Hofs #eb1 #eb2
     3183<(vptr_eq_1 … eb1) in INJb1 <(vptr_eq_1 … eb2) #INJb'
     3184<(vptr_eq_2 … eb1) in Hofs <(vptr_eq_2 … eb2) #Hofs >Hofs
     3185cut (f b = Some ? delta);
     3186[ whd in INJb':(??%?); cases (f b) in INJb' ⊢ %;
     3187  [ #H @(False_ind … (grumpydestruct … H)) | #delta' #H elim (grumpydestruct2 ?????? H); // ]
     3188] #INJb
     3189lapply (valid_pointer_shift_no_overflow … VALID INJb); //; #NOOV
     3190elim Hmem_shift;#ms_inj #ms_samedomain #ms_domain #ms_range_1 #ms_range_2
     3191>(add_signed …) >(signed_repr …) //;
     3192>(signed_repr …) /2/;
     3193@(valid_pointer_inj … VALID) /2/;
     3194qed.
    31973195
    31983196(* Relation between shifts and loads. *)
    31993197
    3200 nlemma load_shift:
     3198lemma load_shift:
    32013199  ∀f,m1,m2,chunk,b,ofs,delta,v1.
    32023200  mem_shift f m1 m2 →
     
    32043202  f b = Some ? delta →
    32053203  ∃v2. load chunk m2 b (ofs + delta) = Some ? v2 ∧ val_shift f v1 v2.
    3206 #f;#m1;#m2;#chunk;#b;#ofs;#delta;#v1;
    3207 *;#ms_inj;#ms_samedomain;#ms_domain;#ms_range_1;#ms_range_2;
    3208 #LOAD; #INJb;
    3209 nwhd in ⊢ (??(λ_.??%)); napply (ms_inj … LOAD);
    3210 nwhd in ⊢ (??%?); nrewrite > INJb; //;
    3211 nqed.
    3212 
    3213 nlemma loadv_shift:
     3204#f #m1 #m2 #chunk #b #ofs #delta #v1
     3205*;#ms_inj #ms_samedomain #ms_domain #ms_range_1 #ms_range_2
     3206#LOAD #INJb
     3207whd in ⊢ (??(λ_.??%)); @(ms_inj … LOAD)
     3208whd in ⊢ (??%?); >INJb //;
     3209qed.
     3210
     3211lemma loadv_shift:
    32143212  ∀f,m1,m2,chunk,a1,a2,v1.
    32153213  mem_shift f m1 m2 →
     
    32173215  val_shift f a1 a2 →
    32183216  ∃v2. loadv chunk m2 a2 = Some ? v2 ∧ val_shift f v1 v2.
    3219 #f;#m1;#m2;#chunk;#a1;#a2;#v1;#Hmem_shift;#LOADV;#Hval_shift;
    3220 ninversion Hval_shift;
    3221 ##[ ##1,2,4: #x;#H;nrewrite > H in LOADV;#H';nwhd in H':(??%?);napply False_ind; ndestruct; ##]
    3222 #b1;#ofs1;#b2;#ofs2;#delta;#INJb1;#Hofs;#ea1;#ea2; nrewrite > ea1 in LOADV; #LOADV;
    3223 nlapply INJb1; nwhd in ⊢ (??%? → ?);
    3224 nlapply (refl ? (f b1)); ncases (f b1) in ⊢ (???% → %);
    3225 ##[ #_; nwhd in ⊢ (??%? → ?); #H; napply False_ind; napply (False_ind … (grumpydestruct … H));
    3226 ##| #delta'; #DELTA; nwhd in ⊢ (??%? → ?); #H; nelim (grumpydestruct2 ?????? H);
    3227     #eb;#edelta;
    3228 ##] nlapply (load_shift … Hmem_shift LOADV DELTA); *; #v2; *;#LOAD;#INJ;
    3229 @ v2; @; //; nrewrite > Hofs; nrewrite > eb in LOAD; nrewrite > edelta;
    3230 nrewrite < (?:signed (add ofs1 (repr delta)) = signed ofs1 + delta);
    3231 ##[#H'; napply H'; (* XXX // doesn't work *)
    3232 ##| nrewrite < edelta; napply (address_shift … chunk … Hmem_shift … DELTA);
    3233     napply (load_valid_access … LOADV);
    3234 ##]
    3235 nqed.
     3217#f #m1 #m2 #chunk #a1 #a2 #v1 #Hmem_shift #LOADV #Hval_shift
     3218inversion Hval_shift;
     3219[ 1,2,4: #x #H >H in LOADV #H' whd in H':(??%?);@False_ind destruct; ]
     3220#b1 #ofs1 #b2 #ofs2 #delta #INJb1 #Hofs #ea1 #ea2 >ea1 in LOADV #LOADV
     3221lapply INJb1; whd in ⊢ (??%? → ?);
     3222lapply (refl ? (f b1)); cases (f b1) in ⊢ (???% → %);
     3223[ #_ whd in ⊢ (??%? → ?); #H @False_ind @(False_ind … (grumpydestruct … H))
     3224| #delta' #DELTA whd in ⊢ (??%? → ?); #H elim (grumpydestruct2 ?????? H);
     3225    #eb #edelta
     3226] lapply (load_shift … Hmem_shift LOADV DELTA); *; #v2 *;#LOAD #INJ
     3227%{ v2} % //; >Hofs >eb in LOAD >edelta
     3228<(?:signed (add ofs1 (repr delta)) = signed ofs1 + delta)
     3229[#H' @H' (* XXX // doesn't work *)
     3230| <edelta @(address_shift … chunk … Hmem_shift … DELTA)
     3231    @(load_valid_access … LOADV)
     3232]
     3233qed.
    32363234
    32373235(* Relation between shifts and stores. *)
    32383236
    3239 nlemma store_within_shift:
     3237lemma store_within_shift:
    32403238  ∀f,chunk,m1,b,ofs,v1,n1,m2,delta,v2.
    32413239  mem_shift f m1 m2 →
     
    32463244    store chunk m2 b (ofs + delta) v2 = Some ? n2
    32473245    ∧ mem_shift f n1 n2.
    3248 #f;#chunk;#m1;#b;#ofs;#v1;#n1;#m2;#delta;#v2;
    3249 *;#ms_inj;#ms_samedomain;#ms_domain;#ms_range_1;#ms_range_2;
    3250 #STORE1;#INJb;#Hval_shift;
    3251 nlapply (store_mapped_inj … ms_inj ?? STORE1 ?);
    3252 ##[ #chunk'; #echunk; napply (load_result_inject … chunk); /2/;
    3253 ##| nwhd in ⊢ (??%?); nrewrite > INJb; (* XXX: // has stopped working *) napply refl
    3254 ##| nwhd; #b1;#b1';#delta1;#b2;#b2';#delta2;
    3255     nwhd in ⊢ (? → ??%? → ??%? → ?);
    3256     nelim (f b1); nelim (f b2);
    3257     ##[#_;#e1;nwhd in e1:(??%?);ndestruct;
    3258     ##|#z;#_;#e1;nwhd in e1:(??%?);ndestruct;
    3259     ##|#z;#_;#_;#e2;nwhd in e2:(??%?);ndestruct;
    3260     ##|#delta1';#delta2';#neb;#e1;#e2;
    3261        nwhd in e1:(??%?) e2:(??%?);
    3262        ndestruct;
    3263        @1;@1;@1;//;
    3264     ##]
    3265 ##| ##7: //;
    3266 ##| ##4,5,6: ##skip
    3267 ##]
    3268 *;#n2;*;#STORE;#MINJ;
    3269 @ n2; @; //; @;
    3270 ##[ (* inj *) //
    3271 ##| (* samedomain *)
    3272     nrewrite > (nextblock_store … STORE1);
    3273     nrewrite > (nextblock_store … STORE);
     3246#f #chunk #m1 #b #ofs #v1 #n1 #m2 #delta #v2
     3247*;#ms_inj #ms_samedomain #ms_domain #ms_range_1 #ms_range_2
     3248#STORE1 #INJb #Hval_shift
     3249lapply (store_mapped_inj … ms_inj ?? STORE1 ?);
     3250[ #chunk' #echunk @(load_result_inject … chunk) /2/;
     3251| whd in ⊢ (??%?); >INJb (* XXX: // has stopped working *) napply refl
     3252| whd; #b1 #b1' #delta1 #b2 #b2' #delta2
     3253    whd in ⊢ (? → ??%? → ??%? → ?);
     3254    elim (f b1); elim (f b2);
     3255    [#_ #e1 whd in e1:(??%?);destruct;
     3256    |#z #_ #e1 whd in e1:(??%?);destruct;
     3257    |#z #_ #_ #e2 whd in e2:(??%?);destruct;
     3258    |#delta1' #delta2' #neb #e1 #e2
     3259       whd in e1:(??%?) e2:(??%?);
     3260       destruct;
     3261       %{1} %{1} %{1} //;
     3262    ]
     3263| 7: //;
     3264| 4,5,6: ##skip
     3265]
     3266*;#n2 *;#STORE #MINJ
     3267%{ n2} % //; %
     3268[ (* inj *) //
     3269| (* samedomain *)
     3270    >(nextblock_store … STORE1)
     3271    >(nextblock_store … STORE)
    32743272    //;
    3275 ##| (* domain *)
    3276     nrewrite > (nextblock_store … STORE1);
     3273| (* domain *)
     3274    >(nextblock_store … STORE1)
    32773275    //
    3278 ##| (* range *)
     3276| (* range *)
    32793277    /2/
    3280 ##| #b1;#delta1;#INJb1;
    3281     nrewrite > (low_bound_store … STORE b1);
    3282     nrewrite > (high_bound_store … STORE b1);
    3283     napply ms_range_2;//;
    3284 ##] nqed.
    3285 
    3286 nlemma store_outside_shift:
     3278| #b1 #delta1 #INJb1
     3279    >(low_bound_store … STORE b1)
     3280    >(high_bound_store … STORE b1)
     3281    @ms_range_2 //;
     3282] qed.
     3283
     3284lemma store_outside_shift:
    32873285  ∀f,chunk,m1,b,ofs,m2,v,m2',delta.
    32883286  mem_shift f m1 m2 →
     
    32923290  store chunk m2 b ofs v = Some ? m2' →
    32933291  mem_shift f m1 m2'.
    3294 #f;#chunk;#m1;#b;#ofs;#m2;#v;#m2';#delta;
    3295 *;#ms_inj;#ms_samedomain;#ms_domain;#ms_range_1;#ms_range_2;
    3296 #INJb;#Hbounds;#STORE;@;
    3297 ##[ (* inj *)
    3298     napply (store_outside_inj … STORE); //;
    3299     #b';#d'; nwhd in ⊢ (??%? → ?); nlapply (refl ? (f b')); nelim (f b') in ⊢ (???% → %);
    3300     ##[ #_; #e; nwhd in e:(??%?); ndestruct;
    3301     ##| #d''; #ef; #e; nelim (grumpydestruct2 ?????? e); #eb; #ed;
    3302         nrewrite > eb in ef ⊢ %; nrewrite > ed; nrewrite > INJb; #ed';
    3303         nrewrite < (grumpydestruct1 ??? ed'); //
    3304     ##]
    3305 ##| (* samedomain *) nrewrite > (nextblock_store … STORE); //
    3306 ##| (* domain *) //
    3307 ##| (* range *) /2/
    3308 ##| #b1;#delta1;#INJb1;
    3309     nrewrite > (low_bound_store … STORE b1);
    3310     nrewrite > (high_bound_store … STORE b1);
    3311     napply ms_range_2;//;
    3312 ##] nqed.
    3313 
    3314 nlemma storev_shift:
     3292#f #chunk #m1 #b #ofs #m2 #v #m2' #delta
     3293*;#ms_inj #ms_samedomain #ms_domain #ms_range_1 #ms_range_2
     3294#INJb #Hbounds #STORE %
     3295[ (* inj *)
     3296    @(store_outside_inj … STORE) //;
     3297    #b' #d' whd in ⊢ (??%? → ?); lapply (refl ? (f b')); elim (f b') in ⊢ (???% → %);
     3298    [ #_ #e whd in e:(??%?); destruct;
     3299    | #d'' #ef #e elim (grumpydestruct2 ?????? e); #eb #ed
     3300        >eb in ef ⊢ % >ed >INJb #ed'
     3301        <(grumpydestruct1 ??? ed') //
     3302    ]
     3303| (* samedomain *) >(nextblock_store … STORE) //
     3304| (* domain *) //
     3305| (* range *) /2/
     3306| #b1 #delta1 #INJb1
     3307    >(low_bound_store … STORE b1)
     3308    >(high_bound_store … STORE b1)
     3309    @ms_range_2 //;
     3310] qed.
     3311
     3312lemma storev_shift:
    33153313  ∀f,chunk,m1,a1,v1,n1,m2,a2,v2.
    33163314  mem_shift f m1 m2 →
     
    33203318  ∃n2.
    33213319    storev chunk m2 a2 v2 = Some ? n2 ∧ mem_shift f n1 n2.
    3322 #f;#chunk;#m1;#a1;#v1;#n1;#m2;#a2;#v2;
    3323 #Hmem_shift;#STOREV;#Hval_shift_a;#Hval_shift_v;
    3324 ninversion Hval_shift_a;
    3325 ##[ ##1,2,4: #x;#H;nrewrite > H in STOREV;#H';nwhd in H':(??%?); napply False_ind; ndestruct; ##]
    3326 #b1;#ofs1;#b2;#ofs2;#delta;
    3327 nwhd in ⊢ (??%? → ?); nlapply (refl ? (f b1)); nelim (f b1) in ⊢ (???% → %);
    3328 ##[#_; #e; nwhd in e:(??%?); ndestruct; ##]
    3329 #x; #INJb1; #e; nelim (grumpydestruct2 ?????? e); #eb;#ex;
    3330 nrewrite > ex in INJb1; #INJb1;
    3331 #OFS; #ea1;#ea2; nrewrite > ea1 in STOREV; #STOREV;
    3332 nlapply (store_within_shift … Hmem_shift STOREV INJb1 Hval_shift_v);
    3333 *; #n2; *; #A;#B;
    3334 @ n2; @; //;
    3335 nrewrite > OFS; nrewrite > eb in A;
    3336 nrewrite < (?:signed (add ofs1 (repr delta)) = signed ofs1 + delta);
    3337 ##[ #H; napply H; (* XXX /2/ *)
    3338 ##| napply (address_shift … chunk … Hmem_shift ? INJb1);
    3339     napply (store_valid_access_3 … STOREV);
    3340 ##]
    3341 nqed.
     3320#f #chunk #m1 #a1 #v1 #n1 #m2 #a2 #v2
     3321#Hmem_shift #STOREV #Hval_shift_a #Hval_shift_v
     3322inversion Hval_shift_a;
     3323[ 1,2,4: #x #H >H in STOREV #H' whd in H':(??%?); @False_ind destruct; ]
     3324#b1 #ofs1 #b2 #ofs2 #delta
     3325whd in ⊢ (??%? → ?); lapply (refl ? (f b1)); elim (f b1) in ⊢ (???% → %);
     3326[#_ #e whd in e:(??%?); destruct; ]
     3327#x #INJb1 #e elim (grumpydestruct2 ?????? e); #eb #ex
     3328>ex in INJb1 #INJb1
     3329#OFS #ea1 #ea2 >ea1 in STOREV #STOREV
     3330lapply (store_within_shift … Hmem_shift STOREV INJb1 Hval_shift_v);
     3331*; #n2 *; #A #B
     3332%{ n2} % //;
     3333>OFS >eb in A
     3334<(?:signed (add ofs1 (repr delta)) = signed ofs1 + delta)
     3335[ #H @H (* XXX /2/ *)
     3336| @(address_shift … chunk … Hmem_shift ? INJb1)
     3337    @(store_valid_access_3 … STOREV)
     3338]
     3339qed.
    33423340
    33433341(* Relation between shifts and [free]. *)
    33443342
    3345 nlemma free_shift:
     3343lemma free_shift:
    33463344  ∀f,m1,m2,b.
    33473345  mem_shift f m1 m2 →
    33483346  mem_shift f (free m1 b) (free m2 b).
    3349 #f;#m1;#m2;#b;
    3350 *;#ms_inj;#ms_samedomain;#ms_domain;#ms_range_1;#ms_range_2; @;
    3351 ##[ (* inj *)
    3352     napply free_right_inj; ##[ napply free_left_inj; //
    3353     ##| #b1;#delta; #chunk;#ofs; nwhd in ⊢ (??%? → ?);
    3354         nlapply (refl ? (f b1)); nelim (f b1) in ⊢ (???% → %);
    3355         ##[ #_; #e; nwhd in e:(??%?); ndestruct;
    3356         ##| #delta'; #INJb1; #e; nwhd in e:(??%?); ndestruct;
     3347#f #m1 #m2 #b
     3348*;#ms_inj #ms_samedomain #ms_domain #ms_range_1 #ms_range_2 %
     3349[ (* inj *)
     3350    @free_right_inj [ @free_left_inj //
     3351    | #b1 #delta #chunk #ofs whd in ⊢ (??%? → ?);
     3352        lapply (refl ? (f b1)); elim (f b1) in ⊢ (???% → %);
     3353        [ #_ #e whd in e:(??%?); destruct;
     3354        | #delta' #INJb1 #e whd in e:(??%?); destruct;
    33573355            napply valid_access_free_2
    3358         ##]
    3359     ##]
    3360 ##| (* samedomain *) nwhd in ⊢ (??%%); //
    3361 ##| (* domain *) nrewrite > (?:nextblock (free m1 b) = nextblock m1); //
    3362 ##| (* range *) /2/
    3363 ##| #b';#delta;#INJb'; ncases (decidable_eq_Z b' b); #eb;
    3364     ##[ nrewrite > eb;
    3365         nrewrite > (low_bound_free_same ??); nrewrite > (high_bound_free_same ??);
     3356        ]
     3357    ]
     3358| (* samedomain *) whd in ⊢ (??%%); //
     3359| (* domain *) >(?:nextblock (free m1 b) = nextblock m1) //
     3360| (* range *) /2/
     3361| #b' #delta #INJb' cases (decidable_eq_Z b' b); #eb
     3362    [ >eb
     3363        >(low_bound_free_same ??) >(high_bound_free_same ??)
    33663364        (* arith *) napply daemon
    3367     ##| nrewrite > (low_bound_free …); //; nrewrite > (high_bound_free …); /2/;
    3368     ##]
    3369 ##] nqed.
     3365    | >(low_bound_free …) //; >(high_bound_free …) /2/;
     3366    ]
     3367] qed.
    33703368
    33713369(* Relation between shifts and allocation. *)
    33723370
    3373 ndefinition shift_incr : memshift → memshift → Prop ≝ λf1,f2: memshift.
     3371definition shift_incr : memshift → memshift → Prop ≝ λf1,f2: memshift.
    33743372  ∀b. f1 b = f2 b ∨ f1 b = None ?.
    33753373
    3376 nremark shift_incr_inject_incr:
     3374lemma shift_incr_inject_incr:
    33773375  ∀f1,f2.
    33783376  shift_incr f1 f2 → inject_incr (meminj_of_shift f1) (meminj_of_shift f2).
    3379 #f1;#f2;#Hshift; nwhd in ⊢ (?%%); nwhd; #b;
    3380 nelim (Hshift b); #INJ; nrewrite > INJ; /2/;
    3381 nqed.
    3382 
    3383 nlemma val_shift_incr:
     3377#f1 #f2 #Hshift whd in ⊢ (?%%); whd; #b
     3378elim (Hshift b); #INJ >INJ /2/;
     3379qed.
     3380
     3381lemma val_shift_incr:
    33843382  ∀f1,f2,v1,v2.
    33853383  shift_incr f1 f2 → val_shift f1 v1 v2 → val_shift f2 v1 v2.
    3386 #f1;#f2;#v1;#v2;#Hshift_incr; nwhd in ⊢ (% → %);
    3387 napply val_inject_incr;
    3388 napply shift_incr_inject_incr; //;
    3389 nqed.
     3384#f1 #f2 #v1 #v2 #Hshift_incr whd in ⊢ (% → %);
     3385@val_inject_incr
     3386@shift_incr_inject_incr //;
     3387qed.
    33903388
    33913389(* *
     
    34013399***)
    34023400
    3403 nlemma alloc_shift:
     3401lemma alloc_shift:
    34043402  ∀f,m1,m2,lo1,hi1,m1',b,delta,lo2,hi2.
    34053403  mem_shift f m1 m2 →
     
    34143412  ∧ shift_incr f f'
    34153413  ∧ f' b = Some ? delta.
    3416 #f;#m1;#m2;#lo1;#hi1;#m1';#b;#delta;#lo2;#hi2;
    3417 *;#ms_inj;#ms_samedomain;#ms_domain;#ms_range_1;#ms_range_2;
    3418 #ALLOC;#Hlo_delta;#Hhi_delta;#Hdelta_range;#Hlo_range;#Hhi_range;#Hinj_aligned;
    3419 nlapply (refl ? (alloc m2 lo2 hi2)); nelim (alloc m2 lo2 hi2) in ⊢ (???% → %);
    3420 #m2';#b';#ALLOC2;
    3421 ncut (b' = b);
    3422 ##[ nrewrite > (alloc_result … ALLOC); nrewrite > (alloc_result … ALLOC2); // ##]
    3423 #eb; nrewrite > eb;
    3424 ncut (f b = None ?);
    3425 ##[ nlapply (ms_domain b); nrewrite > (alloc_result … ALLOC);
    3426     nelim (f (nextblock m1)); //;
    3427     #z; (* arith *) napply daemon
    3428 ##]
    3429 #FB;
    3430 nletin f' ≝ (λb':block. if eqZb b' b then Some ? delta else f b');
    3431 ncut (shift_incr f f');
    3432 ##[ nwhd; #b0; nwhd in ⊢ (?(???%)?);
    3433     napply eqZb_elim; /2/; ##]
    3434 #Hshift_incr;
    3435 ncut (f' b = Some ? delta);
    3436 ##[ nwhd in ⊢ (??%?); nrewrite > (eqZb_z_z …); // ##] #efb';
    3437 @ f'; @ m2'; @; //; @; //; @; //; @;
    3438 ##[ (* inj *)
    3439     ncut (mem_inj val_inject (meminj_of_shift f') m1 m2);
    3440     ##[ nwhd; #chunk;#b1;#ofs;#v1;#b2;#delta2; #MINJf'; #LOAD;
    3441         ncut (meminj_of_shift f b1 = Some ? 〈b2, delta2〉);
    3442         ##[ nrewrite < MINJf'; nwhd in ⊢ (???(?%?)); nwhd in ⊢ (??%%);
    3443             napply eqZb_elim; //; #eb;
    3444             nrewrite > eb;
    3445             ncut (valid_block m1 b);
    3446             ##[ napply valid_access_valid_block;
    3447               ##[ ##3: napply load_valid_access; // ##]
    3448             ##]
    3449             ncut (¬valid_block m1 b); ##[ /2/ ##]
    3450             #H;#H'; napply False_ind; napply (absurd ? H' H)
    3451         ##] #MINJf;
    3452         nlapply (ms_inj … MINJf LOAD); *; #v2; *; #A; #B;
    3453         @ v2; @; //;
    3454         napply (val_inject_incr … B);
    3455         napply shift_incr_inject_incr; //
    3456     ##] #Hmem_inj;
    3457     napply (alloc_parallel_inj … delta Hmem_inj ALLOC ALLOC2 ?); /2/;
    3458     nwhd in ⊢ (??%?); nrewrite > efb'; /2/;
    3459 ##| (* samedomain *)
    3460     nrewrite > (nextblock_alloc … ALLOC);
    3461     nrewrite > (nextblock_alloc … ALLOC2);
     3414#f #m1 #m2 #lo1 #hi1 #m1' #b #delta #lo2 #hi2
     3415*;#ms_inj #ms_samedomain #ms_domain #ms_range_1 #ms_range_2
     3416#ALLOC #Hlo_delta #Hhi_delta #Hdelta_range #Hlo_range #Hhi_range #Hinj_aligned
     3417lapply (refl ? (alloc m2 lo2 hi2)); elim (alloc m2 lo2 hi2) in ⊢ (???% → %);
     3418#m2' #b' #ALLOC2
     3419cut (b' = b);
     3420[ >(alloc_result … ALLOC) >(alloc_result … ALLOC2) // ]
     3421#eb >eb
     3422cut (f b = None ?);
     3423[ lapply (ms_domain b); >(alloc_result … ALLOC)
     3424    elim (f (nextblock m1)); //;
     3425    #z (* arith *) napply daemon
     3426]
     3427#FB
     3428letin f' ≝ (λb':block. if eqZb b' b then Some ? delta else f b');
     3429cut (shift_incr f f');
     3430[ whd; #b0 whd in ⊢ (?(???%)?);
     3431    @eqZb_elim /2/; ]
     3432#Hshift_incr
     3433cut (f' b = Some ? delta);
     3434[ whd in ⊢ (??%?); >(eqZb_z_z …) // ] #efb'
     3435%{ f'} %{ m2'} % //; % //; % //; %
     3436[ (* inj *)
     3437    cut (mem_inj val_inject (meminj_of_shift f') m1 m2);
     3438    [ whd; #chunk #b1 #ofs #v1 #b2 #delta2 #MINJf' #LOAD
     3439        cut (meminj_of_shift f b1 = Some ? 〈b2, delta2〉);
     3440        [ <MINJf' whd in ⊢ (???(?%?)); whd in ⊢ (??%%);
     3441            @eqZb_elim //; #eb
     3442            >eb
     3443            cut (valid_block m1 b);
     3444            [ @valid_access_valid_block
     3445              [ 3: @load_valid_access // ]
     3446            ]
     3447            cut (¬valid_block m1 b); [ /2/ ]
     3448            #H #H' @False_ind napply (absurd ? H' H)
     3449        ] #MINJf
     3450        lapply (ms_inj … MINJf LOAD); *; #v2 *; #A #B
     3451        %{ v2} % //;
     3452        @(val_inject_incr … B)
     3453        @shift_incr_inject_incr //
     3454    ] #Hmem_inj
     3455    @(alloc_parallel_inj … delta Hmem_inj ALLOC ALLOC2 ?) /2/;
     3456    whd in ⊢ (??%?); >efb' /2/;
     3457| (* samedomain *)
     3458    >(nextblock_alloc … ALLOC)
     3459    >(nextblock_alloc … ALLOC2)
    34623460    //;
    3463 ##| (* domain *)
    3464     #b0; (* FIXME: unfold *) nrewrite > (refl ? (f' b0):f' b0 = if eqZb b0 b then Some ? delta else f b0);
    3465     nrewrite > (nextblock_alloc … ALLOC);
    3466     nrewrite > (alloc_result … ALLOC);
    3467     napply eqZb_elim; #eb0;
    3468     ##[ nrewrite > eb0; (* arith *) napply daemon
    3469     ##| nlapply (ms_domain b0); nelim (f b0);
     3461| (* domain *)
     3462    #b0 (* FIXME: unfold *) >(refl ? (f' b0):f' b0 = if eqZb b0 b then Some ? delta else f b0)
     3463    >(nextblock_alloc … ALLOC)
     3464    >(alloc_result … ALLOC)
     3465    @eqZb_elim #eb0
     3466    [ >eb0 (* arith *) napply daemon
     3467    | lapply (ms_domain b0); elim (f b0);
    34703468        (* arith *) napply daemon
    3471     ##]
    3472 ##| (* range *)
    3473     #b0;#delta0; nwhd in ⊢ (??%? → ?);
    3474     napply eqZb_elim;
    3475     ##[ #_; #e; nrewrite < (grumpydestruct1 ??? e); //
    3476     ##| #neb; #e; napply (ms_range_1 … b0); napply e;
    3477     ##]
    3478 ##| #b0;#delta0; nwhd in ⊢ (??%? → ?);
    3479     nrewrite > (low_bound_alloc … ALLOC2 ?);
    3480     nrewrite > (high_bound_alloc … ALLOC2 ?);
    3481     napply eqZb_elim; #eb0; nrewrite > eb;
    3482     ##[ nrewrite > eb0; #ed; nrewrite < (grumpydestruct1 ??? ed);
    3483         nrewrite > (eqZb_z_z ?); /3/;
    3484     ##| #edelta0; nrewrite > (eqZb_false … eb0);
    3485         napply ms_range_2; nwhd in edelta0:(??%?); //;
    3486     ##]
    3487 ##]
    3488 nqed.
     3469    ]
     3470| (* range *)
     3471    #b0 #delta0 whd in ⊢ (??%? → ?);
     3472    @eqZb_elim
     3473    [ #_ #e <(grumpydestruct1 ??? e) //
     3474    | #neb #e @(ms_range_1 … b0) @e
     3475    ]
     3476| #b0 #delta0 whd in ⊢ (??%? → ?);
     3477    >(low_bound_alloc … ALLOC2 ?)
     3478    >(high_bound_alloc … ALLOC2 ?)
     3479    @eqZb_elim #eb0 >eb
     3480    [ >eb0 #ed <(grumpydestruct1 ??? ed)
     3481        >(eqZb_z_z ?) /3/;
     3482    | #edelta0 >(eqZb_false … eb0)
     3483        @ms_range_2 whd in edelta0:(??%?); //;
     3484    ]
     3485]
     3486qed.
    34893487*)*)
    34903488(* ** Relation between signed and unsigned loads and stores *)
     
    34953493(* Signed 8- and 16-bit stores can be performed like unsigned stores. *)
    34963494
    3497 nremark in_bounds_equiv:
    3498   ∀chunk1,chunk2,m,psp,b,ofs.∀A:Type.∀a1,a2: A.
     3495lemma in_bounds_equiv:
     3496  ∀chunk1,chunk2,m,psp,b,ofs.∀A:Type[0].∀a1,a2: A.
    34993497  size_chunk chunk1 = size_chunk chunk2 →
    35003498  (match in_bounds m chunk1 psp b ofs with [ inl _ ⇒ a1 | inr _ ⇒ a2]) =
    35013499  (match in_bounds m chunk2 psp b ofs with [ inl _ ⇒ a1 | inr _ ⇒ a2]).
    3502 #chunk1;#chunk2;#m;#psp b ofs;#A;#a1;#a2;#Hsize;
    3503 nelim (in_bounds m chunk1 psp b ofs);
    3504 ##[ #H; nwhd in ⊢ (??%?); nrewrite > (in_bounds_true … A a1 a2 ?); //;
    3505     napply valid_access_compat; //;
    3506 ##| #H; nwhd in ⊢ (??%?); nelim (in_bounds m chunk2 psp b ofs); //;
    3507     #H'; napply False_ind; napply (absurd ?? H);
    3508     napply valid_access_compat; //;
    3509 ##] nqed.
    3510 
    3511 nlemma storev_8_signed_unsigned:
     3500#chunk1 #chunk2 #m #psp #b #ofs #A #a1 #a2 #Hsize
     3501elim (in_bounds m chunk1 psp b ofs);
     3502[ #H whd in ⊢ (??%?); >(in_bounds_true … A a1 a2 ?) //;
     3503    @valid_access_compat //;
     3504| #H whd in ⊢ (??%?); elim (in_bounds m chunk2 psp b ofs); //;
     3505    #H' @False_ind @(absurd ?? H)
     3506    @valid_access_compat //;
     3507] qed.
     3508
     3509lemma storev_8_signed_unsigned:
    35123510  ∀m,a,v.
    35133511  storev Mint8signed m a v = storev Mint8unsigned m a v.
    3514 #m;#a;#v; nwhd in ⊢ (??%%); nelim a; //;
    3515 #psp b ofs; nwhd in ⊢ (??%%);
    3516 nrewrite > (in_bounds_equiv Mint8signed Mint8unsigned … (option mem) ???); //;
    3517 nqed.
    3518 
    3519 nlemma storev_16_signed_unsigned:
     3512#m #a #v whd in ⊢ (??%%); elim a; //;
     3513#psp #b #ofs whd in ⊢ (??%%);
     3514>(in_bounds_equiv Mint8signed Mint8unsigned … (option mem) ???) //;
     3515qed.
     3516
     3517lemma storev_16_signed_unsigned:
    35203518  ∀m,a,v.
    35213519  storev Mint16signed m a v = storev Mint16unsigned m a v.
    3522 #m;#a;#v; nwhd in ⊢ (??%%); nelim a; //;
    3523 #psp b ofs; nwhd in ⊢ (??%%);
    3524 nrewrite > (in_bounds_equiv Mint16signed Mint16unsigned … (option mem) ???); //;
    3525 nqed.
     3520#m #a #v whd in ⊢ (??%%); elim a; //;
     3521#psp #b #ofs whd in ⊢ (??%%);
     3522>(in_bounds_equiv Mint16signed Mint16unsigned … (option mem) ???) //;
     3523qed.
    35263524
    35273525(* Likewise, some target processors (e.g. the PowerPC) do not have
     
    35313529
    35323530(* Nonessential properties that may require arithmetic
    3533 nlemma loadv_8_signed_unsigned:
     3531lemma loadv_8_signed_unsigned:
    35343532  ∀m,a.
    35353533  loadv Mint8signed m a = option_map ?? (sign_ext 8) (loadv Mint8unsigned m a).
    3536 #m;#a; nwhd in ⊢ (??%(????(%))); nelim a; //;
    3537 #psp b ofs; nwhd in ⊢ (??%(????%));
    3538 nrewrite > (in_bounds_equiv Mint8signed Mint8unsigned … (option val) ???); //;
    3539 nelim (in_bounds m Mint8unsigned psp b (signed ofs)); /2/;
    3540 #H; nwhd in ⊢ (??%%);
    3541 nelim (getN 0 (signed ofs) (contents (blocks m b)));
    3542 ##[ ##1,3: //;
    3543 ##| #i; nwhd in ⊢ (??(??%)(??%));
    3544     nrewrite > (sign_ext_zero_ext ?? i); ##[ napply refl; (* XXX: // ? *)
    3545     ##| (* arith *) napply daemon;
    3546     ##]
    3547 ##| #sp; ncases sp; //;
    3548 ##]
    3549 nqed.
     3534#m #a whd in ⊢ (??%(????(%))); elim a; //;
     3535#psp #b #ofs whd in ⊢ (??%(????%));
     3536>(in_bounds_equiv Mint8signed Mint8unsigned … (option val) ???) //;
     3537elim (in_bounds m Mint8unsigned psp b (signed ofs)); /2/;
     3538#H whd in ⊢ (??%%);
     3539elim (getN 0 (signed ofs) (contents (blocks m b)));
     3540[ 1,3: //;
     3541| #i whd in ⊢ (??(??%)(??%));
     3542    >(sign_ext_zero_ext ?? i) [ @refl (* XXX: // ? *)
     3543    | (* arith *) @daemon
     3544    ]
     3545| #sp cases sp; //;
     3546]
     3547qed.
    35503548*)
Note: See TracChangeset for help on using the changeset viewer.