252 |
252 |
253 lemma heap_def2 [simp]: "heap s a=globs s (Heap a)" |
253 lemma heap_def2 [simp]: "heap s a=globs s (Heap a)" |
254 by (simp add: heap_def) |
254 by (simp add: heap_def) |
255 |
255 |
256 |
256 |
257 syntax |
257 abbreviation val_this :: "st \<Rightarrow> val" |
258 val_this :: "st \<Rightarrow> val" |
258 where "val_this s == the (locals s This)" |
259 lookup_obj :: "st \<Rightarrow> val \<Rightarrow> obj" |
259 |
260 |
260 abbreviation lookup_obj :: "st \<Rightarrow> val \<Rightarrow> obj" |
261 translations |
261 where "lookup_obj s a' == the (heap s (the_Addr a'))" |
262 "val_this s" == "CONST the (locals s This)" |
|
263 "lookup_obj s a'" == "CONST the (heap s (the_Addr a'))" |
|
264 |
262 |
265 subsection "memory allocation" |
263 subsection "memory allocation" |
266 |
264 |
267 constdefs |
265 constdefs |
268 new_Addr :: "heap \<Rightarrow> loc option" |
266 new_Addr :: "heap \<Rightarrow> loc option" |
284 done |
282 done |
285 |
283 |
286 |
284 |
287 subsection "initialization" |
285 subsection "initialization" |
288 |
286 |
289 syntax |
287 abbreviation init_vals :: "('a, ty) table \<Rightarrow> ('a, val) table" |
290 |
288 where "init_vals vs == Option.map default_val \<circ> vs" |
291 init_vals :: "('a, ty) table \<Rightarrow> ('a, val) table" |
|
292 |
|
293 translations |
|
294 "init_vals vs" == "CONST Option.map default_val \<circ> vs" |
|
295 |
289 |
296 lemma init_arr_comps_base [simp]: "init_vals (arr_comps T 0) = empty" |
290 lemma init_arr_comps_base [simp]: "init_vals (arr_comps T 0) = empty" |
297 apply (unfold arr_comps_def in_bounds_def) |
291 apply (unfold arr_comps_def in_bounds_def) |
298 apply (rule ext) |
292 apply (rule ext) |
299 apply auto |
293 apply auto |
323 "set_locals l \<equiv> st_case (\<lambda>g l'. st g l)" |
317 "set_locals l \<equiv> st_case (\<lambda>g l'. st g l)" |
324 |
318 |
325 init_obj :: "prog \<Rightarrow> obj_tag \<Rightarrow> oref \<Rightarrow> st \<Rightarrow> st" |
319 init_obj :: "prog \<Rightarrow> obj_tag \<Rightarrow> oref \<Rightarrow> st \<Rightarrow> st" |
326 "init_obj G oi r \<equiv> gupd(r\<mapsto>\<lparr>tag=oi, values=init_vals (var_tys G oi r)\<rparr>)" |
320 "init_obj G oi r \<equiv> gupd(r\<mapsto>\<lparr>tag=oi, values=init_vals (var_tys G oi r)\<rparr>)" |
327 |
321 |
328 syntax |
322 abbreviation |
329 init_class_obj :: "prog \<Rightarrow> qtname \<Rightarrow> st \<Rightarrow> st" |
323 init_class_obj :: "prog \<Rightarrow> qtname \<Rightarrow> st \<Rightarrow> st" |
330 |
324 where "init_class_obj G C == init_obj G undefined (Inr C)" |
331 translations |
|
332 "init_class_obj G C" == "init_obj G CONST undefined (CONST Inr C)" |
|
333 |
325 |
334 lemma gupd_def2 [simp]: "gupd(r\<mapsto>obj) (st g l) = st (g(r\<mapsto>obj)) l" |
326 lemma gupd_def2 [simp]: "gupd(r\<mapsto>obj) (st g l) = st (g(r\<mapsto>obj)) l" |
335 apply (unfold gupd_def) |
327 apply (unfold gupd_def) |
336 apply (simp (no_asm)) |
328 apply (simp (no_asm)) |
337 done |
329 done |
511 apply (unfold abrupt_if_def) |
503 apply (unfold abrupt_if_def) |
512 apply (split split_if) |
504 apply (split split_if) |
513 apply auto |
505 apply auto |
514 done |
506 done |
515 |
507 |
516 syntax |
508 abbreviation raise_if :: "bool \<Rightarrow> xname \<Rightarrow> abopt \<Rightarrow> abopt" |
517 |
509 where "raise_if c xn == abrupt_if c (Some (Xcpt (Std xn)))" |
518 raise_if :: "bool \<Rightarrow> xname \<Rightarrow> abopt \<Rightarrow> abopt" |
510 |
519 np :: "val \<spacespace> \<Rightarrow> abopt \<Rightarrow> abopt" |
511 abbreviation np :: "val \<Rightarrow> abopt \<Rightarrow> abopt" |
520 check_neg:: "val \<spacespace> \<Rightarrow> abopt \<Rightarrow> abopt" |
512 where "np v == raise_if (v = Null) NullPointer" |
521 error_if :: "bool \<Rightarrow> error \<Rightarrow> abopt \<Rightarrow> abopt" |
513 |
522 |
514 abbreviation check_neg :: "val \<Rightarrow> abopt \<Rightarrow> abopt" |
523 translations |
515 where "check_neg i' == raise_if (the_Intg i'<0) NegArrSize" |
524 |
516 |
525 "raise_if c xn" == "abrupt_if c (Some (Xcpt (Std xn)))" |
517 abbreviation error_if :: "bool \<Rightarrow> error \<Rightarrow> abopt \<Rightarrow> abopt" |
526 "np v" == "raise_if (v = Null) NullPointer" |
518 where "error_if c e == abrupt_if c (Some (Error e))" |
527 "check_neg i'" == "raise_if (the_Intg i'<0) NegArrSize" |
|
528 "error_if c e" == "abrupt_if c (Some (Error e))" |
|
529 |
519 |
530 lemma raise_if_None [simp]: "(raise_if c x y = None) = (\<not>c \<and> y = None)" |
520 lemma raise_if_None [simp]: "(raise_if c x y = None) = (\<not>c \<and> y = None)" |
531 apply (simp add: abrupt_if_def) |
521 apply (simp add: abrupt_if_def) |
532 by auto |
522 by auto |
533 declare raise_if_None [THEN iffD1, dest!] |
523 declare raise_if_None [THEN iffD1, dest!] |
590 section "full program state" |
580 section "full program state" |
591 |
581 |
592 types |
582 types |
593 state = "abopt \<times> st" --{* state including abruption information *} |
583 state = "abopt \<times> st" --{* state including abruption information *} |
594 |
584 |
595 syntax |
|
596 Norm :: "st \<Rightarrow> state" |
|
597 abrupt :: "state \<Rightarrow> abopt" |
|
598 store :: "state \<Rightarrow> st" |
|
599 |
|
600 translations |
585 translations |
601 |
|
602 "Norm s" == "(None,s)" |
|
603 "abrupt" => "fst" |
|
604 "store" => "snd" |
|
605 "abopt" <= (type) "State.abrupt option" |
586 "abopt" <= (type) "State.abrupt option" |
606 "abopt" <= (type) "abrupt option" |
587 "abopt" <= (type) "abrupt option" |
607 "state" <= (type) "abopt \<times> State.st" |
588 "state" <= (type) "abopt \<times> State.st" |
608 "state" <= (type) "abopt \<times> st" |
589 "state" <= (type) "abopt \<times> st" |
609 |
590 |
610 |
591 abbreviation |
|
592 Norm :: "st \<Rightarrow> state" |
|
593 where "Norm s == (None, s)" |
|
594 |
|
595 abbreviation (input) |
|
596 abrupt :: "state \<Rightarrow> abopt" |
|
597 where "abrupt == fst" |
|
598 |
|
599 abbreviation (input) |
|
600 store :: "state \<Rightarrow> st" |
|
601 where "store == snd" |
611 |
602 |
612 lemma single_stateE: "\<forall>Z. Z = (s::state) \<Longrightarrow> False" |
603 lemma single_stateE: "\<forall>Z. Z = (s::state) \<Longrightarrow> False" |
613 apply (erule_tac x = "(Some k,y)" in all_dupE) |
604 apply (erule_tac x = "(Some k,y)" in all_dupE) |
614 apply (erule_tac x = "(None,y)" in allE) |
605 apply (erule_tac x = "(None,y)" in allE) |
615 apply clarify |
606 apply clarify |
681 by (cases s) simp |
672 by (cases s) simp |
682 |
673 |
683 lemma supd_abrupt_invariant [simp]: "abrupt (supd f s) = abrupt s" |
674 lemma supd_abrupt_invariant [simp]: "abrupt (supd f s) = abrupt s" |
684 by (cases s) simp |
675 by (cases s) simp |
685 |
676 |
686 syntax |
677 abbreviation set_lvars :: "locals \<Rightarrow> state \<Rightarrow> state" |
687 |
678 where "set_lvars l == supd (set_locals l)" |
688 set_lvars :: "locals \<Rightarrow> state \<Rightarrow> state" |
679 |
689 restore_lvars :: "state \<Rightarrow> state \<Rightarrow> state" |
680 abbreviation restore_lvars :: "state \<Rightarrow> state \<Rightarrow> state" |
690 |
681 where "restore_lvars s' s == set_lvars (locals (store s')) s" |
691 translations |
|
692 |
|
693 "set_lvars l" == "supd (set_locals l)" |
|
694 "restore_lvars s' s" == "set_lvars (locals (store s')) s" |
|
695 |
682 |
696 lemma set_set_lvars [simp]: "\<And> s. set_lvars l (set_lvars l' s) = set_lvars l s" |
683 lemma set_set_lvars [simp]: "\<And> s. set_lvars l (set_lvars l' s) = set_lvars l s" |
697 apply (simp (no_asm_simp) only: split_tupled_all) |
684 apply (simp (no_asm_simp) only: split_tupled_all) |
698 apply (simp (no_asm)) |
685 apply (simp (no_asm)) |
699 done |
686 done |