source: src/joint/BEValues.ma @ 1874

Last change on this file since 1874 was 1874, checked in by campbell, 8 years ago

First cut at using back-end memory model throughout.
Note the correction to BEValues.

File size: 6.0 KB
RevLine 
[1213]1(* Type of values used in the dynamic semantics of the back-end intermediate
2   languages. Inspired by common/Values.ma, adapted from Compcert *)
3
4include "common/Pointers.ma".
5
6record part (r: region): Type[0] ≝
7 { part_no:> nat
[1874]8 ; part_no_ok: part_no < size_pointer r
[1213]9 }.
10
11(* Byte-sized values used in the back-end.
12   Values larger than a single Byte are represented via their parts.
13   Values are either:
14  - machine integers (Bytes)
15  - parts of a pointer seen as a triple giving the representation of the
16    pointer (in terms of the memory regions such a pointer could address),
17    a memory address and an integer offset with respect to this address;
18  - a null pointer: the region denotes the pointer size
19  - the [BVundef] value denoting an arbitrary bit pattern, such as the
20    value of an uninitialized variable
21*)
22
23inductive beval: Type[0] ≝
24  | BVundef: beval
25  | BVByte: Byte → beval
26  | BVnull: ∀r:region. part r → beval
27  | BVptr: ∀p:pointer. part (ptype p) → beval.
28
29definition eq_beval: beval → beval → bool ≝
30 λv1,v2.
31  match v1 with
32   [ BVundef      ⇒ match v2 with [ BVundef      ⇒ true                           | _ ⇒ false ]
33   | BVByte b1    ⇒ match v2 with [ BVByte b2    ⇒ eq_bv … b1 b2                  | _ ⇒ false ]
34   | BVnull r1 p1 ⇒ match v2 with [ BVnull r2 p2 ⇒ eq_region … r1 r2 ∧ eqb p1 p2  | _ ⇒ false ]
35   | BVptr P1 p1  ⇒ match v2 with [ BVptr P2 p2  ⇒ eq_pointer … P1 P2 ∧ eqb p1 p2 | _ ⇒ false ]].
36
37axiom CorruptedValue: String.
38
39let rec pointer_of_bevals_aux (p:pointer) (part: nat) (l: list beval) on l : res pointer ≝
40 match l with
41  [ nil ⇒
42     if eqb part (size_pointer (ptype p)) then
43      OK … p
44     else
45      Error … [MSG CorruptedValue]
46  | cons v tl ⇒
47     match v with
48      [ BVptr p' part' ⇒
49         if eq_pointer p p' ∧ eqb part part' then
50          pointer_of_bevals_aux p (S part) tl
51         else
52          Error … [MSG CorruptedValue]
53      | _ ⇒ Error … [MSG CorruptedValue]]].
54
55axiom NotAPointer: String.
56
57(* CSC: use vectors in place of lists? Or even better products of tuples
58   (more easily pattern matchable in the finite case)? requires one more parameter *)
59definition pointer_of_bevals: list beval → res pointer ≝
60 λl.
61 match l with
62  [ nil ⇒ Error … [MSG NotAPointer]
63  | cons he tl ⇒
64     match he with
65      [ BVptr p part ⇒
66         if eqb part 0 then pointer_of_bevals_aux p 1 tl else Error … [MSG NotAPointer]
67      | _ ⇒ Error … [MSG NotAPointer]]].
68
69(* CSC: use vectors in place of lists? Or even better products of tuples
70   (more easily pattern matchable in the finite case)? *)
71let rec bevals_of_pointer_aux (p:pointer) (part: nat) (n: nat) (pr: plus part n = size_pointer (ptype p)) on n: list beval ≝
72 match n with
73  [ O ⇒ λ_.[]
74  | S m ⇒ λpr':n=S m.(BVptr p (mk_part … part …))::bevals_of_pointer_aux p (S part) m ?] (refl ? n).
[1516]75/3/ (*Andrea: by _ cannot be re-parsed*) qed.
[1213]76
77definition bevals_of_pointer: pointer → list beval ≝
78 λp. bevals_of_pointer_aux p 0 (size_pointer (ptype p)) ….
79// qed.
80
81lemma pointer_of_bevals_bevals_of_pointer:
82 ∀p. pointer_of_bevals (bevals_of_pointer p) = OK … p.
83* * #pbl #pok #poff
84try %
[1516]85whd in ⊢ (??%?); >reflexive_eq_pointer >(eqb_n_n 1) [2,3: %]
86whd in ⊢ (??%?); >reflexive_eq_pointer >(eqb_n_n 2) %
[1213]87qed.
88
89(* CSC: move elsewhere *)
90(* CSC: Wrong data-type? Use products of products *)
91definition list_to_pair: ∀A:Type[0]. ∀l:list A. length … l = 2 → A × A.
92 #A #l cases l [2: #a #tl cases tl [2: #b #tl' cases tl' [1: #_ @〈a,b〉 | #c #tl'']]]
93 #abs normalize in abs; destruct
94qed.
95
96axiom NotATwoBytesPointer: String.
97
98(* Fails if the address is not representable as a pair *)
99definition beval_pair_of_pointer: pointer → res (beval × beval) ≝
100 λp. match p with [ mk_pointer pty pbl pok poff ⇒
101  match pty with
102   [ XData ⇒ λpok. OK … (list_to_pair … (bevals_of_pointer (mk_pointer XData pbl pok poff)) ?)
103   | Code ⇒ λpok. OK … (list_to_pair … (bevals_of_pointer (mk_pointer Code pbl pok poff)) ?)
104   | _ ⇒ λ_. Error … [MSG NotATwoBytesPointer]] pok].
105% qed.
106
[1395]107definition beval_pair_of_code_pointer: (Σp:pointer. ptype p = Code) → beval × beval ≝
108 λp. match p return λp. ptype p = Code → ? with [ mk_pointer pty pbl pok poff ⇒
109  match pty return λpty. ? → pty = Code → ? with
110   [ Code ⇒ λpok.λE. list_to_pair ? (bevals_of_pointer (mk_pointer Code pbl ? poff)) ?
111   | _ ⇒ λpok'.λabs. ⊥] pok] ?.
112[@(pi2 … p) |7: // |8: %] destruct (abs)
113qed.
114
115
116axiom NotACodePointer: String.
117definition code_pointer_of_beval_pair: beval × beval → res (Σp:pointer. ptype p = Code) ≝
118 λp.
119  let 〈v1,v2〉 ≝ p in
120  do p ← pointer_of_bevals [v1;v2] ;
121  match ptype p return λpty. ptype p = pty → res (Σp:pointer. ptype p = Code) with
[1601]122  [ Code ⇒ λE.OK ? (mk_Sig … p ?)
[1395]123  | _ ⇒ λ_.Error … [MSG NotACodePointer]] ?.
124// qed.
125
[1213]126axiom ValueNotABoolean: String.
127
128definition bool_of_beval: beval → res bool ≝
129 λv.match v with
130  [ BVundef ⇒ Error … [MSG ValueNotABoolean]
131  | BVByte b ⇒ OK … (eq_bv … (zero …) b)
132  | BVnull x y ⇒  OK … false
133  | BVptr p q ⇒ OK ? true ].
134
135axiom BadByte: String.
136
137definition Byte_of_val: beval → res Byte ≝ (*CSC: move elsewhere *)
138 λb.match b with
139  [ BVByte b ⇒ OK … b
140  | _ ⇒ Error … [MSG BadByte]].
141
[1359]142axiom NotAnInt32Val: String.
143definition Word_of_list_beval: list beval → res int ≝
144 λl.
145  let first_byte ≝ λl.
146   match l with
147    [ nil ⇒ Error ? [MSG NotAnInt32Val]
148    | cons hd tl ⇒ do b ← Byte_of_val hd ; OK ? 〈b,tl〉 ] in
149  do 〈b1,l〉 ← first_byte l ;
150  do 〈b2,l〉 ← first_byte l ;
151  do 〈b3,l〉 ← first_byte l ;
152  do 〈b4,l〉 ← first_byte l ;
153   match l with
154    [ nil ⇒ OK ? (b4 @@ b3 @@ b2 @@ b1)
155    | _ ⇒ Error ? [MSG NotAnInt32Val] ].
156
[1213]157(* CSC: maybe we should introduce a type of 1-bit-sized values *)
158definition BVtrue: beval ≝ BVByte [[false;false;false;false;false;false;false;true]].
159definition BVfalse: beval ≝ BVByte (zero …).
[1395]160definition beval_of_bool : bool → beval ≝ λb. if b then BVtrue else BVfalse.
Note: See TracBrowser for help on using the repository browser.