theory Legacy_Char
imports Main
begin

datatype nibble =
    Nibble0 | Nibble1 | Nibble2 | Nibble3 | Nibble4 | Nibble5 | Nibble6 | Nibble7
  | Nibble8 | Nibble9 | NibbleA | NibbleB | NibbleC | NibbleD | NibbleE | NibbleF

datatype legacy_char = LegacyChar nibble nibble

function mk_legacy_nibble :: "nat \<Rightarrow> nibble" where
  "mk_legacy_nibble 0 = Nibble0"
| "mk_legacy_nibble (Suc 0) = Nibble1"
| "mk_legacy_nibble 2 = Nibble2"
| "mk_legacy_nibble 3 = Nibble3"
| "mk_legacy_nibble 4 = Nibble4"
| "mk_legacy_nibble 5 = Nibble5"
| "mk_legacy_nibble 6 = Nibble6"
| "mk_legacy_nibble 7 = Nibble7"
| "mk_legacy_nibble 8 = Nibble8"
| "mk_legacy_nibble 9 = Nibble9"
| "mk_legacy_nibble 10 = NibbleA"
| "mk_legacy_nibble 11 = NibbleB"
| "mk_legacy_nibble 12 = NibbleC"
| "mk_legacy_nibble 13 = NibbleD"
| "mk_legacy_nibble 14 = NibbleE"
| "mk_legacy_nibble 15 = NibbleF"
| "x \<ge> 16 \<Longrightarrow> mk_legacy_nibble x = undefined"
                      apply auto apply atomize_elim by arith
termination apply (relation "{}") by auto

fun unmk_legacy_nibble where
  "unmk_legacy_nibble Nibble0 = 0"
| "unmk_legacy_nibble Nibble1 = 1"
| "unmk_legacy_nibble Nibble2 = 2"
| "unmk_legacy_nibble Nibble3 = 3"
| "unmk_legacy_nibble Nibble4 = 4"
| "unmk_legacy_nibble Nibble5 = 5"
| "unmk_legacy_nibble Nibble6 = 6"
| "unmk_legacy_nibble Nibble7 = 7"
| "unmk_legacy_nibble Nibble8 = 8"
| "unmk_legacy_nibble Nibble9 = 9"
| "unmk_legacy_nibble NibbleA = 10"
| "unmk_legacy_nibble NibbleB = 11"
| "unmk_legacy_nibble NibbleC = 12"
| "unmk_legacy_nibble NibbleD = 13"
| "unmk_legacy_nibble NibbleE = 14"
| "unmk_legacy_nibble NibbleF = 15"

definition mk_legacy_char :: "char \<Rightarrow> legacy_char" where
  "mk_legacy_char c = LegacyChar (mk_legacy_nibble (nat_of_char c div 16))  (mk_legacy_nibble (nat_of_char c mod 16))"

