src/HOL/Bali/TypeSafe.thy
changeset 14030 cd928c0ac225
parent 13690 ac335b2f4a39
child 14700 2f885b7e5ba7
equal deleted inserted replaced
14029:fe031a7c75bc 14030:cd928c0ac225
  1228  "\<And> tab tab' ys. tab z=tab' z \<Longrightarrow> (tab(xs[\<mapsto>]ys)) z = (tab'(xs[\<mapsto>]ys)) z"
  1228  "\<And> tab tab' ys. tab z=tab' z \<Longrightarrow> (tab(xs[\<mapsto>]ys)) z = (tab'(xs[\<mapsto>]ys)) z"
  1229 proof (induct xs)
  1229 proof (induct xs)
  1230   case Nil thus ?case by simp
  1230   case Nil thus ?case by simp
  1231 next
  1231 next
  1232   case (Cons x xs tab tab' ys)
  1232   case (Cons x xs tab tab' ys)
  1233   have "(tab(x\<mapsto>hd ys)(xs[\<mapsto>]tl ys)) z = (tab'(x\<mapsto>hd ys)(xs[\<mapsto>]tl ys)) z"
  1233   note Hyps = this
  1234     by (rule Cons.hyps) (rule map_upd_cong_ext)
  1234   show ?case
  1235   thus ?case
  1235   proof (cases ys)
  1236     by simp
  1236     case Nil
       
  1237     thus ?thesis by simp
       
  1238   next
       
  1239     case (Cons y ys')
       
  1240     have "(tab(x\<mapsto>y)(xs[\<mapsto>]ys')) z = (tab'(x\<mapsto>y)(xs[\<mapsto>]ys')) z"
       
  1241       by (rules intro: Hyps map_upd_cong_ext)
       
  1242     with Cons show ?thesis
       
  1243       by simp
       
  1244   qed
  1237 qed
  1245 qed
  1238    
  1246    
  1239 lemma map_upd_override: "(tab(x\<mapsto>y)) x = (tab'(x\<mapsto>y)) x"
  1247 lemma map_upd_override: "(tab(x\<mapsto>y)) x = (tab'(x\<mapsto>y)) x"
  1240   by simp
  1248   by simp
  1241 
       
  1242 
       
  1243 lemma map_upds_override_cong:
       
  1244 "\<And> tab tab' zs. x\<in> set ws \<Longrightarrow> 
       
  1245  (tab(ws[\<mapsto>]zs)) x = (tab'(ws[\<mapsto>]zs)) x"
       
  1246 proof (induct ws)
       
  1247   case Nil thus ?case by simp
       
  1248 next
       
  1249   case (Cons w ws tab tab' zs)
       
  1250   have x: "x \<in> set (w#ws)" .
       
  1251   show ?case
       
  1252   proof (cases "x=w")
       
  1253     case True thus ?thesis
       
  1254       by simp (rule map_upds_cong_ext, rule map_upd_override)
       
  1255   next
       
  1256     case False
       
  1257     with x have "x \<in> set ws"
       
  1258       by simp
       
  1259     with Cons.hyps show ?thesis
       
  1260       by simp
       
  1261   qed
       
  1262 qed
       
  1263 
       
  1264 lemma map_upds_in_suffix: assumes x: "x \<in> set xs" 
       
  1265  shows "\<And> tab qs. (tab(ps @ xs[\<mapsto>]qs)) x = (tab(xs[\<mapsto>]drop (length ps) qs)) x"
       
  1266 proof (induct ps)
       
  1267   case Nil thus ?case by simp
       
  1268 next
       
  1269   case (Cons p ps tab qs)
       
  1270   have "(tab(p\<mapsto>hd qs)(ps @ xs[\<mapsto>](tl qs))) x
       
  1271           =(tab(p\<mapsto>hd qs)(xs[\<mapsto>]drop (length ps) (tl qs))) x"
       
  1272     by (rule Cons.hyps)
       
  1273   moreover
       
  1274   have "drop (Suc (length ps)) qs=drop (length ps) (tl qs)"
       
  1275     by (cases qs) simp+
       
  1276   ultimately show ?case
       
  1277     by simp (rule map_upds_override_cong)
       
  1278 qed
       
  1279  
       
  1280 
  1249 
  1281 lemma map_upds_eq_length_suffix: "\<And> tab qs. 
  1250 lemma map_upds_eq_length_suffix: "\<And> tab qs. 
  1282         length ps = length qs \<Longrightarrow> tab(ps@xs[\<mapsto>]qs) = tab(ps[\<mapsto>]qs)(xs[\<mapsto>][])"
  1251         length ps = length qs \<Longrightarrow> tab(ps@xs[\<mapsto>]qs) = tab(ps[\<mapsto>]qs)(xs[\<mapsto>][])"
  1283 proof (induct ps)
  1252 proof (induct ps)
  1284   case Nil thus ?case by simp
  1253   case Nil thus ?case by simp
  1325     \<Longrightarrow> \<exists> z. (tab(xs[\<mapsto>]ys)) vn = Some z"
  1294     \<Longrightarrow> \<exists> z. (tab(xs[\<mapsto>]ys)) vn = Some z"
  1326 proof (induct xs)
  1295 proof (induct xs)
  1327   case Nil thus ?case by simp
  1296   case Nil thus ?case by simp
  1328 next
  1297 next
  1329   case (Cons x xs tab ys z)
  1298   case (Cons x xs tab ys z)
  1330   have "tab vn = Some z" .
  1299   have z: "tab vn = Some z" .
  1331   then obtain z' where "(tab(x\<mapsto>hd ys)) vn = Some z'" 
  1300   show ?case
  1332     by (rule map_upd_Some_expand [of tab,elim_format]) blast
  1301   proof (cases ys)
  1333   hence "\<exists> z. (tab (x\<mapsto>hd ys)(xs[\<mapsto>]tl ys)) vn = Some z"
  1302     case Nil
  1334     by (rule Cons.hyps)
  1303     with z show ?thesis by simp
  1335   thus ?case
  1304   next
  1336     by simp
  1305     case (Cons y ys')
       
  1306     have ys: "ys = y#ys'".
       
  1307     from z obtain z' where "(tab(x\<mapsto>y)) vn = Some z'"
       
  1308       by (rule map_upd_Some_expand [of tab,elim_format]) blast
       
  1309     hence "\<exists>z. ((tab(x\<mapsto>y))(xs[\<mapsto>]ys')) vn = Some z"
       
  1310       by (rule Cons.hyps)
       
  1311     with ys show ?thesis
       
  1312       by simp
       
  1313   qed
  1337 qed
  1314 qed
  1338 
  1315 
  1339 
  1316 
  1340 lemma map_upd_Some_swap:
  1317 lemma map_upd_Some_swap:
  1341  "(tab(r\<mapsto>w)(u\<mapsto>v)) vn = Some z \<Longrightarrow> \<exists> z. (tab(u\<mapsto>v)(r\<mapsto>w)) vn = Some z"
  1318  "(tab(r\<mapsto>w)(u\<mapsto>v)) vn = Some z \<Longrightarrow> \<exists> z. (tab(u\<mapsto>v)(r\<mapsto>w)) vn = Some z"
  1346 by (simp add: fun_upd_def)
  1323 by (simp add: fun_upd_def)
  1347 
  1324 
  1348 
  1325 
  1349 lemma map_eq_upd_eq: "tab vn = tab' vn \<Longrightarrow> (tab(x\<mapsto>y)) vn = (tab'(x\<mapsto>y)) vn"
  1326 lemma map_eq_upd_eq: "tab vn = tab' vn \<Longrightarrow> (tab(x\<mapsto>y)) vn = (tab'(x\<mapsto>y)) vn"
  1350 by (simp add: fun_upd_def)
  1327 by (simp add: fun_upd_def)
  1351 
       
  1352 lemma map_eq_upds_eq: 
       
  1353   "\<And> tab tab' ys. 
       
  1354    tab vn = tab' vn \<Longrightarrow> (tab(xs[\<mapsto>]ys)) vn = (tab'(xs[\<mapsto>]ys)) vn"
       
  1355 proof (induct xs)
       
  1356   case Nil thus ?case by simp 
       
  1357 next
       
  1358   case (Cons x xs tab tab' ys)
       
  1359   have "tab vn = tab' vn" .
       
  1360   hence "(tab(x\<mapsto>hd ys)) vn = (tab'(x\<mapsto>hd ys)) vn"
       
  1361     by (rule map_eq_upd_eq)
       
  1362   hence "(tab(x\<mapsto>hd ys)(xs[\<mapsto>]tl ys)) vn = (tab'(x\<mapsto>hd ys)(xs[\<mapsto>]tl ys)) vn"
       
  1363     by (rule Cons.hyps)
       
  1364   thus ?case 
       
  1365     by simp
       
  1366 qed
       
  1367 
  1328 
  1368 lemma map_upd_in_expansion_map_swap:
  1329 lemma map_upd_in_expansion_map_swap:
  1369  "\<lbrakk>(tab(x\<mapsto>y)) vn = Some z;tab vn \<noteq> Some z\<rbrakk> 
  1330  "\<lbrakk>(tab(x\<mapsto>y)) vn = Some z;tab vn \<noteq> Some z\<rbrakk> 
  1370                  \<Longrightarrow>  (tab'(x\<mapsto>y)) vn = Some z"
  1331                  \<Longrightarrow>  (tab'(x\<mapsto>y)) vn = Some z"
  1371 by (simp add: fun_upd_def)
  1332 by (simp add: fun_upd_def)
  1375                  \<Longrightarrow>  (tab'(xs[\<mapsto>]ys)) vn = Some z"
  1336                  \<Longrightarrow>  (tab'(xs[\<mapsto>]ys)) vn = Some z"
  1376 proof (induct xs)
  1337 proof (induct xs)
  1377   case Nil thus ?case by simp
  1338   case Nil thus ?case by simp
  1378 next
  1339 next
  1379   case (Cons x xs tab tab' ys z)
  1340   case (Cons x xs tab tab' ys z)
  1380   from Cons.prems obtain 
  1341   have some: "(tab(x # xs[\<mapsto>]ys)) vn = Some z" .
  1381     some: "(tab(x\<mapsto>hd ys)(xs[\<mapsto>]tl ys)) vn = Some z" and
  1342   have tab_not_z: "tab vn \<noteq> Some z".
  1382     tab_not_z: "tab vn \<noteq> Some z"
       
  1383     by simp
       
  1384   show ?case
  1343   show ?case
  1385   proof (cases "(tab(x\<mapsto>hd ys)) vn \<noteq> Some z")
  1344   proof (cases "ys")
  1386     case True
  1345     case Nil with some tab_not_z show ?thesis by simp
  1387     with some have "(tab'(x\<mapsto>hd ys)(xs[\<mapsto>]tl ys)) vn = Some z"
  1346   next
  1388       by (rule Cons.hyps)
  1347     case (Cons y tl)
  1389     thus ?thesis 
  1348     have ys: "ys = y#tl".
  1390       by simp
  1349     show ?thesis
  1391   next
  1350     proof (cases "(tab(x\<mapsto>y)) vn \<noteq> Some z")
  1392     case False
  1351       case True
  1393     hence tabx_z: "(tab(x\<mapsto>hd ys)) vn = Some z" by blast
  1352       with some ys have "(tab'(x\<mapsto>y)(xs[\<mapsto>]tl)) vn = Some z"
  1394     moreover
  1353 	by (fastsimp intro: Cons.hyps)
  1395     from tabx_z tab_not_z
  1354       with ys show ?thesis 
  1396     have "(tab'(x\<mapsto>hd ys)) vn = Some z" 
  1355 	by simp
  1397       by (rule map_upd_in_expansion_map_swap)
  1356     next
  1398     ultimately
  1357       case False
  1399     have "(tab(x\<mapsto>hd ys)) vn =(tab'(x\<mapsto>hd ys)) vn"
  1358       hence tabx_z: "(tab(x\<mapsto>y)) vn = Some z" by blast
  1400       by simp
  1359       moreover
  1401     hence "(tab(x\<mapsto>hd ys)(xs[\<mapsto>]tl ys)) vn = (tab'(x\<mapsto>hd ys)(xs[\<mapsto>]tl ys)) vn"
  1360       from tabx_z tab_not_z
  1402       by (rule map_eq_upds_eq)
  1361       have "(tab'(x\<mapsto>y)) vn = Some z" 
  1403     with some 
  1362 	by (rule map_upd_in_expansion_map_swap)
  1404     show ?thesis 
  1363       ultimately
  1405       by simp
  1364       have "(tab(x\<mapsto>y)) vn =(tab'(x\<mapsto>y)) vn"
       
  1365 	by simp
       
  1366       hence "(tab(x\<mapsto>y)(xs[\<mapsto>]tl)) vn = (tab'(x\<mapsto>y)(xs[\<mapsto>]tl)) vn"
       
  1367 	by (rule map_upds_cong_ext)
       
  1368       with some ys
       
  1369       show ?thesis 
       
  1370 	by simp
       
  1371     qed
  1406   qed
  1372   qed
  1407 qed
  1373 qed
  1408    
  1374    
  1409 lemma map_upds_Some_swap: 
  1375 lemma map_upds_Some_swap: 
  1410  assumes r_u: "(tab(r\<mapsto>w)(u\<mapsto>v)(xs[\<mapsto>]ys)) vn = Some z"
  1376  assumes r_u: "(tab(r\<mapsto>w)(u\<mapsto>v)(xs[\<mapsto>]ys)) vn = Some z"
  1462                   \<Longrightarrow> tab vn = Some el"
  1428                   \<Longrightarrow> tab vn = Some el"
  1463 proof  (induct "xs")
  1429 proof  (induct "xs")
  1464   case Nil thus ?case by simp
  1430   case Nil thus ?case by simp
  1465 next
  1431 next
  1466   case (Cons x xs tab tab' ys)
  1432   case (Cons x xs tab tab' ys)
  1467   from Cons.prems
  1433   have tab_vn: "(tab(x # xs[\<mapsto>]ys)) vn = Some el".
  1468   have "(tab(x\<mapsto>hd ys)) vn = Some el"
  1434   have tab'_vn: "(tab'(x # xs[\<mapsto>]ys)) vn = None".
  1469     by - (rule Cons.hyps,auto)
  1435   show ?case
  1470   moreover from Cons.prems 
  1436   proof (cases ys)
  1471   have "(tab'(x\<mapsto>hd ys)(xs[\<mapsto>]tl ys)) vn = None" 
  1437     case Nil
  1472     by simp
  1438     with tab_vn show ?thesis by simp
  1473   hence "(tab'(x\<mapsto>hd ys)) vn = None"
  1439   next
  1474     by (rule map_upds_None_cut)
  1440     case (Cons y tl)
  1475   ultimately show "tab vn = Some el" 
  1441     have ys: "ys=y#tl".
  1476     by (rule map_upd_cut_irrelevant)
  1442     with tab_vn tab'_vn 
       
  1443     have "(tab(x\<mapsto>y)) vn = Some el"
       
  1444       by - (rule Cons.hyps,auto)
       
  1445     moreover from tab'_vn ys
       
  1446     have "(tab'(x\<mapsto>y)(xs[\<mapsto>]tl)) vn = None" 
       
  1447       by simp
       
  1448     hence "(tab'(x\<mapsto>y)) vn = None"
       
  1449       by (rule map_upds_None_cut)
       
  1450     ultimately show "tab vn = Some el" 
       
  1451       by (rule map_upd_cut_irrelevant)
       
  1452   qed
  1477 qed
  1453 qed
       
  1454 
  1478    
  1455    
  1479 lemma dom_vname_split:
  1456 lemma dom_vname_split:
  1480  "dom (lname_case (ename_case (tab(x\<mapsto>y)(xs[\<mapsto>]ys)) a) b)
  1457  "dom (lname_case (ename_case (tab(x\<mapsto>y)(xs[\<mapsto>]ys)) a) b)
  1481    = dom (lname_case (ename_case (tab(x\<mapsto>y)) a) b) \<union> 
  1458    = dom (lname_case (ename_case (tab(x\<mapsto>y)) a) b) \<union> 
  1482      dom (lname_case (ename_case (tab(xs[\<mapsto>]ys)) a) b)"
  1459      dom (lname_case (ename_case (tab(xs[\<mapsto>]ys)) a) b)"
  1529 qed
  1506 qed
  1530 
  1507 
  1531 lemma dom_map_upd: "\<And> tab. dom (tab(x\<mapsto>y)) = dom tab \<union> {x}"
  1508 lemma dom_map_upd: "\<And> tab. dom (tab(x\<mapsto>y)) = dom tab \<union> {x}"
  1532 by (auto simp add: dom_def fun_upd_def)
  1509 by (auto simp add: dom_def fun_upd_def)
  1533 
  1510 
  1534 lemma dom_map_upds: "\<And> tab ys. dom (tab(xs[\<mapsto>]ys)) = dom tab \<union> set xs"
  1511 lemma dom_map_upds: "\<And> tab ys. length xs = length ys 
       
  1512   \<Longrightarrow> dom (tab(xs[\<mapsto>]ys)) = dom tab \<union> set xs"
  1535 proof (induct xs)
  1513 proof (induct xs)
  1536   case Nil thus ?case by (simp add: dom_def)
  1514   case Nil thus ?case by (simp add: dom_def)
  1537 next
  1515 next
  1538   case (Cons x xs tab ys)
  1516   case (Cons x xs tab ys)
  1539   have "dom (tab(x\<mapsto>hd ys)(xs[\<mapsto>]tl ys)) = dom (tab(x\<mapsto>hd ys)) \<union> set xs" .
  1517   note Hyp = Cons.hyps
  1540   moreover 
  1518   have len: "length (x#xs)=length ys".
  1541   have "dom (tab(x\<mapsto>hd ys)) = dom tab \<union> {x}"
       
  1542     by (rule dom_map_upd)
       
  1543   ultimately
       
  1544   show ?case
  1519   show ?case
  1545     by simp
  1520   proof (cases ys)
       
  1521     case Nil with len show ?thesis by simp
       
  1522   next
       
  1523     case (Cons y tl)
       
  1524     with len have "dom (tab(x\<mapsto>y)(xs[\<mapsto>]tl)) = dom (tab(x\<mapsto>y)) \<union> set xs"
       
  1525       by - (rule Hyp,simp)
       
  1526     moreover 
       
  1527     have "dom (tab(x\<mapsto>hd ys)) = dom tab \<union> {x}"
       
  1528       by (rule dom_map_upd)
       
  1529     ultimately
       
  1530     show ?thesis using Cons
       
  1531       by simp
       
  1532   qed
  1546 qed
  1533 qed
  1547  
  1534  
  1548 
       
  1549 
       
  1550 lemma dom_ename_case_None_simp:
  1535 lemma dom_ename_case_None_simp:
  1551  "dom (ename_case vname_tab None) = VNam ` (dom vname_tab)"
  1536  "dom (ename_case vname_tab None) = VNam ` (dom vname_tab)"
  1552   apply (auto simp add: dom_def image_def )
  1537   apply (auto simp add: dom_def image_def )
  1553   apply (case_tac "x")
  1538   apply (case_tac "x")
  1554   apply auto
  1539   apply auto
  1581 
  1566 
  1582 lemma image_comp: 
  1567 lemma image_comp: 
  1583  "f ` g ` A = (f \<circ> g) ` A"
  1568  "f ` g ` A = (f \<circ> g) ` A"
  1584 by (auto simp add: image_def)
  1569 by (auto simp add: image_def)
  1585 
  1570 
       
  1571 
  1586 lemma dom_locals_init_lvars: 
  1572 lemma dom_locals_init_lvars: 
  1587   assumes m: "m=(mthd (the (methd G C sig)))"  
  1573   assumes m: "m=(mthd (the (methd G C sig)))"  
       
  1574   assumes len: "length (pars m) = length pvs"
  1588   shows "dom (locals (store (init_lvars G C sig (invmode m e) a pvs s)))  
  1575   shows "dom (locals (store (init_lvars G C sig (invmode m e) a pvs s)))  
  1589            = parameters m"
  1576            = parameters m"
  1590 proof -
  1577 proof -
  1591   from m
  1578   from m
  1592   have static_m': "is_static m = static m"
  1579   have static_m': "is_static m = static m"
  1593     by simp
  1580     by simp
       
  1581   from len
  1594   have dom_vnames: "dom (empty(pars m[\<mapsto>]pvs))=set (pars m)"
  1582   have dom_vnames: "dom (empty(pars m[\<mapsto>]pvs))=set (pars m)"
  1595     by (simp add: dom_map_upds)
  1583     by (simp add: dom_map_upds)
  1596   show ?thesis
  1584   show ?thesis
  1597   proof (cases "static m")
  1585   proof (cases "static m")
  1598     case True
  1586     case True
  1606     show ?thesis
  1594     show ?thesis
  1607       by (cases s) (simp add: init_lvars_def Let_def parameters_def
  1595       by (cases s) (simp add: init_lvars_def Let_def parameters_def
  1608                               dom_lname_ename_case_simps image_comp)
  1596                               dom_lname_ename_case_simps image_comp)
  1609   qed
  1597   qed
  1610 qed
  1598 qed
       
  1599 
  1611 
  1600 
  1612 lemma da_e2_BinOp:
  1601 lemma da_e2_BinOp:
  1613   assumes da: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>
  1602   assumes da: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>
  1614                   \<turnstile>dom (locals (store s0)) \<guillemotright>\<langle>BinOp binop e1 e2\<rangle>\<^sub>e\<guillemotright> A"
  1603                   \<turnstile>dom (locals (store s0)) \<guillemotright>\<langle>BinOp binop e1 e2\<rangle>\<^sub>e\<guillemotright> A"
  1615     and wt_e1: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>e1\<Colon>-e1T"
  1604     and wt_e1: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>e1\<Colon>-e1T"
  3281 	    moreover have "parameters (mthd dynM) \<subseteq>  dom (locals (store s3'))"
  3270 	    moreover have "parameters (mthd dynM) \<subseteq>  dom (locals (store s3'))"
  3282 	    proof -
  3271 	    proof -
  3283 	      from is_static_eq 
  3272 	      from is_static_eq 
  3284 	      have "(invmode (mthd dynM) e) = (invmode statM e)"
  3273 	      have "(invmode (mthd dynM) e) = (invmode statM e)"
  3285 		by (simp add: invmode_def)
  3274 		by (simp add: invmode_def)
  3286 	      with init_lvars dynM' is_static_eq normal_s2 mode 
  3275 	      moreover
       
  3276 	      have "length (pars (mthd dynM)) = length vs" 
       
  3277 	      proof -
       
  3278 		from normal_s2 conf_args
       
  3279 		have "length vs = length pTs"
       
  3280 		  by (simp add: list_all2_def)
       
  3281 		also from pTs_widen
       
  3282 		have "\<dots> = length pTs'"
       
  3283 		  by (simp add: widens_def list_all2_def)
       
  3284 		also from wf_dynM
       
  3285 		have "\<dots> = length (pars (mthd dynM))"
       
  3286 		  by (simp add: wf_mdecl_def wf_mhead_def)
       
  3287 		finally show ?thesis ..
       
  3288 	      qed
       
  3289 	      moreover note init_lvars dynM' is_static_eq normal_s2 mode 
       
  3290 	      ultimately
  3287 	      have "parameters (mthd dynM) = dom (locals (store s3))"
  3291 	      have "parameters (mthd dynM) = dom (locals (store s3))"
  3288 		using dom_locals_init_lvars 
  3292 		using dom_locals_init_lvars 
  3289                   [of "mthd dynM" G invDeclC "\<lparr>name=mn,parTs=pTs'\<rparr>" e a vs s2]
  3293                   [of "mthd dynM" G invDeclC "\<lparr>name=mn,parTs=pTs'\<rparr>" vs e a s2]
  3290 		by simp
  3294 		by simp
  3291 	      also from check
  3295 	      also from check
  3292 	      have "dom (locals (store s3)) \<subseteq>  dom (locals (store s3'))"
  3296 	      have "dom (locals (store s3)) \<subseteq>  dom (locals (store s3'))"
  3293 		by (simp add:  eq_s3'_s3)
  3297 		by (simp add:  eq_s3'_s3)
  3294 	      finally show ?thesis .
  3298 	      finally show ?thesis .