src/HOL/MicroJava/J/Conform.ML
author oheimb
Fri, 14 Jul 2000 20:47:11 +0200
changeset 9348 f495dba0cb07
parent 9240 f4d76cb26433
child 9758 88366d7332ff
permissions -rw-r--r--
corrections (cast relation, Prog.ML -> Decl.ML)
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
8011
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
     1
(*  Title:      HOL/MicroJava/J/Conform.ML
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
     2
    ID:         $Id$
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
     3
    Author:     David von Oheimb
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
     4
    Copyright   1999 Technische Universitaet Muenchen
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
     5
*)
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
     6
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
     7
section "hext";
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
     8
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
     9
val hextI = prove_goalw thy [hext_def] "\\<And>h. \
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    10
\ \\<forall>a C fs . h  a = Some (C,fs) \\<longrightarrow>  \
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    11
\     (\\<exists>fs'. h' a = Some (C,fs')) \\<Longrightarrow> h\\<le>|h'" (K [Auto_tac ]);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    12
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    13
val hext_objD = prove_goalw thy [hext_def] 
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    14
"\\<And>h. \\<lbrakk>h\\<le>|h'; h a = Some (C,fs) \\<rbrakk> \\<Longrightarrow> \\<exists>fs'. h' a = Some (C,fs')" 
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    15
	(K [Force_tac 1]);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    16
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    17
val hext_refl = prove_goal thy "h\\<le>|h" (K [
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    18
	rtac hextI 1,
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    19
	Fast_tac 1]);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    20
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    21
val hext_new = prove_goal thy "\\<And>h. h a = None \\<Longrightarrow> h\\<le>|h(a\\<mapsto>x)" (K [
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    22
	rtac hextI 1,
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    23
	safe_tac HOL_cs,
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    24
	 ALLGOALS (case_tac "aa = a"),
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    25
	   Auto_tac]);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    26
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    27
val hext_trans = prove_goal thy "\\<And>h. \\<lbrakk>h\\<le>|h'; h'\\<le>|h''\\<rbrakk> \\<Longrightarrow> h\\<le>|h''" (K [
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    28
	rtac hextI 1,
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    29
	safe_tac HOL_cs,
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    30
	 fast_tac (HOL_cs addDs [hext_objD]) 1]);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    31
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    32
Addsimps [hext_refl, hext_new];
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    33
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    34
val hext_upd_obj = prove_goal thy 
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    35
"\\<And>h. h a = Some (C,fs) \\<Longrightarrow> h\\<le>|h(a\\<mapsto>(C,fs'))" (K [
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    36
	rtac hextI 1,
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    37
	safe_tac HOL_cs,
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    38
	 ALLGOALS (case_tac "aa = a"),
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    39
	   Auto_tac]);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    40
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    41
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    42
section "conf";
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    43
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    44
val conf_Null = prove_goalw thy [conf_def] 
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    45
"G,h\\<turnstile>Null\\<Colon>\\<preceq>T = G\\<turnstile>RefT NullT\\<preceq>T" (K [Simp_tac 1]);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    46
Addsimps [conf_Null];
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    47
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    48
val conf_litval = prove_goalw thy [conf_def] 
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    49
"typeof (\\<lambda>v. None) v = Some T \\<longrightarrow> G,h\\<turnstile>v\\<Colon>\\<preceq>T" (K [
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    50
	rtac val_.induct 1,
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    51
	    Auto_tac]) RS mp;
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    52
9240
f4d76cb26433 added BinOp
oheimb
parents: 8185
diff changeset
    53
Goalw [conf_def] "G,s\\<turnstile>Unit\\<Colon>\\<preceq>PrimT Void";
f4d76cb26433 added BinOp
oheimb
parents: 8185
diff changeset
    54
by( Simp_tac 1);
f4d76cb26433 added BinOp
oheimb
parents: 8185
diff changeset
    55
qed "conf_VoidI";
f4d76cb26433 added BinOp
oheimb
parents: 8185
diff changeset
    56
f4d76cb26433 added BinOp
oheimb
parents: 8185
diff changeset
    57
Goalw [conf_def] "G,s\\<turnstile>Bool b\\<Colon>\\<preceq>PrimT Boolean";
f4d76cb26433 added BinOp
oheimb
parents: 8185
diff changeset
    58
by( Simp_tac 1);
f4d76cb26433 added BinOp
oheimb
parents: 8185
diff changeset
    59
qed "conf_BooleanI";
f4d76cb26433 added BinOp
oheimb
parents: 8185
diff changeset
    60
f4d76cb26433 added BinOp
oheimb
parents: 8185
diff changeset
    61
Goalw [conf_def] "G,s\\<turnstile>Intg i\\<Colon>\\<preceq>PrimT Integer";
f4d76cb26433 added BinOp
oheimb
parents: 8185
diff changeset
    62
by( Simp_tac 1);
f4d76cb26433 added BinOp
oheimb
parents: 8185
diff changeset
    63
qed "conf_IntegerI";
f4d76cb26433 added BinOp
oheimb
parents: 8185
diff changeset
    64
f4d76cb26433 added BinOp
oheimb
parents: 8185
diff changeset
    65
Addsimps [conf_VoidI, conf_BooleanI, conf_IntegerI];
f4d76cb26433 added BinOp
oheimb
parents: 8185
diff changeset
    66
8011
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    67
val conf_AddrI = prove_goalw thy [conf_def] 
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    68
"\\<And>G. \\<lbrakk>h a = Some obj; G\\<turnstile>obj_ty obj\\<preceq>T\\<rbrakk> \\<Longrightarrow> G,h\\<turnstile>Addr a\\<Colon>\\<preceq>T"
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    69
(K [Asm_full_simp_tac 1]);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    70
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    71
val conf_obj_AddrI = prove_goalw thy [conf_def]
8185
59b62e8804b4 Rduced Class C <= Class D to C <= D.
nipkow
parents: 8116
diff changeset
    72
 "\\<And>G. \\<lbrakk>h a = Some (C,fs); G\\<turnstile>C\\<preceq>C D\\<rbrakk> \\<Longrightarrow> G,h\\<turnstile>Addr a\\<Colon>\\<preceq> Class D" 
8011
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    73
(K [Asm_full_simp_tac 1]);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    74
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    75
Goalw [conf_def] "is_type G T \\<longrightarrow> G,h\\<turnstile>default_val T\\<Colon>\\<preceq>T";
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    76
by (res_inst_tac [("y","T")] ty.exhaust 1);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    77
by  (etac ssubst 1);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    78
by  (res_inst_tac [("y","prim_ty")] prim_ty.exhaust 1);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    79
by    (auto_tac (claset(), simpset() addsimps [widen.null]));
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    80
qed_spec_mp "defval_conf";
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    81
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    82
val conf_upd_obj = prove_goalw thy [conf_def] 
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    83
"h a = Some (C,fs) \\<longrightarrow> (G,h(a\\<mapsto>(C,fs'))\\<turnstile>x\\<Colon>\\<preceq>T) = (G,h\\<turnstile>x\\<Colon>\\<preceq>T)" (fn _ => [
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    84
	rtac impI 1,
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    85
	rtac val_.induct 1,
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    86
	 ALLGOALS Simp_tac,
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    87
	case_tac "loc = a" 1,
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    88
	 ALLGOALS Asm_simp_tac]) RS mp;
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    89
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    90
val conf_widen = prove_goalw thy [conf_def] 
8082
381716a86fcb removed inj_eq from the default simpset again
oheimb
parents: 8032
diff changeset
    91
"\\<And>G. wf_prog wf_mb G \\<Longrightarrow> G,h\\<turnstile>x\\<Colon>\\<preceq>T \\<longrightarrow> G\\<turnstile>T\\<preceq>T' \\<longrightarrow> G,h\\<turnstile>x\\<Colon>\\<preceq>T'" (K [
8011
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    92
	rtac val_.induct 1,
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    93
	    ALLGOALS Simp_tac,
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    94
	    ALLGOALS (fast_tac (HOL_cs addIs [widen_trans]))]) RS mp RS mp;
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    95
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    96
val conf_hext' = prove_goalw thy [conf_def] 
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    97
	"\\<And>h. h\\<le>|h' \\<Longrightarrow> (\\<forall>v T. G,h\\<turnstile>v\\<Colon>\\<preceq>T \\<longrightarrow> G,h'\\<turnstile>v\\<Colon>\\<preceq>T)" (K [
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    98
	REPEAT (rtac allI 1),
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
    99
	rtac val_.induct 1,
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   100
	 ALLGOALS Simp_tac,
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   101
	safe_tac (HOL_cs addSDs [option_map_SomeD]),
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   102
	rewtac option_map_def,
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   103
	  dtac hext_objD 1,
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   104
	   Auto_tac]);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   105
val conf_hext = conf_hext' RS spec RS spec RS mp;
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   106
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   107
val new_locD = prove_goalw thy [conf_def] 
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   108
	"\\<lbrakk>h a = None; G,h\\<turnstile>Addr t\\<Colon>\\<preceq>T\\<rbrakk> \\<Longrightarrow> t\\<noteq>a" (fn prems => [
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   109
	cut_facts_tac prems 1,
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   110
	Full_simp_tac 1,
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   111
	safe_tac HOL_cs,
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   112
	Asm_full_simp_tac 1]);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   113
8185
59b62e8804b4 Rduced Class C <= Class D to C <= D.
nipkow
parents: 8116
diff changeset
   114
Goalw [conf_def]
59b62e8804b4 Rduced Class C <= Class D to C <= D.
nipkow
parents: 8116
diff changeset
   115
 "G,h\\<turnstile>a'\\<Colon>\\<preceq>RefT T \\<longrightarrow> a' = Null |  \
59b62e8804b4 Rduced Class C <= Class D to C <= D.
nipkow
parents: 8116
diff changeset
   116
\ (\\<exists>a obj T'. a' = Addr a \\<and>  h a = Some obj \\<and>  obj_ty obj = T' \\<and>  G\\<turnstile>T'\\<preceq>RefT T)";
59b62e8804b4 Rduced Class C <= Class D to C <= D.
nipkow
parents: 8116
diff changeset
   117
by(induct_tac "a'" 1);
59b62e8804b4 Rduced Class C <= Class D to C <= D.
nipkow
parents: 8116
diff changeset
   118
by(Auto_tac);
59b62e8804b4 Rduced Class C <= Class D to C <= D.
nipkow
parents: 8116
diff changeset
   119
qed_spec_mp "conf_RefTD";
8011
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   120
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   121
val conf_NullTD = prove_goal thy "\\<And>G. G,h\\<turnstile>a'\\<Colon>\\<preceq>RefT NullT \\<Longrightarrow> a' = Null" (K [
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   122
	dtac conf_RefTD 1,
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   123
	Step_tac 1,
8185
59b62e8804b4 Rduced Class C <= Class D to C <= D.
nipkow
parents: 8116
diff changeset
   124
	 Auto_tac]);
8011
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   125
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   126
val non_npD = prove_goal thy "\\<And>G. \\<lbrakk>a' \\<noteq> Null; G,h\\<turnstile>a'\\<Colon>\\<preceq>RefT t\\<rbrakk> \\<Longrightarrow> \
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   127
\ \\<exists>a C fs. a' = Addr a \\<and>  h a = Some (C,fs) \\<and>  G\\<turnstile>Class C\\<preceq>RefT t" (K [
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   128
	dtac conf_RefTD 1,
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   129
	Step_tac 1,
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   130
	 Auto_tac]);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   131
