[2601] | 1 | open Preamble |
---|
| 2 | |
---|
| 3 | open Division |
---|
| 4 | |
---|
[2717] | 5 | open Exp |
---|
| 6 | |
---|
[2601] | 7 | open Arithmetic |
---|
| 8 | |
---|
| 9 | open Extranat |
---|
| 10 | |
---|
| 11 | open Vector |
---|
| 12 | |
---|
| 13 | open Div_and_mod |
---|
| 14 | |
---|
| 15 | open Jmeq |
---|
| 16 | |
---|
| 17 | open Russell |
---|
| 18 | |
---|
| 19 | open List |
---|
| 20 | |
---|
| 21 | open Util |
---|
| 22 | |
---|
| 23 | open FoldStuff |
---|
| 24 | |
---|
| 25 | open BitVector |
---|
| 26 | |
---|
| 27 | open Types |
---|
| 28 | |
---|
| 29 | open Bool |
---|
| 30 | |
---|
| 31 | open Relations |
---|
| 32 | |
---|
| 33 | open Nat |
---|
| 34 | |
---|
| 35 | open Hints_declaration |
---|
| 36 | |
---|
| 37 | open Core_notation |
---|
| 38 | |
---|
| 39 | open Pts |
---|
| 40 | |
---|
| 41 | open Logic |
---|
| 42 | |
---|
| 43 | open Positive |
---|
| 44 | |
---|
| 45 | open Z |
---|
| 46 | |
---|
| 47 | open BitVectorZ |
---|
| 48 | |
---|
| 49 | open Proper |
---|
| 50 | |
---|
| 51 | open PositiveMap |
---|
| 52 | |
---|
| 53 | open Deqsets |
---|
| 54 | |
---|
[2649] | 55 | open ErrorMessages |
---|
| 56 | |
---|
[2601] | 57 | open PreIdentifiers |
---|
| 58 | |
---|
| 59 | open Errors |
---|
| 60 | |
---|
| 61 | open Extralib |
---|
| 62 | |
---|
| 63 | open Setoids |
---|
| 64 | |
---|
| 65 | open Monad |
---|
| 66 | |
---|
| 67 | open Option |
---|
| 68 | |
---|
| 69 | open Lists |
---|
| 70 | |
---|
| 71 | open Identifiers |
---|
| 72 | |
---|
| 73 | open Integers |
---|
| 74 | |
---|
| 75 | open AST |
---|
| 76 | |
---|
[2649] | 77 | type block = |
---|
| 78 | Z.z |
---|
| 79 | (* singleton inductive, whose constructor was mk_block *) |
---|
[2601] | 80 | |
---|
[2649] | 81 | (** val block_rect_Type4 : (Z.z -> 'a1) -> block -> 'a1 **) |
---|
[2730] | 82 | let rec block_rect_Type4 h_mk_block x_5622 = |
---|
| 83 | let block_id = x_5622 in h_mk_block block_id |
---|
[2601] | 84 | |
---|
[2649] | 85 | (** val block_rect_Type5 : (Z.z -> 'a1) -> block -> 'a1 **) |
---|
[2730] | 86 | let rec block_rect_Type5 h_mk_block x_5624 = |
---|
| 87 | let block_id = x_5624 in h_mk_block block_id |
---|
[2601] | 88 | |
---|
[2649] | 89 | (** val block_rect_Type3 : (Z.z -> 'a1) -> block -> 'a1 **) |
---|
[2730] | 90 | let rec block_rect_Type3 h_mk_block x_5626 = |
---|
| 91 | let block_id = x_5626 in h_mk_block block_id |
---|
[2601] | 92 | |
---|
[2649] | 93 | (** val block_rect_Type2 : (Z.z -> 'a1) -> block -> 'a1 **) |
---|
[2730] | 94 | let rec block_rect_Type2 h_mk_block x_5628 = |
---|
| 95 | let block_id = x_5628 in h_mk_block block_id |
---|
[2601] | 96 | |
---|
[2649] | 97 | (** val block_rect_Type1 : (Z.z -> 'a1) -> block -> 'a1 **) |
---|
[2730] | 98 | let rec block_rect_Type1 h_mk_block x_5630 = |
---|
| 99 | let block_id = x_5630 in h_mk_block block_id |
---|
[2601] | 100 | |
---|
[2649] | 101 | (** val block_rect_Type0 : (Z.z -> 'a1) -> block -> 'a1 **) |
---|
[2730] | 102 | let rec block_rect_Type0 h_mk_block x_5632 = |
---|
| 103 | let block_id = x_5632 in h_mk_block block_id |
---|
[2601] | 104 | |
---|
| 105 | (** val block_id : block -> Z.z **) |
---|
| 106 | let rec block_id xxx = |
---|
[2649] | 107 | let yyy = xxx in yyy |
---|
[2601] | 108 | |
---|
[2649] | 109 | (** val block_inv_rect_Type4 : block -> (Z.z -> __ -> 'a1) -> 'a1 **) |
---|
[2601] | 110 | let block_inv_rect_Type4 hterm h1 = |
---|
| 111 | let hcut = block_rect_Type4 h1 hterm in hcut __ |
---|
| 112 | |
---|
[2649] | 113 | (** val block_inv_rect_Type3 : block -> (Z.z -> __ -> 'a1) -> 'a1 **) |
---|
[2601] | 114 | let block_inv_rect_Type3 hterm h1 = |
---|
| 115 | let hcut = block_rect_Type3 h1 hterm in hcut __ |
---|
| 116 | |
---|
[2649] | 117 | (** val block_inv_rect_Type2 : block -> (Z.z -> __ -> 'a1) -> 'a1 **) |
---|
[2601] | 118 | let block_inv_rect_Type2 hterm h1 = |
---|
| 119 | let hcut = block_rect_Type2 h1 hterm in hcut __ |
---|
| 120 | |
---|
[2649] | 121 | (** val block_inv_rect_Type1 : block -> (Z.z -> __ -> 'a1) -> 'a1 **) |
---|
[2601] | 122 | let block_inv_rect_Type1 hterm h1 = |
---|
| 123 | let hcut = block_rect_Type1 h1 hterm in hcut __ |
---|
| 124 | |
---|
[2649] | 125 | (** val block_inv_rect_Type0 : block -> (Z.z -> __ -> 'a1) -> 'a1 **) |
---|
[2601] | 126 | let block_inv_rect_Type0 hterm h1 = |
---|
| 127 | let hcut = block_rect_Type0 h1 hterm in hcut __ |
---|
| 128 | |
---|
| 129 | (** val block_discr : block -> block -> __ **) |
---|
| 130 | let block_discr x y = |
---|
[2649] | 131 | Logic.eq_rect_Type2 x (let a0 = x in Obj.magic (fun _ dH -> dH __)) y |
---|
[2601] | 132 | |
---|
| 133 | (** val block_jmdiscr : block -> block -> __ **) |
---|
| 134 | let block_jmdiscr x y = |
---|
[2649] | 135 | Logic.eq_rect_Type2 x (let a0 = x in Obj.magic (fun _ dH -> dH __)) y |
---|
[2601] | 136 | |
---|
[2649] | 137 | (** val block_region : block -> AST.region **) |
---|
| 138 | let block_region b = |
---|
| 139 | match Z.zleb (block_id b) Z.OZ with |
---|
| 140 | | Bool.True -> AST.Code |
---|
| 141 | | Bool.False -> AST.XData |
---|
| 142 | |
---|
| 143 | (** val dummy_block_code : block **) |
---|
| 144 | let dummy_block_code = |
---|
| 145 | Z.OZ |
---|
| 146 | |
---|
[2601] | 147 | (** val eq_block : block -> block -> Bool.bool **) |
---|
| 148 | let eq_block b1 b2 = |
---|
[2649] | 149 | Z.eqZb (block_id b1) (block_id b2) |
---|
[2601] | 150 | |
---|
| 151 | (** val block_eq : Deqsets.deqSet **) |
---|
| 152 | let block_eq = |
---|
| 153 | Obj.magic eq_block |
---|
| 154 | |
---|
| 155 | (** val offset_size : Nat.nat **) |
---|
| 156 | let offset_size = |
---|
| 157 | Nat.times (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S (Nat.S |
---|
| 158 | Nat.O)))))))) AST.size_pointer |
---|
| 159 | |
---|
| 160 | type offset = |
---|
| 161 | BitVector.bitVector |
---|
| 162 | (* singleton inductive, whose constructor was mk_offset *) |
---|
| 163 | |
---|
| 164 | (** val offset_rect_Type4 : (BitVector.bitVector -> 'a1) -> offset -> 'a1 **) |
---|
[2730] | 165 | let rec offset_rect_Type4 h_mk_offset x_5648 = |
---|
| 166 | let offv = x_5648 in h_mk_offset offv |
---|
[2601] | 167 | |
---|
| 168 | (** val offset_rect_Type5 : (BitVector.bitVector -> 'a1) -> offset -> 'a1 **) |
---|
[2730] | 169 | let rec offset_rect_Type5 h_mk_offset x_5650 = |
---|
| 170 | let offv = x_5650 in h_mk_offset offv |
---|
[2601] | 171 | |
---|
| 172 | (** val offset_rect_Type3 : (BitVector.bitVector -> 'a1) -> offset -> 'a1 **) |
---|
[2730] | 173 | let rec offset_rect_Type3 h_mk_offset x_5652 = |
---|
| 174 | let offv = x_5652 in h_mk_offset offv |
---|
[2601] | 175 | |
---|
| 176 | (** val offset_rect_Type2 : (BitVector.bitVector -> 'a1) -> offset -> 'a1 **) |
---|
[2730] | 177 | let rec offset_rect_Type2 h_mk_offset x_5654 = |
---|
| 178 | let offv = x_5654 in h_mk_offset offv |
---|
[2601] | 179 | |
---|
| 180 | (** val offset_rect_Type1 : (BitVector.bitVector -> 'a1) -> offset -> 'a1 **) |
---|
[2730] | 181 | let rec offset_rect_Type1 h_mk_offset x_5656 = |
---|
| 182 | let offv = x_5656 in h_mk_offset offv |
---|
[2601] | 183 | |
---|
| 184 | (** val offset_rect_Type0 : (BitVector.bitVector -> 'a1) -> offset -> 'a1 **) |
---|
[2730] | 185 | let rec offset_rect_Type0 h_mk_offset x_5658 = |
---|
| 186 | let offv = x_5658 in h_mk_offset offv |
---|
[2601] | 187 | |
---|
| 188 | (** val offv : offset -> BitVector.bitVector **) |
---|
| 189 | let rec offv xxx = |
---|
| 190 | let yyy = xxx in yyy |
---|
| 191 | |
---|
| 192 | (** val offset_inv_rect_Type4 : |
---|
| 193 | offset -> (BitVector.bitVector -> __ -> 'a1) -> 'a1 **) |
---|
| 194 | let offset_inv_rect_Type4 hterm h1 = |
---|
| 195 | let hcut = offset_rect_Type4 h1 hterm in hcut __ |
---|
| 196 | |
---|
| 197 | (** val offset_inv_rect_Type3 : |
---|
| 198 | offset -> (BitVector.bitVector -> __ -> 'a1) -> 'a1 **) |
---|
| 199 | let offset_inv_rect_Type3 hterm h1 = |
---|
| 200 | let hcut = offset_rect_Type3 h1 hterm in hcut __ |
---|
| 201 | |
---|
| 202 | (** val offset_inv_rect_Type2 : |
---|
| 203 | offset -> (BitVector.bitVector -> __ -> 'a1) -> 'a1 **) |
---|
| 204 | let offset_inv_rect_Type2 hterm h1 = |
---|
| 205 | let hcut = offset_rect_Type2 h1 hterm in hcut __ |
---|
| 206 | |
---|
| 207 | (** val offset_inv_rect_Type1 : |
---|
| 208 | offset -> (BitVector.bitVector -> __ -> 'a1) -> 'a1 **) |
---|
| 209 | let offset_inv_rect_Type1 hterm h1 = |
---|
| 210 | let hcut = offset_rect_Type1 h1 hterm in hcut __ |
---|
| 211 | |
---|
| 212 | (** val offset_inv_rect_Type0 : |
---|
| 213 | offset -> (BitVector.bitVector -> __ -> 'a1) -> 'a1 **) |
---|
| 214 | let offset_inv_rect_Type0 hterm h1 = |
---|
| 215 | let hcut = offset_rect_Type0 h1 hterm in hcut __ |
---|
| 216 | |
---|
| 217 | (** val offset_discr : offset -> offset -> __ **) |
---|
| 218 | let offset_discr x y = |
---|
| 219 | Logic.eq_rect_Type2 x (let a0 = x in Obj.magic (fun _ dH -> dH __)) y |
---|
| 220 | |
---|
| 221 | (** val offset_jmdiscr : offset -> offset -> __ **) |
---|
| 222 | let offset_jmdiscr x y = |
---|
| 223 | Logic.eq_rect_Type2 x (let a0 = x in Obj.magic (fun _ dH -> dH __)) y |
---|
| 224 | |
---|
| 225 | (** val eq_offset : offset -> offset -> Bool.bool **) |
---|
| 226 | let eq_offset x y = |
---|
| 227 | BitVector.eq_bv offset_size (offv x) (offv y) |
---|
| 228 | |
---|
| 229 | (** val offset_of_Z : Z.z -> offset **) |
---|
| 230 | let offset_of_Z z0 = |
---|
| 231 | BitVectorZ.bitvector_of_Z offset_size z0 |
---|
| 232 | |
---|
| 233 | (** val shift_offset : Nat.nat -> offset -> BitVector.bitVector -> offset **) |
---|
| 234 | let shift_offset n o i = |
---|
| 235 | Arithmetic.addition_n offset_size (offv o) |
---|
| 236 | (Arithmetic.sign_ext n offset_size i) |
---|
| 237 | |
---|
| 238 | (** val shift_offset_n : |
---|
| 239 | Nat.nat -> offset -> Nat.nat -> AST.signedness -> BitVector.bitVector -> |
---|
| 240 | offset **) |
---|
| 241 | let shift_offset_n n o i sg j = |
---|
| 242 | Arithmetic.addition_n offset_size (offv o) |
---|
| 243 | (Arithmetic.short_multiplication offset_size |
---|
| 244 | (Arithmetic.bitvector_of_nat offset_size i) |
---|
| 245 | (match sg with |
---|
| 246 | | AST.Signed -> Arithmetic.sign_ext n offset_size j |
---|
| 247 | | AST.Unsigned -> Arithmetic.zero_ext n offset_size j)) |
---|
| 248 | |
---|
| 249 | (** val neg_shift_offset : |
---|
| 250 | Nat.nat -> offset -> BitVector.bitVector -> offset **) |
---|
| 251 | let neg_shift_offset n o i = |
---|
| 252 | Arithmetic.subtraction offset_size (offv o) |
---|
| 253 | (Arithmetic.sign_ext n offset_size i) |
---|
| 254 | |
---|
| 255 | (** val neg_shift_offset_n : |
---|
| 256 | Nat.nat -> offset -> Nat.nat -> AST.signedness -> BitVector.bitVector -> |
---|
| 257 | offset **) |
---|
| 258 | let neg_shift_offset_n n o i sg j = |
---|
| 259 | Arithmetic.subtraction offset_size (offv o) |
---|
| 260 | (Arithmetic.short_multiplication offset_size |
---|
| 261 | (Arithmetic.bitvector_of_nat offset_size i) |
---|
| 262 | (match sg with |
---|
| 263 | | AST.Signed -> Arithmetic.sign_ext n offset_size j |
---|
| 264 | | AST.Unsigned -> Arithmetic.zero_ext n offset_size j)) |
---|
| 265 | |
---|
| 266 | (** val sub_offset : Nat.nat -> offset -> offset -> BitVector.bitVector **) |
---|
| 267 | let sub_offset n x y = |
---|
| 268 | Arithmetic.sign_ext offset_size n |
---|
| 269 | (Arithmetic.subtraction offset_size (offv x) (offv y)) |
---|
| 270 | |
---|
| 271 | (** val zero_offset : offset **) |
---|
| 272 | let zero_offset = |
---|
| 273 | BitVector.zero offset_size |
---|
| 274 | |
---|
| 275 | (** val lt_offset : offset -> offset -> Bool.bool **) |
---|
| 276 | let lt_offset x y = |
---|
| 277 | Arithmetic.lt_u offset_size (offv x) (offv y) |
---|
| 278 | |
---|
| 279 | type pointer = { pblock : block; poff : offset } |
---|
| 280 | |
---|
| 281 | (** val pointer_rect_Type4 : (block -> offset -> 'a1) -> pointer -> 'a1 **) |
---|
[2730] | 282 | let rec pointer_rect_Type4 h_mk_pointer x_5674 = |
---|
| 283 | let { pblock = pblock0; poff = poff0 } = x_5674 in |
---|
[2601] | 284 | h_mk_pointer pblock0 poff0 |
---|
| 285 | |
---|
| 286 | (** val pointer_rect_Type5 : (block -> offset -> 'a1) -> pointer -> 'a1 **) |
---|
[2730] | 287 | let rec pointer_rect_Type5 h_mk_pointer x_5676 = |
---|
| 288 | let { pblock = pblock0; poff = poff0 } = x_5676 in |
---|
[2601] | 289 | h_mk_pointer pblock0 poff0 |
---|
| 290 | |
---|
| 291 | (** val pointer_rect_Type3 : (block -> offset -> 'a1) -> pointer -> 'a1 **) |
---|
[2730] | 292 | let rec pointer_rect_Type3 h_mk_pointer x_5678 = |
---|
| 293 | let { pblock = pblock0; poff = poff0 } = x_5678 in |
---|
[2601] | 294 | h_mk_pointer pblock0 poff0 |
---|
| 295 | |
---|
| 296 | (** val pointer_rect_Type2 : (block -> offset -> 'a1) -> pointer -> 'a1 **) |
---|
[2730] | 297 | let rec pointer_rect_Type2 h_mk_pointer x_5680 = |
---|
| 298 | let { pblock = pblock0; poff = poff0 } = x_5680 in |
---|
[2601] | 299 | h_mk_pointer pblock0 poff0 |
---|
| 300 | |
---|
| 301 | (** val pointer_rect_Type1 : (block -> offset -> 'a1) -> pointer -> 'a1 **) |
---|
[2730] | 302 | let rec pointer_rect_Type1 h_mk_pointer x_5682 = |
---|
| 303 | let { pblock = pblock0; poff = poff0 } = x_5682 in |
---|
[2601] | 304 | h_mk_pointer pblock0 poff0 |
---|
| 305 | |
---|
| 306 | (** val pointer_rect_Type0 : (block -> offset -> 'a1) -> pointer -> 'a1 **) |
---|
[2730] | 307 | let rec pointer_rect_Type0 h_mk_pointer x_5684 = |
---|
| 308 | let { pblock = pblock0; poff = poff0 } = x_5684 in |
---|
[2601] | 309 | h_mk_pointer pblock0 poff0 |
---|
| 310 | |
---|
| 311 | (** val pblock : pointer -> block **) |
---|
| 312 | let rec pblock xxx = |
---|
| 313 | xxx.pblock |
---|
| 314 | |
---|
| 315 | (** val poff : pointer -> offset **) |
---|
| 316 | let rec poff xxx = |
---|
| 317 | xxx.poff |
---|
| 318 | |
---|
| 319 | (** val pointer_inv_rect_Type4 : |
---|
| 320 | pointer -> (block -> offset -> __ -> 'a1) -> 'a1 **) |
---|
| 321 | let pointer_inv_rect_Type4 hterm h1 = |
---|
| 322 | let hcut = pointer_rect_Type4 h1 hterm in hcut __ |
---|
| 323 | |
---|
| 324 | (** val pointer_inv_rect_Type3 : |
---|
| 325 | pointer -> (block -> offset -> __ -> 'a1) -> 'a1 **) |
---|
| 326 | let pointer_inv_rect_Type3 hterm h1 = |
---|
| 327 | let hcut = pointer_rect_Type3 h1 hterm in hcut __ |
---|
| 328 | |
---|
| 329 | (** val pointer_inv_rect_Type2 : |
---|
| 330 | pointer -> (block -> offset -> __ -> 'a1) -> 'a1 **) |
---|
| 331 | let pointer_inv_rect_Type2 hterm h1 = |
---|
| 332 | let hcut = pointer_rect_Type2 h1 hterm in hcut __ |
---|
| 333 | |
---|
| 334 | (** val pointer_inv_rect_Type1 : |
---|
| 335 | pointer -> (block -> offset -> __ -> 'a1) -> 'a1 **) |
---|
| 336 | let pointer_inv_rect_Type1 hterm h1 = |
---|
| 337 | let hcut = pointer_rect_Type1 h1 hterm in hcut __ |
---|
| 338 | |
---|
| 339 | (** val pointer_inv_rect_Type0 : |
---|
| 340 | pointer -> (block -> offset -> __ -> 'a1) -> 'a1 **) |
---|
| 341 | let pointer_inv_rect_Type0 hterm h1 = |
---|
| 342 | let hcut = pointer_rect_Type0 h1 hterm in hcut __ |
---|
| 343 | |
---|
| 344 | (** val pointer_discr : pointer -> pointer -> __ **) |
---|
| 345 | let pointer_discr x y = |
---|
| 346 | Logic.eq_rect_Type2 x |
---|
| 347 | (let { pblock = a0; poff = a1 } = x in Obj.magic (fun _ dH -> dH __ __)) |
---|
| 348 | y |
---|
| 349 | |
---|
| 350 | (** val pointer_jmdiscr : pointer -> pointer -> __ **) |
---|
| 351 | let pointer_jmdiscr x y = |
---|
| 352 | Logic.eq_rect_Type2 x |
---|
| 353 | (let { pblock = a0; poff = a1 } = x in Obj.magic (fun _ dH -> dH __ __)) |
---|
| 354 | y |
---|
| 355 | |
---|
| 356 | (** val ptype : pointer -> AST.region **) |
---|
| 357 | let ptype p = |
---|
[2649] | 358 | block_region p.pblock |
---|
[2601] | 359 | |
---|
| 360 | (** val shift_pointer : |
---|
| 361 | Nat.nat -> pointer -> BitVector.bitVector -> pointer **) |
---|
| 362 | let shift_pointer n p i = |
---|
| 363 | { pblock = p.pblock; poff = (shift_offset n p.poff i) } |
---|
| 364 | |
---|
| 365 | (** val shift_pointer_n : |
---|
| 366 | Nat.nat -> pointer -> Nat.nat -> AST.signedness -> BitVector.bitVector -> |
---|
| 367 | pointer **) |
---|
| 368 | let shift_pointer_n n p i sg j = |
---|
| 369 | { pblock = p.pblock; poff = (shift_offset_n n p.poff i sg j) } |
---|
| 370 | |
---|
| 371 | (** val neg_shift_pointer : |
---|
| 372 | Nat.nat -> pointer -> BitVector.bitVector -> pointer **) |
---|
| 373 | let neg_shift_pointer n p i = |
---|
| 374 | { pblock = p.pblock; poff = (neg_shift_offset n p.poff i) } |
---|
| 375 | |
---|
| 376 | (** val neg_shift_pointer_n : |
---|
| 377 | Nat.nat -> pointer -> Nat.nat -> AST.signedness -> BitVector.bitVector -> |
---|
| 378 | pointer **) |
---|
| 379 | let neg_shift_pointer_n n p i sg j = |
---|
| 380 | { pblock = p.pblock; poff = (neg_shift_offset_n n p.poff i sg j) } |
---|
| 381 | |
---|
| 382 | (** val eq_pointer : pointer -> pointer -> Bool.bool **) |
---|
| 383 | let eq_pointer p3 p4 = |
---|
| 384 | Bool.andb (eq_block p3.pblock p4.pblock) (eq_offset p3.poff p4.poff) |
---|
| 385 | |
---|