lemma legacy_char_000: "mk_legacy_char CHR 000 = LegacyChar Nibble0 Nibble0" by (simp add: mk_legacy_char_def)
lemma legacy_char_001: "mk_legacy_char CHR 001 = LegacyChar Nibble0 Nibble1" by (simp add: mk_legacy_char_def)
lemma legacy_char_002: "mk_legacy_char CHR 002 = LegacyChar Nibble0 Nibble2" by (simp add: mk_legacy_char_def)
lemma legacy_char_003: "mk_legacy_char CHR 003 = LegacyChar Nibble0 Nibble3" by (simp add: mk_legacy_char_def)
lemma legacy_char_004: "mk_legacy_char CHR 004 = LegacyChar Nibble0 Nibble4" by (simp add: mk_legacy_char_def)
lemma legacy_char_005: "mk_legacy_char CHR 005 = LegacyChar Nibble0 Nibble5" by (simp add: mk_legacy_char_def)
lemma legacy_char_006: "mk_legacy_char CHR 006 = LegacyChar Nibble0 Nibble6" by (simp add: mk_legacy_char_def)
lemma legacy_char_007: "mk_legacy_char CHR 007 = LegacyChar Nibble0 Nibble7" by (simp add: mk_legacy_char_def)
lemma legacy_char_008: "mk_legacy_char CHR 008 = LegacyChar Nibble0 Nibble8" by (simp add: mk_legacy_char_def)
lemma legacy_char_009: "mk_legacy_char CHR 009 = LegacyChar Nibble0 Nibble9" by (simp add: mk_legacy_char_def)
lemma legacy_char_010: "mk_legacy_char CHR 010 = LegacyChar Nibble0 NibbleA" by (simp add: mk_legacy_char_def)
lemma legacy_char_011: "mk_legacy_char CHR 011 = LegacyChar Nibble0 NibbleB" by (simp add: mk_legacy_char_def)
lemma legacy_char_012: "mk_legacy_char CHR 012 = LegacyChar Nibble0 NibbleC" by (simp add: mk_legacy_char_def)
lemma legacy_char_013: "mk_legacy_char CHR 013 = LegacyChar Nibble0 NibbleD" by (simp add: mk_legacy_char_def)
lemma legacy_char_014: "mk_legacy_char CHR 014 = LegacyChar Nibble0 NibbleE" by (simp add: mk_legacy_char_def)
lemma legacy_char_015: "mk_legacy_char CHR 015 = LegacyChar Nibble0 NibbleF" by (simp add: mk_legacy_char_def)
lemma legacy_char_016: "mk_legacy_char CHR 016 = LegacyChar Nibble1 Nibble0" by (simp add: mk_legacy_char_def)
lemma legacy_char_017: "mk_legacy_char CHR 017 = LegacyChar Nibble1 Nibble1" by (simp add: mk_legacy_char_def)
lemma legacy_char_018: "mk_legacy_char CHR 018 = LegacyChar Nibble1 Nibble2" by (simp add: mk_legacy_char_def)
lemma legacy_char_019: "mk_legacy_char CHR 019 = LegacyChar Nibble1 Nibble3" by (simp add: mk_legacy_char_def)
lemma legacy_char_020: "mk_legacy_char CHR 020 = LegacyChar Nibble1 Nibble4" by (simp add: mk_legacy_char_def)
lemma legacy_char_021: "mk_legacy_char CHR 021 = LegacyChar Nibble1 Nibble5" by (simp add: mk_legacy_char_def)
lemma legacy_char_022: "mk_legacy_char CHR 022 = LegacyChar Nibble1 Nibble6" by (simp add: mk_legacy_char_def)
lemma legacy_char_023: "mk_legacy_char CHR 023 = LegacyChar Nibble1 Nibble7" by (simp add: mk_legacy_char_def)
lemma legacy_char_024: "mk_legacy_char CHR 024 = LegacyChar Nibble1 Nibble8" by (simp add: mk_legacy_char_def)
lemma legacy_char_025: "mk_legacy_char CHR 025 = LegacyChar Nibble1 Nibble9" by (simp add: mk_legacy_char_def)
lemma legacy_char_026: "mk_legacy_char CHR 026 = LegacyChar Nibble1 NibbleA" by (simp add: mk_legacy_char_def)
lemma legacy_char_027: "mk_legacy_char CHR 027 = LegacyChar Nibble1 NibbleB" by (simp add: mk_legacy_char_def)
lemma legacy_char_028: "mk_legacy_char CHR 028 = LegacyChar Nibble1 NibbleC" by (simp add: mk_legacy_char_def)
lemma legacy_char_029: "mk_legacy_char CHR 029 = LegacyChar Nibble1 NibbleD" by (simp add: mk_legacy_char_def)
lemma legacy_char_030: "mk_legacy_char CHR 030 = LegacyChar Nibble1 NibbleE" by (simp add: mk_legacy_char_def)
lemma legacy_char_031: "mk_legacy_char CHR 031 = LegacyChar Nibble1 NibbleF" by (simp add: mk_legacy_char_def)
lemma legacy_char_032: "mk_legacy_char CHR 032 = LegacyChar Nibble2 Nibble0" by (simp add: mk_legacy_char_def)
lemma legacy_char_033: "mk_legacy_char CHR 033 = LegacyChar Nibble2 Nibble1" by (simp add: mk_legacy_char_def)
lemma legacy_char_034: "mk_legacy_char CHR 034 = LegacyChar Nibble2 Nibble2" by (simp add: mk_legacy_char_def)
lemma legacy_char_035: "mk_legacy_char CHR 035 = LegacyChar Nibble2 Nibble3" by (simp add: mk_legacy_char_def)
lemma legacy_char_036: "mk_legacy_char CHR 036 = LegacyChar Nibble2 Nibble4" by (simp add: mk_legacy_char_def)
lemma legacy_char_037: "mk_legacy_char CHR 037 = LegacyChar Nibble2 Nibble5" by (simp add: mk_legacy_char_def)
lemma legacy_char_038: "mk_legacy_char CHR 038 = LegacyChar Nibble2 Nibble6" by (simp add: mk_legacy_char_def)
lemma legacy_char_039: "mk_legacy_char CHR 039 = LegacyChar Nibble2 Nibble7" by (simp add: mk_legacy_char_def)
lemma legacy_char_040: "mk_legacy_char CHR 040 = LegacyChar Nibble2 Nibble8" by (simp add: mk_legacy_char_def)
lemma legacy_char_041: "mk_legacy_char CHR 041 = LegacyChar Nibble2 Nibble9" by (simp add: mk_legacy_char_def)
lemma legacy_char_042: "mk_legacy_char CHR 042 = LegacyChar Nibble2 NibbleA" by (simp add: mk_legacy_char_def)
lemma legacy_char_043: "mk_legacy_char CHR 043 = LegacyChar Nibble2 NibbleB" by (simp add: mk_legacy_char_def)
lemma legacy_char_044: "mk_legacy_char CHR 044 = LegacyChar Nibble2 NibbleC" by (simp add: mk_legacy_char_def)
lemma legacy_char_045: "mk_legacy_char CHR 045 = LegacyChar Nibble2 NibbleD" by (simp add: mk_legacy_char_def)
lemma legacy_char_046: "mk_legacy_char CHR 046 = LegacyChar Nibble2 NibbleE" by (simp add: mk_legacy_char_def)
lemma legacy_char_047: "mk_legacy_char CHR 047 = LegacyChar Nibble2 NibbleF" by (simp add: mk_legacy_char_def)
lemma legacy_char_048: "mk_legacy_char CHR 048 = LegacyChar Nibble3 Nibble0" by (simp add: mk_legacy_char_def)
lemma legacy_char_049: "mk_legacy_char CHR 049 = LegacyChar Nibble3 Nibble1" by (simp add: mk_legacy_char_def)
lemma legacy_char_050: "mk_legacy_char CHR 050 = LegacyChar Nibble3 Nibble2" by (simp add: mk_legacy_char_def)
lemma legacy_char_051: "mk_legacy_char CHR 051 = LegacyChar Nibble3 Nibble3" by (simp add: mk_legacy_char_def)
lemma legacy_char_052: "mk_legacy_char CHR 052 = LegacyChar Nibble3 Nibble4" by (simp add: mk_legacy_char_def)
lemma legacy_char_053: "mk_legacy_char CHR 053 = LegacyChar Nibble3 Nibble5" by (simp add: mk_legacy_char_def)
lemma legacy_char_054: "mk_legacy_char CHR 054 = LegacyChar Nibble3 Nibble6" by (simp add: mk_legacy_char_def)
lemma legacy_char_055: "mk_legacy_char CHR 055 = LegacyChar Nibble3 Nibble7" by (simp add: mk_legacy_char_def)
lemma legacy_char_056: "mk_legacy_char CHR 056 = LegacyChar Nibble3 Nibble8" by (simp add: mk_legacy_char_def)
lemma legacy_char_057: "mk_legacy_char CHR 057 = LegacyChar Nibble3 Nibble9" by (simp add: mk_legacy_char_def)
lemma legacy_char_058: "mk_legacy_char CHR 058 = LegacyChar Nibble3 NibbleA" by (simp add: mk_legacy_char_def)
lemma legacy_char_059: "mk_legacy_char CHR 059 = LegacyChar Nibble3 NibbleB" by (simp add: mk_legacy_char_def)
lemma legacy_char_060: "mk_legacy_char CHR 060 = LegacyChar Nibble3 NibbleC" by (simp add: mk_legacy_char_def)
lemma legacy_char_061: "mk_legacy_char CHR 061 = LegacyChar Nibble3 NibbleD" by (simp add: mk_legacy_char_def)
lemma legacy_char_062: "mk_legacy_char CHR 062 = LegacyChar Nibble3 NibbleE" by (simp add: mk_legacy_char_def)
lemma legacy_char_063: "mk_legacy_char CHR 063 = LegacyChar Nibble3 NibbleF" by (simp add: mk_legacy_char_def)
lemma legacy_char_064: "mk_legacy_char CHR 064 = LegacyChar Nibble4 Nibble0" by (simp add: mk_legacy_char_def)
lemma legacy_char_065: "mk_legacy_char CHR 065 = LegacyChar Nibble4 Nibble1" by (simp add: mk_legacy_char_def)
lemma legacy_char_066: "mk_legacy_char CHR 066 = LegacyChar Nibble4 Nibble2" by (simp add: mk_legacy_char_def)
lemma legacy_char_067: "mk_legacy_char CHR 067 = LegacyChar Nibble4 Nibble3" by (simp add: mk_legacy_char_def)
lemma legacy_char_068: "mk_legacy_char CHR 068 = LegacyChar Nibble4 Nibble4" by (simp add: mk_legacy_char_def)
lemma legacy_char_069: "mk_legacy_char CHR 069 = LegacyChar Nibble4 Nibble5" by (simp add: mk_legacy_char_def)
lemma legacy_char_070: "mk_legacy_char CHR 070 = LegacyChar Nibble4 Nibble6" by (simp add: mk_legacy_char_def)
lemma legacy_char_071: "mk_legacy_char CHR 071 = LegacyChar Nibble4 Nibble7" by (simp add: mk_legacy_char_def)
lemma legacy_char_072: "mk_legacy_char CHR 072 = LegacyChar Nibble4 Nibble8" by (simp add: mk_legacy_char_def)
lemma legacy_char_073: "mk_legacy_char CHR 073 = LegacyChar Nibble4 Nibble9" by (simp add: mk_legacy_char_def)
lemma legacy_char_074: "mk_legacy_char CHR 074 = LegacyChar Nibble4 NibbleA" by (simp add: mk_legacy_char_def)
lemma legacy_char_075: "mk_legacy_char CHR 075 = LegacyChar Nibble4 NibbleB" by (simp add: mk_legacy_char_def)
lemma legacy_char_076: "mk_legacy_char CHR 076 = LegacyChar Nibble4 NibbleC" by (simp add: mk_legacy_char_def)
lemma legacy_char_077: "mk_legacy_char CHR 077 = LegacyChar Nibble4 NibbleD" by (simp add: mk_legacy_char_def)
lemma legacy_char_078: "mk_legacy_char CHR 078 = LegacyChar Nibble4 NibbleE" by (simp add: mk_legacy_char_def)
lemma legacy_char_079: "mk_legacy_char CHR 079 = LegacyChar Nibble4 NibbleF" by (simp add: mk_legacy_char_def)
lemma legacy_char_080: "mk_legacy_char CHR 080 = LegacyChar Nibble5 Nibble0" by (simp add: mk_legacy_char_def)
lemma legacy_char_081: "mk_legacy_char CHR 081 = LegacyChar Nibble5 Nibble1" by (simp add: mk_legacy_char_def)
lemma legacy_char_082: "mk_legacy_char CHR 082 = LegacyChar Nibble5 Nibble2" by (simp add: mk_legacy_char_def)
lemma legacy_char_083: "mk_legacy_char CHR 083 = LegacyChar Nibble5 Nibble3" by (simp add: mk_legacy_char_def)
lemma legacy_char_084: "mk_legacy_char CHR 084 = LegacyChar Nibble5 Nibble4" by (simp add: mk_legacy_char_def)
lemma legacy_char_085: "mk_legacy_char CHR 085 = LegacyChar Nibble5 Nibble5" by (simp add: mk_legacy_char_def)
lemma legacy_char_086: "mk_legacy_char CHR 086 = LegacyChar Nibble5 Nibble6" by (simp add: mk_legacy_char_def)
lemma legacy_char_087: "mk_legacy_char CHR 087 = LegacyChar Nibble5 Nibble7" by (simp add: mk_legacy_char_def)
lemma legacy_char_088: "mk_legacy_char CHR 088 = LegacyChar Nibble5 Nibble8" by (simp add: mk_legacy_char_def)
lemma legacy_char_089: "mk_legacy_char CHR 089 = LegacyChar Nibble5 Nibble9" by (simp add: mk_legacy_char_def)
lemma legacy_char_090: "mk_legacy_char CHR 090 = LegacyChar Nibble5 NibbleA" by (simp add: mk_legacy_char_def)
lemma legacy_char_091: "mk_legacy_char CHR 091 = LegacyChar Nibble5 NibbleB" by (simp add: mk_legacy_char_def)
lemma legacy_char_092: "mk_legacy_char CHR 092 = LegacyChar Nibble5 NibbleC" by (simp add: mk_legacy_char_def)
lemma legacy_char_093: "mk_legacy_char CHR 093 = LegacyChar Nibble5 NibbleD" by (simp add: mk_legacy_char_def)
lemma legacy_char_094: "mk_legacy_char CHR 094 = LegacyChar Nibble5 NibbleE" by (simp add: mk_legacy_char_def)
lemma legacy_char_095: "mk_legacy_char CHR 095 = LegacyChar Nibble5 NibbleF" by (simp add: mk_legacy_char_def)
lemma legacy_char_096: "mk_legacy_char CHR 096 = LegacyChar Nibble6 Nibble0" by (simp add: mk_legacy_char_def)
lemma legacy_char_097: "mk_legacy_char CHR 097 = LegacyChar Nibble6 Nibble1" by (simp add: mk_legacy_char_def)
lemma legacy_char_098: "mk_legacy_char CHR 098 = LegacyChar Nibble6 Nibble2" by (simp add: mk_legacy_char_def)
lemma legacy_char_099: "mk_legacy_char CHR 099 = LegacyChar Nibble6 Nibble3" by (simp add: mk_legacy_char_def)
lemma legacy_char_100: "mk_legacy_char CHR 100 = LegacyChar Nibble6 Nibble4" by (simp add: mk_legacy_char_def)
lemma legacy_char_101: "mk_legacy_char CHR 101 = LegacyChar Nibble6 Nibble5" by (simp add: mk_legacy_char_def)
lemma legacy_char_102: "mk_legacy_char CHR 102 = LegacyChar Nibble6 Nibble6" by (simp add: mk_legacy_char_def)
lemma legacy_char_103: "mk_legacy_char CHR 103 = LegacyChar Nibble6 Nibble7" by (simp add: mk_legacy_char_def)
lemma legacy_char_104: "mk_legacy_char CHR 104 = LegacyChar Nibble6 Nibble8" by (simp add: mk_legacy_char_def)
lemma legacy_char_105: "mk_legacy_char CHR 105 = LegacyChar Nibble6 Nibble9" by (simp add: mk_legacy_char_def)
lemma legacy_char_106: "mk_legacy_char CHR 106 = LegacyChar Nibble6 NibbleA" by (simp add: mk_legacy_char_def)
lemma legacy_char_107: "mk_legacy_char CHR 107 = LegacyChar Nibble6 NibbleB" by (simp add: mk_legacy_char_def)
lemma legacy_char_108: "mk_legacy_char CHR 108 = LegacyChar Nibble6 NibbleC" by (simp add: mk_legacy_char_def)
lemma legacy_char_109: "mk_legacy_char CHR 109 = LegacyChar Nibble6 NibbleD" by (simp add: mk_legacy_char_def)
lemma legacy_char_110: "mk_legacy_char CHR 110 = LegacyChar Nibble6 NibbleE" by (simp add: mk_legacy_char_def)
lemma legacy_char_111: "mk_legacy_char CHR 111 = LegacyChar Nibble6 NibbleF" by (simp add: mk_legacy_char_def)
lemma legacy_char_112: "mk_legacy_char CHR 112 = LegacyChar Nibble7 Nibble0" by (simp add: mk_legacy_char_def)
lemma legacy_char_113: "mk_legacy_char CHR 113 = LegacyChar Nibble7 Nibble1" by (simp add: mk_legacy_char_def)
lemma legacy_char_114: "mk_legacy_char CHR 114 = LegacyChar Nibble7 Nibble2" by (simp add: mk_legacy_char_def)
lemma legacy_char_115: "mk_legacy_char CHR 115 = LegacyChar Nibble7 Nibble3" by (simp add: mk_legacy_char_def)
lemma legacy_char_116: "mk_legacy_char CHR 116 = LegacyChar Nibble7 Nibble4" by (simp add: mk_legacy_char_def)
lemma legacy_char_117: "mk_legacy_char CHR 117 = LegacyChar Nibble7 Nibble5" by (simp add: mk_legacy_char_def)
lemma legacy_char_118: "mk_legacy_char CHR 118 = LegacyChar Nibble7 Nibble6" by (simp add: mk_legacy_char_def)
lemma legacy_char_119: "mk_legacy_char CHR 119 = LegacyChar Nibble7 Nibble7" by (simp add: mk_legacy_char_def)
lemma legacy_char_120: "mk_legacy_char CHR 120 = LegacyChar Nibble7 Nibble8" by (simp add: mk_legacy_char_def)
lemma legacy_char_121: "mk_legacy_char CHR 121 = LegacyChar Nibble7 Nibble9" by (simp add: mk_legacy_char_def)
lemma legacy_char_122: "mk_legacy_char CHR 122 = LegacyChar Nibble7 NibbleA" by (simp add: mk_legacy_char_def)
lemma legacy_char_123: "mk_legacy_char CHR 123 = LegacyChar Nibble7 NibbleB" by (simp add: mk_legacy_char_def)
lemma legacy_char_124: "mk_legacy_char CHR 124 = LegacyChar Nibble7 NibbleC" by (simp add: mk_legacy_char_def)
lemma legacy_char_125: "mk_legacy_char CHR 125 = LegacyChar Nibble7 NibbleD" by (simp add: mk_legacy_char_def)
lemma legacy_char_126: "mk_legacy_char CHR 126 = LegacyChar Nibble7 NibbleE" by (simp add: mk_legacy_char_def)
lemma legacy_char_127: "mk_legacy_char CHR 127 = LegacyChar Nibble7 NibbleF" by (simp add: mk_legacy_char_def)
lemma legacy_char_128: "mk_legacy_char CHR 128 = LegacyChar Nibble8 Nibble0" by (simp add: mk_legacy_char_def)
lemma legacy_char_129: "mk_legacy_char CHR 129 = LegacyChar Nibble8 Nibble1" by (simp add: mk_legacy_char_def)
lemma legacy_char_130: "mk_legacy_char CHR 130 = LegacyChar Nibble8 Nibble2" by (simp add: mk_legacy_char_def)
lemma legacy_char_131: "mk_legacy_char CHR 131 = LegacyChar Nibble8 Nibble3" by (simp add: mk_legacy_char_def)
lemma legacy_char_132: "mk_legacy_char CHR 132 = LegacyChar Nibble8 Nibble4" by (simp add: mk_legacy_char_def)
lemma legacy_char_133: "mk_legacy_char CHR 133 = LegacyChar Nibble8 Nibble5" by (simp add: mk_legacy_char_def)
lemma legacy_char_134: "mk_legacy_char CHR 134 = LegacyChar Nibble8 Nibble6" by (simp add: mk_legacy_char_def)
lemma legacy_char_135: "mk_legacy_char CHR 135 = LegacyChar Nibble8 Nibble7" by (simp add: mk_legacy_char_def)
lemma legacy_char_136: "mk_legacy_char CHR 136 = LegacyChar Nibble8 Nibble8" by (simp add: mk_legacy_char_def)
lemma legacy_char_137: "mk_legacy_char CHR 137 = LegacyChar Nibble8 Nibble9" by (simp add: mk_legacy_char_def)
lemma legacy_char_138: "mk_legacy_char CHR 138 = LegacyChar Nibble8 NibbleA" by (simp add: mk_legacy_char_def)
lemma legacy_char_139: "mk_legacy_char CHR 139 = LegacyChar Nibble8 NibbleB" by (simp add: mk_legacy_char_def)
lemma legacy_char_140: "mk_legacy_char CHR 140 = LegacyChar Nibble8 NibbleC" by (simp add: mk_legacy_char_def)
lemma legacy_char_141: "mk_legacy_char CHR 141 = LegacyChar Nibble8 NibbleD" by (simp add: mk_legacy_char_def)
lemma legacy_char_142: "mk_legacy_char CHR 142 = LegacyChar Nibble8 NibbleE" by (simp add: mk_legacy_char_def)
lemma legacy_char_143: "mk_legacy_char CHR 143 = LegacyChar Nibble8 NibbleF" by (simp add: mk_legacy_char_def)
lemma legacy_char_144: "mk_legacy_char CHR 144 = LegacyChar Nibble9 Nibble0" by (simp add: mk_legacy_char_def)
lemma legacy_char_145: "mk_legacy_char CHR 145 = LegacyChar Nibble9 Nibble1" by (simp add: mk_legacy_char_def)
lemma legacy_char_146: "mk_legacy_char CHR 146 = LegacyChar Nibble9 Nibble2" by (simp add: mk_legacy_char_def)
lemma legacy_char_147: "mk_legacy_char CHR 147 = LegacyChar Nibble9 Nibble3" by (simp add: mk_legacy_char_def)
lemma legacy_char_148: "mk_legacy_char CHR 148 = LegacyChar Nibble9 Nibble4" by (simp add: mk_legacy_char_def)
lemma legacy_char_149: "mk_legacy_char CHR 149 = LegacyChar Nibble9 Nibble5" by (simp add: mk_legacy_char_def)
lemma legacy_char_150: "mk_legacy_char CHR 150 = LegacyChar Nibble9 Nibble6" by (simp add: mk_legacy_char_def)
lemma legacy_char_151: "mk_legacy_char CHR 151 = LegacyChar Nibble9 Nibble7" by (simp add: mk_legacy_char_def)
lemma legacy_char_152: "mk_legacy_char CHR 152 = LegacyChar Nibble9 Nibble8" by (simp add: mk_legacy_char_def)
lemma legacy_char_153: "mk_legacy_char CHR 153 = LegacyChar Nibble9 Nibble9" by (simp add: mk_legacy_char_def)
lemma legacy_char_154: "mk_legacy_char CHR 154 = LegacyChar Nibble9 NibbleA" by (simp add: mk_legacy_char_def)
lemma legacy_char_155: "mk_legacy_char CHR 155 = LegacyChar Nibble9 NibbleB" by (simp add: mk_legacy_char_def)
lemma legacy_char_156: "mk_legacy_char CHR 156 = LegacyChar Nibble9 NibbleC" by (simp add: mk_legacy_char_def)
lemma legacy_char_157: "mk_legacy_char CHR 157 = LegacyChar Nibble9 NibbleD" by (simp add: mk_legacy_char_def)
lemma legacy_char_158: "mk_legacy_char CHR 158 = LegacyChar Nibble9 NibbleE" by (simp add: mk_legacy_char_def)
lemma legacy_char_159: "mk_legacy_char CHR 159 = LegacyChar Nibble9 NibbleF" by (simp add: mk_legacy_char_def)
lemma legacy_char_160: "mk_legacy_char CHR 160 = LegacyChar NibbleA Nibble0" by (simp add: mk_legacy_char_def)
lemma legacy_char_161: "mk_legacy_char CHR 161 = LegacyChar NibbleA Nibble1" by (simp add: mk_legacy_char_def)
lemma legacy_char_162: "mk_legacy_char CHR 162 = LegacyChar NibbleA Nibble2" by (simp add: mk_legacy_char_def)
lemma legacy_char_163: "mk_legacy_char CHR 163 = LegacyChar NibbleA Nibble3" by (simp add: mk_legacy_char_def)
lemma legacy_char_164: "mk_legacy_char CHR 164 = LegacyChar NibbleA Nibble4" by (simp add: mk_legacy_char_def)
lemma legacy_char_165: "mk_legacy_char CHR 165 = LegacyChar NibbleA Nibble5" by (simp add: mk_legacy_char_def)
lemma legacy_char_166: "mk_legacy_char CHR 166 = LegacyChar NibbleA Nibble6" by (simp add: mk_legacy_char_def)
lemma legacy_char_167: "mk_legacy_char CHR 167 = LegacyChar NibbleA Nibble7" by (simp add: mk_legacy_char_def)
lemma legacy_char_168: "mk_legacy_char CHR 168 = LegacyChar NibbleA Nibble8" by (simp add: mk_legacy_char_def)
lemma legacy_char_169: "mk_legacy_char CHR 169 = LegacyChar NibbleA Nibble9" by (simp add: mk_legacy_char_def)
lemma legacy_char_170: "mk_legacy_char CHR 170 = LegacyChar NibbleA NibbleA" by (simp add: mk_legacy_char_def)
lemma legacy_char_171: "mk_legacy_char CHR 171 = LegacyChar NibbleA NibbleB" by (simp add: mk_legacy_char_def)
lemma legacy_char_172: "mk_legacy_char CHR 172 = LegacyChar NibbleA NibbleC" by (simp add: mk_legacy_char_def)
lemma legacy_char_173: "mk_legacy_char CHR 173 = LegacyChar NibbleA NibbleD" by (simp add: mk_legacy_char_def)
lemma legacy_char_174: "mk_legacy_char CHR 174 = LegacyChar NibbleA NibbleE" by (simp add: mk_legacy_char_def)
lemma legacy_char_175: "mk_legacy_char CHR 175 = LegacyChar NibbleA NibbleF" by (simp add: mk_legacy_char_def)
lemma legacy_char_176: "mk_legacy_char CHR 176 = LegacyChar NibbleB Nibble0" by (simp add: mk_legacy_char_def)
lemma legacy_char_177: "mk_legacy_char CHR 177 = LegacyChar NibbleB Nibble1" by (simp add: mk_legacy_char_def)
lemma legacy_char_178: "mk_legacy_char CHR 178 = LegacyChar NibbleB Nibble2" by (simp add: mk_legacy_char_def)
lemma legacy_char_179: "mk_legacy_char CHR 179 = LegacyChar NibbleB Nibble3" by (simp add: mk_legacy_char_def)
lemma legacy_char_180: "mk_legacy_char CHR 180 = LegacyChar NibbleB Nibble4" by (simp add: mk_legacy_char_def)
lemma legacy_char_181: "mk_legacy_char CHR 181 = LegacyChar NibbleB Nibble5" by (simp add: mk_legacy_char_def)
lemma legacy_char_182: "mk_legacy_char CHR 182 = LegacyChar NibbleB Nibble6" by (simp add: mk_legacy_char_def)
lemma legacy_char_183: "mk_legacy_char CHR 183 = LegacyChar NibbleB Nibble7" by (simp add: mk_legacy_char_def)
lemma legacy_char_184: "mk_legacy_char CHR 184 = LegacyChar NibbleB Nibble8" by (simp add: mk_legacy_char_def)
lemma legacy_char_185: "mk_legacy_char CHR 185 = LegacyChar NibbleB Nibble9" by (simp add: mk_legacy_char_def)
lemma legacy_char_186: "mk_legacy_char CHR 186 = LegacyChar NibbleB NibbleA" by (simp add: mk_legacy_char_def)
lemma legacy_char_187: "mk_legacy_char CHR 187 = LegacyChar NibbleB NibbleB" by (simp add: mk_legacy_char_def)
lemma legacy_char_188: "mk_legacy_char CHR 188 = LegacyChar NibbleB NibbleC" by (simp add: mk_legacy_char_def)
lemma legacy_char_189: "mk_legacy_char CHR 189 = LegacyChar NibbleB NibbleD" by (simp add: mk_legacy_char_def)
lemma legacy_char_190: "mk_legacy_char CHR 190 = LegacyChar NibbleB NibbleE" by (simp add: mk_legacy_char_def)
lemma legacy_char_191: "mk_legacy_char CHR 191 = LegacyChar NibbleB NibbleF" by (simp add: mk_legacy_char_def)
lemma legacy_char_192: "mk_legacy_char CHR 192 = LegacyChar NibbleC Nibble0" by (simp add: mk_legacy_char_def)
lemma legacy_char_193: "mk_legacy_char CHR 193 = LegacyChar NibbleC Nibble1" by (simp add: mk_legacy_char_def)
lemma legacy_char_194: "mk_legacy_char CHR 194 = LegacyChar NibbleC Nibble2" by (simp add: mk_legacy_char_def)
lemma legacy_char_195: "mk_legacy_char CHR 195 = LegacyChar NibbleC Nibble3" by (simp add: mk_legacy_char_def)
lemma legacy_char_196: "mk_legacy_char CHR 196 = LegacyChar NibbleC Nibble4" by (simp add: mk_legacy_char_def)
lemma legacy_char_197: "mk_legacy_char CHR 197 = LegacyChar NibbleC Nibble5" by (simp add: mk_legacy_char_def)
lemma legacy_char_198: "mk_legacy_char CHR 198 = LegacyChar NibbleC Nibble6" by (simp add: mk_legacy_char_def)
lemma legacy_char_199: "mk_legacy_char CHR 199 = LegacyChar NibbleC Nibble7" by (simp add: mk_legacy_char_def)
lemma legacy_char_200: "mk_legacy_char CHR 200 = LegacyChar NibbleC Nibble8" by (simp add: mk_legacy_char_def)
lemma legacy_char_201: "mk_legacy_char CHR 201 = LegacyChar NibbleC Nibble9" by (simp add: mk_legacy_char_def)
lemma legacy_char_202: "mk_legacy_char CHR 202 = LegacyChar NibbleC NibbleA" by (simp add: mk_legacy_char_def)
lemma legacy_char_203: "mk_legacy_char CHR 203 = LegacyChar NibbleC NibbleB" by (simp add: mk_legacy_char_def)
lemma legacy_char_204: "mk_legacy_char CHR 204 = LegacyChar NibbleC NibbleC" by (simp add: mk_legacy_char_def)
lemma legacy_char_205: "mk_legacy_char CHR 205 = LegacyChar NibbleC NibbleD" by (simp add: mk_legacy_char_def)
lemma legacy_char_206: "mk_legacy_char CHR 206 = LegacyChar NibbleC NibbleE" by (simp add: mk_legacy_char_def)
lemma legacy_char_207: "mk_legacy_char CHR 207 = LegacyChar NibbleC NibbleF" by (simp add: mk_legacy_char_def)
lemma legacy_char_208: "mk_legacy_char CHR 208 = LegacyChar NibbleD Nibble0" by (simp add: mk_legacy_char_def)
lemma legacy_char_209: "mk_legacy_char CHR 209 = LegacyChar NibbleD Nibble1" by (simp add: mk_legacy_char_def)
lemma legacy_char_210: "mk_legacy_char CHR 210 = LegacyChar NibbleD Nibble2" by (simp add: mk_legacy_char_def)
lemma legacy_char_211: "mk_legacy_char CHR 211 = LegacyChar NibbleD Nibble3" by (simp add: mk_legacy_char_def)
lemma legacy_char_212: "mk_legacy_char CHR 212 = LegacyChar NibbleD Nibble4" by (simp add: mk_legacy_char_def)
lemma legacy_char_213: "mk_legacy_char CHR 213 = LegacyChar NibbleD Nibble5" by (simp add: mk_legacy_char_def)
lemma legacy_char_214: "mk_legacy_char CHR 214 = LegacyChar NibbleD Nibble6" by (simp add: mk_legacy_char_def)
lemma legacy_char_215: "mk_legacy_char CHR 215 = LegacyChar NibbleD Nibble7" by (simp add: mk_legacy_char_def)
lemma legacy_char_216: "mk_legacy_char CHR 216 = LegacyChar NibbleD Nibble8" by (simp add: mk_legacy_char_def)
lemma legacy_char_217: "mk_legacy_char CHR 217 = LegacyChar NibbleD Nibble9" by (simp add: mk_legacy_char_def)
lemma legacy_char_218: "mk_legacy_char CHR 218 = LegacyChar NibbleD NibbleA" by (simp add: mk_legacy_char_def)
lemma legacy_char_219: "mk_legacy_char CHR 219 = LegacyChar NibbleD NibbleB" by (simp add: mk_legacy_char_def)
lemma legacy_char_220: "mk_legacy_char CHR 220 = LegacyChar NibbleD NibbleC" by (simp add: mk_legacy_char_def)
lemma legacy_char_221: "mk_legacy_char CHR 221 = LegacyChar NibbleD NibbleD" by (simp add: mk_legacy_char_def)
lemma legacy_char_222: "mk_legacy_char CHR 222 = LegacyChar NibbleD NibbleE" by (simp add: mk_legacy_char_def)
lemma legacy_char_223: "mk_legacy_char CHR 223 = LegacyChar NibbleD NibbleF" by (simp add: mk_legacy_char_def)
lemma legacy_char_224: "mk_legacy_char CHR 224 = LegacyChar NibbleE Nibble0" by (simp add: mk_legacy_char_def)
lemma legacy_char_225: "mk_legacy_char CHR 225 = LegacyChar NibbleE Nibble1" by (simp add: mk_legacy_char_def)
lemma legacy_char_226: "mk_legacy_char CHR 226 = LegacyChar NibbleE Nibble2" by (simp add: mk_legacy_char_def)
lemma legacy_char_227: "mk_legacy_char CHR 227 = LegacyChar NibbleE Nibble3" by (simp add: mk_legacy_char_def)
lemma legacy_char_228: "mk_legacy_char CHR 228 = LegacyChar NibbleE Nibble4" by (simp add: mk_legacy_char_def)
lemma legacy_char_229: "mk_legacy_char CHR 229 = LegacyChar NibbleE Nibble5" by (simp add: mk_legacy_char_def)
lemma legacy_char_230: "mk_legacy_char CHR 230 = LegacyChar NibbleE Nibble6" by (simp add: mk_legacy_char_def)
lemma legacy_char_231: "mk_legacy_char CHR 231 = LegacyChar NibbleE Nibble7" by (simp add: mk_legacy_char_def)
lemma legacy_char_232: "mk_legacy_char CHR 232 = LegacyChar NibbleE Nibble8" by (simp add: mk_legacy_char_def)
lemma legacy_char_233: "mk_legacy_char CHR 233 = LegacyChar NibbleE Nibble9" by (simp add: mk_legacy_char_def)
lemma legacy_char_234: "mk_legacy_char CHR 234 = LegacyChar NibbleE NibbleA" by (simp add: mk_legacy_char_def)
lemma legacy_char_235: "mk_legacy_char CHR 235 = LegacyChar NibbleE NibbleB" by (simp add: mk_legacy_char_def)
lemma legacy_char_236: "mk_legacy_char CHR 236 = LegacyChar NibbleE NibbleC" by (simp add: mk_legacy_char_def)
lemma legacy_char_237: "mk_legacy_char CHR 237 = LegacyChar NibbleE NibbleD" by (simp add: mk_legacy_char_def)
lemma legacy_char_238: "mk_legacy_char CHR 238 = LegacyChar NibbleE NibbleE" by (simp add: mk_legacy_char_def)
lemma legacy_char_239: "mk_legacy_char CHR 239 = LegacyChar NibbleE NibbleF" by (simp add: mk_legacy_char_def)
lemma legacy_char_240: "mk_legacy_char CHR 240 = LegacyChar NibbleF Nibble0" by (simp add: mk_legacy_char_def)
lemma legacy_char_241: "mk_legacy_char CHR 241 = LegacyChar NibbleF Nibble1" by (simp add: mk_legacy_char_def)
lemma legacy_char_242: "mk_legacy_char CHR 242 = LegacyChar NibbleF Nibble2" by (simp add: mk_legacy_char_def)
lemma legacy_char_243: "mk_legacy_char CHR 243 = LegacyChar NibbleF Nibble3" by (simp add: mk_legacy_char_def)
lemma legacy_char_244: "mk_legacy_char CHR 244 = LegacyChar NibbleF Nibble4" by (simp add: mk_legacy_char_def)
lemma legacy_char_245: "mk_legacy_char CHR 245 = LegacyChar NibbleF Nibble5" by (simp add: mk_legacy_char_def)
lemma legacy_char_246: "mk_legacy_char CHR 246 = LegacyChar NibbleF Nibble6" by (simp add: mk_legacy_char_def)
lemma legacy_char_247: "mk_legacy_char CHR 247 = LegacyChar NibbleF Nibble7" by (simp add: mk_legacy_char_def)
lemma legacy_char_248: "mk_legacy_char CHR 248 = LegacyChar NibbleF Nibble8" by (simp add: mk_legacy_char_def)
lemma legacy_char_249: "mk_legacy_char CHR 249 = LegacyChar NibbleF Nibble9" by (simp add: mk_legacy_char_def)
lemma legacy_char_250: "mk_legacy_char CHR 250 = LegacyChar NibbleF NibbleA" by (simp add: mk_legacy_char_def)
lemma legacy_char_251: "mk_legacy_char CHR 251 = LegacyChar NibbleF NibbleB" by (simp add: mk_legacy_char_def)
lemma legacy_char_252: "mk_legacy_char CHR 252 = LegacyChar NibbleF NibbleC" by (simp add: mk_legacy_char_def)
lemma legacy_char_253: "mk_legacy_char CHR 253 = LegacyChar NibbleF NibbleD" by (simp add: mk_legacy_char_def)
lemma legacy_char_254: "mk_legacy_char CHR 254 = LegacyChar NibbleF NibbleE" by (simp add: mk_legacy_char_def)
lemma legacy_char_255: "mk_legacy_char CHR 255 = LegacyChar NibbleF NibbleF" by (simp add: mk_legacy_char_def)