8106
de9fae0cdfde improved symbol for subcls relation
oheimb
parents: 8082
diff changeset
   132
val non_np_objD = prove_goal thy "\\<And>G. \\<lbrakk>a' \\<noteq> Null; G,h\\<turnstile>a'\\<Colon>\\<preceq> Class C; C \\<noteq> Object\\<rbrakk> \\<Longrightarrow> \
8185
59b62e8804b4 Rduced Class C <= Class D to C <= D.
nipkow
parents: 8116
diff changeset
   133
\ (\\<exists>a C' fs. a' = Addr a \\<and>  h a = Some (C',fs) \\<and>  G\\<turnstile>C'\\<preceq>C C)" 
59b62e8804b4 Rduced Class C <= Class D to C <= D.
nipkow
parents: 8116
diff changeset
   134
	(K[fast_tac (claset() addDs [non_npD]) 1]);
8011
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   135
8082
381716a86fcb removed inj_eq from the default simpset again
oheimb
parents: 8032
diff changeset
   136
Goal "a' \\<noteq> Null \\<longrightarrow> wf_prog wf_mb G \\<longrightarrow> G,h\\<turnstile>a'\\<Colon>\\<preceq>RefT t \\<longrightarrow>\
8011
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   137
\ (\\<forall>C. t = ClassT C \\<longrightarrow> C \\<noteq> Object) \\<longrightarrow> \
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   138
\ (\\<exists>a C fs. a' = Addr a \\<and>  h a = Some (C,fs) \\<and>  G\\<turnstile>Class C\\<preceq>RefT t)";
8185
59b62e8804b4 Rduced Class C <= Class D to C <= D.
nipkow
parents: 8116
diff changeset
   139
by(rtac impI 1);
59b62e8804b4 Rduced Class C <= Class D to C <= D.
nipkow
parents: 8116
diff changeset
   140
by(rtac impI 1);
59b62e8804b4 Rduced Class C <= Class D to C <= D.
nipkow
parents: 8116
diff changeset
   141
by(res_inst_tac [("y","t")] ref_ty.exhaust 1);
59b62e8804b4 Rduced Class C <= Class D to C <= D.
nipkow
parents: 8116
diff changeset
   142
 by(Safe_tac);
59b62e8804b4 Rduced Class C <= Class D to C <= D.
nipkow
parents: 8116
diff changeset
   143
 by(dtac conf_NullTD 1);
59b62e8804b4 Rduced Class C <= Class D to C <= D.
nipkow
parents: 8116
diff changeset
   144
 by(contr_tac 1);
59b62e8804b4 Rduced Class C <= Class D to C <= D.
nipkow
parents: 8116
diff changeset
   145
by(dtac non_np_objD 1);
59b62e8804b4 Rduced Class C <= Class D to C <= D.
nipkow
parents: 8116
diff changeset
   146
  by(atac 1);
59b62e8804b4 Rduced Class C <= Class D to C <= D.
nipkow
parents: 8116
diff changeset
   147
 by(Fast_tac 1);
59b62e8804b4 Rduced Class C <= Class D to C <= D.
nipkow
parents: 8116
diff changeset
   148
by(Fast_tac 1);
8011
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   149
qed_spec_mp "non_np_objD'";
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   150
8082
381716a86fcb removed inj_eq from the default simpset again
oheimb
parents: 8032
diff changeset
   151
Goal "wf_prog wf_mb G \\<Longrightarrow> \\<forall>Ts Ts'. list_all2 (conf G h) vs Ts \\<longrightarrow> list_all2 (\\<lambda>T T'. G\\<turnstile>T\\<preceq>T') Ts Ts' \\<longrightarrow>  list_all2 (conf G h) vs Ts'";
8116
759f712f8f06 int:nat->int is pushed inwards.
nipkow
parents: 8106
diff changeset
   152
by(induct_tac "vs" 1);
759f712f8f06 int:nat->int is pushed inwards.
nipkow
parents: 8106
diff changeset
   153
 by(ALLGOALS Clarsimp_tac);
759f712f8f06 int:nat->int is pushed inwards.
nipkow
parents: 8106
diff changeset
   154
by(forward_tac [list_all2_lengthD RS sym] 1);
759f712f8f06 int:nat->int is pushed inwards.
nipkow
parents: 8106
diff changeset
   155
by(full_simp_tac (simpset()addsimps[length_Suc_conv]) 1);
759f712f8f06 int:nat->int is pushed inwards.
nipkow
parents: 8106
diff changeset
   156
by(Safe_tac);
759f712f8f06 int:nat->int is pushed inwards.
nipkow
parents: 8106
diff changeset
   157
by(forward_tac [list_all2_lengthD RS sym] 1);
759f712f8f06 int:nat->int is pushed inwards.
nipkow
parents: 8106
diff changeset
   158
by(full_simp_tac (simpset()addsimps[length_Suc_conv]) 1);
759f712f8f06 int:nat->int is pushed inwards.
nipkow
parents: 8106
diff changeset
   159
by(Clarify_tac 1);
759f712f8f06 int:nat->int is pushed inwards.
nipkow
parents: 8106
diff changeset
   160
by(fast_tac (claset() addEs [conf_widen]) 1);
8011
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   161
qed_spec_mp "conf_list_gext_widen";
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   162
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   163
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   164
section "lconf";
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   165
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   166
val lconfD = prove_goalw thy [lconf_def] 
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   167
   "\\<And>X. \\<lbrakk> G,h\\<turnstile>vs[\\<Colon>\\<preceq>]Ts; Ts n = Some T \\<rbrakk> \\<Longrightarrow> G,h\\<turnstile>(the (vs n))\\<Colon>\\<preceq>T"
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   168
 (K [Force_tac 1]);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   169
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   170
val lconf_hext = prove_goalw thy [lconf_def] 
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   171
	"\\<And>X. \\<lbrakk> G,h\\<turnstile>l[\\<Colon>\\<preceq>]L; h\\<le>|h' \\<rbrakk> \\<Longrightarrow> G,h'\\<turnstile>l[\\<Colon>\\<preceq>]L" (K [
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   172
		fast_tac (claset() addEs [conf_hext]) 1]);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   173
AddEs [lconf_hext];
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   174
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   175
Goalw [lconf_def] "\\<And>X. \\<lbrakk> G,h\\<turnstile>l[\\<Colon>\\<preceq>]lT; \
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   176
\ G,h\\<turnstile>v\\<Colon>\\<preceq>T; lT va = Some T \\<rbrakk> \\<Longrightarrow> G,h\\<turnstile>l(va\\<mapsto>v)[\\<Colon>\\<preceq>]lT";
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   177
by( Clarify_tac 1);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   178
by( case_tac "n = va" 1);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   179
 by Auto_tac;
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   180
qed "lconf_upd";
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   181
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   182
Goal "\\<forall>x. P x \\<longrightarrow> R (dv x) x \\<Longrightarrow> (\\<forall>x. map_of fs f = Some x \\<longrightarrow> P x) \\<longrightarrow> \
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   183
\ (\\<forall>T. map_of fs f = Some T \\<longrightarrow> \
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   184
\ (\\<exists>v. map_of (map (\\<lambda>(f,ft). (f, dv ft)) fs) f = Some v \\<and>  R v T))";
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   185
by( induct_tac "fs" 1);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   186
by Auto_tac;
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   187
qed_spec_mp "lconf_init_vars_lemma";
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   188
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   189
Goalw [lconf_def, init_vars_def] 
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   190
"\\<forall>n. \\<forall>T. map_of fs n = Some T \\<longrightarrow> is_type G T \\<Longrightarrow> G,h\\<turnstile>init_vars fs[\\<Colon>\\<preceq>]map_of fs";
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   191
by Auto_tac;
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   192
by( rtac lconf_init_vars_lemma 1);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   193
by(   atac 3);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   194
by(  strip_tac 1);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   195
by(  etac defval_conf 1);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   196
by Auto_tac;
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   197
qed "lconf_init_vars";
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   198
AddSIs [lconf_init_vars];
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   199
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   200
val lconf_ext = prove_goalw thy [lconf_def] 
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   201
"\\<And>X. \\<lbrakk>G,s\\<turnstile>l[\\<Colon>\\<preceq>]L; G,s\\<turnstile>v\\<Colon>\\<preceq>T\\<rbrakk> \\<Longrightarrow> G,s\\<turnstile>l(vn\\<mapsto>v)[\\<Colon>\\<preceq>]L(vn\\<mapsto>T)" 
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   202
	(K [Auto_tac]);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   203
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   204
Goalw [lconf_def] "G,h\\<turnstile>l[\\<Colon>\\<preceq>]L \\<Longrightarrow> \\<forall>vs Ts. nodups vns \\<longrightarrow> length Ts = length vns \\<longrightarrow> list_all2 (\\<lambda>v T. G,h\\<turnstile>v\\<Colon>\\<preceq>T) vs Ts \\<longrightarrow> G,h\\<turnstile>l(vns[\\<mapsto>]vs)[\\<Colon>\\<preceq>]L(vns[\\<mapsto>]Ts)";
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   205
by( induct_tac "vns" 1);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   206
by(  ALLGOALS Clarsimp_tac);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   207
by( forward_tac [list_all2_lengthD] 1);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   208
by( auto_tac (claset(), simpset() addsimps [length_Suc_conv]));
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   209
qed_spec_mp "lconf_ext_list";
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   210
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   211
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   212
section "oconf";
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   213
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   214
val oconf_hext = prove_goalw thy [oconf_def] 
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   215
"\\<And>X. G,h\\<turnstile>obj\\<surd> \\<Longrightarrow> h\\<le>|h' \\<Longrightarrow> G,h'\\<turnstile>obj\\<surd>" (K [Fast_tac 1]);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   216
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   217
val oconf_obj = prove_goalw thy [oconf_def,lconf_def] "G,h\\<turnstile>(C,fs)\\<surd> = \
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   218
\ (\\<forall>T f. map_of(fields (G,C)) f = Some T \\<longrightarrow> (\\<exists>v. fs f = Some v \\<and>  G,h\\<turnstile>v\\<Colon>\\<preceq>T))"(K [
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   219
	Auto_tac]);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   220
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   221
val oconf_objD = oconf_obj RS iffD1 RS spec RS spec RS mp;
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   222
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   223
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   224
section "hconf";
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   225
8032
1eaae1a2f8ff Minor mods.
nipkow
parents: 8011
diff changeset
   226
