talparser.opp.exp 52.4 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786
File "talparser.mly", line 501, characters 14-19:
Warning: the token Tasub is unused.
File "talparser.mly", line 501, characters 20-25:
Warning: the token Taupd is unused.
File "talparser.mly", line 502, characters 15-20:
Warning: the token Tbool is unused.
File "talparser.mly", line 502, characters 32-38:
Warning: the token Tbtagi is unused.
File "talparser.mly", line 502, characters 39-47:
Warning: the token Tbtagvar is unused.
File "talparser.mly", line 551, characters 29-33:
Warning: the token Tecg is unused.
File "talparser.mly", line 557, characters 7-12:
Warning: the token Tprfn is unused.
%{
open Utilities;;
open Numtypes;;
open Identifier;;
open Tal;;

let err s =
  Gcdfec.post_error (Gcdfec.mk_err_parse_symbol s)
;;

let parse_error s = err s;;

let errn n s =
  Gcdfec.post_error (Gcdfec.mk_err_parse_rhs n s)
;;

let dword_error n =
  errn n "operand requires dword ptr"
;;

let ck_dword_l ptr_opt n op =
  match ptr_opt with
    None ->
      (match op with
    	Prjl(_,_,_) -> dword_error n
      | _ -> ())
  | Some RPl -> dword_error n
  | Some RPe -> ()
  | _ -> ()
;;

let ck_dword_lr ptr_opt n op =
  match ptr_opt with
    None ->
      (match op with
    	Prjr(_,_,_) | Prjl(_,_,_) -> dword_error n
      | _ -> ())
  | Some RPl -> dword_error n
  | Some RPe -> ()
  | _ -> ()
;;

let ck_dword_b ptr_opt op1 op2 =
  match ptr_opt with
    None -> 
      (match op1 with
      	Prjr(_,_,_) | Prjl(_,_,_) ->
      	  (match op2 with
	    Immed _ -> err "dword ptr required"
	  |	_ -> ())
      | _ -> ())
  | Some RPl -> err "dword ptr required"
  | Some RPe -> ()
  | _ -> ()
;;

(* Dave/Dan: The part for genop g, 
 * if g is prefixed by a dword ptr, then the size should be 32 bits.
 * if g is prefixed by a byte ptr, then the size should be 8 bits.
 * if g is a 32 bit register or immediate address, the size should be 32 bits.
 * otherwise take the size from the second operand.
 *)
let get_part ptr_opt g g2_part =
  match ptr_opt with
    Some p -> p
  | None   ->
      (match g with
      	Reg  _ -> RPe
      | Addr _ -> RPe
      | _      -> g2_part)
;;

let mk_label_coerce n (o,cs) =
  match o with
    Addr l -> (l,cs)
  | _ -> errn n "bad label coerce"; raise Gcdfec.Exit
;;

let mk_reg_coerce n (o,cs) =
  match o with
    Reg r -> (r,cs)
  | _ -> errn n "bad register coerce"; raise Gcdfec.Exit
;;

let mk_reg n o =
  match o with
    Reg r -> r 
  | _ -> errn n "operand must be a register"; raise Gcdfec.Exit
;;

let mk_scale n =
  if n =$ i32_1 then Byte1
  else if n =$ i32_2 then Byte2
  else if n =$ i32_4 then Byte4
  else if n =$ i32_8 then Byte8
  else (err "bad scale"; raise Gcdfec.Exit)
;;

let mk_cc n s =
  match String.uppercase s with
    "A" | "NBE" -> Above                  | "LE" | "NG" -> LessEq       
  | "AE" | "NB" | "NC" -> AboveEq	  | "NE" | "NZ" -> NotEq        
  | "B" | "NAE" | "C" -> Below		  | "NO" -> NotOverflow         
  | "BE" | "NA" -> BelowEq		  | "NS" -> NotSign             
  | "E" | "Z" -> Eq			  | "O" -> Overflow             
  | "G" | "NLE" -> Greater		  | "PE" | "P" -> ParityEven    
  | "GE" | "NL" -> GreaterEq		  | "PO" | "NP" -> ParityOdd    
  | "L" | "NGE" -> Less			  | "S" -> Sign                 
  | _ -> errn n "bad condition code"; raise Gcdfec.Exit
;;

let process_prj (o,cs) n opt =
  match o with
    Reg r -> Prjr ((r,cs),n,opt)
  | Addr l -> Prjl ((l,cs),n,opt)
  | _ -> err "bad projection for genop"; raise Gcdfec.Exit
;;

let chk_arr_reg n (r,part) s =
  if s =$ i32_1 then
    (if part<>RPl then errn n "register part does not match scale")
  else if s =$ i32_2 then
    (if part<>RPx then errn n "register part does not match scale")
  else if s =$ i32_4 then
    (if part<>RPe then errn n "register part does not match scale")
  else errn n "bad scale";
  r
    ;;

type bi = BInum of int32 | BIstr of string;;

let process_byte_list bis =
  let f bi = match bi with BInum _ -> 1 | BIstr s -> String.length s in
  let len = List.fold_left (+) 0 (List.map f bis) in
  let s = String.create len in
  let rec g off bis =
    match bis with
      [] -> Dbytes (s)
    | (BInum n)::bis ->
 	let n = int32_to_int n in
	s.[off] <- Char.chr (n land 255); g (off+1) bis
    | (BIstr s1)::bis ->
 	let l = String.length s1 in
	String.blit s1 0 s off l; g (off+l) bis
  in
  g 0 bis
;;

let do_rep ri = 
   ri,ref None

type coercearg =
    CAnone
  | CAgc of genop
  | CAnc of identifier

let process_dd_coerce (go,clist) =
  match go with
    CAnone -> if clist<>[] then err "bad dd coerce"; Djunk
  | CAgc (Immed i) -> D4bytes (i,clist)
  | CAgc (Addr l) -> Dlabel (l,clist)
  | _ -> err "bad dd coerce"; raise Gcdfec.Exit
;;

(* is the float in decimal format? *)
let is_decimal f =
  let l = String.length f in
  let rec aux i =
    if i < l then
      if f.[i] = '.' then true
      else aux (i+1)
    else false in
  aux 0

(* convert strings in hexadecimal format into floating-point values *)
let process_f32 f = 
  try hex_to_f32 f
  with Invalid_argument _ -> (err "bad 32-bit float literal."; 
			      raise Gcdfec.Exit)
let process_f64 f = 
  try hex_to_f64 f
  with Invalid_argument _ -> (err "bad 32-bit float literal."; 
			      raise Gcdfec.Exit)

let rec make_tapps (o,cs) tcs =
  match tcs with
    [] -> (o,cs)
  | c::tcs -> make_tapps (o,(Tapp c)::cs) tcs
;;

type kmu_item = 
   MU of (identifier*kind) list 
 | PR of (identifier * identifier * kind * identifier * kind * con) list

type int_item =
    INTabbrev of identifier*con
  | INTcon of int_con
  | INTval of identifier*con
  | INTkmuabbrev of kmu_item
  | INTkindabbrev of identifier*kind
;;

 (* rename kind variables within the mu
    so they will be distinct from the abbreviations *)
let do_mu ikl kinds =
   (* create renaming dictionary kd, and rename first component of ikl *)
   let iikl,kd = List.fold_left (fun (ikl,d) (i,k) ->
      let name = (id_new (id_to_string i)) in 
      (i,name,k)::ikl, Dict.insert d i (kvar name)) ([], Dict.empty id_compare) ikl in 
   (* use dictionary to rename second component of ikl *)
   let ikl = List.map (fun (oldi,newi,k) -> (newi, Talcon.ksubsts kd k)) iikl in 
   let iil = List.map (fun (oldi,newi,k) -> (oldi,newi)) iikl in
   (* add abbreviations to kinds *)
   kinds := (List.fold_right (fun (oldi,newi) l ->
      (oldi,defkind(Kmu(ikl,newi))) ::l) iil (!kinds))
	 
(* rename both the kind variable, j, and the con variable f *)
let do_pr l abbrevs = 
   (* create dictionary, and rename f&j in l
      Careful --- j could appear multiple times in l *)
   let (_,l,kd,cd) = List.fold_left (fun (jd,l,kd,cd) (j,a,k,f,k',c) -> 
      let newj = try Dict.lookup jd j with 
	 Dict.Absent -> (id_new (id_to_string j)) in 
      let newf = (id_new (id_to_string f)) in 
      Dict.insert jd j newj, 
      (f, newj,a,k,newf,k',c)::l,
      Dict.insert kd j (kvar newj),
      Dict.insert cd f (cvar newf))
	 (Dict.empty id_compare, [], 
	    Dict.empty id_compare, Dict.empty id_compare) l in   
   (* substitute within k,k' and c *)
   let ffl = List.map (fun (oldf, j,a,k,f,k',c) -> (oldf,f)) l in 
   let l = List.map (fun (oldf, j,a,k,f,k',c) -> 
      (j,a,Talcon.ksubsts kd k, f, Talcon.ksubsts kd k',
	 Talcon.substs (kd,cd) c)) l in 
   abbrevs := (List.fold_right
		    (fun (oldf,newf) ab -> 
		       (oldf,defcon(Cpr(newf, l)))::ab) ffl (!abbrevs)) 
	 
let process_int_items is =
  let abbrevs = ref []
  and cons = ref []
  and vals = ref [] 
(* LX *)
  and kinds = ref [] 
(* end LX *)
in
  let rec loop is =
    match is with
      [] -> ()
    | (INTabbrev (v,c))::is -> abbrevs := (v,c) :: !abbrevs; loop is
    | (INTcon lkcd)::is -> cons := lkcd :: !cons; loop is
    | (INTval (l,c))::is -> vals := (l,c) :: !vals; loop is 
(* LX *)
    | (INTkmuabbrev km)::is ->
	 (match km with
	    MU ikl -> do_mu ikl kinds
	  | PR l -> do_pr l abbrevs);	       
	 loop is
    | (INTkindabbrev (a,b))::is -> kinds := (a,b) :: !kinds; loop is
(* end LX *)
in
  loop is;
  { int_abbrevs=Array.of_list (List.rev !abbrevs);
(* LX *)
     int_kindabbrevs = Array.of_list (List.rev !kinds);
(* end LX *)
     int_cons=Array.of_list (List.rev !cons);
     int_vals=Array.of_list (List.rev !vals)
  }
;;

type imp_item =
    IMPimport of string
  | IMPexport of string
  | IMPabbrev of (identifier*con)
(* LX *)
  | IMPkindabbrev of (identifier*kind)
  | IMPkmuabbrev of kmu_item
(* LX *)
  | IMPconblock of (identifier*kind*con)
  | IMPcode
  | IMPdata
  | IMPlabel of identifier
  | IMPlabeltype of con
  | IMPinst of instruction
  | IMPcoerce of unit coerce
  | IMPalign of Numtypes.int32
  | IMPdi of data_item
(* Cyclone *)
  | IMPtemplate
  | IMPtemplate_start of identifier * con
  | IMPtemplate_end
(* End Cyclone *)
;;

(* Allowable patterns:
 *   i*a*((.c (l lc i* )* )|(.d (l lc? di* )* ))*
 *   exports allowed anywhere, conblocks allowed anywhere after typedefs
 *)

(* Implement as a state machine:
 *   0: looking for imports
 *   1: seen an abbrev
 *   2: seen a .code
 *   3: seen a .data
 *   5: seen a con block but no code or data
(* Cyclone *)
 *   6: in .code, template
(* End Cyclone *)
 *)

let process_mod_items items =
  let imports = ref []
  and exports = ref []
  and abbrevs = ref []
  and con_blocks = ref []
  and code_blocks = ref []
  and data_blocks = ref [] in
(* Cyclone *)
  let templates = ref []
  and template_labels = ref None
  and template_blocks = ref [] 
(* End Cyclone *)
(* LX *)
  and kinds = ref []
  and kmus = ref []
(* end LX *) 
in
  let code_block l is =
    let (c,is) = 
      match is with
      	(IMPlabeltype c)::is -> (Some c,is)
      |	is -> (None,is)
    and insts = ref [] in
    let rec loop is =
      match is with
      	(IMPinst i)::is -> insts := i :: !insts; loop is
      |	_ -> is in
    let is = loop is in
    ((l,c,Array.of_list (List.rev !insts)),is) in
  let data_block l is =
    let (align,co,is) = 
      match is with
      |	(IMPlabeltype c)::(IMPalign n)::is -> (    n,Some c,is)
      |	(IMPalign n)::(IMPlabeltype c)::is -> (    n,Some c,is)
      |	(IMPlabeltype c)              ::is -> (i32_4,Some c,is)
      |	(IMPalign n)                  ::is -> (    n,None  ,is)
      |	_                                  -> (i32_4,None  ,is) in
    let (clist,is ) =
      match is with
	(IMPcoerce ((),clist))::is -> (clist,is)
      |	_ -> ([],is) in
    let dis = ref [] in
    let rec loop is =
      match is with
	(IMPdi di)::is -> dis := di :: !dis; loop is
      |	_ -> is in
    let is = loop is in
    ((l,align,co,(List.rev !dis,clist)),is) in
  let rec loop s is =
    match s,is with
      _,[] -> ()
    | 0,(IMPimport intref)::is -> imports := intref :: !imports; loop s is
    | _,(IMPexport intref)::is -> exports := intref :: !exports; loop s is
    | (0 | 1),(IMPabbrev lc)::is -> abbrevs := lc :: !abbrevs; loop 1 is
(* LX *)
    | _,(IMPkmuabbrev km)::is ->
	 (match km with
	    MU ikl -> do_mu ikl kinds
	  | PR l -> do_pr l abbrevs);
	 loop s is
    | _,(IMPkindabbrev a)::is -> kinds := a :: !kinds; loop s is
(* end LX *)
    | (0 | 1 | 2 | 3 | 5),(IMPconblock lkc)::is ->
	con_blocks := lkc :: !con_blocks; loop (if s<2 then 5 else s) is
    | (0 | 1 | 2 | 3 | 5),(IMPcode)::is -> loop 2 is
    | (0 | 1 | 2 | 3 | 5),(IMPdata)::is -> loop 3 is
    | 2,(IMPlabel l)::is ->
 	let (cb,is) = code_block l is in
	code_blocks := cb :: !code_blocks; loop s is
    | 3,(IMPlabel l)::is ->
 	let (db,is) = data_block l is in
	data_blocks := db :: !data_blocks; loop s is
(* Cyclone *)
    | 2,(IMPtemplate_start(lengthlabel,con))::is ->
        template_labels := Some(lengthlabel,con);
        template_blocks := [];
        loop 6 is
    | 6,IMPtemplate_end::is ->
        begin
          let cbs = List.rev(!template_blocks) in
          match !template_labels with
            Some(lengthlabel,con) ->
              template_labels := None;
              template_blocks := [];
              templates := (lengthlabel,con,cbs) :: !templates;
              loop 2 is
          | None -> failwith "TEMPLATE_END without TEMPLATE_START"
        end
    | 6,(IMPlabel l)::is ->
 	let (cb,is) = code_block l is in
	template_blocks := cb :: !template_blocks; loop s is
(* End Cyclone *)
    | _,_ -> err "bad items"; raise Gcdfec.Exit
  in
  loop 0 items;
  { import_refs=Array.of_list 
      (List.map (function s -> Int_filename s) (List.rev !imports));
    export_refs=Array.of_list 
      (List.map (function s -> Int_filename s) (List.rev !exports));
    pre_imp = { imp_abbrevs=Array.of_list (List.rev !abbrevs);
(* LX *)
		imp_kindabbrevs = Array.of_list (List.rev !kinds);
(* end LX *)
		con_blocks=Array.of_list (List.rev !con_blocks);
		code_blocks=Array.of_list (List.rev !code_blocks);
		data_blocks=Array.of_list (List.rev !data_blocks);
(* Cyclone *)
		templates=Array.of_list (List.rev !templates);
(* End Cyclone *)
	  };
  }
;;

let process_coerce n (go,clist) =
  match go with
    CAnone -> IMPcoerce ((),clist)
  | CAgc ((Reg r) as gop) -> IMPinst (Coerce (gop,clist))
  | CAgc ((Prjr (_,_,_)) as gop)-> IMPinst (Coerce (gop,clist))
  | CAnc name -> IMPinst (CoerceName (name,clist))
  | _ -> errn n "bad coerce directive"; raise Gcdfec.Exit
;;

let process_coerce_in_list (go,clist) =
  match go with
    CAnone -> 
      err "can't coerce data inside virtual instruction list"; 
      raise Gcdfec.Exit
  | CAgc ((Reg r) as gop) -> Coerce (gop,clist)
  | CAgc ((Prjr (_,_,_)) as gop)-> Coerce (gop,clist)
  | CAnc name -> CoerceName (name,clist)
  | _ -> err "bad coerce directive"; raise Gcdfec.Exit
;;

let empty_regs = Dict.empty (compare);;

let mk_id s =
  let l = String.length s in
  let i = ref (l - 1) in
  while !i>=0 & s.[!i]>='0' & s.[!i]<='9' do decr i done;
  if !i>=0 & !i<l-1 & s.[!i]='$' then begin
    (* Check for leading zeros *)
    if !i<l-2 & s.[!i+1]='0' then err "bad identifier";
    id_make (String.sub s 0 !i) (int_of_string (String.sub s (!i+1) (l- !i-1)))
  end else
    id_of_string s
;;

(* Floating Point *)

let fpbinop_to_pop op =
  match op with
    Fadd  -> Faddp
  | Fdiv  -> Fdivp
  | Fdivr -> Fdivrp
  | Fmul  -> Fmulp
  | Fsub  -> Fsubp
  | Fsubr -> Fsubrp
  | _ -> invalid_arg "op_to_pop: cant convert"
%}
%start coerce
%start con
%start tal_int
%start tal_pre_mod
%token Txor
%token Txchg
%token Tword
%token Tvoid
%token Tvirtual
%token Tvcase
%token <Tal.variance> Tvar
%token Tval
%token Tunroll
%token Tunpack
%token Ttypeof
%token Ttype
%token Ttrue
%token Ttptr
%token Ttmpl
%token Ttest
%token Ttemplate_start
%token Ttemplate_end
%token Ttapp
%token Ttal_struct
%token <string> Ttal_import
%token <string> Ttal_export
%token Ttal_ends
%token Ttagof
%token Tsunpack
%token Tsum
%token Tsubsume
%token Tsub
%token <string> Tstring
%token Tstc
%token Tstar
%token Tst
%token Tsptr
%token Tsp
%token Tslot
%token Tsi
%token Tshrd
%token Tshr
%token Tshld
%token Tshl
%token <Tal.condition> Tset
%token Tse
%token Tsbb
%token Tsar
%token Tsal
%token Tsahf
%token Trsb
%token Tror
%token Trollsum
%token Troll
%token Trol
%token Tretn
%token Trep
%token Tremovename
%token <Tal.reg> Treg
%token Trec
%token Trdtsc
%token Trcr
%token Trcl
%token Trcb
%token Trb
%token Trab
%token Tqword
%token Tquestion
%token Tpushfd
%token Tpushad
%token Tpush
%token Tptr
%token Tprove
%token Tproof
%token Tprfn
%token Tpopfd
%token Tpopad
%token Tpop
%token Tplusplus
%token Tplus
%token Tpack
%token Tor
%token <Numtypes.int32> Tnumber
%token Tnot
%token Tnop
%token Tneg
%token Tnameobj
%token Tname
%token Tmulu
%token Tmuls
%token Tmul
%token Tmovzx
%token Tmovsx
%token Tmov
%token Tminus
%token Tmalloc
%token Tlts
%token Tltes
%token Tlsb
%token Tloopned
%token Tlooped
%token Tloopd
%token <string> Tliteral
%token Tletroll
%token Tletprod
%token Tleq
%token Tlea
%token Tlcb
%token Tlb
%token Tlahf
%token Tlabeltype
%token Tlabel
%token Tlab
%token Tkindrec
%token Tkind
%token Tjunk
%token Tjmp
%token Tjecxz
%token <Tal.condition> Tj
%token Tinto
%token Tint
%token Tinj
%token <string> Tinclude
%token Tinc
%token Timul
%token Tidiv
%token <string> Tident
%token Thash
%token <Tal.fpsomeargs> Tfstsw
%token <Tal.fpsomeargs> Tfpunary
%token <Tal.fpsomeargs> Tfpsst
%token <Tal.fpsomeargs> Tfpregs
%token <int> Tfpregq
%token <int> Tfpreg
%token <Tal.fpsomeargs> Tfpnone_or_reg
%token <Tal.fpsomeargs> Tfpmem
%token <Tal.fpsomeargs> Tfpbin
%token <Tal.fpnoargs> Tfp
%token Tforgetunique
%token Tforgetname
%token Tfn
%token Tfloat64
%token Tfloat32
%token <string> Tfloat
%token Tffree
%token <Tal.fpsomeargs> Tfcom
%token Tfalse
%token Tfallthru
%token Tequal
%token Teol
%token Teof
%token Tend
%token Tecg
%token Tdx
%token Tdword
%token Tdw
%token Tdr
%token Tdot
%token Tdl
%token Tdiv
%token Tdi
%token Tdh
%token Tdfloat64
%token Tdfloat32
%token Tdec
%token Tdd
%token Tdb
%token Tdata
%token Tcx
%token Tcwde
%token Tcwd
%token Tcons
%token Tconrec
%token Tcomma
%token Tcolon
%token Tcoerce
%token Tcode
%token Tcnot
%token Tcmp
%token <Tal.condition> Tcmov
%token Tcmc
%token Tclc
%token Tcl
%token Tcimplies
%token Tciff
%token Tch
%token Tcgstart
%token Tcgregion
%token Tcgholejmp
%token Tcgholejcc
%token Tcghole
%token Tcgforget
%token Tcgfilljmp
%token Tcgfilljcc
%token Tcgfill
%token Tcgend
%token Tcgdump
%token Tcdq
%token Tcbw
%token Tcase
%token Tcaret
%token Tcap
%token Tcand
%token Tcall
%token Tbyte
%token Tbx
%token Tbtagvar
%token Tbtagi
%token Tbswap
%token Tbp
%token Tbool
%token Tbl
%token <Tal.kind> Tbk
%token Tbh
%token Tbar
%token Tbang
%token Tbackquote
%token Tax
%token Taupd
%token Tasub
%token Tarray
%token Tandkind
%token Tandcon
%token Tand
%token Tamperlsb
%token Tamper
%token Talign
%token Tal
%token Tah
%token Tadd
%token Tadc
%token T_end_TAL
%token T_begin_TAL
%token T_begin_CYCLONE
%token TTm
%token TT
%token TS
%token TRL
%token TRH
%token TR16
%token TR
%token TNm
%token <Tal.scale> TJB
%token TExist
%token <Tal.scale> TB
%token TAll
%token Tarrow
%right Tarrow 
%type <Tal.genop> anop
%type <Tal.genop Tal.coerce> anop_coerce
%type <Tal.genop Tal.coerce> coerce
%type <Tal.con> con
%type <Tal.machine_state> machine_state
%type <Tal.tal_int> tal_int
%type <Tal.tal_pre_mod> tal_pre_mod
%type <Tal.genop> unary_op
%type <Tal.genop Tal.coerce> unary_op_coerce
%%

tal_int:
| _1 = int_items _2 = Teof
    {                 (process_int_items _1)}

int_items:
| 
    {   ([])}
| _1 = int_item _2 = int_items
    {                     (_1::_2)}
| _1 = Teol _2 = int_items
    {                 (_2)}

int_item:
| _1 = Ttype _2 = Tlab _3 = tvar _4 = Tequal _5 = con _6 = Trab _7 = Teol
    {                                       (INTabbrev (_3,_5))}
| _1 = Ttype _2 = Tlab _3 = label _4 = Tcolon _5 = kind _6 = Trab _7 = Teol
    {                                         (INTcon (_3,_5,AbsCon))}
| _1 = Ttype _2 = Tlab _3 = label _4 = Tcolon _5 = kind _6 = Tequal _7 = con _8 = Trab _9 = Teol
    {                                                    (INTcon (_3,_5,ConcCon _7))}
| _1 = Ttype _2 = Tlab _3 = label _4 = Tcolon _5 = kind _6 = Tleq _7 = con _8 = Trab _9 = Teol
    {                                                  (INTcon (_3,_5,BoundCon _7))}
| _1 = Tval _2 = label _3 = Tcomma _4 = econ _5 = Teol
    {                              (INTval (_2,_4))}
| _1 = Tkind _2 = Tlab _3 = kvar _4 = Tequal _5 = kind _6 = Trab _7 = Teol
    {                                        (INTkindabbrev (_3,_5))}
| _1 = Tkindrec _2 = Tlab _3 = kvar _4 = Tequal _5 = kind _6 = Trab _7 = Teol _8 = andkinds
    {     (INTkmuabbrev (MU((_3, _5)::_8)) )}
| _1 = Tconrec _2 = prcon _3 = andcons
    {     (INTkmuabbrev (PR(_2::_3)) )}

prcon:
| _1 = Tlab _2 = tvar _3 = Tcolon _4 = kvar _5 = Tarrow _6 = kind _7 = Tequal _8 = Tfn _9 = tvar _10 = Tcolon _11 = kind _12 = Tdot _13 = con _14 = Trab _15 = Teol
    {    ( (_4, _9, _11, _2, _6, _13) )}

andkinds:
| 
    {          ([])}
| _1 = andkind _2 = andkinds
    {                                   ( _1::_2 )}

andkind:
| _1 = Tandkind _2 = Tlab _3 = kvar _4 = Tequal _5 = kind _6 = Trab _7 = Teol
    {                                                  ( (_3, _5) )}

andcons:
| 
    {         ([])}
| _1 = Tandcon _2 = prcon _3 = andcons
    {                                      ( _2::_3 )}

tal_pre_mod:
| _1 = prolog _2 = imp_items _3 = epilog
    {                          (process_mod_items _2)}

prolog:
| _1 = eols _2 = Tinclude _3 = Teol _4 = eols _5 = T_begin_TAL _6 = Teol
    {       (if (String.lowercase _2)<>"tal.inc" then err "invalid prolog")}
| _1 = eols _2 = Tinclude _3 = Teol _4 = eols _5 = Tinclude _6 = Teol _7 = eols _8 = T_begin_TAL _9 = Teol _10 = eols _11 = T_begin_CYCLONE _12 = Teol
    {   ( if (String.lowercase _2)<>"tal.inc" then failwith "invalid prolog";
     if (String.lowercase _5)<>"cyclone.inc" then failwith "invalid prolog" )}

epilog:
| _1 = T_end_TAL _2 = Teol _3 = eols _4 = Tend _5 = eols _6 = Teof
    {                                     (())}

eols:
| 
    {      (())}
| _1 = Teol _2 = eols
    {                       (())}

imp_items:
| 
    {   ([])}
| _1 = imp_item _2 = imp_items
    {                     (_1::_2)}
| _1 = Teol _2 = imp_items
    {                 (_2)}

imp_item:
| _1 = Ttal_import _2 = Teol
    {                   (IMPimport _1)}
| _1 = Ttal_export _2 = Teol
    {                   (IMPexport _1)}
| _1 = Ttype _2 = Tlab _3 = tvar _4 = Tequal _5 = con _6 = Trab _7 = Teol
    {                                       (IMPabbrev (_3,_5))}
| _1 = Ttype _2 = Tlab _3 = label _4 = Tcolon _5 = kind _6 = Tequal _7 = con _8 = Trab _9 = Teol
    {                                                    (IMPconblock (_3,_5,_7))}
| _1 = Tcode _2 = Teol
    {             (IMPcode)}
| _1 = Tdata _2 = Teol
    {             (IMPdata)}
| _1 = label _2 = Tcolon
    {               (IMPlabel _1)}
| _1 = Tlabeltype _2 = econ _3 = Teol
    {                       (IMPlabeltype _2)}
| _1 = instruction _2 = Teol
    {                   (IMPinst _1)}
| _1 = Tcoerce _2 = coerce1 _3 = Teol
    {                       (process_coerce 2 _2)}
| _1 = Talign _2 = Tnumber _3 = Teol
    {                      (IMPalign _2)}
| _1 = data_item _2 = Teol
    {                 (IMPdi _1)}
| _1 = Ttemplate_start _2 = label _3 = Tcomma _4 = econ
    {                                    (IMPtemplate_start(_2,_4))}
| _1 = Ttemplate_end
    {                (IMPtemplate_end)}
| _1 = Tkind _2 = Tlab _3 = kvar _4 = Tequal _5 = kind _6 = Trab _7 = Teol
    {                                        (IMPkindabbrev (_3,_5))}
| _1 = Tkindrec _2 = Tlab _3 = kvar _4 = Tequal _5 = kind _6 = Trab _7 = Teol _8 = andkinds
    {     (IMPkmuabbrev (MU((_3, _5)::_8)) )}
| _1 = Tconrec _2 = prcon _3 = andcons
    {     (IMPkmuabbrev (PR(_2::_3)) )}

instructionlist:
| _1 = instruction
    {              ( [_1] )}
| _1 = instruction _2 = instructionlist
    {                              ( _1::_2 )}
| _1 = Tcoerce _2 = coerce1
    {                  ( [process_coerce_in_list _2] )}
| _1 = Tcoerce _2 = coerce1 _3 = instructionlist
    {                                  ( (process_coerce_in_list _2)::_3 )}

instruction:
| _1 = Tadc _2 = binop
    {             (ArithBin (Adc,fst _2,snd _2))}
| _1 = Tadd _2 = binop
    {             (ArithBin (Add,fst _2,snd _2))}
| _1 = Tand _2 = binop
    {             (ArithBin (And,fst _2,snd _2))}
| _1 = Tbswap _2 = reg
    {             (Bswap _2)}
| _1 = Tcall _2 = unary_op_coerce
    {                        (Call _2)}
| _1 = Tcbw
    {       (Conv Cbw)}
| _1 = Tcdq
    {       (Conv Cdq)}
| _1 = Tclc
    {       (Clc)}
| _1 = Tcmc
    {       (Cmc)}
| _1 = Tcmov _2 = reg _3 = Tcomma _4 = anop_coerce
    {                               (Cmovcc (_1,_2,_4))}
| _1 = Tcmp _2 = binop3
    {              (Cmp (fst _2,snd _2))}
| _1 = Tcwd
    {       (Conv Cwd)}
| _1 = Tcwde
    {        (Conv Cwde)}
| _1 = Tdec _2 = unary_op
    {                (ArithUn (Dec,_2))}
| _1 = Tdiv _2 = unary_op
    {                (ArithMD (Div,_2))}
| _1 = Tidiv _2 = unary_op
    {                 (ArithMD (Idiv,_2))}
| _1 = imul
    {       (_1)}
| _1 = Tinc _2 = unary_op
    {                (ArithUn (Inc,_2))}
| _1 = Tint _2 = Tnumber
    {               (Int (int32_to_int8 _2))}
| _1 = Tinto
    {        (Into)}
| _1 = Tj _2 = coerce
    {            (Jcc (_1,mk_label_coerce 2 _2,None))}
| _1 = Tj _2 = coerce _3 = Tvirtual _4 = Tlab _5 = instructionlist _6 = Trab
    {    (Jcc (_1, mk_label_coerce 2 _2, Some _5))}
| _1 = Tjecxz _2 = coerce
    {                (Jecxz (mk_label_coerce 2 _2,None))}
| _1 = Tjecxz _2 = coerce _3 = Tvirtual _4 = Tlab _5 = instructionlist _6 = Trab
    {    (Jecxz (mk_label_coerce 2 _2, Some _5))}
| _1 = Tjmp _2 = anop_coerce
    {                   (Jmp _2)}
| _1 = Tlahf
    {        (Lahf)}
| _1 = Tlea _2 = reg _3 = Tcomma _4 = anop
    {                       (Lea (_2,_4))}
| _1 = Tloopd _2 = coerce
    {                (Loopd (mk_label_coerce 2 _2,None))}
| _1 = Tlooped _2 = coerce
    {                 (Loopd (mk_label_coerce 2 _2,Some true))}
| _1 = Tloopned _2 = coerce
    {                  (Loopd (mk_label_coerce 2 _2,Some false))}
| _1 = Tmov _2 = binop2
    {              (Mov (fst _2,snd _2))}
| _1 = Tmov _2 = binop_part
    {    ( let ((g1,p1),(g2,p2)) = _2 in 
    if p1<>p2 then err "Mov requires operands to have the same size.";
    Movpart(false,g1,p1,g2,p2) 
    )}
| _1 = Tmovsx _2 = binop_part
    {                    (let ((g1,p1),(g2,p2)) = _2 in Movpart(false,g1,p1,g2,p2) )}
| _1 = Tmovzx _2 = binop_part
    {                    (let ((g1,p1),(g2,p2)) = _2 in Movpart(true ,g1,p1,g2,p2) )}
| _1 = Tmul _2 = unary_op
    {                (ArithMD (Mul,_2))}
| _1 = Tneg _2 = unary_op
    {                (ArithUn (Neg,_2))}
| _1 = Tnop
    {       (Nop)}
| _1 = Tnot _2 = unary_op
    {                (ArithUn (Not,_2))}
| _1 = Tor _2 = binop
    {            (ArithBin (Or,fst _2,snd _2))}
| _1 = Tpop _2 = unary_op
    {                (Pop _2)}
| _1 = Tpopad
    {         (Popad)}
| _1 = Tpopfd
    {         (Popfd)}
| _1 = Tpush _2 = unary_op_coerce
    {                        (Push _2)}
| _1 = Tpushad
    {          (Pushad)}
| _1 = Tpushfd
    {          (Pushfd)}
| _1 = Trcl _2 = unary_op _3 = Tcomma _4 = shift_amount
    {                                    (ArithSR (Rcl,_2,_4))}
| _1 = Trcr _2 = unary_op _3 = Tcomma _4 = shift_amount
    {                                    (ArithSR (Rcr,_2,_4))}
| _1 = Trdtsc
    {         ( Rdtsc )}
| _1 = Tretn
    {        (Retn None)}
| _1 = Tretn _2 = Tnumber
    {                (Retn (Some _2))}
| _1 = Trol _2 = unary_op _3 = Tcomma _4 = shift_amount
    {                                    (ArithSR (Rol,_2,_4))}
| _1 = Tror _2 = unary_op _3 = Tcomma _4 = shift_amount
    {                                    (ArithSR (Ror,_2,_4))}
| _1 = Tsahf
    {        (Sahf)}
| _1 = Tsal _2 = unary_op _3 = Tcomma _4 = shift_amount
    {                                    (ArithSR (Sal,_2,_4))}
| _1 = Tsar _2 = unary_op _3 = Tcomma _4 = shift_amount
    {                                    (ArithSR (Sar,_2,_4))}
| _1 = Tsbb _2 = binop
    {             (ArithBin (Sbb,fst _2,snd _2))}
| _1 = Tset _2 = regpart
    {    (if snd _2 <> RPl then
       (err "set requires low byte register"; raise Gcdfec.Exit)
     else Setcc (_1,Reg (fst _2)))}
| _1 = Tshl _2 = unary_op _3 = Tcomma _4 = shift_amount
    {                                    (ArithSR (Shl,_2,_4))}
| _1 = Tshld _2 = anop _3 = Tcomma _4 = reg _5 = Tcomma _6 = shift_amount
    {                                            (Shld (_2,_4,_6))}
| _1 = Tshr _2 = unary_op _3 = Tcomma _4 = shift_amount
    {                                    (ArithSR (Shr,_2,_4))}
| _1 = Tshrd _2 = anop _3 = Tcomma _4 = reg _5 = Tcomma _6 = shift_amount
    {                                            (Shrd (_2,_4,_6))}
| _1 = Tstc
    {       (Stc)}
| _1 = Tsub _2 = binop
    {             (ArithBin (Sub,fst _2,snd _2))}
| _1 = Ttest _2 = binop
    {              (Test (fst _2,snd _2))}
| _1 = Txchg _2 = anop _3 = Tcomma _4 = reg
    {                        (Xchg (_2,_4))}
| _1 = Txor _2 = binop
    {             (ArithBin (Xor,fst _2,snd _2))}
| _1 = Tfallthru
    {            (Fallthru [])}
| _1 = Tfallthru _2 = Tlab _3 = Trab
    {                      (Fallthru [])}
| _1 = Tfallthru _2 = econlist
    {                     (Fallthru _2)}
| _1 = Tmalloc _2 = tvar _3 = Tcomma _4 = Tnumber _5 = Tcomma _6 = mallocarg
    {                                               (Malloc (_2,_4,Some _6))}
| _1 = Tmalloc _2 = tvar _3 = Tcomma _4 = Tnumber
    {                              (Malloc (_2,_4,None))}
| _1 = Tproof _2 = Tlab _3 = proofop _4 = Trab
    {                           (Proof _3)}
| _1 = Tunpack _2 = tvar _3 = Tcomma _4 = reg _5 = Tcomma _6 = anop_coerce
    {                                             (Unpack (_2,_4,_6))}
| _1 = Tsunpack _2 = tvar _3 = Tcomma _4 = genop
    {                             (Sunpack (_2,_4))}
| _1 = Tnameobj _2 = tvar _3 = Tcomma _4 = anop
    {                            (Nameobj(_2,_4))}
| _1 = Tforgetunique _2 = tvar
    {                     (ForgetUnique(_2))}
| _1 = Tremovename _2 = tvar
    {                   (RemoveName(_2))}
| _1 = Tfp
    {                (FPnoargs _1)}
| _1 = Tfpbin
    {                (FPsomeargs (fpbinop_to_pop _1,FPstack2 (false,1)))}
| _1 = Tfpbin _2 = fpregs
    {                (let (b,i) = _2 in FPsomeargs (_1,FPstack2 (b,i)))}
| _1 = Tfpbin _2 = fpmem
    {                (FPsomeargs (_1,_2))}
| _1 = Tfpmem _2 = fpmem
    {                (FPsomeargs (_1,_2))}
| _1 = Tfpsst _2 = fpregs
    {    (let (b,i) = _2 in
     if b then (errn 3 "floating point operation requires 2nd arg ST"; Nop)
     else FPsomeargs (_1,FPstack2(b,i)))}
| _1 = Tfcom
    {        (FPsomeargs (_1,FPstack2 (false,1)))}
| _1 = Tfcom _2 = fpreg
    {              (FPsomeargs (_1,FPstack2 (false, _2)))}
| _1 = Tfcom _2 = fpmem
    {              (FPsomeargs (_1,_2))}
| _1 = Tfpnone_or_reg
    {                 (FPsomeargs (_1,FPstack 1))}
| _1 = Tfpnone_or_reg _2 = fpreg
    {                       (FPsomeargs (_1,FPstack _2))}
| _1 = Tfpunary _2 = fpreg
    {                 (FPsomeargs (_1,FPstack _2))}
| _1 = Tfpunary _2 = fpmem
    {                 (FPsomeargs (_1,_2))}
| _1 = Tffree _2 = fpreg
    {               (FPsomeargs (Ffree, FPstack _2))}
| _1 = Tfpregs _2 = fpregs
    {                 (let (b,i) = _2 in FPsomeargs (_1,FPstack2 (b,i)))}
| _1 = Tfstsw _2 = Tax
    {             (FPsomeargs (_1,FPgenop (Byte2,Reg Eax)))}
| _1 = Tfstsw _2 = fpmem
    {               (FPsomeargs (_1,_2))}
| _1 = Tcgstart _2 = Tlab _3 = tvar _4 = Tcomma _5 = con _6 = Trab
    {                                     (CgStart (_3,_5))}
| _1 = Tcgdump _2 = reg _3 = Tcomma _4 = tvar _5 = Tcomma _6 = reg _7 = Tcomma _8 = label
    {                                                  (CgDump (_2, _4, _6, _8))}
| _1 = Tcgfill _2 = reg _3 = Tcomma _4 = reg _5 = Tcomma _6 = label _7 = Tcomma _8 = label _9 = Tcomma _10 = reg
    {                                                              (CgFill (_2, _4, _6, _8, _10))}
| _1 = Tcgfilljmp _2 = reg _3 = Tcomma _4 = reg _5 = Tcomma _6 = label _7 = Tcomma _8 = label _9 = Tcomma _10 = reg _11 = Tcomma _12 = label _13 = Tcomma _14 = label
    {   ( CgFillJmp(_2,_4,_6,_8,_10,_12,_14) )}
| _1 = Tcgfilljcc _2 = reg _3 = Tcomma _4 = reg _5 = Tcomma _6 = label _7 = Tcomma _8 = label _9 = Tcomma _10 = reg _11 = Tcomma _12 = label _13 = Tcomma _14 = label
    {   ( CgFillJcc(_2,_4,_6,_8,_10,_12,_14) )}
| _1 = Tcgforget _2 = tvar _3 = Tcomma _4 = tvar
    {                             (CgForget (_2,_4))}
| _1 = Tcgend _2 = reg
    {             (CgEnd (_2))}
| _1 = Tcghole _2 = reg _3 = Tcomma _4 = label _5 = Tcomma _6 = label
    {                                        (CgHole(_2,_4,_6))}
| _1 = Tcgholejmp _2 = label _3 = Tcomma _4 = coerce
    {                                 (CgHoleJmp(_2,mk_label_coerce 4 _4))}
| _1 = Tcgholejcc _2 = Tident _3 = Tcomma _4 = label _5 = Tcomma _6 = coerce
    {    (CgHoleJcc(mk_cc 2 _2,_4,mk_label_coerce 4 _6,None))}
| _1 = Tcgholejcc _2 = Tident _3 = Tcomma _4 = label _5 = Tcomma _6 = coerce _7 = Tvirtual _8 = Tlab _9 = instructionlist _10 = Trab
    {    (CgHoleJcc(mk_cc 2 _2,_4,mk_label_coerce 4 _6,Some _9))}
| _1 = Tletprod _2 = Tlsb _3 = tvars _4 = Trsb _5 = Tcomma _6 = con
    {                                      ( Letprod(_3,_6) )}
| _1 = Tletroll _2 = tvar _3 = Tcomma _4 = con
    {                           ( Letroll(_2,_4) )}
| _1 = Tvcase _2 = Tnumber _3 = Tcomma _4 = tvar _5 = Tcomma _6 = con _7 = Tcomma _8 = coerce
    {                                                      ( Vcase(_2,_6,_4,_8) )}

imul:
| _1 = Timul _2 = ptr_opt _3 = genop
    {                      (ck_dword_lr _2 3 _3; ArithMD (Imul1,_3))}
| _1 = Timul _2 = ptr_opt _3 = genop _4 = Tcomma _5 = ptr_opt _6 = genop
    {    (ck_dword_b _2 _3 _6;
     ck_dword_b _5 _6 _3;
     ArithBin (Imul2,_3,_6))}
| _1 = Timul _2 = ptr_opt _3 = genop _4 = Tcomma _5 = ptr_opt _6 = genop _7 = Tcomma _8 = Tnumber
    {    ((match _2 with
     Some _ -> errn 2 "imul register has ptr";
    | None  -> ());
     ck_dword_l _5 6 _6;
     Imul3 (mk_reg 3 _3,_6,_8))}

mallocarg:
| _1 = Tlab _2 = mallocarg_aux _3 = Trab
    {                          (_2)}

mallocarg_aux:
| _1 = Tlsb _2 = mallocarg_auxs0 _3 = Trsb
    {                            (Mprod _2)}
| _1 = Tcolon _2 = Tnumber
    {                 (Mbytes (mk_scale _2))}
| _1 = Tarray _2 = Tlb _3 = Tnumber _4 = Tcomma _5 = TB _6 = Trb
    {                                   (Mbytearray (_5,_3))}

mallocarg_auxs0:
| 
    {    ([])}
| _1 = mallocarg_auxs
    {                 (_1)}

mallocarg_auxs:
| _1 = mallocarg_aux
    {                 ([_1])}
| _1 = mallocarg_aux _2 = Tcomma _3 = mallocarg_auxs
    {                                      (_1::_3)}

shift_amount:
| _1 = Tnumber
    {          (Some _1)}
| _1 = Tcl
    {      (None)}

anop:
| _1 = ptr_opt _2 = genop
    {                    (ck_dword_l _1 2 _2; _2)}

anop_coerce:
| _1 = ptr_opt _2 = coerce
    {                            (ck_dword_l _1 2 (fst _2); _2)}

unary_op:
| _1 = ptr_opt _2 = genop
    {                        (ck_dword_lr _1 2 _2; _2)}

unary_op_coerce:
| _1 = ptr_opt _2 = coerce
    {                                (ck_dword_lr _1 2 (fst _2); _2)}

binop:
| _1 = ptr_opt _2 = genop _3 = Tcomma _4 = ptr_opt _5 = genop
    {    (ck_dword_b _1 _2 _5;
     ck_dword_b _4 _5 _2;
     (_2,_5))}

binop3:
| _1 = ptr_opt _2 = coerce _3 = Tcomma _4 = ptr_opt _5 = coerce
    {    ( ck_dword_b _1 (fst _2) (fst _5);
      ck_dword_b _4 (fst _5) (fst _2);
      (_2,_5))}

binop2:
| _1 = ptr_opt _2 = genop _3 = Tcomma _4 = ptr_opt _5 = coerce
    {    (ck_dword_b _1 _2 (fst _5);
     ck_dword_b _4 (fst _5) _2;
     (_2,_5))}

binop_part:
| _1 = ptr_opt _2 = genop _3 = Tcomma _4 = binop_part_side
    {                                       ( ((_2, get_part _1 _2 (snd _4)),_4) )}
| _1 = binop_part_side _2 = Tcomma _3 = ptr_opt _4 = genop
    {                                       ( (_1,(_4, get_part _3 _4 (snd _1))) )}
| _1 = binop_part_side _2 = Tcomma _3 = binop_part_side
    {                                         ( (_1,_3) )}

binop_part_side:
| _1 = Tbyte _2 = Tptr _3 = genop
    {                   ( (_3, RPl) )}
| _1 = genop_part
    {                   ( _1 )}

ptr_opt:
| 
    {   (None)}
| _1 = Tdword _2 = Tptr
    {              (Some RPe)}

genop:
| _1 = Tnumber
    {          (Immed _1)}
| _1 = reg
    {      (Reg _1)}
| _1 = label
    {        (Addr _1)}
| _1 = Tlsb _2 = coerce _3 = Trsb
    {                   (process_prj _2 i32_0 None)}
| _1 = Tlsb _2 = coerce _3 = Tplus _4 = Tnumber _5 = Trsb
    {                                 (process_prj _2 _4 None)}
| _1 = Tlsb _2 = coerce _3 = Tplus _4 = Tnumber _5 = Tstar _6 = reg _7 = Trsb
    {    (process_prj _2 i32_0 (Some (mk_scale _4,_6)))}
| _1 = Tlsb _2 = coerce _3 = Tplus _4 = Tnumber _5 = Tstar _6 = reg _7 = Tplus _8 = Tnumber _9 = Trsb
    {    (process_prj _2 _8 (Some (mk_scale _4,_6)))}
| _1 = Tlsb _2 = coerce _3 = Tplus _4 = reg _5 = Trsb
    {    (process_prj _2 i32_0 (Some (Byte1,_4)))}
| _1 = Tlsb _2 = coerce _3 = Tplus _4 = reg _5 = Tplus _6 = Tnumber _7 = Trsb
    {    (process_prj _2 _6 (Some (Byte1,_4)))}

genop_part:
| _1 = part
    {       ( ( Reg (fst _1),snd _1) )}

proofop:
| _1 = Tident _2 = Tlab _3 = conlist0 _4 = Trab
    {                            ( [(mk_id _1, _3)] )}
| _1 = Tident _2 = Tlab _3 = conlist0 _4 = Trab _5 = proofop
    {                                    ( (mk_id _1, _3) :: _5 )}

coerce:
| _1 = coerce1
    {    (let (go,clist) = _1 in
    match go with 
      CAnone -> err "bad coercion"; raise Gcdfec.Exit
    | CAgc g -> (g,clist)
    | CAnc n -> err "bad name coercion"; raise Gcdfec.Exit )}

coerce1:
| _1 = genop
    {        ((CAgc _1,[]))}
| _1 = Tquestion
    {            ((CAnone,[]))}
| _1 = Tname _2 = Tlb _3 = Tident _4 = Trb
    {                       ((CAnc (mk_id _3),[]))}
| _1 = Tpack _2 = Tlb _3 = econ _4 = Tcomma _5 = coerce1 _6 = Tcomma _7 = econ _8 = Trb
    {    (let (o,cs) = _5 in (o,Pack (_3,_7)::cs))}
| _1 = Ttapp _2 = Tlb _3 = coerce1 _4 = Tcomma _5 = eannotation_list _6 = Trb
    {                                                (make_tapps _3 _5)}
| _1 = Troll _2 = Tlb _3 = econ _4 = Tcomma _5 = coerce1 _6 = Trb
    {    (let (o,cs) = _5 in (o,Roll _3::cs))}
| _1 = Tunroll _2 = Tlb _3 = coerce1 _4 = Trb
    {    (let (o,cs) = _3 in (o,Unroll ::cs))}
| _1 = Tsum _2 = Tlb _3 = econ _4 = Tcomma _5 = coerce1 _6 = Trb
    {    (let (o,cs) = _5 in (o,Tosum _3::cs))}
| _1 = Trollsum _2 = Tlb _3 = econ _4 = Tcomma _5 = coerce1 _6 = Trb
    {    (let (o,cs) = _5 in (o,RollTosum _3::cs))}
| _1 = Trec _2 = Tlb _3 = coerce1 _4 = Trb
    {    (let (o,cs) = _3 in (o,Fromsum ::cs))}
| _1 = Tarray _2 = Tlb _3 = Tnumber _4 = Tcomma _5 = Tnumber _6 = Tcomma _7 = econ _8 = Tcomma _9 = coerce1 _10 = Trb
    {    (let (o,cs) = _9 in (o,Toarray (_3,int32_to_int _5,_7)::cs))}
| _1 = Tslot _2 = Tlb _3 = Tnumber _4 = Tcomma _5 = Tnumber _6 = Tcomma _7 = coerce1 _8 = Trb
    {    (let (o,cs) = _7 in (o,Slot (_3,_5)::cs))}
| _1 = Tsubsume _2 = Tlb _3 = econ _4 = Tcomma _5 = coerce1 _6 = Trb
    {    (let (o,cs) = _5 in (o,Subsume _3::cs))}
| _1 = Tforgetname _2 = Tlb _3 = coerce1 _4 = Trb
    {    (let (o,cs) = _3 in (o,Forgetname::cs))}
| _1 = Tprove _2 = Tlb _3 = coerce1 _4 = Trb
    {    (let (o,cs) = _3 in (o,Prove::cs))}

reg:
| _1 = Treg
    {       (_1)}
| _1 = TR _2 = Tlb _3 = Tident _4 = Trb
    {                    (Virt (mk_id _3))}

regpart:
| _1 = Treg
    {       ((_1,RPe))}
| _1 = TR _2 = Tlb _3 = Tident _4 = Trb
    {                    ((Virt (mk_id _3),RPe))}
| _1 = part
    {       ( _1 )}

part:
| _1 = Tax
    {       ((Eax,RPx))}
| _1 = Tbx
    {                          ((Ebx,RPx))}
| _1 = Tcx
    {                                             ((Ecx,RPx))}
| _1 = Tdx
    {                                                                ((Edx,RPx))}
| _1 = Tsi
    {       ((Esi,RPx))}
| _1 = Tdi
    {                          ((Edi,RPx))}
| _1 = Tbp
    {                                             ((Ebp,RPx))}
| _1 = Tsp
    {                                                                ((Esp,RPx))}
| _1 = Tal
    {       ((Eax,RPl))}
| _1 = Tbl
    {                          ((Ebx,RPl))}
| _1 = Tcl
    {                                             ((Ecx,RPl))}
| _1 = Tdl
    {                                                                ((Edx,RPl))}
| _1 = Tah
    {       ((Eax,RPh))}
| _1 = Tbh
    {                          ((Ebx,RPh))}
| _1 = Tch
    {                                             ((Ecx,RPh))}
| _1 = Tdh
    {                                                                ((Edx,RPh))}
| _1 = TR16 _2 = Tlb _3 = Tident _4 = Trb
    {                      ((Virt (mk_id _3),RPx))}
| _1 = TRL _2 = Tlb _3 = Tident _4 = Trb
    {                     ((Virt (mk_id _3),RPl))}
| _1 = TRH _2 = Tlb _3 = Tident _4 = Trb
    {                     ((Virt (mk_id _3),RPh))}

fpreg:
| _1 = Tst
    {      (0)}
| _1 = Tst _2 = Tlb _3 = Tnumber _4 = Trb
    {                      (int32_to_int _3)}

fpregs:
| _1 = Tst _2 = Tcomma _3 = fpreg
    {                   ((true,_3))}
| _1 = Tst _2 = Tlb _3 = Tnumber _4 = Trb _5 = Tcomma _6 = Tst
    {                                 ((false,int32_to_int _3))}

fpmem:
| _1 = Tword _2 = Tptr _3 = genop
    {                    (FPgenop (Byte2,_3))}
| _1 = Tdword _2 = Tptr _3 = genop
    {                    (FPgenop (Byte4,_3))}
| _1 = Tqword _2 = Tptr _3 = genop
    {                    (FPgenop (Byte8,_3))}

data_item:
| _1 = Tdb _2 = byte_list
    {                (process_byte_list _2)}
| _1 = Tdw _2 = Tnumber
    {              (D2bytes (int32_to_int16 _2))}
| _1 = Tdd _2 = coerce1
    {              (process_dd_coerce _2)}
| _1 = Tdr _2 = rep_item
    {               (let x = do_rep _2 in Drep (fst x, snd x))}
| _1 = Tdfloat32 _2 = Tliteral
    {                     (Dfloat32 (process_f32 _2))}
| _1 = Tdfloat64 _2 = Tliteral
    {                     (Dfloat64 (process_f64 _2))}
| _1 = Tdfloat32 _2 = Tfloat
    {                   (Dfloat32 (dec_to_f32 _2))}
| _1 = Tdfloat64 _2 = Tfloat
    {                   (Dfloat64 (dec_to_f64 _2))}
| _1 = Ttal_struct
    {              (Dup)}
| _1 = Ttal_ends
    {            (Ddown)}

rep_item:
| _1 = Ttype _2 = con
    {            ((RCon _2))}
| _1 = Tkind _2 = kind
    {             ((RKind _2))}
| _1 = Tlabel _2 = label
    {               ((RLabel _2))}

byte_list:
| _1 = byte_item _2 = byte_list_rest
    {                           (_1::_2)}

byte_list_rest:
| 
    {   ([])}
| _1 = Tcomma _2 = byte_item _3 = byte_list_rest
    {                                  (_2::_3)}

byte_item:
| _1 = Tnumber
    {          (BInum _1)}
| _1 = Tstring
    {          (BIstr _1)}

econ:
| _1 = Tlab _2 = con _3 = Trab
    {                (_2)}

econlist:
| _1 = Tlab _2 = conlist _3 = Trab
    {                    (_2)}

eannotation_list:
| _1 = Tlab _2 = annotation_list _3 = Trab
    {                            (_2 (* Dan added for annotations *))}

annotation_list:
| _1 = annotation
    {             ([_1])}
| _1 = annotation _2 = Tcomma _3 = annotation_list
    {                                    (_1::_3)}

annotation:
| _1 = con
    {                          (Con       _1)}
| _1 = reg
    {                          (AReg      _1)}
| _1 = reg _2 = Tnumber
    {                          (StackTail (_1 ,int32_to_int _2))}
| _1 = reg _2 = Tnumber _3 = Tnumber _4 = con
    {                          (StackSlice(_1, int32_to_int _2, int32_to_int _3, _4))}

conlist0:
| 
    {   ([])}
| _1 = conlist
    {          (_1)}

conlist:
| _1 = con
    {      ([_1])}
| _1 = con _2 = Tcomma _3 = conlist
    {                     (_1::_3)}

con:
| _1 = con1
    {          (_1)}

con1:
| _1 = con2
    {       (_1)}
| _1 = Tfn _2 = vck _3 = vcks _4 = Tdot _5 = con1
    {    (List.fold_right (fun (v,k) c -> defcon(Clam (v,k,c))) (_2::_3) _5)}

con2:
| _1 = con3
    {       (_1)}
| _1 = con2 _2 = con3
    {            (defcon (Capp (_1,_2)))}
| _1 = Tsptr _2 = con3
    {             (defcon (Csptr _2))}
| _1 = Ttptr _2 = tvar
    {             (defcon (Ctptr _2))}

con3:
| _1 = con4
    {       (_1)}
| _1 = con4 _2 = Tdot _3 = Tnumber
    {                    (defcon(Cproj (int32_to_int _3,_1)))}
| _1 = Tinj _2 = Tnumber _3 = con4 _4 = Tlsb _5 = kind _6 = Trsb
    {                                   ( defcon(Cinj (int32_to_int _2, _3, _5)))}
| _1 = Troll _2 = Tlsb _3 = kind _4 = Trsb _5 = con4
    {                            ( defcon (Cfold(_3, _5)) )}

con4:
| _1 = con5
    {       (_1)}
| _1 = TAll _2 = Tlsb _3 = vck _4 = vcks _5 = Trsb _6 = Tdot _7 = con4
    {    (List.fold_right (fun (v,k) c -> defcon(Cforall (v,k,c))) (_3::_4) _7)}
| _1 = TAll _2 = Tlsb _3 = vck _4 = vcks _5 = Tbar _6 = con4 _7 = Trsb _8 = Tdot _9 = con4
    {    (match List.rev (_3::_4) with
      (v,k)::vks -> 
	List.fold_left (fun c (v,k) -> cforall v k c) 
	  (cforall v k (cif _6 _9)) vks
    | [] -> failwith "impossible")}
| _1 = TExist _2 = Tlsb _3 = vck _4 = vcks _5 = Trsb _6 = Tdot _7 = con4
    {    (List.fold_right (fun (v,k) c -> cexist v k c) (_3::_4) _7)}
| _1 = TExist _2 = Tlsb _3 = vck _4 = vcks _5 = Tbar _6 = con4 _7 = Trsb _8 = Tdot _9 = con4
    {    (match List.rev (_3::_4) with
      (v,k)::vks -> 
	List.fold_left (fun c (v,k) -> cexist v k c) 
	  (cexistp v k _6 _9) vks
    | [] -> failwith "impossible")}
| _1 = Tcode _2 = con4
    {                 (defcon(Ccode _2))}
| _1 = Tcaret _2 = TT _3 = Tlsb _4 = tags _5 = Trsb
    {                           (chptr _4 None None)}
| _1 = Tcaret _2 = opt_tags _3 = con4
    {                       (chptr _2 (Some _3) None)}
| _1 = Tcaret _2 = TT _3 = Tvar _4 = Tlb _5 = con _6 = Trb _7 = con4
    {                                  (chptr [] (Some _7) (Some (_5,_3)))}
| _1 = Tcaret _2 = TT _3 = Tvar _4 = Tlb _5 = con _6 = Tcomma _7 = tags _8 = Trb _9 = con4
    {    (chptr _7 (Some _9) (Some (_5,_3)))}

con5:
| _1 = con6
    {       (_1)}
| _1 = con6 _2 = Tciff _3 = con5
    {                  (ciff _1 _3)}
| _1 = con6 _2 = Tcimplies _3 = con5
    {                      (cimplies _1 _3)}

con6:
| _1 = con7
    {                (_1)}
| _1 = con7 _2 = Tamper _3 = con8
    {                   (defcon(Cmsjoin(_1,_3)))}
| _1 = con7 _2 = Thash _3 = con6
    {                  (defcon(Cappend (_1,_3)))}
| _1 = con7 _2 = Tcand _3 = con6
    {                  (cand [_1; _3])}

con7:
| _1 = con8
    {       (_1)}
| _1 = con8 _2 = Tcons _3 = con7
    {                  (defcon(Ccons (_1,_3)))}
| _1 = con8 _2 = Tbar _3 = con7
    {                 (cor [_1; _3])}

con8:
| _1 = con9
    {       (_1)}
| _1 = con8 _2 = Tvar
    {            (defcon (Cfield (_1,_2)))}

con9:
| _1 = con10
    {        (_1)}
| _1 = con10 _2 = Tlts _3 = con9
    {                  (clts _1 _3)}
| _1 = con10 _2 = Tlab _3 = con9
    {                  (cltu _1 _3)}
| _1 = con10 _2 = Tltes _3 = con9
    {                   (cltes _1 _3)}
| _1 = con10 _2 = Tleq _3 = con9
    {                  (clteu _1 _3)}
| _1 = con10 _2 = Tequal _3 = con9
    {                    (ceq _1 _3)}
| _1 = con10 _2 = Tnot _3 = Tequal _4 = con9
    {                         (cne _1 _4)}

con10:
| _1 = con11
    {        (_1)}
| _1 = con11 _2 = Tplusplus _3 = con10
    {                        (cadd [_1; _3])}
| _1 = con11 _2 = Tminus _3 = con10
    {                     (csub _1 _3)}

con11:
| _1 = con12
    {        (_1)}
| _1 = Tnumber _2 = Tmuls _3 = con11
    {                      (cmuls _1 _3)}
| _1 = Tnumber _2 = Tmulu _3 = con11
    {                      (cmulu _1 _3)}

con12:
| _1 = con100
    {         (_1)}
| _1 = Tcnot _2 = con12
    {              (cnot  _2)}

con100:
| _1 = tvar
    {       (defcon(Cvar _1))}
| _1 = Tlsb _2 = conlist0 _3 = Trsb
    {                     (defcon(Ctuple _2))}
| _1 = Tbackquote _2 = label
    {                   (defcon(Clab _2))}
| _1 = Ttypeof _2 = label
    {                (defcon (Ctypeof _2) )}
| _1 = pcon
    {       (defcon(Cprim _1))}
| _1 = Trec _2 = Tlb _3 = reclist _4 = Trb
    {                       (defcon(Crec _3))}
| _1 = machine_state
    {                (defcon(Cms _1))}
| _1 = Tstar _2 = Tlsb _3 = conlist0 _4 = Trsb
    {                           (defcon(Cprod _3))}
| _1 = Tplus _2 = Tlsb _3 = conlist0 _4 = Trsb
    {                           (defcon(Csum _3))}
| _1 = Tarray _2 = Tlb _3 = con _4 = Tcomma _5 = con _6 = Trb
    {                                (defcon (Carray (_3,_5)))}
| _1 = TS _2 = Tlb _3 = con _4 = Trb
    {                 (defcon (Csing _3))}
| _1 = Trep _2 = Tlb _3 = rep_item _4 = Trb
    {                        (defcon (Cr (_3)))}
| _1 = TNm _2 = Tlb _3 = con _4 = Trb
    {                  (defcon (Cname _3))}
| _1 = Ttagof _2 = Tlb _3 = con _4 = Trb
    {                     (defcon (Ctagof _3))}
| _1 = Tamperlsb _2 = conlist0 _3 = Trsb
    {                          (defcon(Cjoin _2))}
| _1 = Tcap _2 = Tlsb _3 = caplist _4 = Trsb
    {    (defcon(Ccap (Dict.inserts (Dict.empty id_compare) _3)))}
| _1 = Tse
    {      (defcon(Cempty))}
| _1 = Tlb _2 = con _3 = Trb
    {              (_2)}
| _1 = Ttmpl _2 = Tlb _3 = con _4 = Tcomma _5 = con_opt _6 = Tcomma _7 = lab_con_list _8 = Tcomma _9 = lab_con_list _10 = Trb
    {                      (defcon (Ctmpl (_3,_5,_7,_9)))}
| _1 = Tcgregion _2 = Tlb _3 = con _4 = Tcomma _5 = con_opt _6 = Tcomma _7 = lab_hole_list _8 = Trb
    {         (defcon (Ctrgn (_3,_5,_7)))}
| _1 = Tvoid _2 = Tlsb _3 = kind _4 = Trsb
    {                       (defcon(Cvoid _3))}
| _1 = Tcase _2 = Tlb _3 = con _4 = Trb _5 = tvar _6 = Tlsb _7 = conlist _8 = Trsb
    {                                           (defcon(Ccase (_3,_5,_7)))}

caplist:
| 
    {           ( [] )}
| _1 = caplist0
    {           ( _1 )}

caplist0:
| _1 = capentry
    {           ( [_1] )}
| _1 = capentry _2 = Tcomma _3 = caplist0
    {                           ( _1::_3 )}

capentry:
| _1 = tvar _2 = Tcolon _3 = con
    {                  ( (_1,(MayAlias,_3)) )}
| _1 = tvar _2 = Tbang _3 = con
    {                  ( (_1,(Unique,_3)) )}

con_opt:
| _1 = Tstar
    {        (None)}
| _1 = con
    {        (Some _1)}

lab_con_list:
| _1 = Tlcb _2 = Trcb
    {            ([])}
| _1 = Tlcb _2 = lab_con_list0 _3 = Trcb
    {                          (_2)}

lab_con_list0:
| _1 = label _2 = Tcolon _3 = con
    {                   ([(_1,_3)])}
| _1 = label _2 = Tcolon _3 = con _4 = Tcomma _5 = lab_con_list0
    {                                        ((_1,_3)::(_5))}

labels_and_holes:
| _1 = Tlb _2 = tvar _3 = Tcomma _4 = lab_con_list _5 = Tcomma _6 = lab_con_list _7 = Trb
    {    ( (_2,_4,_6) )}

lab_hole_list:
| _1 = Tlcb _2 = Trcb
    {            ([])}
| _1 = Tlcb _2 = lab_hole_list0 _3 = Trcb
    {                           (_2)}

lab_hole_list0:
| _1 = labels_and_holes
    {                   ([_1])}
| _1 = labels_and_holes _2 = Tcomma _3 = lab_hole_list0
    {                                         ((_1)::(_3))}

vcks:
| 
    {   ([])}
| _1 = vck _2 = vcks
    {           (_1::_2)}

vck:
| _1 = tvar _2 = Tcolon _3 = kind
    {                   ((_1,_3))}

opt_tags:
| 
    {   ([])}
| _1 = TT _2 = Tlb _3 = tags _4 = Trb
    {                  (_3)}

tags:
| _1 = Tnumber
    {          ([_1])}
| _1 = Tnumber _2 = Tcomma _3 = tags
    {                      (_1::_3)}

pcon:
| _1 = TB
    {     (PCbytes _1)}
| _1 = Tfloat32
    {           (PCfloat32)}
| _1 = Tfloat64
    {           (PCfloat64)}
| _1 = Tjunk _2 = Tnumber
    {                (PCjunk _2)}
| _1 = TJB
    {      (PCjunkbytes _1)}
| _1 = Tnumber
    {          (PCint _1)}
| _1 = Ttrue
    {        (PCtrue)}
| _1 = Tfalse
    {         (PCfalse)}

reclist:
| _1 = recitem
    {          ([_1])}
| _1 = recitem _2 = Tcomma _3 = reclist
    {                         (_1::_3)}

recitem:
| _1 = tvar _2 = Tcolon _3 = kind _4 = Tdot _5 = con
    {                            ((_1,_3,_5))}

machine_state:
| _1 = Tlcb _2 = rccs _3 = Trcb
    {                 (_2)}

rccs:
| 
    {   (ms_empty)}
| _1 = rccs1
    {        (_1)}

rccs1:
| _1 = reg _2 = Tcolon _3 = con
    {                 (ms_set_reg ms_empty _1 _3)}
| _1 = Tcap _2 = Tcolon _3 = con
    {                  (ms_set_cap ms_empty _3)}
| _1 = Tfpreg
    {          (ms_set_fpstack ms_empty (fpstack_init_reg fpstack_empty _1))}
| _1 = Tfpregq
    {          (ms_set_fpstack ms_empty (fpstack_hide_reg fpstack_empty _1))}
| _1 = Tfpreg _2 = Tquestion
    {                   (ms_set_fpstack ms_empty (fpstack_hide_reg fpstack_empty _1))}
| _1 = rccs1 _2 = Tcomma _3 = reg _4 = Tcolon _5 = con
    {                              (ms_set_reg _1 _3 _5)}
| _1 = rccs1 _2 = Tcomma _3 = Tcap _4 = Tcolon _5 = con
    {                               (ms_set_cap _1 _5)}
| _1 = rccs1 _2 = Tcomma _3 = Tfpreg
    {    (ms_set_fpstack _1 (fpstack_init_reg (ms_get_fpstack _1) _3))}
| _1 = rccs1 _2 = Tcomma _3 = Tfpregq
    {    (ms_set_fpstack _1 (fpstack_hide_reg (ms_get_fpstack _1) _3))}
| _1 = rccs1 _2 = Tcomma _3 = Tfpreg _4 = Tquestion
    {    (ms_set_fpstack _1 (fpstack_hide_reg (ms_get_fpstack _1) _3))}

kind:
| _1 = Tlb _2 = kind _3 = Trb
    {               (_2)}
| _1 = Tbk
    {      (_1)}
| _1 = TT
    {      (ktype)}
| _1 = TTm
    {      (kmem)}
| _1 = TTm _2 = Tnumber
    {              (kmemi _2)}
| _1 = kind _2 = Tarrow _3 = kind
    {                   (karrow _1 _3)}
| _1 = Tstar _2 = Tlsb _3 = kind_list _4 = Trsb
    {                            (kprod _3)}
| _1 = Tplus _2 = Tlsb _3 = kind_list _4 = Trsb
    {                            (ksum _3)}
| _1 = kvar
    {       (kvar _1)}

kind_list:
| 
    {   ([])}
| _1 = kind _2 = kind_list_rest
    {                      (_1::_2)}

kind_list_rest:
| 
    {   ([])}
| _1 = Tcomma _2 = kind _3 = kind_list_rest
    {                             (_2::_3)}

label:
| _1 = Tident
    {         (mk_id _1)}

tvar:
| _1 = Tident
    {         (mk_id _1)}

tvars:
| _1 = tvar
    {       ([ _1 ] )}
| _1 = tvar _2 = Tcomma _3 = tvars
    {                    ( _1 :: _3 )}

kvar:
| _1 = Tident
    {         (mk_id _1)}

%%