lemmas legacy_char_simps = legacy_char_000 legacy_char_001 legacy_char_002 legacy_char_003 legacy_char_004 legacy_char_005 legacy_char_006 legacy_char_007 legacy_char_008 legacy_char_009 legacy_char_010 legacy_char_011 legacy_char_012 legacy_char_013 legacy_char_014 legacy_char_015 legacy_char_016 legacy_char_017 legacy_char_018 legacy_char_019 legacy_char_020 legacy_char_021 legacy_char_022 legacy_char_023 legacy_char_024 legacy_char_025 legacy_char_026 legacy_char_027 legacy_char_028 legacy_char_029 legacy_char_030 legacy_char_031 legacy_char_032 legacy_char_033 legacy_char_034 legacy_char_035 legacy_char_036 legacy_char_037 legacy_char_038 legacy_char_039 legacy_char_040 legacy_char_041 legacy_char_042 legacy_char_043 legacy_char_044 legacy_char_045 legacy_char_046 legacy_char_047 legacy_char_048 legacy_char_049 legacy_char_050 legacy_char_051 legacy_char_052 legacy_char_053 legacy_char_054 legacy_char_055 legacy_char_056 legacy_char_057 legacy_char_058 legacy_char_059 legacy_char_060 legacy_char_061 legacy_char_062 legacy_char_063 legacy_char_064 legacy_char_065 legacy_char_066 legacy_char_067 legacy_char_068 legacy_char_069 legacy_char_070 legacy_char_071 legacy_char_072 legacy_char_073 legacy_char_074 legacy_char_075 legacy_char_076 legacy_char_077 legacy_char_078 legacy_char_079 legacy_char_080 legacy_char_081 legacy_char_082 legacy_char_083 legacy_char_084 legacy_char_085 legacy_char_086 legacy_char_087 legacy_char_088 legacy_char_089 legacy_char_090 legacy_char_091 legacy_char_092 legacy_char_093 legacy_char_094 legacy_char_095 legacy_char_096 legacy_char_097 legacy_char_098 legacy_char_099 legacy_char_100 legacy_char_101 legacy_char_102 legacy_char_103 legacy_char_104 legacy_char_105 legacy_char_106 legacy_char_107 legacy_char_108 legacy_char_109 legacy_char_110 legacy_char_111 legacy_char_112 legacy_char_113 legacy_char_114 legacy_char_115 legacy_char_116 legacy_char_117 legacy_char_118 legacy_char_119 legacy_char_120 legacy_char_121 legacy_char_122 legacy_char_123 legacy_char_124 legacy_char_125 legacy_char_126 legacy_char_127 legacy_char_128 legacy_char_129 legacy_char_130 legacy_char_131 legacy_char_132 legacy_char_133 legacy_char_134 legacy_char_135 legacy_char_136 legacy_char_137 legacy_char_138 legacy_char_139 legacy_char_140 legacy_char_141 legacy_char_142 legacy_char_143 legacy_char_144 legacy_char_145 legacy_char_146 legacy_char_147 legacy_char_148 legacy_char_149 legacy_char_150 legacy_char_151 legacy_char_152 legacy_char_153 legacy_char_154 legacy_char_155 legacy_char_156 legacy_char_157 legacy_char_158 legacy_char_159 legacy_char_160 legacy_char_161 legacy_char_162 legacy_char_163 legacy_char_164 legacy_char_165 legacy_char_166 legacy_char_167 legacy_char_168 legacy_char_169 legacy_char_170 legacy_char_171 legacy_char_172 legacy_char_173 legacy_char_174 legacy_char_175 legacy_char_176 legacy_char_177 legacy_char_178 legacy_char_179 legacy_char_180 legacy_char_181 legacy_char_182 legacy_char_183 legacy_char_184 legacy_char_185 legacy_char_186 legacy_char_187 legacy_char_188 legacy_char_189 legacy_char_190 legacy_char_191 legacy_char_192 legacy_char_193 legacy_char_194 legacy_char_195 legacy_char_196 legacy_char_197 legacy_char_198 legacy_char_199 legacy_char_200 legacy_char_201 legacy_char_202 legacy_char_203 legacy_char_204 legacy_char_205 legacy_char_206 legacy_char_207 legacy_char_208 legacy_char_209 legacy_char_210 legacy_char_211 legacy_char_212 legacy_char_213 legacy_char_214 legacy_char_215 legacy_char_216 legacy_char_217 legacy_char_218 legacy_char_219 legacy_char_220 legacy_char_221 legacy_char_222 legacy_char_223 legacy_char_224 legacy_char_225 legacy_char_226 legacy_char_227 legacy_char_228 legacy_char_229 legacy_char_230 legacy_char_231 legacy_char_232 legacy_char_233 legacy_char_234 legacy_char_235 legacy_char_236 legacy_char_237 legacy_char_238 legacy_char_239 legacy_char_240 legacy_char_241 legacy_char_242 legacy_char_243 legacy_char_244 legacy_char_245 legacy_char_246 legacy_char_247 legacy_char_248 legacy_char_249 legacy_char_250 legacy_char_251 legacy_char_252 legacy_char_253 legacy_char_254 legacy_char_255