Goalw [hconf_def] "\\<lbrakk>G\\<turnstile>h h\\<surd>; h a = Some obj\\<rbrakk> \\<Longrightarrow> G,h\\<turnstile>obj\\<surd>";
8011
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   227
by (Fast_tac 1);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   228
qed "hconfD";
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   229
8032
1eaae1a2f8ff Minor mods.
nipkow
parents: 8011
diff changeset
   230
Goalw [hconf_def] "\\<forall>a obj. h a=Some obj \\<longrightarrow> G,h\\<turnstile>obj\\<surd> \\<Longrightarrow> G\\<turnstile>h h\\<surd>";
8011
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   231
by (Fast_tac 1);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   232
qed "hconfI";
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   233
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   234
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   235
section "conforms";
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   236
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   237
val conforms_heapD = prove_goalw thy [conforms_def]
8032
1eaae1a2f8ff Minor mods.
nipkow
parents: 8011
diff changeset
   238
	"(h, l)\\<Colon>\\<preceq>(G, lT) \\<Longrightarrow> G\\<turnstile>h h\\<surd>"
8011
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   239
	(fn prems => [cut_facts_tac prems 1, Asm_full_simp_tac 1]);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   240
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   241
val conforms_localD = prove_goalw thy [conforms_def]
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   242
	 "(h, l)\\<Colon>\\<preceq>(G, lT) \\<Longrightarrow> G,h\\<turnstile>l[\\<Colon>\\<preceq>]lT" (fn prems => [
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   243
	cut_facts_tac prems 1, Asm_full_simp_tac 1]);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   244
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   245
val conformsI = prove_goalw thy [conforms_def] 
8032
1eaae1a2f8ff Minor mods.
nipkow
parents: 8011
diff changeset
   246
