You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

632 lines
21 KiB

(*
* Copyright (c) Facebook, Inc. and its affiliates.
*
* This source code is licensed under the MIT license found in the
* LICENSE file in the root directory of this source tree.
*)
(* A simple, concrete memory model where the heap is an array of bytes. This is
* how llair views memory, and how we give semantics to llvm. Although LLVM's
* real memory model is still a subject of research, this is mostly to do with
* enabling the right collection of compiler optimisations. Since we only want to
* think about LLVM semantics after optimisation, the concrete model is likely to
* be sufficient. *)
open HolKernel boolLib bossLib Parse;
open arithmeticTheory listTheory rich_listTheory pairTheory;
open logrootTheory numposrepTheory wordsTheory pred_setTheory finite_mapTheory;
open settingsTheory miscTheory;
new_theory "memory_model";
numLib.prefer_num ();
(* Heap addresses *)
Datatype:
addr = A num
End
(* Values that fit in registers *)
Datatype:
reg_v =
| FlatV 'a
| AggV (reg_v list)
End
(* An interval of allocated memory.
* Args: whether it's freeable, the starting address (inclusive), and the ending address
* (exclusive)
*)
Datatype:
interval = Interval bool num num
End
Datatype:
heap = <| memory : addr |-> 'a # word8;
allocations : interval set;
valid_addresses : addr set|>
End
5 years ago
Definition erase_tags_def:
erase_tags h =
<| memory := (λ(t,b). ((), b)) o_f h.memory;
allocations := h.allocations;
valid_addresses := h.valid_addresses |>
End
(* shapes statically describe the shape of a value in a register. Flat shapes
* take a given number of bytes, Array shapes are replicated a certain number of
* times
*)
Datatype:
shape =
| Flat num 'a
| Array shape num
| Tuple (shape list)
End
(* Does a value have a given shape. The function argument answers the question
* for flat values/shapes.
* We use mutual recursion instead of list_rel to work around a HOL bug. *)
Definition value_shape_def:
(value_shape f (Flat n t) (FlatV x) f n t x)
(value_shape f (Array s n) (AggV vs)
every (value_shape f s) vs length vs = n)
(value_shape f (Tuple ss) (AggV vs)
value_shapes f ss vs)
(value_shape _ _ _ F)
(value_shapes f [] [] T)
(value_shapes f (s::ss) (v::vs)
value_shape f s v value_shapes f ss vs)
(value_shapes _ _ _ F)
Termination
WF_REL_TAC `measure (\x. case x of | INL (_, x, _) => shape_size (\x.0) x | INR (_, y, _) => shape1_size (\x.0) y)`
End
Theorem value_shapes_list_rel:
∀f ss vs. value_shapes f ss vs list_rel (value_shape f) ss vs
Proof
Induct_on `ss` >> Cases_on `vs` >> rw [value_shape_def]
QED
Theorem value_shape_cases:
∀f s v.
value_shape f s v
(∃n t x. s = Flat n t v = FlatV x f n t x)
(∃s2 n vs. s = Array s2 n v = AggV vs
every (value_shape f s2) vs length vs = n)
(∃ss vs. s = Tuple ss v = AggV vs value_shapes f ss vs)
Proof
rw [] >>
Cases_on `s` >> Cases_on `v` >> rw [value_shape_def] >> metis_tac []
QED
Definition sizeof_def:
(sizeof (Flat n t) = n)
(sizeof (Array s n) = n * sizeof s)
(sizeof (Tuple ss) = sum (map sizeof ss))
Termination
WF_REL_TAC `measure (shape_size (\x.0))` >> rw [] >>
Induct_on `ss` >> rw [definition "shape_size_def"] >>
res_tac >> decide_tac
End
Definition interval_to_set_def:
interval_to_set (Interval _ start stop) =
{ n | start n n < stop }
End
Definition interval_ok_def:
interval_ok (Interval b i1 i2) valid_addresses
i1 i2 image A (interval_to_set (Interval b i1 i2)) valid_addresses
End
Definition interval_freeable_def:
interval_freeable (Interval b _ _) b
End
Definition is_allocated_def:
is_allocated b1 h
interval_ok b1 h.valid_addresses
∃b2. b2 h.allocations (interval_freeable b1 interval_freeable b2)
interval_to_set b1 interval_to_set b2
End
Definition is_free_def:
is_free b1 h
interval_ok b1 h.valid_addresses
∀b2. b2 h.allocations interval_to_set b1 interval_to_set b2 =
End
(* The allocations are of intervals that don't overlap *)
Definition allocations_ok_def:
allocations_ok h
∀i1 i2.
i1 h.allocations i2 h.allocations
interval_ok i1 h.valid_addresses interval_ok i2 h.valid_addresses
(interval_to_set i1 interval_to_set i2 i1 = i2)
End
(* The heap maps exactly the address in the allocations *)
Definition heap_ok_def:
heap_ok h
allocations_ok h
∀n. flookup h.memory (A n) None ∃i. i h.allocations n interval_to_set i
End
Definition get_bytes_def:
get_bytes h (Interval _ start stop) =
map
(λoff.
case flookup h.memory (A (start + off)) of
| Some w => w)
(count_list (stop - start))
End
Definition set_bytes_def:
(set_bytes p [] n h = h)
(set_bytes p (b::bs) n h =
set_bytes p bs (Suc n) (h with memory := h.memory |+ (A n, (p, b))))
End
(* Allocate a free chunk of memory, and write non-deterministic bytes into it *)
Inductive allocate:
∀h size tag p bytes b.
b = Interval T p (p + size)
is_free b h
length bytes = size
allocate h size tag (p, set_bytes tag bytes p
<| memory := h.memory;
allocations := { b } h.allocations;
valid_addresses := h.valid_addresses |>)
End
Definition deallocate_def:
deallocate addrs h =
let to_remove = { Interval T n stop | A n set addrs Interval T n stop h.allocations } in
<| memory := fdiff h.memory (image A (bigunion (image interval_to_set to_remove)));
allocations := h.allocations DIFF to_remove;
valid_addresses := h.valid_addresses |>
End
5 years ago
(* Read len bytes from the list of bytes, and convert it into a number,
* little-endian encoding *)
5 years ago
Definition le_read_num_def:
le_read_num len (bs : word8 list) =
if length bs < len then
5 years ago
(l2n 256 (map w2n bs), [])
else
5 years ago
(l2n 256 (map w2n (take len bs)), drop len bs)
End
5 years ago
(* Return len bytes that are the little-endian encoding of the argument number,
* assuming that it fits*)
Definition le_write_num_def:
le_write_num len n =
let (l : word8 list) = map n2w (n2l 256 n) in
take len (l ++ replicate (len - length l) 0w)
End
(* Read a from a list of bytes bs to build a register value described by a
* shape. The function f is applied to the word read from a flat list of bytes
* in little-endian order. *)
Definition bytes_to_value_def:
5 years ago
(bytes_to_value f (Flat n t) bs = (FlatV o f n t ## I) (le_read_num n bs))
(bytes_to_value f (Array s n) bs = (AggV ## I) (read_array f n s bs))
(bytes_to_value f (Tuple ts) bs = (AggV ## I) (read_str f ts bs))
(read_array f 0 s bs = ([], bs))
(read_array f (Suc n) s bs =
let (v, bs) = bytes_to_value f s bs in
let (rest, bs) = read_array f n s bs in
(v::rest, bs))
(read_str f [] bs = ([], bs))
(read_str f (s::ss) bs =
let (v, bs) = bytes_to_value f s bs in
let (rest, bs) = read_str f ss bs in
(v::rest, bs))
Termination
WF_REL_TAC `measure (λx. case x of
| INL (_, t, bs) => shape_size (\x.0) t
| INR (INL (_, n, t, bs)) => n + shape_size (\x.0) t
| INR (INR (_, ts, bs)) => shape1_size (\x.0) ts)`
End
(* Convert the given value to a list of bytes, the function gives the size, and
* a machine word for a flat value *)
Definition value_to_bytes_def:
(value_to_bytes f (FlatV x) =
let (size, word) = f x in
5 years ago
le_write_num size word)
(value_to_bytes f (AggV vs) = flat (map (value_to_bytes f) vs))
Termination
WF_REL_TAC `measure (reg_v_size (\x. 0) o snd)` >>
Induct >> rw [definition "reg_v_size_def"] >>
TRY (first_x_assum drule) >>
decide_tac
End
(* ----- Theorems about converting between values and byte lists ----- *)
5 years ago
Theorem le_write_num_length:
∀l x. length (le_write_num l w) = l
Proof
5 years ago
rw [le_write_num_def]
QED
Theorem v2b_size_lem:
(∀(f:num->'a->'b->bool) s v. (∀n t x. f n t x fst (g x) = n) value_shape f s v length (value_to_bytes g v) = sizeof s)
(∀(f:num->'a->'b->bool) ss vs. (∀n t x. f n t x fst (g x) = n) value_shapes f ss vs sum (map (length o value_to_bytes g) vs) = sum (map sizeof ss))
Proof
ho_match_mp_tac value_shape_ind >>
rw [value_to_bytes_def, sizeof_def, value_shape_def]
>- (
pairarg_tac >> simp [] >>
5 years ago
metis_tac [FST, le_write_num_length])
>- (
simp [LENGTH_FLAT, MAP_MAP_o, combinTheory.o_DEF] >>
Induct_on `vs` >> rw [ADD1] >> fs [LEFT_ADD_DISTRIB] >>
metis_tac [])
>- (fs [LENGTH_FLAT, ETA_THM, MAP_MAP_o, combinTheory.o_DEF] >> metis_tac [])
>- metis_tac [ADD_COMM]
QED
Theorem v2b_size:
∀f s v g. (∀n t x. f n t x fst (g x) = n) value_shape f s v length (value_to_bytes g v) = sizeof s
Proof
metis_tac [v2b_size_lem]
QED
Theorem b2v_size_lem:
5 years ago
(∀(f:num->'c ->num -> 'b) s bs. sizeof s length bs
∃v. bytes_to_value f s bs = (v, drop (sizeof s) bs))
5 years ago
(∀(f:num->'c ->num -> 'b) n s bs. n * sizeof s length bs
∃vs. read_array f n s bs = (vs, drop (n * sizeof s) bs))
5 years ago
(∀(f:num->'c ->num -> 'b) ss bs. sum (map sizeof ss) length bs
∃vs. read_str f ss bs = (vs, drop (sum (map sizeof ss)) bs))
Proof
ho_match_mp_tac bytes_to_value_ind >>
5 years ago
rw [sizeof_def, bytes_to_value_def, le_read_num_def] >>
fs []
>- (simp [PAIR_MAP] >> metis_tac [SND])
>- (
pairarg_tac >> rw [] >> pairarg_tac >> rw [] >>
fs [ADD1] >> rw [] >> fs [DROP_DROP_T, LEFT_ADD_DISTRIB])
>- fs [DROP_DROP_T, LEFT_ADD_DISTRIB]
QED
Theorem b2v_size:
∀f s bs. sizeof s length bs
∃v. bytes_to_value f s bs = (v, drop (sizeof s) bs)
Proof
metis_tac [b2v_size_lem]
QED
Theorem b2v_smaller:
∀f s bs. sizeof s length bs
length (snd (bytes_to_value f s bs)) = length bs - sizeof s
Proof
rw [] >> imp_res_tac b2v_size >>
Cases_on `bytes_to_value f s bs` >> fs [] >>
first_x_assum (qspec_then `f` mp_tac) >> rw []
QED
Theorem b2v_append_lem:
5 years ago
(∀(f:num->'c->num -> 'b) s bs. sizeof s length bs
bytes_to_value f s (bs ++ bs') = (I ## (λx. x ++ bs')) (bytes_to_value f s bs))
5 years ago
(∀(f:num->'c->num -> 'b) n s bs. n * sizeof s length bs
∃vs. read_array f n s (bs ++ bs') = (I ## (λx. x ++ bs')) (read_array f n s bs))
5 years ago
(∀(f:num->'c-> num -> 'b) ss bs. sum (map sizeof ss) length bs
∃vs. read_str f ss (bs ++ bs') = (I ## (λx. x ++ bs')) (read_str f ss bs))
Proof
ho_match_mp_tac bytes_to_value_ind >>
5 years ago
rw [sizeof_def, bytes_to_value_def, le_read_num_def] >>
fs [TAKE_APPEND, DROP_APPEND,
DECIDE ``!x y. x y x - y = 0n``, ETA_THM]
>- (simp [PAIR_MAP] >> metis_tac [SND])
>- (simp [PAIR_MAP] >> metis_tac [SND])
>- (
rpt (pairarg_tac >> simp []) >> fs [ADD1] >>
BasicProvers.VAR_EQ_TAC >> fs [LEFT_ADD_DISTRIB] >>
first_x_assum irule >>
`sizeof s length bs` by decide_tac >>
qspec_then `f` drule b2v_smaller >>
disch_then (qspec_then `f` mp_tac) >>
rw [])
>- (
rpt (pairarg_tac >> simp []) >> fs [ADD1] >>
BasicProvers.VAR_EQ_TAC >> fs [LEFT_ADD_DISTRIB] >>
first_x_assum irule >>
`sizeof s length bs` by decide_tac >>
qspec_then `f` drule b2v_smaller >>
disch_then (qspec_then `f` mp_tac) >>
rw [])
QED
Theorem b2v_append:
∀f s bs bs'. sizeof s length bs
bytes_to_value f s (bs ++ bs') = (I ## (λx. x ++ bs')) (bytes_to_value f s bs)
Proof
metis_tac [b2v_append_lem]
QED
Theorem le_read_write:
5 years ago
∀size n bs.
n < 256 ** size le_read_num size (le_write_num size n bs) = (n, bs)
Proof
5 years ago
rw [le_read_num_def, le_write_num_length]
>- (
5 years ago
`take size (le_write_num size n bs) = le_write_num size n`
by metis_tac [le_write_num_length, TAKE_LENGTH_APPEND] >>
simp [le_write_num_def, w2l_def, l2w_def] >>
fs [SIMP_RULE (srw_ss()) [map_replicate] l2n_padding, TAKE_APPEND, take_replicate] >>
simp [MAP_TAKE, MAP_MAP_o, combinTheory.o_DEF, mod_n2l] >>
rename1 `n2l 256 m` >>
5 years ago
Cases_on `size = 0` >> fs [] >>
`length (n2l 256 m) size`
by (
rw [LENGTH_n2l] >>
`256 = 2 ** 8` by EVAL_TAC >>
ASM_REWRITE_TAC [] >> simp [log_change_base_power, GSYM LESS_EQ] >>
rw [] >> fs [bitTheory.LOG2_def, dimword_def] >>
`8 * (log 2 m DIV 8) log 2 m` by metis_tac [mul_div_bound, EVAL ``8 0n``] >>
5 years ago
`LOG 2 m LOG 2 (256 ** size)` by simp [LOG_LE_MONO, LESS_IMP_LESS_OR_EQ] >>
pop_assum mp_tac >>
`256 = 2 ** 8` by EVAL_TAC >>
ASM_REWRITE_TAC [EXP_MUL] >> simp [log_base_power] >>
5 years ago
Cases_on `log 2 m DIV 8 = size` >> rw [] >>
CCONTR_TAC >> fs [] >>
`log 2 m = (8 * (log 2 m DIV 8))` by intLib.COOPER_TAC >> fs [] >>
`2 ** log 2 m = 2 ** (8 * (log 2 m DIV 8))` by rw [] >>
fs [EXP_EXP_MULT] >>
`2 ** log 2 m m` by rw [exp_log_bound] >>
decide_tac) >>
simp [mod_n2l, l2n_n2l, TAKE_LENGTH_TOO_LONG]
)
5 years ago
>- metis_tac [le_write_num_length, DROP_LENGTH_APPEND]
QED
Theorem le_write_read:
5 years ago
∀size n bs bs'.
size length bs
le_read_num size bs = (n, bs')
5 years ago
le_write_num size n ++ bs' = bs
Proof
5 years ago
rw [le_read_num_def] >>
qmatch_goalsub_abbrev_tac `l2n _ l` >>
`le_write_num size (l2n 256 l) = take size bs` suffices_by metis_tac [TAKE_DROP] >>
simp [le_write_num_def, w2l_l2w] >>
`l2n 256 l < 256 ** size`
by (
5 years ago
`size length bs` by decide_tac >>
metis_tac [l2n_lt, LENGTH_TAKE, LENGTH_MAP, EVAL ``0n < 256``]) >>
`every ($> 256) l`
by (
simp [EVERY_MAP, Abbr `l`] >> irule EVERY_TAKE >> simp [] >>
rpt (pop_assum kall_tac) >>
Induct_on `bs` >> rw [] >>
Cases_on `h` >> fs []) >>
rw [n2l_l2n]
>- (
rw [TAKE_def, take_replicate] >>
5 years ago
Cases_on `size` >> fs [] >>
rfs [l2n_0] >> unabbrev_all_tac >> fs [EVERY_MAP] >>
ONCE_REWRITE_TAC [GSYM REPLICATE] >>
5 years ago
qmatch_goalsub_abbrev_tac `take size _` >>
qpat_assum `¬(_ < _)` mp_tac >>
qpat_assum `every (\x. 0 = w2n x) _` mp_tac >>
rpt (pop_assum kall_tac) >>
qid_spec_tac `bs` >>
5 years ago
Induct_on `size` >> rw [] >>
Cases_on `bs` >> rw [] >> fs [] >>
Cases_on `h` >> fs [] >>
first_x_assum irule >> rw [] >>
irule MONO_EVERY >>
qexists_tac `(λx. 0 = w2n x)` >> rw []) >>
fs [MAP_TAKE, MAP_MAP_o, combinTheory.o_DEF] >>
`exists (\y. 0 y) l`
by (
fs [l2n_eq_0, combinTheory.o_DEF] >> fs [EXISTS_MEM, EVERY_MEM] >>
qexists_tac `x` >> rfs [MOD_MOD, GREATER_DEF]) >>
simp [LOG_l2n_dropWhile] >>
`length (dropWhile ($= 0) (reverse l)) 0`
by (
Cases_on `l` >> fs [dropWhile_eq_nil, combinTheory.o_DEF, EXISTS_REVERSE]) >>
`0 < length (dropWhile ($= 0) (reverse l))` by decide_tac >>
fs [SUC_PRE] >>
5 years ago
`map n2w l = take size bs`
by (simp [Abbr `l`, MAP_TAKE, MAP_MAP_o, combinTheory.o_DEF, n2w_w2n]) >>
simp [TAKE_TAKE_MIN] >>
5 years ago
`length l = size` by simp [Abbr `l`] >>
`length (dropWhile ($= 0) (reverse l)) size`
by metis_tac [LESS_EQ_TRANS, LENGTH_dropWhile_LESS_EQ, LENGTH_REVERSE] >>
rw [MIN_DEF] >> fs []
>- (
simp [TAKE_APPEND, TAKE_TAKE_MIN, MIN_DEF, take_replicate] >>
`replicate (length l length (dropWhile ($= 0) (reverse l))) 0w =
take (length l (length (dropWhile ($= 0) (reverse l)))) (drop (length (dropWhile ($= 0) (reverse l))) bs)`
suffices_by (rw [] >> irule take_drop_partition >> simp []) >>
rw [LIST_EQ_REWRITE, EL_REPLICATE, EL_TAKE, EL_DROP] >>
`length (dropWhile ($= 0) (reverse l)) =
length (dropWhile (λx. 0 = w2n x) (reverse (take (length l) bs)))`
by (
`reverse l = reverse (take (length l) (map w2n bs))` by metis_tac [] >>
ONCE_ASM_REWRITE_TAC [] >>
qpat_x_assum `Abbrev (l = _)` kall_tac >>
simp [GSYM MAP_TAKE, GSYM MAP_REVERSE, dropWhile_map, combinTheory.o_DEF]) >>
fs [] >>
`x + length (dropWhile (λx. 0 = w2n x) (reverse (take (length l) bs))) < length l` by decide_tac >>
drule (SIMP_RULE std_ss [LET_THM] dropWhile_rev_take) >>
rw [] >>
REWRITE_TAC [GSYM w2n_11, word_0_n2w] >>
simp [])
>- rw [TAKE_APPEND, TAKE_TAKE]
QED
Theorem b2v_v2b_lem:
(∀f s v.
value_shape f s v
5 years ago
(∀x t n. f n t x fst (h x) = n g n t (snd (h x)) = x snd (h x) < 256 ** n)
∀bs.
5 years ago
bytes_to_value g s (value_to_bytes h v ++ bs) = (v, bs))
(∀f ss vs.
value_shapes f ss vs
5 years ago
(∀x t n. f n t x fst (h x) = n g n t (snd (h x)) = x snd (h x) < 256 ** n)
∀bs.
5 years ago
read_str g ss (flat (map (value_to_bytes h) vs) ++ bs) = (vs, bs))
Proof
ho_match_mp_tac value_shape_ind >> rw [value_shape_def] >>
fs [bytes_to_value_def, value_to_bytes_def] >> rw []
>- (
pairarg_tac >> fs [] >>
first_x_assum drule >> simp [] >> rw [] >>
simp [le_read_write])
>- (
qmatch_abbrev_tac `_ x = _` >>
`x = (vs, bs)` suffices_by (simp [PAIR_MAP] >> metis_tac [PAIR_EQ, FST, SND]) >>
unabbrev_all_tac >>
qid_spec_tac `bs` >> Induct_on `vs` >> simp [bytes_to_value_def] >>
rw [] >> fs [definition "reg_v_size_def"] >>
pairarg_tac >> fs [] >>
pairarg_tac >> fs [] >>
rename1 `value_shape _ s v1` >>
qpat_x_assum `_ !bs. P bs` mp_tac >> impl_tac >> simp [] >>
metis_tac [APPEND_ASSOC, PAIR_EQ])
>- (
qmatch_abbrev_tac `_ x = _` >>
`x = (vs, bs)` suffices_by (simp [PAIR_MAP] >> metis_tac [PAIR_EQ, FST, SND]) >>
metis_tac [])
>- (
pairarg_tac >> fs [] >>
pairarg_tac >> fs [] >>
metis_tac [APPEND_ASSOC, PAIR_EQ])
QED
Theorem b2v_v2b:
∀f g h s v bs.
value_shape f s v
5 years ago
(∀x n t. f n t x fst (h x) = n g n t (snd (h x)) = x snd (h x) < 256 ** n)
bytes_to_value g s (value_to_bytes h v ++ bs) = (v, bs)
Proof
metis_tac [b2v_v2b_lem]
QED
Theorem flookup_set_bytes:
∀tag bytes n h n'.
flookup ((set_bytes tag bytes n h).memory) (A n') =
if n n' n' < n + length bytes then
Some (tag, el (n' - n) bytes)
else
flookup h.memory (A n')
Proof
Induct_on `bytes` >> rw [set_bytes_def, EL_CONS, PRE_SUB1] >>
fs [ADD1, FLOOKUP_UPDATE] >>
`n = n'` by decide_tac >>
rw []
QED
Theorem set_bytes_unchanged:
∀t bs p h. (set_bytes t bs p h).valid_addresses = h.valid_addresses
(set_bytes t bs p h).allocations = h.allocations
Proof
Induct_on `bs` >> rw [set_bytes_def]
QED
Theorem allocate_unchanged:
∀h1 v1 t h2 v2.
allocate h1 v1 t (v2, h2)
h1.valid_addresses = h2.valid_addresses
h1.allocations h2.allocations
Proof
rw [allocate_cases] >> rw [set_bytes_unchanged]
QED
Theorem allocate_heap_ok:
∀h1 v1 t v2 h2. heap_ok h1 allocate h1 v1 t (v2,h2) heap_ok h2
Proof
rw [allocate_cases, heap_ok_def]
>- (
fs [allocations_ok_def] >> rpt gen_tac >> disch_tac >> fs [is_free_def] >> rw [] >>
fs [set_bytes_unchanged] >> metis_tac [INTER_COMM])
>- (
rw [flookup_set_bytes, set_bytes_unchanged]
>- rw [RIGHT_AND_OVER_OR, EXISTS_OR_THM, interval_to_set_def] >>
eq_tac >> rw [] >> fs [interval_to_set_def] >>
metis_tac [])
QED
Theorem set_bytes_heap_ok:
∀h tag bytes n b.
heap_ok h is_allocated (Interval b n (n + length bytes)) h
heap_ok (set_bytes tag bytes n h)
Proof
rw [heap_ok_def]
>- (fs [allocations_ok_def] >> rw [set_bytes_unchanged] >> metis_tac [])
>- (
fs [flookup_set_bytes, set_bytes_unchanged] >> rw [] >>
fs [is_allocated_def, interval_to_set_def, SUBSET_DEF] >>
metis_tac [LESS_EQ_REFL, DECIDE ``!x y. x < x + SUC y``])
QED
Theorem erase_tags_set_bytes:
∀p v l h. erase_tags (set_bytes p v l h) = set_bytes () v l (erase_tags h)
Proof
Induct_on `v` >> rw [set_bytes_def] >>
irule (METIS_PROVE [] ``x = y f a b c x = f a b c y``) >>
rw [erase_tags_def]
QED
Theorem erase_tags_unit_id[simp]:
∀h. erase_tags h = h
Proof
rw [erase_tags_def, theorem "heap_component_equality", fmap_eq_flookup, FLOOKUP_o_f] >>
CASE_TAC >> rw [] >>
Cases_on `x'` >> rw []
QED
Theorem is_allocated_suc:
n n' is_allocated (Interval b n (Suc n')) h is_allocated (Interval b n n') h
Proof
rw [is_allocated_def, interval_ok_def, interval_to_set_def, SUBSET_DEF,
interval_freeable_def]
>- (first_x_assum irule >> rw [])
>- (qexists_tac `b2` >> rw [])
QED
Theorem get_bytes_erase_tags:
∀h i. heap_ok h is_allocated i h map snd (get_bytes (erase_tags h) i) = map snd (get_bytes h i)
Proof
Cases_on `i` >> rw [get_bytes_def, MAP_MAP_o, combinTheory.o_DEF, erase_tags_def] >>
Induct_on `n0 - n` >> rw [erase_tags_def, FLOOKUP_o_f]
>- (`n0 - n = 0` by decide_tac >> rw [COUNT_LIST_def]) >>
Cases_on `n0` >> fs [] >>
`Suc n' - n = Suc (n' - n)` by decide_tac >>
asm_simp_tac std_ss [COUNT_LIST_SNOC] >>
`v = n' - n` by decide_tac >> fs [] >>
first_x_assum (qspecl_then [`n'`, `n`] mp_tac) >> rw []
>- (
fs [LIST_EQ_REWRITE, EL_MAP, FLOOKUP_o_f] >> rw [] >>
`n n'` by decide_tac >>
drule is_allocated_suc >> disch_then drule >> rw []) >>
BasicProvers.EVERY_CASE_TAC >> rw []
>- (
fs [heap_ok_def] >> rfs [is_allocated_def] >>
first_x_assum (qspec_then `n'` mp_tac) >> rw [] >>
pop_assum (qspec_then `b2` mp_tac) >> rw [] >>
fs [interval_to_set_def, SUBSET_DEF] >>
first_x_assum (qspec_then `n'` mp_tac) >> rw []) >>
pairarg_tac >> rw []
QED
Theorem is_allocated_erase_tags[simp]:
∀i h. is_allocated i (erase_tags h) is_allocated i h
Proof
rw [is_allocated_def, erase_tags_def]
QED
export_theory ();