lemma unmk_legacy_nibble:
  assumes "x < 16"
  shows "unmk_legacy_nibble (mk_legacy_nibble x) = x"
proof -
  consider "x=0" | "x=1" | "x=2" | "x=3" | "x=4" | "x=5" | "x=6" | "x=7" | "x=8" | "x=9" | "x=10" | "x=11" | "x=12" | "x=13" | "x=14" | "x=15"
    apply atomize_elim using `x<16` by arith
  thus ?thesis apply cases by simp_all
qed

lemma mk_legacy_nibble_inj:
  assumes "x < 16" and "y < 16"
  shows "mk_legacy_nibble x = mk_legacy_nibble y \<longleftrightarrow> x=y"
  apply rule
   apply (subst unmk_legacy_nibble[OF `x<16`, symmetric])
   apply (subst unmk_legacy_nibble[OF `y<16`, symmetric])
  by auto

lemma mk_legacy_char_inj: "x = y \<longleftrightarrow> mk_legacy_char x = mk_legacy_char y"
proof -
  define a b where "a = nat_of_char x" and "b = nat_of_char y"
  have a: "a<256" by (simp add: a_def)
  hence adiv16: "a div 16 < 16" by arith
  have amod16: "a mod 16 < 16" by arith
  have b: "b<256" by (simp add: b_def)
  hence bdiv16: "b div 16 < 16" by arith
  have bmod16: "b mod 16 < 16" by arith
  have "(a = b) =
    (LegacyChar (mk_legacy_nibble (a div 16)) (mk_legacy_nibble (a mod 16)) =
     LegacyChar (mk_legacy_nibble (b div 16)) (mk_legacy_nibble (b mod 16)))"
    apply simp
    apply (subst mk_legacy_nibble_inj[OF adiv16 bdiv16])
    apply (subst mk_legacy_nibble_inj[OF amod16 bmod16])
    apply rule
     apply simp
    apply (subst mult_div_mod_eq[where a=a and b=16, symmetric])
    apply (subst mult_div_mod_eq[where a=b and b=16, symmetric])
    by arith
  thus ?thesis
    unfolding mk_legacy_char_def nat_of_char_eq_iff[symmetric] a_def[symmetric] b_def[symmetric]
    by assumption
qed

lemma "CHR ''y'' \<noteq> CHR ''z''"
  using[[simp_trace_new]]
  by (simp only: List.list.inject mk_legacy_char_inj legacy_char.inject nibble.distinct legacy_char_simps HOL.simp_thms)

end


(*  Title:       Safe OCL
    Author:      Denis Nikiforov, March 2019
    Maintainer:  Denis Nikiforov <denis.nikif at gmail.com>
    License:     LGPL
*)
section \<open>Object Model\<close>
theory Object_Model
  imports Finite_Map_Ext "HOL-Library.Extended_Nat"
          "HOL-Library.Phantom_Type"
begin

text \<open>
  The section defines a generic object model.\<close>

(*** Type Synonyms **********************************************************)

subsection \<open>Type Synonyms\<close>

type_synonym attr = String.literal
type_synonym assoc = String.literal
type_synonym role = String.literal
type_synonym oper = String.literal
type_synonym param = String.literal
type_synonym elit = String.literal

type_synonym 'a enum_type = "('a, String.literal) phantom"

datatype param_dir = In | Out | InOut

type_synonym 'c assoc_end = "'c \<times> nat \<times> enat \<times> bool \<times> bool"
type_synonym 't param_spec = "param \<times> 't \<times> param_dir"
type_synonym ('t, 'e) oper_def = "oper \<times> 't param_spec list \<times> 't \<times> bool \<times> 'e option"
type_synonym ('t, 'e) oper_spec = "'t \<times> ('t, 'e) oper_def"

definition "assoc_end_class :: 'c assoc_end \<Rightarrow> 'c \<equiv> fst"
definition "assoc_end_min :: 'c assoc_end \<Rightarrow> nat \<equiv> fst \<circ> snd"
definition "assoc_end_max :: 'c assoc_end \<Rightarrow> enat \<equiv> fst \<circ> snd \<circ> snd"
definition "assoc_end_ordered :: 'c assoc_end \<Rightarrow> bool \<equiv> fst \<circ> snd \<circ> snd \<circ> snd"
definition "assoc_end_unique :: 'c assoc_end \<Rightarrow> bool \<equiv> snd \<circ> snd \<circ> snd \<circ> snd"

definition "oper_context :: ('t, 'e) oper_spec \<Rightarrow> 't \<equiv> fst"
definition "oper_name :: ('t, 'e) oper_spec \<Rightarrow> oper \<equiv> fst \<circ> snd"
definition "oper_params :: ('t, 'e) oper_spec \<Rightarrow> 't param_spec list \<equiv> fst \<circ> snd \<circ> snd"
definition "oper_result :: ('t, 'e) oper_spec \<Rightarrow> 't \<equiv> fst \<circ> snd \<circ> snd \<circ> snd"
definition "oper_static :: ('t, 'e) oper_spec \<Rightarrow> bool \<equiv> fst \<circ> snd \<circ> snd \<circ> snd \<circ> snd"
definition "oper_body :: ('t, 'e) oper_spec \<Rightarrow> 'e option \<equiv> snd \<circ> snd \<circ> snd \<circ> snd \<circ> snd"

definition "param_name ::'t param_spec \<Rightarrow> param \<equiv> fst"
definition "param_type ::'t param_spec \<Rightarrow> 't \<equiv> fst \<circ> snd"
definition "param_dir ::'t param_spec \<Rightarrow> param_dir \<equiv> snd \<circ> snd"

definition "oper_in_params op \<equiv>
  filter (\<lambda>p. param_dir p = In \<or> param_dir p = InOut) (oper_params op)"

definition "oper_out_params op \<equiv>
  filter (\<lambda>p. param_dir p = Out \<or> param_dir p = InOut) (oper_params op)"

subsection \<open>Attributes\<close>

inductive owned_attribute' where
  "\<C> |\<in>| fmdom attributes \<Longrightarrow>
   fmlookup attributes \<C> = Some attrs\<^sub>\<C> \<Longrightarrow>
   fmlookup attrs\<^sub>\<C> attr = Some \<tau> \<Longrightarrow>
   owned_attribute' attributes \<C> attr \<tau>"