"\\<lbrakk>G\\<turnstile>h h\\<surd>; G,h\\<turnstile>l[\\<Colon>\\<preceq>]lT\\<rbrakk> \\<Longrightarrow> (h, l)\\<Colon>\\<preceq>(G, lT)" (fn prems => [
8011
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   247
	cut_facts_tac prems 1,
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   248
	Simp_tac 1,
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   249
	Auto_tac]);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   250
8032
1eaae1a2f8ff Minor mods.
nipkow
parents: 8011
diff changeset
   251
Goal "\\<lbrakk>(h,l)\\<Colon>\\<preceq>(G,lT); h\\<le>|h'; G\\<turnstile>h h'\\<surd> \\<rbrakk> \\<Longrightarrow> (h',l)\\<Colon>\\<preceq>(G,lT)";
8011
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   252
by( fast_tac (HOL_cs addDs [conforms_localD] 
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   253
  addSEs [conformsI, lconf_hext]) 1);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   254
qed "conforms_hext";
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   255
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   256
Goal "\\<lbrakk>(h,l)\\<Colon>\\<preceq>(G, lT); G,h(a\\<mapsto>obj)\\<turnstile>obj\\<surd>; h\\<le>|h(a\\<mapsto>obj)\\<rbrakk> \\<Longrightarrow> (h(a\\<mapsto>obj),l)\\<Colon>\\<preceq>(G, lT)";
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   257
by( rtac conforms_hext 1);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   258
by   Auto_tac;
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   259
by( rtac hconfI 1);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   260
by( dtac conforms_heapD 1);
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   261
by( (auto_tac (HOL_cs addEs [oconf_hext] addDs [hconfD],
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   262
		simpset()delsimps[split_paired_All])));
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   263
qed "conforms_upd_obj";
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   264
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   265
Goalw [conforms_def] 
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   266
"\\<lbrakk>(h, l)\\<Colon>\\<preceq>(G, lT); G,h\\<turnstile>v\\<Colon>\\<preceq>T; lT va = Some T\\<rbrakk> \\<Longrightarrow> \
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   267
\ (h, l(va\\<mapsto>v))\\<Colon>\\<preceq>(G, lT)";
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   268
by( auto_tac (claset() addEs [lconf_upd], simpset()));
d14c4e9e9c8e *** empty log message ***
nipkow
parents:
diff changeset
   269
qed "conforms_upd_local";