inductive attribute_not_closest where
  "owned_attribute' attributes \<D>' attr \<tau>' \<Longrightarrow>
   \<C> \<le> \<D>' \<Longrightarrow>
   \<D>' < \<D> \<Longrightarrow>
   attribute_not_closest attributes \<C> attr \<D> \<tau>"

inductive closest_attribute where
  "owned_attribute' attributes \<D> attr \<tau> \<Longrightarrow>
   \<C> \<le> \<D> \<Longrightarrow>
   \<not> attribute_not_closest attributes \<C> attr \<D> \<tau> \<Longrightarrow>
   closest_attribute attributes \<C> attr \<D> \<tau>"

inductive closest_attribute_not_unique where
  "closest_attribute attributes \<C> attr \<D>' \<tau>' \<Longrightarrow>
   \<D> \<noteq> \<D>' \<or> \<tau> \<noteq> \<tau>' \<Longrightarrow>
   closest_attribute_not_unique attributes \<C> attr \<D> \<tau>"

inductive unique_closest_attribute where
  "closest_attribute attributes \<C> attr \<D> \<tau> \<Longrightarrow>
   \<not> closest_attribute_not_unique attributes \<C> attr \<D> \<tau> \<Longrightarrow>
   unique_closest_attribute attributes \<C> attr \<D> \<tau>"

subsection \<open>Association Ends\<close>

inductive role_refer_class where
  "role |\<in>| fmdom ends \<Longrightarrow>
   fmlookup ends role = Some end \<Longrightarrow>
   assoc_end_class end = \<C> \<Longrightarrow>
   role_refer_class ends \<C> role"

inductive association_ends' where
  "\<C> |\<in>| classes \<Longrightarrow>
   assoc |\<in>| fmdom associations \<Longrightarrow>
   fmlookup associations assoc = Some ends \<Longrightarrow>
   role_refer_class ends \<C> from \<Longrightarrow>
   role |\<in>| fmdom ends \<Longrightarrow>
   fmlookup ends role = Some end \<Longrightarrow>
   role \<noteq> from \<Longrightarrow>
   association_ends' classes associations \<C> from role end"

inductive association_ends_not_unique' where
  "association_ends' classes associations \<C> from role end\<^sub>1 \<Longrightarrow>
   association_ends' classes associations \<C> from role end\<^sub>2 \<Longrightarrow>
   end\<^sub>1 \<noteq> end\<^sub>2 \<Longrightarrow>
   association_ends_not_unique' classes associations"

inductive owned_association_end' where
  "association_ends' classes associations \<C> from role end \<Longrightarrow>
   owned_association_end' classes associations \<C> None role end"
| "association_ends' classes associations \<C> from role end \<Longrightarrow>
   owned_association_end' classes associations \<C> (Some from) role end"

inductive association_end_not_closest where
  "owned_association_end' classes associations \<D>' from role end' \<Longrightarrow>
   \<C> \<le> \<D>' \<Longrightarrow>
   \<D>' < \<D> \<Longrightarrow>
   association_end_not_closest classes associations \<C> from role \<D> end"

inductive closest_association_end where
  "owned_association_end' classes associations \<D> from role end \<Longrightarrow>
   \<C> \<le> \<D> \<Longrightarrow>
   \<not> association_end_not_closest classes associations \<C> from role \<D> end \<Longrightarrow>
   closest_association_end classes associations \<C> from role \<D> end"

inductive closest_association_end_not_unique where
  "closest_association_end classes associations \<C> from role \<D>' end' \<Longrightarrow>
   \<D> \<noteq> \<D>' \<or> end \<noteq> end' \<Longrightarrow>
   closest_association_end_not_unique classes associations \<C> from role \<D> end"

inductive unique_closest_association_end where
  "closest_association_end classes associations \<C> from role \<D> end \<Longrightarrow>
   \<not> closest_association_end_not_unique classes associations \<C> from role \<D> end \<Longrightarrow>
   unique_closest_association_end classes associations \<C> from role \<D> end"

subsection \<open>Association Classes\<close>

inductive referred_by_association_class'' where
  "fmlookup association_classes \<A> = Some assoc \<Longrightarrow>
   fmlookup associations assoc = Some ends \<Longrightarrow>
   role_refer_class ends \<C> from \<Longrightarrow>
   referred_by_association_class'' association_classes associations \<C> from \<A>"

inductive referred_by_association_class' where
  "referred_by_association_class'' association_classes associations \<C> from \<A> \<Longrightarrow>
   referred_by_association_class' association_classes associations \<C> None \<A>"
| "referred_by_association_class'' association_classes associations \<C> from \<A> \<Longrightarrow>
   referred_by_association_class' association_classes associations \<C> (Some from) \<A>"

inductive association_class_not_closest where
  "referred_by_association_class' association_classes associations \<D>' from \<A> \<Longrightarrow>
   \<C> \<le> \<D>' \<Longrightarrow>
   \<D>' < \<D> \<Longrightarrow>
   association_class_not_closest association_classes associations \<C> from \<A> \<D>"

inductive closest_association_class where
  "referred_by_association_class' association_classes associations \<D> from \<A> \<Longrightarrow>
   \<C> \<le> \<D> \<Longrightarrow>
   \<not> association_class_not_closest association_classes associations \<C> from \<A> \<D> \<Longrightarrow>
   closest_association_class association_classes associations \<C> from \<A> \<D>"

inductive closest_association_class_not_unique where
  "closest_association_class association_classes associations \<C> from \<A> \<D>' \<Longrightarrow>
   \<D> \<noteq> \<D>' \<Longrightarrow>
   closest_association_class_not_unique
        association_classes associations \<C> from \<A> \<D>"

inductive unique_closest_association_class where
  "closest_association_class association_classes associations \<C> from \<A> \<D> \<Longrightarrow>
   \<not> closest_association_class_not_unique
        association_classes associations \<C> from \<A> \<D> \<Longrightarrow>
   unique_closest_association_class association_classes associations \<C> from \<A> \<D>"

subsection \<open>Association Class Ends\<close>

inductive association_class_end' where
  "fmlookup association_classes \<A> = Some assoc \<Longrightarrow>
   fmlookup associations assoc = Some ends \<Longrightarrow>
   fmlookup ends role = Some end \<Longrightarrow>
   association_class_end' association_classes associations \<A> role end"

inductive association_class_end_not_unique where
  "association_class_end' association_classes associations \<A> role end' \<Longrightarrow>
   end \<noteq> end' \<Longrightarrow>
   association_class_end_not_unique association_classes associations \<A> role end"

inductive unique_association_class_end where
  "association_class_end' association_classes associations \<A> role end \<Longrightarrow>
   \<not> association_class_end_not_unique
        association_classes associations \<A> role end \<Longrightarrow>
   unique_association_class_end association_classes associations \<A> role end"

subsection \<open>Operations\<close>

inductive any_operation' where
  "op |\<in>| fset_of_list operations \<Longrightarrow>
   oper_name op = name \<Longrightarrow>
   \<tau> \<le> oper_context op \<Longrightarrow>
   list_all2 (\<lambda>\<sigma> param. \<sigma> \<le> param_type param) \<pi> (oper_in_params op) \<Longrightarrow>
   any_operation' operations \<tau> name \<pi> op"

inductive operation' where
  "any_operation' operations \<tau> name \<pi> op \<Longrightarrow>
   \<not> oper_static op \<Longrightarrow>
   operation' operations \<tau> name \<pi> op"

inductive operation_not_unique where
  "operation' operations \<tau> name \<pi> oper' \<Longrightarrow>
   oper \<noteq> oper' \<Longrightarrow>
   operation_not_unique operations \<tau> name \<pi> oper"

inductive unique_operation where
  "operation' operations \<tau> name \<pi> oper \<Longrightarrow>
   \<not> operation_not_unique operations \<tau> name \<pi> oper \<Longrightarrow>
   unique_operation operations \<tau> name \<pi> oper"

inductive operation_defined' where
  "unique_operation operations \<tau> name \<pi> oper \<Longrightarrow>
   operation_defined' operations \<tau> name \<pi>"

inductive static_operation' where
  "any_operation' operations \<tau> name \<pi> op \<Longrightarrow>
   oper_static op \<Longrightarrow>
   static_operation' operations \<tau> name \<pi> op"

inductive static_operation_not_unique where
  "static_operation' operations \<tau> name \<pi> oper' \<Longrightarrow>
   oper \<noteq> oper' \<Longrightarrow>
   static_operation_not_unique operations \<tau> name \<pi> oper"

inductive unique_static_operation where
  "static_operation' operations \<tau> name \<pi> oper \<Longrightarrow>
   \<not> static_operation_not_unique operations \<tau> name \<pi> oper \<Longrightarrow>
   unique_static_operation operations \<tau> name \<pi> oper"

inductive static_operation_defined' where
  "unique_static_operation operations \<tau> name \<pi> oper \<Longrightarrow>
   static_operation_defined' operations \<tau> name \<pi>"

subsection \<open>Literals\<close>

inductive has_literal' where
  "fmlookup literals e = Some lits \<Longrightarrow>
   lit |\<in>| lits \<Longrightarrow>
   has_literal' literals e lit"

(*** Definition *************************************************************)

subsection \<open>Definition\<close>

locale object_model =
  fixes classes :: "'a :: semilattice_sup fset"
    and attributes :: "'a \<rightharpoonup>\<^sub>f attr \<rightharpoonup>\<^sub>f 't :: order"
    and associations :: "assoc \<rightharpoonup>\<^sub>f role \<rightharpoonup>\<^sub>f 'a assoc_end"
    and association_classes :: "'a \<rightharpoonup>\<^sub>f assoc"
    and operations :: "('t, 'e) oper_spec list"
    and literals :: "'a enum_type \<rightharpoonup>\<^sub>f elit fset"
  assumes assoc_end_min_less_eq_max:
    "assoc |\<in>| fmdom associations \<Longrightarrow>
     fmlookup associations assoc = Some ends \<Longrightarrow>
     role |\<in>| fmdom ends  \<Longrightarrow>
     fmlookup ends role = Some end \<Longrightarrow>
     assoc_end_min end \<le> assoc_end_max end"
  assumes association_ends_unique:
    "association_ends' classes associations \<C> from role end\<^sub>1 \<Longrightarrow>
     association_ends' classes associations \<C> from role end\<^sub>2 \<Longrightarrow> end\<^sub>1 = end\<^sub>2"
begin

abbreviation "owned_attribute \<equiv>
  owned_attribute' attributes"

abbreviation "attribute \<equiv>
  unique_closest_attribute attributes"

abbreviation "association_ends \<equiv>
  association_ends' classes associations"

abbreviation "owned_association_end \<equiv>
  owned_association_end' classes associations"

abbreviation "association_end \<equiv>
  unique_closest_association_end classes associations"

abbreviation "referred_by_association_class \<equiv>
  unique_closest_association_class association_classes associations"

abbreviation "association_class_end \<equiv>
  unique_association_class_end association_classes associations"

abbreviation "operation \<equiv>
  unique_operation operations"

abbreviation "operation_defined \<equiv>
  operation_defined' operations"

abbreviation "static_operation \<equiv>
  unique_static_operation operations"

abbreviation "static_operation_defined \<equiv>
  static_operation_defined' operations"

abbreviation "has_literal \<equiv>
  has_literal' literals"

end

lemmas object_model_simps =
  assoc_end_class_def
  assoc_end_min_def
  assoc_end_max_def
  assoc_end_ordered_def
  assoc_end_unique_def
  oper_name_def
  oper_context_def
  oper_params_def
  oper_result_def
  oper_static_def
  oper_body_def
  oper_in_params_def
  oper_out_params_def
  has_literal'.simps

(*** Properties *************************************************************)

subsection \<open>Properties\<close>

lemma (in object_model) attribute_det:
  "attribute \<C> attr \<D>\<^sub>1 \<tau>\<^sub>1 \<Longrightarrow>
   attribute \<C> attr \<D>\<^sub>2 \<tau>\<^sub>2 \<Longrightarrow> \<D>\<^sub>1 = \<D>\<^sub>2 \<and> \<tau>\<^sub>1 = \<tau>\<^sub>2"
  by (meson closest_attribute_not_unique.intros unique_closest_attribute.cases)

lemma (in object_model) attribute_self_or_inherited:
  "attribute \<C> attr \<D> \<tau> \<Longrightarrow> \<C> \<le> \<D>"
  by (meson closest_attribute.cases unique_closest_attribute.cases)

lemma (in object_model) attribute_closest:
  "attribute \<C> attr \<D> \<tau> \<Longrightarrow>
   owned_attribute \<D>' attr \<tau> \<Longrightarrow>
   \<C> \<le> \<D>' \<Longrightarrow> \<not> \<D>' < \<D>"
  by (meson attribute_not_closest.intros closest_attribute.cases
      unique_closest_attribute.cases)

lemma (in object_model) association_end_det:
  "association_end \<C> from role \<D>\<^sub>1 end\<^sub>1 \<Longrightarrow>
   association_end \<C> from role \<D>\<^sub>2 end\<^sub>2 \<Longrightarrow> \<D>\<^sub>1 = \<D>\<^sub>2 \<and> end\<^sub>1 = end\<^sub>2"
  by (meson closest_association_end_not_unique.intros
      unique_closest_association_end.cases)

lemma (in object_model) association_end_self_or_inherited:
  "association_end \<C> from role \<D> end \<Longrightarrow> \<C> \<le> \<D>"
  by (meson closest_association_end.cases unique_closest_association_end.cases)

lemma (in object_model) association_end_closest:
  "association_end \<C> from role \<D> end \<Longrightarrow>
   owned_association_end \<D>' from role end \<Longrightarrow>
   \<C> \<le> \<D>' \<Longrightarrow> \<not> \<D>' < \<D>"
  by (meson association_end_not_closest.intros closest_association_end.cases
      unique_closest_association_end.cases)

lemma (in object_model) association_class_end_det:
  "association_class_end \<A> role end\<^sub>1 \<Longrightarrow>
   association_class_end \<A> role end\<^sub>2 \<Longrightarrow> end\<^sub>1 = end\<^sub>2"
  by (meson association_class_end_not_unique.intros unique_association_class_end.cases)

lemma (in object_model) operation_det:
  "operation \<tau> name \<pi> oper\<^sub>1 \<Longrightarrow>
   operation \<tau> name \<pi> oper\<^sub>2 \<Longrightarrow> oper\<^sub>1 = oper\<^sub>2"
  by (meson operation_not_unique.intros unique_operation.cases)

lemma (in object_model) static_operation_det:
  "static_operation \<tau> name \<pi> oper\<^sub>1 \<Longrightarrow>
   static_operation \<tau> name \<pi> oper\<^sub>2 \<Longrightarrow> oper\<^sub>1 = oper\<^sub>2"
  by (meson static_operation_not_unique.intros unique_static_operation.cases)

(*** Notation ***************************************************************)

subsection \<open>Notation\<close>

datatype ('a, 't, 'e) model_element_spec =
  EnumSpec "'a enum_type" "elit list"
| ClassSpec 'a "attr \<rightharpoonup>\<^sub>f 't"
| AssociationSpec assoc "role \<rightharpoonup>\<^sub>f 'a assoc_end"
| ContextSpec 't "('t, 'e) oper_def list"

datatype ('a, 't, 'e) model_spec =
  ModelSpec (model_spec_elements: "('a, 't, 'e) model_element_spec list")

primrec model_spec_classes where
  "model_spec_classes [] = []"
| "model_spec_classes (x # xs) = (case x
    of ClassSpec cls attrs \<Rightarrow> (cls, attrs) # (model_spec_classes xs)
     | _ \<Rightarrow> (model_spec_classes xs))"

primrec model_spec_assocs where
  "model_spec_assocs [] = []"
| "model_spec_assocs (x # xs) = (case x
    of AssociationSpec assoc ends \<Rightarrow> (assoc, ends) # (model_spec_assocs xs)
     | _ \<Rightarrow> (model_spec_assocs xs))"

primrec model_spec_contexts where
  "model_spec_contexts [] = []"
| "model_spec_contexts (x # xs) = (case x
    of ContextSpec ctx opers \<Rightarrow> (ctx, opers) # (model_spec_contexts xs)
     | _ \<Rightarrow> (model_spec_contexts xs))"

primrec model_spec_enums where
  "model_spec_enums [] = []"
| "model_spec_enums (x # xs) = (case x
    of EnumSpec enm lits \<Rightarrow> (enm, fset_of_list lits) # (model_spec_enums xs)
     | _ \<Rightarrow> (model_spec_enums xs))"

definition "model_spec_attributes m \<equiv>
  fmap_of_list (model_spec_classes (model_spec_elements m))"

definition "model_spec_assoc_ens m \<equiv>
  fmap_of_list (model_spec_assocs (model_spec_elements m))"

definition "model_spec_operations m \<equiv>
  concat (map (\<lambda>ctx. map (\<lambda>op. (fst ctx, op)) (snd ctx))
      (model_spec_contexts (model_spec_elements m)))"

definition "model_spec_enum_literals m \<equiv>
  fmap_of_list (model_spec_enums (model_spec_elements m))"

lemmas object_model_notation_simps =
  model_spec_elements_def
  model_spec_assocs_def
  model_spec_assoc_ens_def
  model_spec_enum_literals_def

nonterminal model_elements and model_element

nonterminal enum_def and enum_literal_defs and enum_literal_def

syntax
  "_enum_def" :: "'a \<Rightarrow> enum_literal_defs \<Rightarrow> model_element" ("enum _ {_}" [1000,0] 0)
  "_enum_literal_defs_single" :: "elit \<Rightarrow> enum_literal_defs" ("_")
  "_enum_literal_defs_cons" :: "elit \<Rightarrow> enum_literal_defs \<Rightarrow> enum_literal_defs" ("_, _")

translations
  "_enum_def name literals" \<rightharpoonup> "CONST EnumSpec name literals"
  "_enum_literal_defs_cons x (y # xs)" \<rightharpoonup> "x # y # xs"
  "_enum_literal_defs_single x" \<rightharpoonup> "[x]"

nonterminal class_defs and class_def
nonterminal attr_defs and attr_def

syntax
  "_class_def" :: "'a \<Rightarrow> attr_defs \<Rightarrow> model_element" ("class _ _" [1000,0] 0)
  "_class_def" :: "'a \<Rightarrow> model_element" ("class _" [1000] 0)
  "_attr_def" :: "'a \<Rightarrow> 'b \<Rightarrow> attr_def" ("_ : _" [1000,1000] 0)
  "_attr_defs_single" :: "attr_def \<Rightarrow> attr_defs" ("_")
  "_attr_defs_cons" :: "attr_def \<Rightarrow> attr_defs \<Rightarrow> attr_defs" ("_ _")

translations
  "_class_def cls attrs" \<rightharpoonup> "CONST ClassSpec cls (CONST fmap_of_list attrs)"
  "_class_def cls" \<rightharpoonup> "CONST ClassSpec cls (CONST fmap_of_list [])"
  "_attr_def x y" \<rightharpoonup> "(x, y)"
  "_attr_defs_single x" \<rightharpoonup> "[x]"
  "_attr_defs_cons x (y # xs)" \<rightharpoonup> "x # y # xs"

nonterminal assoc_defs and assoc_def
nonterminal assoc_end_defs and assoc_end_def
nonterminal assoc_end_mult

syntax
  "_assoc_def" :: "'a \<Rightarrow> assoc_end_defs \<Rightarrow> model_element"
      ("association _ _" [1000,100] 10)
  "_assoc_end_defs_single" :: "assoc_end_def \<Rightarrow> assoc_end_defs" ("_")
  "_assoc_end_defs_cons" :: "assoc_end_def \<Rightarrow> assoc_end_defs \<Rightarrow> assoc_end_defs"
      ("_ _")
  "_assoc_end_def" :: "'a \<Rightarrow> 'b \<Rightarrow> assoc_end_mult \<Rightarrow> assoc_end_def"
      ("_ : _ _" [100,100,100] 100)
  "_assoc_end_def_o" :: "'a \<Rightarrow> 'b \<Rightarrow> assoc_end_mult \<Rightarrow> assoc_end_def"
      ("_ : _ _ {ordered}" [100,100,100] 100)
  "_assoc_end_def_u" :: "'a \<Rightarrow> 'b \<Rightarrow> assoc_end_mult \<Rightarrow> assoc_end_def"
      ("_ : _ _ {unique}" [100,100,100] 100)
  "_assoc_end_def_ou" :: "'a \<Rightarrow> 'b \<Rightarrow> assoc_end_mult \<Rightarrow> assoc_end_def"
      ("_ : _ _ {ordered,unique}" [100,100,100] 100)

  "_assoc_end_mult_both" :: "nat \<Rightarrow> assoc_end_mult" ("[_]" [1000] 100)
  "_assoc_end_mult_lower" :: "nat \<Rightarrow> assoc_end_mult" ("[_..(*)]" [1000] 100)
  "_assoc_end_mult" :: "nat \<Rightarrow> nat \<Rightarrow> assoc_end_mult" ("[_.._]" [1000,1000] 100)

translations
  "_assoc_def assoc ends" \<rightharpoonup>
      "CONST AssociationSpec assoc (CONST fmap_of_list ends)"
  "_assoc_end_defs_single x" \<rightharpoonup> "[x]"
  "_assoc_end_defs_cons x (y # xs)" \<rightharpoonup> "x # y # xs"
  "_assoc_end_def name cls (CONST Pair lower upper)" \<rightharpoonup>
      "(name, cls, lower, upper, CONST False, CONST False)"
  "_assoc_end_def_o name cls (CONST Pair lower upper)" \<rightharpoonup>
      "(name, cls, lower, upper, CONST True, CONST False)"
  "_assoc_end_def_u name cls (CONST Pair lower upper)" \<rightharpoonup>
      "(name, cls, lower, upper, CONST False, CONST True)"
  "_assoc_end_def_ou name cls (CONST Pair lower upper)" \<rightharpoonup>
      "(name, cls, lower, upper, CONST True, CONST True)"

  "_assoc_end_mult_both x" \<rightharpoonup> "CONST Pair (x :: nat) (x :: enat)"
  "_assoc_end_mult_lower x" \<rightharpoonup> "CONST Pair (x :: nat) (\<infinity> :: enat)"
  "_assoc_end_mult x y" \<rightharpoonup> "CONST Pair (x :: nat) (y :: enat)"

nonterminal context_defs and context_def
nonterminal oper_defs and oper_def_const and oper_signature
nonterminal oper_params and oper_param

syntax
  "_oper_param" :: "'a \<Rightarrow> 'a \<Rightarrow> oper_param" ("_ : _")
  "_oper_param_in" :: "'a \<Rightarrow> 'a \<Rightarrow> oper_param" ("in _ : _")
  "_oper_param_out" :: "'a \<Rightarrow> 'a \<Rightarrow> oper_param" ("out _ : _")
  "_oper_param_inout" :: "'a \<Rightarrow> 'a \<Rightarrow> oper_param" ("inout _ : _")
  "_oper_params_nil" :: "oper_params" ("")
  "_oper_params_single" :: "oper_param \<Rightarrow> oper_params" ("_")
  "_oper_params_cons" :: "oper_param \<Rightarrow> oper_params \<Rightarrow> oper_params" ("_, _")

translations
  "_oper_param param ty" \<rightharpoonup> "(param, ty, CONST In)"
  "_oper_param_in param ty" \<rightharpoonup> "(param, ty, CONST In)"
  "_oper_param_out param ty" \<rightharpoonup> "(param, ty, CONST Out)"
  "_oper_param_inout param ty" \<rightharpoonup> "(param, ty, CONST InOut)"
  "_oper_params_nil" \<rightharpoonup> "[]"
  "_oper_params_single x" \<rightharpoonup> "[x]"
  "_oper_params_cons x xs" \<rightharpoonup> "x # xs"

syntax
  "_context_def" :: "'a \<Rightarrow> oper_defs \<Rightarrow> model_element"
      ("context _ _" [1000,100] 10)
  "_oper_def" :: "oper_signature \<Rightarrow> 'a \<Rightarrow> oper_def_const"
      ("def : _ = _" [100,100] 100)
  "_oper_def_no_body" :: "oper_signature \<Rightarrow> oper_def_const"
      ("def : _" [100] 100)
  "_oper_def_static" :: "oper_signature \<Rightarrow> 'a \<Rightarrow> oper_def_const"
      ("static def : _ = _" [100,100] 100)
  "_oper_def_static_no_body" :: "oper_signature \<Rightarrow> oper_def_const"
      ("static def : _" [100] 100)
  "_oper_defs_nil" :: "oper_defs" ("")
  "_oper_defs_cons" :: "oper_def_const \<Rightarrow> oper_defs \<Rightarrow> oper_defs" ("_ _")
  "_oper_signature" :: "'a \<Rightarrow> oper_params \<Rightarrow> 'b \<Rightarrow> oper_signature"
      ("_'(_') : _" [1000,100,100] 100)
  "_oper_signature_no_params" :: "'a \<Rightarrow> 'b \<Rightarrow> oper_signature"
      ("_'(') : _" [1000,100] 100)

(*definition "mk_oper_spec op st body \<equiv> (fst op, fst (snd op), snd (snd op), st, body)"*)

datatype ('a, 'b, 'c) Triple = Triple 'a 'b 'c

translations
  "_context_def ctx ops" \<rightharpoonup> "CONST ContextSpec ctx ops"
  "_oper_defs_nil" \<rightharpoonup> "[]"
  "_oper_defs_cons x xs" \<rightharpoonup> "x # xs"

  "_oper_def (CONST Triple op params ty) body" \<rightharpoonup>
      "(op, params, ty, CONST False, CONST Some body)"
  "_oper_def_no_body (CONST Triple op params ty)" \<rightharpoonup>
      "(op, params, ty, CONST False, CONST None)"
  "_oper_def_static (CONST Triple op params ty) body" \<rightharpoonup>
      "(op, params, ty, CONST True, CONST Some body)"
  "_oper_def_static_no_body (CONST Triple op params ty)" \<rightharpoonup>
      "(op, params, ty, CONST True, CONST None)"

  "_oper_signature op params ty" \<rightharpoonup> "CONST Triple op params ty"
  "_oper_signature_no_params op ty" \<rightharpoonup> "CONST Triple op [] ty"
(*
  "_oper_def sign body" \<rightharpoonup>
      "CONST mk_oper_spec sign CONST False (CONST Some body)"
  "_oper_def_no_body sign" \<rightharpoonup>
      "CONST mk_oper_spec sign CONST False CONST None"
  "_oper_def_static sign body" \<rightharpoonup>
      "CONST mk_oper_spec sign CONST True (CONST Some body)"
  "_oper_def_static_no_body sign" \<rightharpoonup>
      "CONST mk_oper_spec sign CONST True (CONST None)"
  "_oper_signature op params ty" \<rightharpoonup> "(op, params, ty)"
  "_oper_signature_no_params op ty" \<rightharpoonup> "(op, [], ty)"
*)

syntax
  "_model" :: "model_elements \<Rightarrow> ('a, 't, 'e) model_spec" ("_" 10)
  "_model_element_single" :: "model_element \<Rightarrow> model_elements" (" _")
  "_model_element_cons" ::
      "model_element \<Rightarrow> model_elements \<Rightarrow> model_elements" ("_ _")

translations
  "_model xs" \<rightharpoonup> "CONST ModelSpec xs"
  "_model_element_single x" \<rightharpoonup> "[x]"
  "_model_element_cons x (y # xs)" \<rightharpoonup> "x # y # xs"

term "
association qwea
z : x [1]"

term "
association qwea
z : x [1..2]
z : x [1..2]

context q
  def: STR ''q''(qq : zz) : ff = ee
  static def : zzz() : qq"

term "
association qwea
z : x [1 .. 2]
z : x [1] {ordered}
z : x [1]
z : x [1 .. *]"

(*** Code Setup *************************************************************)

subsection \<open>Code Setup\<close>

lemma fmember_code_predI [code_pred_intro]:
  "x |\<in>| xs" if "Predicate_Compile.contains (fset xs) x"
  using that by (simp add: Predicate_Compile.contains_def fmember.rep_eq)

code_pred fmember
  by (simp add: Predicate_Compile.contains_def fmember.rep_eq)

code_pred unique_closest_attribute .

code_pred (modes:
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> o \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> o \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> o \<Rightarrow> o \<Rightarrow> bool) association_ends' .

code_pred association_ends_not_unique' .

code_pred (modes:
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> o \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> o \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> o \<Rightarrow> o \<Rightarrow> bool) owned_association_end' .

code_pred (modes:
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> o \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> o \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> o \<Rightarrow> o \<Rightarrow> bool) closest_association_end .

code_pred (modes:
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool ) closest_association_end_not_unique .

code_pred (modes:
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> bool) unique_closest_association_end .

code_pred unique_closest_association_class .

code_pred association_class_end' .

code_pred association_class_end_not_unique .

code_pred unique_association_class_end .

code_pred (modes:
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool) any_operation' .

code_pred (modes:
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool) operation' .

code_pred (modes:
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool) operation_not_unique .

code_pred (modes:
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool) unique_operation .

code_pred operation_defined' .

code_pred (modes:
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool) static_operation' .

code_pred (modes:
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool) static_operation_not_unique .

code_pred (modes:
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool,
    i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool) unique_static_operation .

code_pred static_operation_defined' .

code_pred has_literal' .

end


(*  Title:      HOL/MicroJava/BV/Correct.thy
    Author:     Cornelia Pusch, Gerwin Klein
    Copyright   1999 Technische Universitaet Muenchen
*)

section {* BV Type Safety Invariant *}

theory Correct
imports BVSpec "../JVM/JVMExec"
begin

definition approx_val :: "[jvm_prog,aheap,val,ty err] \<Rightarrow> bool" where
  "approx_val G h v any == case any of Err \<Rightarrow> True | OK T \<Rightarrow> G,h\<turnstile>v::\<preceq>T"

definition approx_loc :: "[jvm_prog,aheap,val list,locvars_type] \<Rightarrow> bool" where
  "approx_loc G hp loc LT == list_all2 (approx_val G hp) loc LT"

definition approx_stk :: "[jvm_prog,aheap,opstack,opstack_type] \<Rightarrow> bool" where
  "approx_stk G hp stk ST == approx_loc G hp stk (map OK ST)"

definition correct_frame  :: "[jvm_prog,aheap,state_type,nat,bytecode] \<Rightarrow> frame \<Rightarrow> bool" where
  "correct_frame G hp == \<lambda>(ST,LT) maxl ins (stk,loc,C,sig,pc).
                         approx_stk G hp stk ST  \<and> approx_loc G hp loc LT \<and>
                         pc < length ins \<and> length loc=length(snd sig)+maxl+1"

primrec correct_frames  :: "[jvm_prog,aheap,prog_type,ty,sig,frame list] \<Rightarrow> bool" where
  "correct_frames G hp phi rT0 sig0 [] = True"
| "correct_frames G hp phi rT0 sig0 (f#frs) =
    (let (stk,loc,C,sig,pc) = f in
    (\<exists>ST LT rT maxs maxl ins et.
      phi C sig ! pc = Some (ST,LT) \<and> is_class G C \<and>
      method (G,C) sig = Some(C,rT,(maxs,maxl,ins,et)) \<and>
    (\<exists>C' mn pTs. ins!pc = (Invoke C' mn pTs) \<and>
           (mn,pTs) = sig0 \<and>
           (\<exists>apTs D ST' LT'.
           (phi C sig)!pc = Some ((rev apTs) @ (Class D) # ST', LT') \<and>
           length apTs = length pTs \<and>
           (\<exists>D' rT' maxs' maxl' ins' et'.
             method (G,D) sig0 = Some(D',rT',(maxs',maxl',ins',et')) \<and>
             G \<turnstile> rT0 \<preceq> rT') \<and>
     correct_frame G hp (ST, LT) maxl ins f \<and>
     correct_frames G hp phi rT sig frs))))"

definition correct_state :: "[jvm_prog,prog_type,jvm_state] \<Rightarrow> bool"
                  ("_,_ |-JVM _ [ok]"  [51,51] 50) where
"correct_state G phi == \<lambda>(xp,hp,frs).
   case xp of
     None \<Rightarrow> (case frs of
             [] \<Rightarrow> True
             | (f#fs) \<Rightarrow> G\<turnstile>h hp\<surd> \<and> preallocated hp \<and>
      (let (stk,loc,C,sig,pc) = f
             in
                         \<exists>rT maxs maxl ins et s.
                         is_class G C \<and>
                         method (G,C) sig = Some(C,rT,(maxs,maxl,ins,et)) \<and>
                         phi C sig ! pc = Some s \<and>
       correct_frame G hp s maxl ins f \<and>
             correct_frames G hp phi rT sig fs))
   | Some x \<Rightarrow> frs = []"

notation (xsymbols)
 correct_state  ("_,_ \<turnstile>JVM _ \<surd>"  [51,51] 50)

lemma sup_ty_opt_OK:
  "(G \<turnstile> X <=o (OK T')) = (\<exists>T. X = OK T \<and> G \<turnstile> T \<preceq> T')"
  by (cases X) auto

subsection {* approx-val *}

lemma approx_val_Err [simp,intro!]:
  "approx_val G hp x Err"
  by (simp add: approx_val_def)

lemma approx_val_OK [iff]:
  "approx_val G hp x (OK T) = (G,hp \<turnstile> x ::\<preceq> T)"
  by (simp add: approx_val_def)

lemma approx_val_Null [simp,intro!]:
  "approx_val G hp Null (OK (RefT x))"
  by (auto simp add: approx_val_def)

lemma approx_val_sup_heap:
  "\<lbrakk> approx_val G hp v T; hp \<le>| hp' \<rbrakk> \<Longrightarrow> approx_val G hp' v T"
  by (cases T) (blast intro: conf_hext)+

lemma approx_val_heap_update:
  "\<lbrakk> hp a = Some obj'; G,hp\<turnstile> v::\<preceq>T; obj_ty obj = obj_ty obj'\<rbrakk>
  \<Longrightarrow> G,hp(a\<mapsto>obj)\<turnstile> v::\<preceq>T"
  by (cases v) (auto simp add: obj_ty_def conf_def)

lemma approx_val_widen:
  "\<lbrakk> approx_val G hp v T; G \<turnstile> T <=o T'; wf_prog wt G \<rbrakk>
  \<Longrightarrow> approx_val G hp v T'"
  by (cases T') (auto simp add: sup_ty_opt_OK intro: conf_widen)

subsection {* approx-loc *}

lemma approx_loc_Nil [simp,intro!]:
  "approx_loc G hp [] []"
  by (simp add: approx_loc_def)

lemma approx_loc_Cons [iff]:
  "approx_loc G hp (l#ls) (L#LT) =
  (approx_val G hp l L \<and> approx_loc G hp ls LT)"
by (simp add: approx_loc_def)

lemma approx_loc_nth:
  "\<lbrakk> approx_loc G hp loc LT; n < length LT \<rbrakk>
  \<Longrightarrow> approx_val G hp (loc!n) (LT!n)"
  by (simp add: approx_loc_def list_all2_conv_all_nth)

lemma approx_loc_imp_approx_val_sup:
  "\<lbrakk>approx_loc G hp loc LT; n < length LT; LT ! n = OK T; G \<turnstile> T \<preceq> T'; wf_prog wt G\<rbrakk>
  \<Longrightarrow> G,hp \<turnstile> (loc!n) ::\<preceq> T'"
  apply (drule approx_loc_nth, assumption)
  apply simp
  apply (erule conf_widen, assumption+)
  done

lemma approx_loc_conv_all_nth:
  "approx_loc G hp loc LT =
  (length loc = length LT \<and> (\<forall>n < length loc. approx_val G hp (loc!n) (LT!n)))"
  by (simp add: approx_loc_def list_all2_conv_all_nth)

lemma approx_loc_sup_heap:
  "\<lbrakk> approx_loc G hp loc LT; hp \<le>| hp' \<rbrakk>
  \<Longrightarrow> approx_loc G hp' loc LT"
  apply (clarsimp simp add: approx_loc_conv_all_nth)
  apply (blast intro: approx_val_sup_heap)
  done

lemma approx_loc_widen:
  "\<lbrakk> approx_loc G hp loc LT; G \<turnstile> LT <=l LT'; wf_prog wt G \<rbrakk>
  \<Longrightarrow> approx_loc G hp loc LT'"
apply (unfold Listn.le_def lesub_def sup_loc_def)
apply (simp (no_asm_use) only: list_all2_conv_all_nth approx_loc_conv_all_nth)
apply (simp (no_asm_simp))
apply clarify
apply (erule allE, erule impE)
 apply simp
apply (erule approx_val_widen)
 apply simp
apply assumption
done

lemma loc_widen_Err [dest]:
  "\<And>XT. G \<turnstile> replicate n Err <=l XT \<Longrightarrow> XT = replicate n Err"
  by (induct n) auto

lemma approx_loc_Err [iff]:
  "approx_loc G hp (replicate n v) (replicate n Err)"
  by (induct n) auto

lemma approx_loc_subst:
  "\<lbrakk> approx_loc G hp loc LT; approx_val G hp x X \<rbrakk>
  \<Longrightarrow> approx_loc G hp (loc[idx:=x]) (LT[idx:=X])"
apply (unfold approx_loc_def list_all2_iff)
apply (auto dest: subsetD [OF set_update_subset_insert] simp add: zip_update)
done

lemma approx_loc_append:
  "length l1=length L1 \<Longrightarrow>
  approx_loc G hp (l1@l2) (L1@L2) =
  (approx_loc G hp l1 L1 \<and> approx_loc G hp l2 L2)"
  apply (unfold approx_loc_def list_all2_iff)
  apply (simp cong: conj_cong)
  apply blast
  done

subsection {* approx-stk *}

lemma approx_stk_rev_lem:
  "approx_stk G hp (rev s) (rev t) = approx_stk G hp s t"
  apply (unfold approx_stk_def approx_loc_def)
  apply (simp add: rev_map [THEN sym])
  done

lemma approx_stk_rev:
  "approx_stk G hp (rev s) t = approx_stk G hp s (rev t)"
  by (auto intro: subst [OF approx_stk_rev_lem])

lemma approx_stk_sup_heap:
  "\<lbrakk> approx_stk G hp stk ST; hp \<le>| hp' \<rbrakk> \<Longrightarrow> approx_stk G hp' stk ST"
  by (auto intro: approx_loc_sup_heap simp add: approx_stk_def)

lemma approx_stk_widen:
  "\<lbrakk> approx_stk G hp stk ST; G \<turnstile> map OK ST <=l map OK ST'; wf_prog wt G \<rbrakk>
  \<Longrightarrow> approx_stk G hp stk ST'"
  by (auto elim: approx_loc_widen simp add: approx_stk_def)

lemma approx_stk_Nil [iff]:
  "approx_stk G hp [] []"
  by (simp add: approx_stk_def)

lemma approx_stk_Cons [iff]:
  "approx_stk G hp (x#stk) (S#ST) =
  (approx_val G hp x (OK S) \<and> approx_stk G hp stk ST)"
  by (simp add: approx_stk_def)

lemma approx_stk_Cons_

lemma approx_stk_append:
  "approx_stk G hp stk (S@S') \<Longrightarrow>
  (\<exists>s stk'. stk = s@stk' \<and> length s = length S \<and> length stk' = length S' \<and>
            approx_stk G hp s S \<and> approx_stk G hp stk' S')"
  by (simp add: list_all2_append2 approx_stk_def approx_loc_def)

lemma approx_stk_all_widen:
  "\<lbrakk> approx_stk G hp stk ST; \<forall>(x, y) \<in> set (zip ST ST'). G \<turnstile> x \<preceq> y; length ST = length ST'; wf_prog wt G \<rbrakk>
  \<Longrightarrow> approx_stk G hp stk ST'"
apply (unfold approx_stk_def)
apply (clarsimp simp add: approx_loc_conv_all_nth all_set_conv_all_nth)
apply (erule allE, erule impE, assumption)
apply (erule allE, erule impE, assumption)
apply (erule conf_widen, assumption+)
done

subsection {* oconf *}

lemma oconf_field_update:
  "\<lbrakk>map_of (fields (G, oT)) FD = Some T; G,hp\<turnstile>v::\<preceq>T; G,hp\<turnstile>(oT,fs)\<surd> \<rbrakk>
  \<Longrightarrow> G,hp\<turnstile>(oT, fs(FD\<mapsto>v))\<surd>"
  by (simp add: oconf_def lconf_def)

lemma oconf_newref:
  "\<lbrakk>hp oref = None; G,hp \<turnstile> obj \<surd>; G,hp \<turnstile> obj' \<surd>\<rbrakk> \<Longrightarrow> G,hp(oref\<mapsto>obj') \<turnstile> obj \<surd>"
  apply (unfold oconf_def lconf_def)
  apply simp
  apply (blast intro: conf_hext hext_new)
  done

lemma oconf_heap_update:
  "\<lbrakk> hp a = Some obj'; obj_ty obj' = obj_ty obj''; G,hp\<turnstile>obj\<surd> \<rbrakk>
  \<Longrightarrow> G,hp(a\<mapsto>obj'')\<turnstile>obj\<surd>"
  apply (unfold oconf_def lconf_def)
  apply (fastforce intro: approx_val_heap_update)
  done

subsection {* hconf *}

lemma hconf_newref:
  "\<lbrakk> hp oref = None; G\<turnstile>h hp\<surd>; G,hp\<turnstile>obj\<surd> \<rbrakk> \<Longrightarrow> G\<turnstile>h hp(oref\<mapsto>obj)\<surd>"
  apply (simp add: hconf_def)
  apply (fast intro: oconf_newref)
  done

lemma hconf_field_update:
  "\<lbrakk> map_of (fields (G, oT)) X = Some T; hp a = Some(oT,fs);
     G,hp\<turnstile>v::\<preceq>T; G\<turnstile>h hp\<surd> \<rbrakk>
  \<Longrightarrow> G\<turnstile>h hp(a \<mapsto> (oT, fs(X\<mapsto>v)))\<surd>"
  apply (simp add: hconf_def)
  apply (fastforce intro: oconf_heap_update oconf_field_update
                  simp add: obj_ty_def)
  done

subsection {* preallocated *}

lemma preallocated_field_update:
  "\<lbrakk> map_of (fields (G, oT)) X = Some T; hp a = Some(oT,fs);
     G\<turnstile>h hp\<surd>; preallocated hp \<rbrakk>
  \<Longrightarrow> preallocated (hp(a \<mapsto> (oT, fs(X\<mapsto>v))))"
  apply (unfold preallocated_def)
  apply (rule allI)
  apply (erule_tac x=x in allE)
  apply simp
  apply (rule ccontr)
  apply (unfold hconf_def)
  apply (erule allE, erule allE, erule impE, assumption)
  apply (unfold oconf_def lconf_def)
  apply (simp del: split_paired_All)
  done

lemma
  assumes none: "hp oref = None" and alloc: "preallocated hp"
  shows preallocated_newref: "preallocated (hp(oref\<mapsto>obj))"
proof (cases oref)
  case (XcptRef x)
  with none alloc have False by (auto elim: preallocatedE [of _ x])
  thus ?thesis ..
next
  case (Loc l)
  with alloc show ?thesis by (simp add: preallocated_def)
qed

subsection {* correct-frames *}

lemmas [simp del] = fun_upd_apply

lemma correct_frames_field_update [rule_format]:
  "\<forall>rT C sig.
  correct_frames G hp phi rT sig frs \<longrightarrow>
  hp a = Some (C,fs) \<longrightarrow>
  map_of (fields (G, C)) fl = Some fd \<longrightarrow>
  G,hp\<turnstile>v::\<preceq>fd
  \<longrightarrow> correct_frames G (hp(a \<mapsto> (C, fs(fl\<mapsto>v)))) phi rT sig frs"
apply (induct frs)
 apply simp
apply clarify
apply (simp (no_asm_use))
apply clarify
apply (unfold correct_frame_def)
apply (simp (no_asm_use))
apply clarify
apply (intro exI conjI)
    apply assumption+
   apply (erule approx_stk_sup_heap)
   apply (erule hext_upd_obj)
  apply (erule approx_loc_sup_heap)
  apply (erule hext_upd_obj)
 apply assumption+
apply blast
done

lemma correct_frames_newref [rule_format]:
  "\<forall>rT C sig.
  hp x = None \<longrightarrow>
  correct_frames G hp phi rT sig frs \<longrightarrow>
  correct_frames G (hp(x \<mapsto> obj)) phi rT sig frs"
apply (induct frs)
 apply simp
apply clarify
apply (simp (no_asm_use))
apply clarify
apply (unfold correct_frame_def)
apply (simp (no_asm_use))
apply clarify
apply (intro exI conjI)
    apply assumption+
   apply (erule approx_stk_sup_heap)
   apply (erule hext_new)
  apply (erule approx_loc_sup_heap)
  apply (erule hext_new)
 apply assumption+
apply blast
done

end


(*
 * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
 *
 * SPDX-License-Identifier: BSD-2-Clause
 *)

section "Words of Length 8"

theory Word_8
imports
  More_Word
  Enumeration_Word
  Even_More_List
  Signed_Words
  Word_Lemmas
begin

context
  includes bit_operations_syntax
begin

lemma len8: "len_of (x :: 8 itself) = 8" by simp

lemma word8_and_max_simp:
  \<open>x AND 0xFF = x\<close> for x :: \<open>8 word\<close>
  using word_and_full_mask_simp [of x]
  by (simp add: numeral_eq_Suc mask_Suc_exp)

lemma enum_word8_eq:
  \<open>enum = [0 :: 8 word, 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]\<close> (is \<open>?lhs = ?rhs\<close>)
proof -
  have \<open>map unat ?lhs = [0..<256]\<close>
    by (simp add: enum_word_def comp_def take_bit_nat_eq_self map_idem_upt_eq unsigned_of_nat)
  also have \<open>\<dots> = map unat ?rhs\<close>
    by (simp add: upt_zero_numeral_unfold)
  finally show ?thesis
    using unat_inj by (rule map_injective)
qed

lemma set_enum_word8_def:
  "(set enum :: 8 word set) = {0, 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}"
  by (simp add: enum_word8_eq)

lemma set_strip_insert: "\<lbrakk> x \<in> insert a S; x \<noteq> a \<rbrakk> \<Longrightarrow> x \<in> S"
  by simp

lemma word8_exhaust:
  fixes x :: \<open>8 word\<close>
  shows "\<lbrakk>x \<noteq> 0; x \<noteq> 1; x \<noteq> 2; x \<noteq> 3; x \<noteq> 4; x \<noteq> 5; x \<noteq> 6; x \<noteq> 7; x \<noteq> 8; x \<noteq> 9; x \<noteq> 10; x \<noteq> 11; x \<noteq>
          12; x \<noteq> 13; x \<noteq> 14; x \<noteq> 15; x \<noteq> 16; x \<noteq> 17; x \<noteq> 18; x \<noteq> 19; x \<noteq> 20; x \<noteq> 21; x \<noteq> 22; x \<noteq>
          23; x \<noteq> 24; x \<noteq> 25; x \<noteq> 26; x \<noteq> 27; x \<noteq> 28; x \<noteq> 29; x \<noteq> 30; x \<noteq> 31; x \<noteq> 32; x \<noteq> 33; x \<noteq>
          34; x \<noteq> 35; x \<noteq> 36; x \<noteq> 37; x \<noteq> 38; x \<noteq> 39; x \<noteq> 40; x \<noteq> 41; x \<noteq> 42; x \<noteq> 43; x \<noteq> 44; x \<noteq>
          45; x \<noteq> 46; x \<noteq> 47; x \<noteq> 48; x \<noteq> 49; x \<noteq> 50; x \<noteq> 51; x \<noteq> 52; x \<noteq> 53; x \<noteq> 54; x \<noteq> 55; x \<noteq>
          56; x \<noteq> 57; x \<noteq> 58; x \<noteq> 59; x \<noteq> 60; x \<noteq> 61; x \<noteq> 62; x \<noteq> 63; x \<noteq> 64; x \<noteq> 65; x \<noteq> 66; x \<noteq>
          67; x \<noteq> 68; x \<noteq> 69; x \<noteq> 70; x \<noteq> 71; x \<noteq> 72; x \<noteq> 73; x \<noteq> 74; x \<noteq> 75; x \<noteq> 76; x \<noteq> 77; x \<noteq>
          78; x \<noteq> 79; x \<noteq> 80; x \<noteq> 81; x \<noteq> 82; x \<noteq> 83; x \<noteq> 84; x \<noteq> 85; x \<noteq> 86; x \<noteq> 87; x \<noteq> 88; x \<noteq>
          89; x \<noteq> 90; x \<noteq> 91; x \<noteq> 92; x \<noteq> 93; x \<noteq> 94; x \<noteq> 95; x \<noteq> 96; x \<noteq> 97; x \<noteq> 98; x \<noteq> 99; x \<noteq>
          100; x \<noteq> 101; x \<noteq> 102; x \<noteq> 103; x \<noteq> 104; x \<noteq> 105; x \<noteq> 106; x \<noteq> 107; x \<noteq> 108; x \<noteq> 109; x \<noteq>
          110; x \<noteq> 111; x \<noteq> 112; x \<noteq> 113; x \<noteq> 114; x \<noteq> 115; x \<noteq> 116; x \<noteq> 117; x \<noteq> 118; x \<noteq> 119; x \<noteq>
          120; x \<noteq> 121; x \<noteq> 122; x \<noteq> 123; x \<noteq> 124; x \<noteq> 125; x \<noteq> 126; x \<noteq> 127; x \<noteq> 128; x \<noteq> 129; x \<noteq>
          130; x \<noteq> 131; x \<noteq> 132; x \<noteq> 133; x \<noteq> 134; x \<noteq> 135; x \<noteq> 136; x \<noteq> 137; x \<noteq> 138; x \<noteq> 139; x \<noteq>
          140; x \<noteq> 141; x \<noteq> 142; x \<noteq> 143; x \<noteq> 144; x \<noteq> 145; x \<noteq> 146; x \<noteq> 147; x \<noteq> 148; x \<noteq> 149; x \<noteq>
          150; x \<noteq> 151; x \<noteq> 152; x \<noteq> 153; x \<noteq> 154; x \<noteq> 155; x \<noteq> 156; x \<noteq> 157; x \<noteq> 158; x \<noteq> 159; x \<noteq>
          160; x \<noteq> 161; x \<noteq> 162; x \<noteq> 163; x \<noteq> 164; x \<noteq> 165; x \<noteq> 166; x \<noteq> 167; x \<noteq> 168; x \<noteq> 169; x \<noteq>
          170; x \<noteq> 171; x \<noteq> 172; x \<noteq> 173; x \<noteq> 174; x \<noteq> 175; x \<noteq> 176; x \<noteq> 177; x \<noteq> 178; x \<noteq> 179; x \<noteq>
          180; x \<noteq> 181; x \<noteq> 182; x \<noteq> 183; x \<noteq> 184; x \<noteq> 185; x \<noteq> 186; x \<noteq> 187; x \<noteq> 188; x \<noteq> 189; x \<noteq>
          190; x \<noteq> 191; x \<noteq> 192; x \<noteq> 193; x \<noteq> 194; x \<noteq> 195; x \<noteq> 196; x \<noteq> 197; x \<noteq> 198; x \<noteq> 199; x \<noteq>
          200; x \<noteq> 201; x \<noteq> 202; x \<noteq> 203; x \<noteq> 204; x \<noteq> 205; x \<noteq> 206; x \<noteq> 207; x \<noteq> 208; x \<noteq> 209; x \<noteq>
          210; x \<noteq> 211; x \<noteq> 212; x \<noteq> 213; x \<noteq> 214; x \<noteq> 215; x \<noteq> 216; x \<noteq> 217; x \<noteq> 218; x \<noteq> 219; x \<noteq>
          220; x \<noteq> 221; x \<noteq> 222; x \<noteq> 223; x \<noteq> 224; x \<noteq> 225; x \<noteq> 226; x \<noteq> 227; x \<noteq> 228; x \<noteq> 229; x \<noteq>
          230; x \<noteq> 231; x \<noteq> 232; x \<noteq> 233; x \<noteq> 234; x \<noteq> 235; x \<noteq> 236; x \<noteq> 237; x \<noteq> 238; x \<noteq> 239; x \<noteq>
          240; x \<noteq> 241; x \<noteq> 242; x \<noteq> 243; x \<noteq> 244; x \<noteq> 245; x \<noteq> 246; x \<noteq> 247; x \<noteq> 248; x \<noteq> 249; x \<noteq>
          250; x \<noteq> 251; x \<noteq> 252; x \<noteq> 253; x \<noteq> 254; x \<noteq> 255\<rbrakk> \<Longrightarrow> P"
  apply (subgoal_tac "x \<in> set enum", subst (asm) set_enum_word8_def)
    apply (drule set_strip_insert, assumption)+
   apply (erule emptyE)
  apply (subst enum_UNIV, rule UNIV_I)
  done

end

end