thys3/BlexerSimp.thy
author Chengsong
Thu, 23 Jun 2022 18:57:19 +0100
changeset 549 9972877a3f39
parent 548 e5db23c100ea
child 550 9feeb279afdd
permissions -rw-r--r--
bsimp def removed
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
544
Chengsong
parents:
diff changeset
     1
theory BlexerSimp
Chengsong
parents:
diff changeset
     2
  imports Blexer 
Chengsong
parents:
diff changeset
     3
begin
Chengsong
parents:
diff changeset
     4
Chengsong
parents:
diff changeset
     5
Chengsong
parents:
diff changeset
     6
fun flts :: "arexp list \<Rightarrow> arexp list"
Chengsong
parents:
diff changeset
     7
  where 
Chengsong
parents:
diff changeset
     8
  "flts [] = []"
Chengsong
parents:
diff changeset
     9
| "flts (AZERO # rs) = flts rs"
Chengsong
parents:
diff changeset
    10
| "flts ((AALTs bs  rs1) # rs) = (map (fuse bs) rs1) @ flts rs"
Chengsong
parents:
diff changeset
    11
| "flts (r1 # rs) = r1 # flts rs"
Chengsong
parents:
diff changeset
    12
Chengsong
parents:
diff changeset
    13
Chengsong
parents:
diff changeset
    14
Chengsong
parents:
diff changeset
    15
fun bsimp_ASEQ :: "bit list \<Rightarrow> arexp \<Rightarrow> arexp \<Rightarrow> arexp"
Chengsong
parents:
diff changeset
    16
  where
Chengsong
parents:
diff changeset
    17
  "bsimp_ASEQ _ AZERO _ = AZERO"
Chengsong
parents:
diff changeset
    18
| "bsimp_ASEQ _ _ AZERO = AZERO"
Chengsong
parents:
diff changeset
    19
| "bsimp_ASEQ bs1 (AONE bs2) r2 = fuse (bs1 @ bs2) r2"
Chengsong
parents:
diff changeset
    20
| "bsimp_ASEQ bs1 r1 r2 = ASEQ  bs1 r1 r2"
Chengsong
parents:
diff changeset
    21
Chengsong
parents:
diff changeset
    22
lemma bsimp_ASEQ0[simp]:
Chengsong
parents:
diff changeset
    23
  shows "bsimp_ASEQ bs r1 AZERO = AZERO"
Chengsong
parents:
diff changeset
    24
  by (case_tac r1)(simp_all)
Chengsong
parents:
diff changeset
    25
Chengsong
parents:
diff changeset
    26
lemma bsimp_ASEQ1:
Chengsong
parents:
diff changeset
    27
  assumes "r1 \<noteq> AZERO" "r2 \<noteq> AZERO" "\<nexists>bs. r1 = AONE bs"
Chengsong
parents:
diff changeset
    28
  shows "bsimp_ASEQ bs r1 r2 = ASEQ bs r1 r2"
Chengsong
parents:
diff changeset
    29
  using assms
Chengsong
parents:
diff changeset
    30
  apply(induct bs r1 r2 rule: bsimp_ASEQ.induct)
Chengsong
parents:
diff changeset
    31
  apply(auto)
Chengsong
parents:
diff changeset
    32
  done
Chengsong
parents:
diff changeset
    33
Chengsong
parents:
diff changeset
    34
lemma bsimp_ASEQ2[simp]:
Chengsong
parents:
diff changeset
    35
  shows "bsimp_ASEQ bs1 (AONE bs2) r2 = fuse (bs1 @ bs2) r2"
Chengsong
parents:
diff changeset
    36
  by (case_tac r2) (simp_all)
Chengsong
parents:
diff changeset
    37
Chengsong
parents:
diff changeset
    38
Chengsong
parents:
diff changeset
    39
fun bsimp_AALTs :: "bit list \<Rightarrow> arexp list \<Rightarrow> arexp"
Chengsong
parents:
diff changeset
    40
  where
Chengsong
parents:
diff changeset
    41
  "bsimp_AALTs _ [] = AZERO"
Chengsong
parents:
diff changeset
    42
| "bsimp_AALTs bs1 [r] = fuse bs1 r"
Chengsong
parents:
diff changeset
    43
| "bsimp_AALTs bs1 rs = AALTs bs1 rs"
Chengsong
parents:
diff changeset
    44
Chengsong
parents:
diff changeset
    45
lemma bmkeps_fuse:
Chengsong
parents:
diff changeset
    46
  assumes "bnullable r"
Chengsong
parents:
diff changeset
    47
  shows "bmkeps (fuse bs r) = bs @ bmkeps r"
Chengsong
parents:
diff changeset
    48
  using assms
Chengsong
parents:
diff changeset
    49
  by (induct r rule: bnullable.induct) (auto)
Chengsong
parents:
diff changeset
    50
Chengsong
parents:
diff changeset
    51
lemma bmkepss_fuse: 
Chengsong
parents:
diff changeset
    52
  assumes "bnullables rs"
Chengsong
parents:
diff changeset
    53
  shows "bmkepss (map (fuse bs) rs) = bs @ bmkepss rs"
Chengsong
parents:
diff changeset
    54
  using assms
Chengsong
parents:
diff changeset
    55
  apply(induct rs arbitrary: bs)
Chengsong
parents:
diff changeset
    56
  apply(auto simp add: bmkeps_fuse bnullable_fuse)
Chengsong
parents:
diff changeset
    57
  done
Chengsong
parents:
diff changeset
    58
Chengsong
parents:
diff changeset
    59
lemma bder_fuse:
Chengsong
parents:
diff changeset
    60
  shows "bder c (fuse bs a) = fuse bs  (bder c a)"
Chengsong
parents:
diff changeset
    61
  apply(induct a arbitrary: bs c)
Chengsong
parents:
diff changeset
    62
  apply(simp_all)
Chengsong
parents:
diff changeset
    63
  done
Chengsong
parents:
diff changeset
    64
Chengsong
parents:
diff changeset
    65
Chengsong
parents:
diff changeset
    66
Chengsong
parents:
diff changeset
    67
Chengsong
parents:
diff changeset
    68
inductive 
Chengsong
parents:
diff changeset
    69
  rrewrite:: "arexp \<Rightarrow> arexp \<Rightarrow> bool" ("_ \<leadsto> _" [99, 99] 99)
Chengsong
parents:
diff changeset
    70
and 
Chengsong
parents:
diff changeset
    71
  srewrite:: "arexp list \<Rightarrow> arexp list \<Rightarrow> bool" (" _ s\<leadsto> _" [100, 100] 100)
Chengsong
parents:
diff changeset
    72
where
Chengsong
parents:
diff changeset
    73
  bs1: "ASEQ bs AZERO r2 \<leadsto> AZERO"
Chengsong
parents:
diff changeset
    74
| bs2: "ASEQ bs r1 AZERO \<leadsto> AZERO"
Chengsong
parents:
diff changeset
    75
| bs3: "ASEQ bs1 (AONE bs2) r \<leadsto> fuse (bs1@bs2) r"
Chengsong
parents:
diff changeset
    76
| bs4: "r1 \<leadsto> r2 \<Longrightarrow> ASEQ bs r1 r3 \<leadsto> ASEQ bs r2 r3"
Chengsong
parents:
diff changeset
    77
| bs5: "r3 \<leadsto> r4 \<Longrightarrow> ASEQ bs r1 r3 \<leadsto> ASEQ bs r1 r4"
Chengsong
parents:
diff changeset
    78
| bs6: "AALTs bs [] \<leadsto> AZERO"
Chengsong
parents:
diff changeset
    79
| bs7: "AALTs bs [r] \<leadsto> fuse bs r"
Chengsong
parents:
diff changeset
    80
| bs10: "rs1 s\<leadsto> rs2 \<Longrightarrow> AALTs bs rs1 \<leadsto> AALTs bs rs2"
Chengsong
parents:
diff changeset
    81
| ss1:  "[] s\<leadsto> []"
Chengsong
parents:
diff changeset
    82
| ss2:  "rs1 s\<leadsto> rs2 \<Longrightarrow> (r # rs1) s\<leadsto> (r # rs2)"
Chengsong
parents:
diff changeset
    83
| ss3:  "r1 \<leadsto> r2 \<Longrightarrow> (r1 # rs) s\<leadsto> (r2 # rs)"
Chengsong
parents:
diff changeset
    84
| ss4:  "(AZERO # rs) s\<leadsto> rs"
Chengsong
parents:
diff changeset
    85
| ss5:  "(AALTs bs1 rs1 # rsb) s\<leadsto> ((map (fuse bs1) rs1) @ rsb)"
Chengsong
parents:
diff changeset
    86
| ss6:  "L (erase a2) \<subseteq> L (erase a1) \<Longrightarrow> (rsa@[a1]@rsb@[a2]@rsc) s\<leadsto> (rsa@[a1]@rsb@rsc)"
Chengsong
parents:
diff changeset
    87
Chengsong
parents:
diff changeset
    88
Chengsong
parents:
diff changeset
    89
inductive 
Chengsong
parents:
diff changeset
    90
  rrewrites:: "arexp \<Rightarrow> arexp \<Rightarrow> bool" ("_ \<leadsto>* _" [100, 100] 100)
Chengsong
parents:
diff changeset
    91
where 
Chengsong
parents:
diff changeset
    92
  rs1[intro, simp]:"r \<leadsto>* r"
Chengsong
parents:
diff changeset
    93
| rs2[intro]: "\<lbrakk>r1 \<leadsto>* r2; r2 \<leadsto> r3\<rbrakk> \<Longrightarrow> r1 \<leadsto>* r3"
Chengsong
parents:
diff changeset
    94
Chengsong
parents:
diff changeset
    95
inductive 
Chengsong
parents:
diff changeset
    96
  srewrites:: "arexp list \<Rightarrow> arexp list \<Rightarrow> bool" ("_ s\<leadsto>* _" [100, 100] 100)
Chengsong
parents:
diff changeset
    97
where 
Chengsong
parents:
diff changeset
    98
  sss1[intro, simp]:"rs s\<leadsto>* rs"
Chengsong
parents:
diff changeset
    99
| sss2[intro]: "\<lbrakk>rs1 s\<leadsto> rs2; rs2 s\<leadsto>* rs3\<rbrakk> \<Longrightarrow> rs1 s\<leadsto>* rs3"
Chengsong
parents:
diff changeset
   100
Chengsong
parents:
diff changeset
   101
Chengsong
parents:
diff changeset
   102
lemma r_in_rstar : "r1 \<leadsto> r2 \<Longrightarrow> r1 \<leadsto>* r2"
Chengsong
parents:
diff changeset
   103
  using rrewrites.intros(1) rrewrites.intros(2) by blast
Chengsong
parents:
diff changeset
   104
Chengsong
parents:
diff changeset
   105
lemma rs_in_rstar: 
Chengsong
parents:
diff changeset
   106
  shows "r1 s\<leadsto> r2 \<Longrightarrow> r1 s\<leadsto>* r2"
Chengsong
parents:
diff changeset
   107
  using rrewrites.intros(1) rrewrites.intros(2) by blast
Chengsong
parents:
diff changeset
   108
Chengsong
parents:
diff changeset
   109
Chengsong
parents:
diff changeset
   110
lemma rrewrites_trans[trans]: 
Chengsong
parents:
diff changeset
   111
  assumes a1: "r1 \<leadsto>* r2"  and a2: "r2 \<leadsto>* r3"
Chengsong
parents:
diff changeset
   112
  shows "r1 \<leadsto>* r3"
Chengsong
parents:
diff changeset
   113
  using a2 a1
Chengsong
parents:
diff changeset
   114
  apply(induct r2 r3 arbitrary: r1 rule: rrewrites.induct) 
Chengsong
parents:
diff changeset
   115
  apply(auto)
Chengsong
parents:
diff changeset
   116
  done
Chengsong
parents:
diff changeset
   117
Chengsong
parents:
diff changeset
   118
lemma srewrites_trans[trans]: 
Chengsong
parents:
diff changeset
   119
  assumes a1: "r1 s\<leadsto>* r2"  and a2: "r2 s\<leadsto>* r3"
Chengsong
parents:
diff changeset
   120
  shows "r1 s\<leadsto>* r3"
Chengsong
parents:
diff changeset
   121
  using a1 a2
Chengsong
parents:
diff changeset
   122
  apply(induct r1 r2 arbitrary: r3 rule: srewrites.induct) 
Chengsong
parents:
diff changeset
   123
   apply(auto)
Chengsong
parents:
diff changeset
   124
  done
Chengsong
parents:
diff changeset
   125
Chengsong
parents:
diff changeset
   126
Chengsong
parents:
diff changeset
   127
Chengsong
parents:
diff changeset
   128
lemma contextrewrites0: 
Chengsong
parents:
diff changeset
   129
  "rs1 s\<leadsto>* rs2 \<Longrightarrow> AALTs bs rs1 \<leadsto>* AALTs bs rs2"
Chengsong
parents:
diff changeset
   130
  apply(induct rs1 rs2 rule: srewrites.inducts)
Chengsong
parents:
diff changeset
   131
   apply simp
Chengsong
parents:
diff changeset
   132
  using bs10 r_in_rstar rrewrites_trans by blast
Chengsong
parents:
diff changeset
   133
Chengsong
parents:
diff changeset
   134
lemma contextrewrites1: 
Chengsong
parents:
diff changeset
   135
  "r \<leadsto>* r' \<Longrightarrow> AALTs bs (r # rs) \<leadsto>* AALTs bs (r' # rs)"
Chengsong
parents:
diff changeset
   136
  apply(induct r r' rule: rrewrites.induct)
Chengsong
parents:
diff changeset
   137
   apply simp
Chengsong
parents:
diff changeset
   138
  using bs10 ss3 by blast
Chengsong
parents:
diff changeset
   139
Chengsong
parents:
diff changeset
   140
lemma srewrite1: 
Chengsong
parents:
diff changeset
   141
  shows "rs1 s\<leadsto> rs2 \<Longrightarrow> (rs @ rs1) s\<leadsto> (rs @ rs2)"
Chengsong
parents:
diff changeset
   142
  apply(induct rs)
Chengsong
parents:
diff changeset
   143
   apply(auto)
Chengsong
parents:
diff changeset
   144
  using ss2 by auto
Chengsong
parents:
diff changeset
   145
Chengsong
parents:
diff changeset
   146
lemma srewrites1: 
Chengsong
parents:
diff changeset
   147
  shows "rs1 s\<leadsto>* rs2 \<Longrightarrow> (rs @ rs1) s\<leadsto>* (rs @ rs2)"
Chengsong
parents:
diff changeset
   148
  apply(induct rs1 rs2 rule: srewrites.induct)
Chengsong
parents:
diff changeset
   149
   apply(auto)
Chengsong
parents:
diff changeset
   150
  using srewrite1 by blast
Chengsong
parents:
diff changeset
   151
Chengsong
parents:
diff changeset
   152
lemma srewrite2: 
Chengsong
parents:
diff changeset
   153
  shows  "r1 \<leadsto> r2 \<Longrightarrow> True"
Chengsong
parents:
diff changeset
   154
  and "rs1 s\<leadsto> rs2 \<Longrightarrow> (rs1 @ rs) s\<leadsto>* (rs2 @ rs)"
Chengsong
parents:
diff changeset
   155
  apply(induct rule: rrewrite_srewrite.inducts)
Chengsong
parents:
diff changeset
   156
  apply(auto)
Chengsong
parents:
diff changeset
   157
  apply (metis append_Cons append_Nil srewrites1)
Chengsong
parents:
diff changeset
   158
  apply(meson srewrites.simps ss3)
Chengsong
parents:
diff changeset
   159
  apply (meson srewrites.simps ss4)
Chengsong
parents:
diff changeset
   160
  apply (meson srewrites.simps ss5)
Chengsong
parents:
diff changeset
   161
  by (metis append_Cons append_Nil srewrites.simps ss6)
Chengsong
parents:
diff changeset
   162
  
Chengsong
parents:
diff changeset
   163
Chengsong
parents:
diff changeset
   164
lemma srewrites3: 
Chengsong
parents:
diff changeset
   165
  shows "rs1 s\<leadsto>* rs2 \<Longrightarrow> (rs1 @ rs) s\<leadsto>* (rs2 @ rs)"
Chengsong
parents:
diff changeset
   166
  apply(induct rs1 rs2 arbitrary: rs rule: srewrites.induct)
Chengsong
parents:
diff changeset
   167
   apply(auto)
Chengsong
parents:
diff changeset
   168
  by (meson srewrite2(2) srewrites_trans)
Chengsong
parents:
diff changeset
   169
Chengsong
parents:
diff changeset
   170
(*
Chengsong
parents:
diff changeset
   171
lemma srewrites4:
Chengsong
parents:
diff changeset
   172
  assumes "rs3 s\<leadsto>* rs4" "rs1 s\<leadsto>* rs2" 
Chengsong
parents:
diff changeset
   173
  shows "(rs1 @ rs3) s\<leadsto>* (rs2 @ rs4)"
Chengsong
parents:
diff changeset
   174
  using assms
Chengsong
parents:
diff changeset
   175
  apply(induct rs3 rs4 arbitrary: rs1 rs2 rule: srewrites.induct)
Chengsong
parents:
diff changeset
   176
  apply (simp add: srewrites3)
Chengsong
parents:
diff changeset
   177
  using srewrite1 by blast
Chengsong
parents:
diff changeset
   178
*)
Chengsong
parents:
diff changeset
   179
Chengsong
parents:
diff changeset
   180
lemma srewrites6:
Chengsong
parents:
diff changeset
   181
  assumes "r1 \<leadsto>* r2" 
Chengsong
parents:
diff changeset
   182
  shows "[r1] s\<leadsto>* [r2]"
Chengsong
parents:
diff changeset
   183
  using assms
Chengsong
parents:
diff changeset
   184
  apply(induct r1 r2 rule: rrewrites.induct)
Chengsong
parents:
diff changeset
   185
   apply(auto)
Chengsong
parents:
diff changeset
   186
  by (meson srewrites.simps srewrites_trans ss3)
Chengsong
parents:
diff changeset
   187
Chengsong
parents:
diff changeset
   188
lemma srewrites7:
Chengsong
parents:
diff changeset
   189
  assumes "rs3 s\<leadsto>* rs4" "r1 \<leadsto>* r2" 
Chengsong
parents:
diff changeset
   190
  shows "(r1 # rs3) s\<leadsto>* (r2 # rs4)"
Chengsong
parents:
diff changeset
   191
  using assms
Chengsong
parents:
diff changeset
   192
  by (smt (verit, best) append_Cons append_Nil srewrites1 srewrites3 srewrites6 srewrites_trans)
Chengsong
parents:
diff changeset
   193
Chengsong
parents:
diff changeset
   194
lemma ss6_stronger_aux:
Chengsong
parents:
diff changeset
   195
  shows "(rs1 @ rs2) s\<leadsto>* (rs1 @ distinctWith rs2 eq1 (set rs1))"
Chengsong
parents:
diff changeset
   196
  apply(induct rs2 arbitrary: rs1)
Chengsong
parents:
diff changeset
   197
  apply(auto)
Chengsong
parents:
diff changeset
   198
  prefer 2
Chengsong
parents:
diff changeset
   199
  apply(drule_tac x="rs1 @ [a]" in meta_spec)
Chengsong
parents:
diff changeset
   200
  apply(simp)
Chengsong
parents:
diff changeset
   201
  apply(drule_tac x="rs1" in meta_spec)
Chengsong
parents:
diff changeset
   202
  apply(subgoal_tac "(rs1 @ a # rs2) s\<leadsto>* (rs1 @ rs2)")
Chengsong
parents:
diff changeset
   203
  using srewrites_trans apply blast
Chengsong
parents:
diff changeset
   204
  apply(subgoal_tac "\<exists>rs1a rs1b. rs1 = rs1a @ [x] @ rs1b")
Chengsong
parents:
diff changeset
   205
  prefer 2
Chengsong
parents:
diff changeset
   206
  apply (simp add: split_list)
Chengsong
parents:
diff changeset
   207
  apply(erule exE)+
Chengsong
parents:
diff changeset
   208
  apply(simp)
Chengsong
parents:
diff changeset
   209
  using eq1_L rs_in_rstar ss6 by force
Chengsong
parents:
diff changeset
   210
Chengsong
parents:
diff changeset
   211
lemma ss6_stronger:
Chengsong
parents:
diff changeset
   212
  shows "rs1 s\<leadsto>* distinctWith rs1 eq1 {}"
Chengsong
parents:
diff changeset
   213
  by (metis append_Nil list.set(1) ss6_stronger_aux)
Chengsong
parents:
diff changeset
   214
Chengsong
parents:
diff changeset
   215
Chengsong
parents:
diff changeset
   216
lemma rewrite_preserves_fuse: 
Chengsong
parents:
diff changeset
   217
  shows "r2 \<leadsto> r3 \<Longrightarrow> fuse bs r2 \<leadsto> fuse bs r3"
Chengsong
parents:
diff changeset
   218
  and   "rs2 s\<leadsto> rs3 \<Longrightarrow> map (fuse bs) rs2 s\<leadsto>* map (fuse bs) rs3"
Chengsong
parents:
diff changeset
   219
proof(induct rule: rrewrite_srewrite.inducts)
Chengsong
parents:
diff changeset
   220
  case (bs3 bs1 bs2 r)
Chengsong
parents:
diff changeset
   221
  then show ?case
Chengsong
parents:
diff changeset
   222
    by (metis fuse.simps(5) fuse_append rrewrite_srewrite.bs3) 
Chengsong
parents:
diff changeset
   223
next
Chengsong
parents:
diff changeset
   224
  case (bs7 bs r)
Chengsong
parents:
diff changeset
   225
  then show ?case
Chengsong
parents:
diff changeset
   226
    by (metis fuse.simps(4) fuse_append rrewrite_srewrite.bs7) 
Chengsong
parents:
diff changeset
   227
next
Chengsong
parents:
diff changeset
   228
  case (ss2 rs1 rs2 r)
Chengsong
parents:
diff changeset
   229
  then show ?case
Chengsong
parents:
diff changeset
   230
    using srewrites7 by force 
Chengsong
parents:
diff changeset
   231
next
Chengsong
parents:
diff changeset
   232
  case (ss3 r1 r2 rs)
Chengsong
parents:
diff changeset
   233
  then show ?case by (simp add: r_in_rstar srewrites7)
Chengsong
parents:
diff changeset
   234
next
Chengsong
parents:
diff changeset
   235
  case (ss5 bs1 rs1 rsb)
Chengsong
parents:
diff changeset
   236
  then show ?case 
Chengsong
parents:
diff changeset
   237
    apply(simp)
Chengsong
parents:
diff changeset
   238
    by (metis (mono_tags, lifting) comp_def fuse_append map_eq_conv rrewrite_srewrite.ss5 srewrites.simps)
Chengsong
parents:
diff changeset
   239
next
Chengsong
parents:
diff changeset
   240
  case (ss6 a1 a2 rsa rsb rsc)
Chengsong
parents:
diff changeset
   241
  then show ?case 
Chengsong
parents:
diff changeset
   242
    apply(simp only: map_append)
Chengsong
parents:
diff changeset
   243
    by (smt (verit, best) erase_fuse list.simps(8) list.simps(9) rrewrite_srewrite.ss6 srewrites.simps)
Chengsong
parents:
diff changeset
   244
qed (auto intro: rrewrite_srewrite.intros)
Chengsong
parents:
diff changeset
   245
Chengsong
parents:
diff changeset
   246
Chengsong
parents:
diff changeset
   247
lemma rewrites_fuse:  
Chengsong
parents:
diff changeset
   248
  assumes "r1 \<leadsto>* r2"
Chengsong
parents:
diff changeset
   249
  shows "fuse bs r1 \<leadsto>* fuse bs r2"
Chengsong
parents:
diff changeset
   250
using assms
Chengsong
parents:
diff changeset
   251
apply(induction r1 r2 arbitrary: bs rule: rrewrites.induct)
Chengsong
parents:
diff changeset
   252
apply(auto intro: rewrite_preserves_fuse rrewrites_trans)
Chengsong
parents:
diff changeset
   253
done
Chengsong
parents:
diff changeset
   254
Chengsong
parents:
diff changeset
   255
Chengsong
parents:
diff changeset
   256
lemma star_seq:  
Chengsong
parents:
diff changeset
   257
  assumes "r1 \<leadsto>* r2"
Chengsong
parents:
diff changeset
   258
  shows "ASEQ bs r1 r3 \<leadsto>* ASEQ bs r2 r3"
Chengsong
parents:
diff changeset
   259
using assms
Chengsong
parents:
diff changeset
   260
apply(induct r1 r2 arbitrary: r3 rule: rrewrites.induct)
Chengsong
parents:
diff changeset
   261
apply(auto intro: rrewrite_srewrite.intros)
Chengsong
parents:
diff changeset
   262
done
Chengsong
parents:
diff changeset
   263
Chengsong
parents:
diff changeset
   264
lemma star_seq2:  
Chengsong
parents:
diff changeset
   265
  assumes "r3 \<leadsto>* r4"
Chengsong
parents:
diff changeset
   266
  shows "ASEQ bs r1 r3 \<leadsto>* ASEQ bs r1 r4"
Chengsong
parents:
diff changeset
   267
  using assms
Chengsong
parents:
diff changeset
   268
apply(induct r3 r4 arbitrary: r1 rule: rrewrites.induct)
Chengsong
parents:
diff changeset
   269
apply(auto intro: rrewrite_srewrite.intros)
Chengsong
parents:
diff changeset
   270
done
Chengsong
parents:
diff changeset
   271
Chengsong
parents:
diff changeset
   272
lemma continuous_rewrite: 
Chengsong
parents:
diff changeset
   273
  assumes "r1 \<leadsto>* AZERO"
Chengsong
parents:
diff changeset
   274
  shows "ASEQ bs1 r1 r2 \<leadsto>* AZERO"
Chengsong
parents:
diff changeset
   275
using assms bs1 star_seq by blast
Chengsong
parents:
diff changeset
   276
Chengsong
parents:
diff changeset
   277
(*
Chengsong
parents:
diff changeset
   278
lemma continuous_rewrite2: 
Chengsong
parents:
diff changeset
   279
  assumes "r1 \<leadsto>* AONE bs"
Chengsong
parents:
diff changeset
   280
  shows "ASEQ bs1 r1 r2 \<leadsto>* (fuse (bs1 @ bs) r2)"
Chengsong
parents:
diff changeset
   281
  using assms  by (meson bs3 rrewrites.simps star_seq)
Chengsong
parents:
diff changeset
   282
*)
Chengsong
parents:
diff changeset
   283
Chengsong
parents:
diff changeset
   284
lemma bsimp_aalts_simpcases: 
Chengsong
parents:
diff changeset
   285
  shows "AONE bs \<leadsto>* bsimp (AONE bs)"  
Chengsong
parents:
diff changeset
   286
  and   "AZERO \<leadsto>* bsimp AZERO" 
Chengsong
parents:
diff changeset
   287
  and   "ACHAR bs c \<leadsto>* bsimp (ACHAR bs c)"
Chengsong
parents:
diff changeset
   288
  by (simp_all)
Chengsong
parents:
diff changeset
   289
Chengsong
parents:
diff changeset
   290
lemma bsimp_AALTs_rewrites: 
Chengsong
parents:
diff changeset
   291
  shows "AALTs bs1 rs \<leadsto>* bsimp_AALTs bs1 rs"
Chengsong
parents:
diff changeset
   292
  by (smt (verit) bs6 bs7 bsimp_AALTs.elims rrewrites.simps)
Chengsong
parents:
diff changeset
   293
Chengsong
parents:
diff changeset
   294
lemma trivialbsimp_srewrites: 
Chengsong
parents:
diff changeset
   295
  "\<lbrakk>\<And>x. x \<in> set rs \<Longrightarrow> x \<leadsto>* f x \<rbrakk> \<Longrightarrow> rs s\<leadsto>* (map f rs)"
Chengsong
parents:
diff changeset
   296
  apply(induction rs)
Chengsong
parents:
diff changeset
   297
   apply simp
Chengsong
parents:
diff changeset
   298
  apply(simp)
Chengsong
parents:
diff changeset
   299
  using srewrites7 by auto
Chengsong
parents:
diff changeset
   300
Chengsong
parents:
diff changeset
   301
Chengsong
parents:
diff changeset
   302
Chengsong
parents:
diff changeset
   303
lemma fltsfrewrites: "rs s\<leadsto>* flts rs"
Chengsong
parents:
diff changeset
   304
  apply(induction rs rule: flts.induct)
Chengsong
parents:
diff changeset
   305
  apply(auto intro: rrewrite_srewrite.intros)
Chengsong
parents:
diff changeset
   306
  apply (meson srewrites.simps srewrites1 ss5)
Chengsong
parents:
diff changeset
   307
  using rs1 srewrites7 apply presburger
Chengsong
parents:
diff changeset
   308
  using srewrites7 apply force
Chengsong
parents:
diff changeset
   309
  apply (simp add: srewrites7)
Chengsong
parents:
diff changeset
   310
  by (simp add: srewrites7)
Chengsong
parents:
diff changeset
   311
Chengsong
parents:
diff changeset
   312
lemma bnullable0:
Chengsong
parents:
diff changeset
   313
shows "r1 \<leadsto> r2 \<Longrightarrow> bnullable r1 = bnullable r2" 
Chengsong
parents:
diff changeset
   314
  and "rs1 s\<leadsto> rs2 \<Longrightarrow> bnullables rs1 = bnullables rs2" 
Chengsong
parents:
diff changeset
   315
  apply(induct rule: rrewrite_srewrite.inducts)
Chengsong
parents:
diff changeset
   316
  apply(auto simp add:  bnullable_fuse)
Chengsong
parents:
diff changeset
   317
   apply (meson UnCI bnullable_fuse imageI)
548
e5db23c100ea before removing distinctWith
Chengsong
parents: 547
diff changeset
   318
  using bnullable_correctness nullable_correctness by blast
e5db23c100ea before removing distinctWith
Chengsong
parents: 547
diff changeset
   319
e5db23c100ea before removing distinctWith
Chengsong
parents: 547
diff changeset
   320
544
Chengsong
parents:
diff changeset
   321
Chengsong
parents:
diff changeset
   322
Chengsong
parents:
diff changeset
   323
lemma rewritesnullable: 
Chengsong
parents:
diff changeset
   324
  assumes "r1 \<leadsto>* r2" 
Chengsong
parents:
diff changeset
   325
  shows "bnullable r1 = bnullable r2"
Chengsong
parents:
diff changeset
   326
using assms 
Chengsong
parents:
diff changeset
   327
  apply(induction r1 r2 rule: rrewrites.induct)
Chengsong
parents:
diff changeset
   328
  apply simp
Chengsong
parents:
diff changeset
   329
  using bnullable0(1) by auto
Chengsong
parents:
diff changeset
   330
Chengsong
parents:
diff changeset
   331
lemma rewrite_bmkeps_aux: 
Chengsong
parents:
diff changeset
   332
  shows "r1 \<leadsto> r2 \<Longrightarrow> (bnullable r1 \<and> bnullable r2 \<Longrightarrow> bmkeps r1 = bmkeps r2)"
Chengsong
parents:
diff changeset
   333
  and   "rs1 s\<leadsto> rs2 \<Longrightarrow> (bnullables rs1 \<and> bnullables rs2 \<Longrightarrow> bmkepss rs1 = bmkepss rs2)" 
Chengsong
parents:
diff changeset
   334
proof (induct rule: rrewrite_srewrite.inducts)
Chengsong
parents:
diff changeset
   335
  case (bs3 bs1 bs2 r)
Chengsong
parents:
diff changeset
   336
  then show ?case by (simp add: bmkeps_fuse) 
Chengsong
parents:
diff changeset
   337
next
Chengsong
parents:
diff changeset
   338
  case (bs7 bs r)
Chengsong
parents:
diff changeset
   339
  then show ?case by (simp add: bmkeps_fuse) 
Chengsong
parents:
diff changeset
   340
next
Chengsong
parents:
diff changeset
   341
  case (ss3 r1 r2 rs)
Chengsong
parents:
diff changeset
   342
  then show ?case
Chengsong
parents:
diff changeset
   343
    using bmkepss.simps bnullable0(1) by presburger
Chengsong
parents:
diff changeset
   344
next
Chengsong
parents:
diff changeset
   345
  case (ss5 bs1 rs1 rsb)
Chengsong
parents:
diff changeset
   346
  then show ?case
Chengsong
parents:
diff changeset
   347
    by (simp add: bmkepss1 bmkepss2 bmkepss_fuse bnullable_fuse)
Chengsong
parents:
diff changeset
   348
next
Chengsong
parents:
diff changeset
   349
  case (ss6 a1 a2 rsa rsb rsc)
Chengsong
parents:
diff changeset
   350
  then show ?case
Chengsong
parents:
diff changeset
   351
    by (smt (verit, best) Nil_is_append_conv bmkepss1 bmkepss2 bnullable_correctness in_set_conv_decomp list.distinct(1) list.set_intros(1) nullable_correctness set_ConsD subsetD)
Chengsong
parents:
diff changeset
   352
qed (auto)
Chengsong
parents:
diff changeset
   353
Chengsong
parents:
diff changeset
   354
lemma rewrites_bmkeps: 
Chengsong
parents:
diff changeset
   355
  assumes "r1 \<leadsto>* r2" "bnullable r1" 
Chengsong
parents:
diff changeset
   356
  shows "bmkeps r1 = bmkeps r2"
Chengsong
parents:
diff changeset
   357
  using assms
Chengsong
parents:
diff changeset
   358
proof(induction r1 r2 rule: rrewrites.induct)
Chengsong
parents:
diff changeset
   359
  case (rs1 r)
Chengsong
parents:
diff changeset
   360
  then show "bmkeps r = bmkeps r" by simp
Chengsong
parents:
diff changeset
   361
next
Chengsong
parents:
diff changeset
   362
  case (rs2 r1 r2 r3)
Chengsong
parents:
diff changeset
   363
  then have IH: "bmkeps r1 = bmkeps r2" by simp
Chengsong
parents:
diff changeset
   364
  have a1: "bnullable r1" by fact
Chengsong
parents:
diff changeset
   365
  have a2: "r1 \<leadsto>* r2" by fact
Chengsong
parents:
diff changeset
   366
  have a3: "r2 \<leadsto> r3" by fact
Chengsong
parents:
diff changeset
   367
  have a4: "bnullable r2" using a1 a2 by (simp add: rewritesnullable) 
Chengsong
parents:
diff changeset
   368
  then have "bmkeps r2 = bmkeps r3"
Chengsong
parents:
diff changeset
   369
    using a3 bnullable0(1) rewrite_bmkeps_aux(1) by blast 
Chengsong
parents:
diff changeset
   370
  then show "bmkeps r1 = bmkeps r3" using IH by simp
Chengsong
parents:
diff changeset
   371
qed
Chengsong
parents:
diff changeset
   372
Chengsong
parents:
diff changeset
   373
Chengsong
parents:
diff changeset
   374
lemma rewrites_to_bsimp: 
Chengsong
parents:
diff changeset
   375
  shows "r \<leadsto>* bsimp r"
Chengsong
parents:
diff changeset
   376
proof (induction r rule: bsimp.induct)
Chengsong
parents:
diff changeset
   377
  case (1 bs1 r1 r2)
Chengsong
parents:
diff changeset
   378
  have IH1: "r1 \<leadsto>* bsimp r1" by fact
Chengsong
parents:
diff changeset
   379
  have IH2: "r2 \<leadsto>* bsimp r2" by fact
Chengsong
parents:
diff changeset
   380
  { assume as: "bsimp r1 = AZERO \<or> bsimp r2 = AZERO"
Chengsong
parents:
diff changeset
   381
    with IH1 IH2 have "r1 \<leadsto>* AZERO \<or> r2 \<leadsto>* AZERO" by auto
Chengsong
parents:
diff changeset
   382
    then have "ASEQ bs1 r1 r2 \<leadsto>* AZERO"
Chengsong
parents:
diff changeset
   383
      by (metis bs2 continuous_rewrite rrewrites.simps star_seq2)  
Chengsong
parents:
diff changeset
   384
    then have "ASEQ bs1 r1 r2 \<leadsto>* bsimp (ASEQ bs1 r1 r2)" using as by auto
Chengsong
parents:
diff changeset
   385
  }
Chengsong
parents:
diff changeset
   386
  moreover
Chengsong
parents:
diff changeset
   387
  { assume "\<exists>bs. bsimp r1 = AONE bs"
Chengsong
parents:
diff changeset
   388
    then obtain bs where as: "bsimp r1 = AONE bs" by blast
Chengsong
parents:
diff changeset
   389
    with IH1 have "r1 \<leadsto>* AONE bs" by simp
Chengsong
parents:
diff changeset
   390
    then have "ASEQ bs1 r1 r2 \<leadsto>* fuse (bs1 @ bs) r2" using bs3 star_seq by blast
Chengsong
parents:
diff changeset
   391
    with IH2 have "ASEQ bs1 r1 r2 \<leadsto>* fuse (bs1 @ bs) (bsimp r2)"
Chengsong
parents:
diff changeset
   392
      using rewrites_fuse by (meson rrewrites_trans) 
Chengsong
parents:
diff changeset
   393
    then have "ASEQ bs1 r1 r2 \<leadsto>* bsimp (ASEQ bs1 (AONE bs) r2)" by simp
Chengsong
parents:
diff changeset
   394
    then have "ASEQ bs1 r1 r2 \<leadsto>* bsimp (ASEQ bs1 r1 r2)" by (simp add: as) 
Chengsong
parents:
diff changeset
   395
  } 
Chengsong
parents:
diff changeset
   396
  moreover
Chengsong
parents:
diff changeset
   397
  { assume as1: "bsimp r1 \<noteq> AZERO" "bsimp r2 \<noteq> AZERO" and as2: "(\<nexists>bs. bsimp r1 = AONE bs)" 
Chengsong
parents:
diff changeset
   398
    then have "bsimp_ASEQ bs1 (bsimp r1) (bsimp r2) = ASEQ bs1 (bsimp r1) (bsimp r2)" 
Chengsong
parents:
diff changeset
   399
      by (simp add: bsimp_ASEQ1) 
Chengsong
parents:
diff changeset
   400
    then have "ASEQ bs1 r1 r2 \<leadsto>* bsimp_ASEQ bs1 (bsimp r1) (bsimp r2)" using as1 as2 IH1 IH2
Chengsong
parents:
diff changeset
   401
      by (metis rrewrites_trans star_seq star_seq2) 
Chengsong
parents:
diff changeset
   402
    then have "ASEQ bs1 r1 r2 \<leadsto>* bsimp (ASEQ bs1 r1 r2)" by simp
Chengsong
parents:
diff changeset
   403
  } 
Chengsong
parents:
diff changeset
   404
  ultimately show "ASEQ bs1 r1 r2 \<leadsto>* bsimp (ASEQ bs1 r1 r2)" by blast
Chengsong
parents:
diff changeset
   405
next
Chengsong
parents:
diff changeset
   406
  case (2 bs1 rs)
Chengsong
parents:
diff changeset
   407
  have IH: "\<And>x. x \<in> set rs \<Longrightarrow> x \<leadsto>* bsimp x" by fact
Chengsong
parents:
diff changeset
   408
  then have "rs s\<leadsto>* (map bsimp rs)" by (simp add: trivialbsimp_srewrites)
Chengsong
parents:
diff changeset
   409
  also have "... s\<leadsto>* flts (map bsimp rs)" by (simp add: fltsfrewrites) 
Chengsong
parents:
diff changeset
   410
  also have "... s\<leadsto>* distinctWith (flts (map bsimp rs)) eq1 {}" by (simp add: ss6_stronger)
Chengsong
parents:
diff changeset
   411
  finally have "AALTs bs1 rs \<leadsto>* AALTs bs1 (distinctWith (flts (map bsimp rs)) eq1 {})"
Chengsong
parents:
diff changeset
   412
    using contextrewrites0 by auto
Chengsong
parents:
diff changeset
   413
  also have "... \<leadsto>* bsimp_AALTs  bs1 (distinctWith (flts (map bsimp rs)) eq1 {})"
Chengsong
parents:
diff changeset
   414
    by (simp add: bsimp_AALTs_rewrites)     
Chengsong
parents:
diff changeset
   415
  finally show "AALTs bs1 rs \<leadsto>* bsimp (AALTs bs1 rs)" by simp
Chengsong
parents:
diff changeset
   416
qed (simp_all)
Chengsong
parents:
diff changeset
   417
Chengsong
parents:
diff changeset
   418
Chengsong
parents:
diff changeset
   419
lemma to_zero_in_alt: 
Chengsong
parents:
diff changeset
   420
  shows "AALT bs (ASEQ [] AZERO r) r2 \<leadsto> AALT bs AZERO r2"
Chengsong
parents:
diff changeset
   421
  by (simp add: bs1 bs10 ss3)
Chengsong
parents:
diff changeset
   422
Chengsong
parents:
diff changeset
   423
Chengsong
parents:
diff changeset
   424
Chengsong
parents:
diff changeset
   425
lemma  bder_fuse_list: 
Chengsong
parents:
diff changeset
   426
  shows "map (bder c \<circ> fuse bs1) rs1 = map (fuse bs1 \<circ> bder c) rs1"
Chengsong
parents:
diff changeset
   427
  apply(induction rs1)
Chengsong
parents:
diff changeset
   428
  apply(simp_all add: bder_fuse)
Chengsong
parents:
diff changeset
   429
  done
Chengsong
parents:
diff changeset
   430
Chengsong
parents:
diff changeset
   431
lemma map1:
Chengsong
parents:
diff changeset
   432
  shows "(map f [a]) = [f a]"
Chengsong
parents:
diff changeset
   433
  by (simp)
Chengsong
parents:
diff changeset
   434
Chengsong
parents:
diff changeset
   435
lemma rewrite_preserves_bder: 
Chengsong
parents:
diff changeset
   436
  shows "r1 \<leadsto> r2 \<Longrightarrow> (bder c r1) \<leadsto>* (bder c r2)"
Chengsong
parents:
diff changeset
   437
  and   "rs1 s\<leadsto> rs2 \<Longrightarrow> map (bder c) rs1 s\<leadsto>* map (bder c) rs2"
Chengsong
parents:
diff changeset
   438
proof(induction rule: rrewrite_srewrite.inducts)
Chengsong
parents:
diff changeset
   439
  case (bs1 bs r2)
Chengsong
parents:
diff changeset
   440
  then show ?case
Chengsong
parents:
diff changeset
   441
    by (simp add: continuous_rewrite) 
Chengsong
parents:
diff changeset
   442
next
Chengsong
parents:
diff changeset
   443
  case (bs2 bs r1)
Chengsong
parents:
diff changeset
   444
  then show ?case 
Chengsong
parents:
diff changeset
   445
    apply(auto)
Chengsong
parents:
diff changeset
   446
    apply (meson bs6 contextrewrites0 rrewrite_srewrite.bs2 rs2 ss3 ss4 sss1 sss2)
Chengsong
parents:
diff changeset
   447
    by (simp add: r_in_rstar rrewrite_srewrite.bs2)
Chengsong
parents:
diff changeset
   448
next
Chengsong
parents:
diff changeset
   449
  case (bs3 bs1 bs2 r)
Chengsong
parents:
diff changeset
   450
  then show ?case 
Chengsong
parents:
diff changeset
   451
    apply(simp)
Chengsong
parents:
diff changeset
   452
    
Chengsong
parents:
diff changeset
   453
    by (metis (no_types, lifting) bder_fuse bs10 bs7 fuse_append rrewrites.simps ss4 to_zero_in_alt)
Chengsong
parents:
diff changeset
   454
next
Chengsong
parents:
diff changeset
   455
  case (bs4 r1 r2 bs r3)
Chengsong
parents:
diff changeset
   456
  have as: "r1 \<leadsto> r2" by fact
Chengsong
parents:
diff changeset
   457
  have IH: "bder c r1 \<leadsto>* bder c r2" by fact
Chengsong
parents:
diff changeset
   458
  from as IH show "bder c (ASEQ bs r1 r3) \<leadsto>* bder c (ASEQ bs r2 r3)"
Chengsong
parents:
diff changeset
   459
    by (metis bder.simps(5) bnullable0(1) contextrewrites1 rewrite_bmkeps_aux(1) star_seq)
Chengsong
parents:
diff changeset
   460
next
Chengsong
parents:
diff changeset
   461
  case (bs5 r3 r4 bs r1)
Chengsong
parents:
diff changeset
   462
  have as: "r3 \<leadsto> r4" by fact 
Chengsong
parents:
diff changeset
   463
  have IH: "bder c r3 \<leadsto>* bder c r4" by fact 
Chengsong
parents:
diff changeset
   464
  from as IH show "bder c (ASEQ bs r1 r3) \<leadsto>* bder c (ASEQ bs r1 r4)"
Chengsong
parents:
diff changeset
   465
    apply(simp)
Chengsong
parents:
diff changeset
   466
    apply(auto)
Chengsong
parents:
diff changeset
   467
    using contextrewrites0 r_in_rstar rewrites_fuse srewrites6 srewrites7 star_seq2 apply presburger
Chengsong
parents:
diff changeset
   468
    using star_seq2 by blast
Chengsong
parents:
diff changeset
   469
next
Chengsong
parents:
diff changeset
   470
  case (bs6 bs)
Chengsong
parents:
diff changeset
   471
  then show ?case
Chengsong
parents:
diff changeset
   472
    using rrewrite_srewrite.bs6 by force 
Chengsong
parents:
diff changeset
   473
next
Chengsong
parents:
diff changeset
   474
  case (bs7 bs r)
Chengsong
parents:
diff changeset
   475
  then show ?case
Chengsong
parents:
diff changeset
   476
    by (simp add: bder_fuse r_in_rstar rrewrite_srewrite.bs7) 
Chengsong
parents:
diff changeset
   477
next
Chengsong
parents:
diff changeset
   478
  case (bs10 rs1 rs2 bs)
Chengsong
parents:
diff changeset
   479
  then show ?case
Chengsong
parents:
diff changeset
   480
    using contextrewrites0 by force    
Chengsong
parents:
diff changeset
   481
next
Chengsong
parents:
diff changeset
   482
  case ss1
Chengsong
parents:
diff changeset
   483
  then show ?case by simp
Chengsong
parents:
diff changeset
   484
next
Chengsong
parents:
diff changeset
   485
  case (ss2 rs1 rs2 r)
Chengsong
parents:
diff changeset
   486
  then show ?case
Chengsong
parents:
diff changeset
   487
    by (simp add: srewrites7) 
Chengsong
parents:
diff changeset
   488
next
Chengsong
parents:
diff changeset
   489
  case (ss3 r1 r2 rs)
Chengsong
parents:
diff changeset
   490
  then show ?case
Chengsong
parents:
diff changeset
   491
    by (simp add: srewrites7) 
Chengsong
parents:
diff changeset
   492
next
Chengsong
parents:
diff changeset
   493
  case (ss4 rs)
Chengsong
parents:
diff changeset
   494
  then show ?case
Chengsong
parents:
diff changeset
   495
    using rrewrite_srewrite.ss4 by fastforce 
Chengsong
parents:
diff changeset
   496
next
Chengsong
parents:
diff changeset
   497
  case (ss5 bs1 rs1 rsb)
Chengsong
parents:
diff changeset
   498
  then show ?case 
Chengsong
parents:
diff changeset
   499
    apply(simp)
Chengsong
parents:
diff changeset
   500
    using bder_fuse_list map_map rrewrite_srewrite.ss5 srewrites.simps by blast
Chengsong
parents:
diff changeset
   501
next
Chengsong
parents:
diff changeset
   502
  case (ss6 a1 a2 bs rsa rsb)
Chengsong
parents:
diff changeset
   503
  then show ?case
Chengsong
parents:
diff changeset
   504
    apply(simp only: map_append map1)
Chengsong
parents:
diff changeset
   505
    apply(rule srewrites_trans)
Chengsong
parents:
diff changeset
   506
    apply(rule rs_in_rstar)
Chengsong
parents:
diff changeset
   507
    apply(rule_tac rrewrite_srewrite.ss6)
Chengsong
parents:
diff changeset
   508
    using Der_def der_correctness apply auto[1]
Chengsong
parents:
diff changeset
   509
    by blast
Chengsong
parents:
diff changeset
   510
qed
Chengsong
parents:
diff changeset
   511
Chengsong
parents:
diff changeset
   512
lemma rewrites_preserves_bder: 
Chengsong
parents:
diff changeset
   513
  assumes "r1 \<leadsto>* r2"
Chengsong
parents:
diff changeset
   514
  shows "bder c r1 \<leadsto>* bder c r2"
Chengsong
parents:
diff changeset
   515
using assms  
Chengsong
parents:
diff changeset
   516
apply(induction r1 r2 rule: rrewrites.induct)
Chengsong
parents:
diff changeset
   517
apply(simp_all add: rewrite_preserves_bder rrewrites_trans)
548
e5db23c100ea before removing distinctWith
Chengsong
parents: 547
diff changeset
   518
  done
544
Chengsong
parents:
diff changeset
   519
Chengsong
parents:
diff changeset
   520
Chengsong
parents:
diff changeset
   521
Chengsong
parents:
diff changeset
   522
Chengsong
parents:
diff changeset
   523
fun ABIncludedByC :: "'a \<Rightarrow> 'b \<Rightarrow> 'c \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> ('c \<Rightarrow> 'c \<Rightarrow> bool) \<Rightarrow> bool" where
Chengsong
parents:
diff changeset
   524
  "ABIncludedByC a b c f subseteqPred = subseteqPred (f a b) c"
Chengsong
parents:
diff changeset
   525
Chengsong
parents:
diff changeset
   526
fun furtherSEQ :: "rexp \<Rightarrow> rexp \<Rightarrow> rexp list" and 
Chengsong
parents:
diff changeset
   527
   turnIntoTerms :: "rexp \<Rightarrow> rexp list "
Chengsong
parents:
diff changeset
   528
   where
Chengsong
parents:
diff changeset
   529
  "furtherSEQ ONE r2 =  turnIntoTerms r2 "
Chengsong
parents:
diff changeset
   530
| "furtherSEQ r11 r2 = [SEQ r11 r2]"
Chengsong
parents:
diff changeset
   531
| "turnIntoTerms (SEQ ONE r2) =  turnIntoTerms r2"
Chengsong
parents:
diff changeset
   532
| "turnIntoTerms (SEQ r1 r2) = concat (map (\<lambda>r11. furtherSEQ r11 r2) (turnIntoTerms r1))"
Chengsong
parents:
diff changeset
   533
| "turnIntoTerms r = [r]"
Chengsong
parents:
diff changeset
   534
Chengsong
parents:
diff changeset
   535
fun regConcat :: "rexp \<Rightarrow> rexp list \<Rightarrow> rexp" where
Chengsong
parents:
diff changeset
   536
  "regConcat acc [] = acc"
Chengsong
parents:
diff changeset
   537
| "regConcat ONE (r # rs1) = regConcat r rs1"
Chengsong
parents:
diff changeset
   538
| "regConcat acc (r # rs1) = regConcat (SEQ acc r) rs1"
Chengsong
parents:
diff changeset
   539
Chengsong
parents:
diff changeset
   540
fun attachCtx :: "arexp \<Rightarrow> rexp list \<Rightarrow> rexp set" where
Chengsong
parents:
diff changeset
   541
  "attachCtx r ctx = set (turnIntoTerms (regConcat (erase r) ctx))"
Chengsong
parents:
diff changeset
   542
Chengsong
parents:
diff changeset
   543
Chengsong
parents:
diff changeset
   544
Chengsong
parents:
diff changeset
   545
fun rs1_subseteq_rs2 :: "rexp set \<Rightarrow> rexp set \<Rightarrow> bool" where
Chengsong
parents:
diff changeset
   546
  "rs1_subseteq_rs2 rs1 rs2 = (rs1 \<subseteq> rs2)"
Chengsong
parents:
diff changeset
   547
545
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   548
fun notZero :: "arexp \<Rightarrow> bool" where
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   549
  "notZero AZERO = True"
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   550
| "notZero _ = False"
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   551
544
Chengsong
parents:
diff changeset
   552
fun prune6 :: "rexp set \<Rightarrow> arexp \<Rightarrow> rexp list \<Rightarrow> arexp" where
Chengsong
parents:
diff changeset
   553
  "prune6 acc a ctx = (if (ABIncludedByC a ctx acc attachCtx rs1_subseteq_rs2) then AZERO else 
Chengsong
parents:
diff changeset
   554
                        (case a of (ASEQ bs r1 r2) \<Rightarrow> bsimp_ASEQ bs (prune6 acc r1 (erase r2 # ctx)) r2
545
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   555
                                 | AALTs bs rs0 \<Rightarrow> bsimp_AALTs bs (filter notZero (map (\<lambda>r.(prune6 acc r ctx)) rs0)))  )"
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   556
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   557
544
Chengsong
parents:
diff changeset
   558
fun dB6 :: "arexp list \<Rightarrow> rexp set \<Rightarrow> arexp list" where
Chengsong
parents:
diff changeset
   559
  "dB6 [] acc = []"
Chengsong
parents:
diff changeset
   560
| "dB6 (a # as) acc = (if (erase a \<in> acc) then (dB6 as acc) 
545
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   561
                       else (let pruned = prune6 acc a [] in 
544
Chengsong
parents:
diff changeset
   562
                              (case pruned of
Chengsong
parents:
diff changeset
   563
                                 AZERO \<Rightarrow> dB6 as acc
545
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   564
                               |xPrime \<Rightarrow> xPrime # (dB6 as ( (set (turnIntoTerms (erase pruned))) \<union> acc)  ) ) ))   "
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   565
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   566
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   567
fun bsimpStrong6 :: "arexp \<Rightarrow> arexp" 
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   568
  where
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   569
  "bsimpStrong6 (ASEQ bs1 r1 r2) = bsimp_ASEQ bs1 (bsimpStrong6 r1) (bsimpStrong6 r2)"
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   570
| "bsimpStrong6 (AALTs bs1 rs) = bsimp_AALTs bs1 (dB6 (flts (map bsimpStrong6 rs)) {}) "
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   571
| "bsimpStrong6 r = r"
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   572
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   573
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   574
fun 
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   575
  bdersStrong6 :: "arexp \<Rightarrow> string \<Rightarrow> arexp"
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   576
where
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   577
  "bdersStrong6 r [] = r"
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   578
| "bdersStrong6 r (c # s) = bdersStrong6 (bsimpStrong6 (bder c r)) s"
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   579
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   580
definition blexerStrong where
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   581
 "blexerStrong r s \<equiv> if bnullable (bdersStrong6 (intern r) s) then 
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   582
                    decode (bmkeps (bdersStrong6 (intern r) s)) r else None"
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   583
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   584
548
e5db23c100ea before removing distinctWith
Chengsong
parents: 547
diff changeset
   585
lemma bders_simp_appendStrong :
e5db23c100ea before removing distinctWith
Chengsong
parents: 547
diff changeset
   586
  shows "bdersStrong6 r (s1 @ s2) = bdersStrong6 (bdersStrong6 r s1) s2"
e5db23c100ea before removing distinctWith
Chengsong
parents: 547
diff changeset
   587
  apply(induct s1 arbitrary: s2 rule: rev_induct)
e5db23c100ea before removing distinctWith
Chengsong
parents: 547
diff changeset
   588
   apply simp
e5db23c100ea before removing distinctWith
Chengsong
parents: 547
diff changeset
   589
  apply auto
e5db23c100ea before removing distinctWith
Chengsong
parents: 547
diff changeset
   590
  done
e5db23c100ea before removing distinctWith
Chengsong
parents: 547
diff changeset
   591
e5db23c100ea before removing distinctWith
Chengsong
parents: 547
diff changeset
   592
546
6e97f4aa7cd0 beforeBig changes
Chengsong
parents: 545
diff changeset
   593
6e97f4aa7cd0 beforeBig changes
Chengsong
parents: 545
diff changeset
   594
547
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   595
lemma rewrites_to_bsimpStrong: 
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   596
  shows "r \<leadsto>* bsimpStrong6 r"
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   597
proof (induction r rule: bsimpStrong6.induct)
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   598
  case (1 bs1 r1 r2)
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   599
  have IH1: "r1 \<leadsto>* bsimpStrong6 r1" by fact
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   600
  have IH2: "r2 \<leadsto>* bsimpStrong6 r2" by fact
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   601
  { assume as: "bsimpStrong6 r1 = AZERO \<or> bsimpStrong6 r2 = AZERO"
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   602
    with IH1 IH2 have "r1 \<leadsto>* AZERO \<or> r2 \<leadsto>* AZERO" by auto
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   603
    then have "ASEQ bs1 r1 r2 \<leadsto>* AZERO"
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   604
      by (metis bs2 continuous_rewrite rrewrites.simps star_seq2)  
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   605
    then have "ASEQ bs1 r1 r2 \<leadsto>* bsimpStrong6 (ASEQ bs1 r1 r2)" using as by auto
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   606
  }
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   607
  moreover
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   608
  { assume "\<exists>bs. bsimpStrong6 r1 = AONE bs"
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   609
    then obtain bs where as: "bsimpStrong6 r1 = AONE bs" by blast
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   610
    with IH1 have "r1 \<leadsto>* AONE bs" by simp
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   611
    then have "ASEQ bs1 r1 r2 \<leadsto>* fuse (bs1 @ bs) r2" using bs3 star_seq by blast
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   612
    with IH2 have "ASEQ bs1 r1 r2 \<leadsto>* fuse (bs1 @ bs) (bsimpStrong6 r2)"
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   613
      using rewrites_fuse by (meson rrewrites_trans) 
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   614
    then have "ASEQ bs1 r1 r2 \<leadsto>* bsimpStrong6 (ASEQ bs1 (AONE bs) r2)" by simp
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   615
    then have "ASEQ bs1 r1 r2 \<leadsto>* bsimpStrong6 (ASEQ bs1 r1 r2)" by (simp add: as) 
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   616
  } 
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   617
  moreover
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   618
  { assume as1: "bsimpStrong6 r1 \<noteq> AZERO" "bsimpStrong6 r2 \<noteq> AZERO" and as2: "(\<nexists>bs. bsimpStrong6 r1 = AONE bs)" 
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   619
    then have "bsimp_ASEQ bs1 (bsimpStrong6 r1) (bsimpStrong6 r2) = ASEQ bs1 (bsimpStrong6 r1) (bsimpStrong6 r2)" 
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   620
      by (simp add: bsimp_ASEQ1) 
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   621
    then have "ASEQ bs1 r1 r2 \<leadsto>* bsimp_ASEQ bs1 (bsimpStrong6 r1) (bsimpStrong6 r2)" using as1 as2 IH1 IH2
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   622
      by (metis rrewrites_trans star_seq star_seq2) 
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   623
    then have "ASEQ bs1 r1 r2 \<leadsto>* bsimpStrong6 (ASEQ bs1 r1 r2)" by simp
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   624
  } 
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   625
  ultimately show "ASEQ bs1 r1 r2 \<leadsto>* bsimpStrong6 (ASEQ bs1 r1 r2)" sorry
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   626
next
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   627
  case (2 bs1 rs)
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   628
  have IH: "\<And>x. x \<in> set rs \<Longrightarrow> x \<leadsto>* bsimpStrong6 x" by fact
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   629
  then have "rs s\<leadsto>* (map bsimpStrong6 rs)" by (simp add: trivialbsimp_srewrites)
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   630
  also have "... s\<leadsto>* flts (map bsimpStrong6 rs)" by (simp add: fltsfrewrites) 
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   631
  also have "... s\<leadsto>* distinctWith (flts (map bsimpStrong6 rs)) eq1 {}" by (simp add: ss6_stronger)
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   632
  finally have "AALTs bs1 rs \<leadsto>* AALTs bs1 (distinctWith (flts (map bsimpStrong6 rs)) eq1 {})"
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   633
    using contextrewrites0 by auto
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   634
  also have "... \<leadsto>* bsimp_AALTs  bs1 (distinctWith (flts (map bsimpStrong6 rs)) eq1 {})"
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   635
    by (simp add: bsimp_AALTs_rewrites)     
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   636
  finally show "AALTs bs1 rs \<leadsto>* bsimpStrong6 (AALTs bs1 rs)" sorry
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   637
qed (simp_all)
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   638
548
e5db23c100ea before removing distinctWith
Chengsong
parents: 547
diff changeset
   639
547
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   640
546
6e97f4aa7cd0 beforeBig changes
Chengsong
parents: 545
diff changeset
   641
545
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   642
lemma centralStrong:  
546
6e97f4aa7cd0 beforeBig changes
Chengsong
parents: 545
diff changeset
   643
  shows "bders r s \<leadsto>* bdersStrong6 r s"
545
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   644
proof(induct s arbitrary: r rule: rev_induct)
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   645
  case Nil
546
6e97f4aa7cd0 beforeBig changes
Chengsong
parents: 545
diff changeset
   646
  then show "bders r [] \<leadsto>* bdersStrong6 r []" by simp
545
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   647
next
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   648
  case (snoc x xs)
546
6e97f4aa7cd0 beforeBig changes
Chengsong
parents: 545
diff changeset
   649
  have IH: "\<And>r. bders r xs \<leadsto>* bdersStrong6 r xs" by fact
6e97f4aa7cd0 beforeBig changes
Chengsong
parents: 545
diff changeset
   650
  have "bders r (xs @ [x]) = bders (bders r xs) [x]" by (simp add: bders_append)
6e97f4aa7cd0 beforeBig changes
Chengsong
parents: 545
diff changeset
   651
  also have "... \<leadsto>* bders (bdersStrong6 r xs) [x]" using IH
545
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   652
    by (simp add: rewrites_preserves_bder)
546
6e97f4aa7cd0 beforeBig changes
Chengsong
parents: 545
diff changeset
   653
  also have "... \<leadsto>* bdersStrong6 (bdersStrong6 r xs) [x]" using IH
547
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   654
    by (simp add: rewrites_to_bsimpStrong)
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   655
  finally show "bders r (xs @ [x]) \<leadsto>* bdersStrong6 r (xs @ [x])" 
feae84f66472 before alternating rewriting relation
Chengsong
parents: 546
diff changeset
   656
    by (simp add: bders_simp_appendStrong)
545
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   657
qed
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   658
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   659
lemma mainStrong: 
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   660
  assumes "bnullable (bders r s)"
546
6e97f4aa7cd0 beforeBig changes
Chengsong
parents: 545
diff changeset
   661
  shows "bmkeps (bders r s) = bmkeps (bdersStrong6 r s)"
545
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   662
proof -
548
e5db23c100ea before removing distinctWith
Chengsong
parents: 547
diff changeset
   663
  have "bders r s \<leadsto>* bdersStrong6 r s" 
e5db23c100ea before removing distinctWith
Chengsong
parents: 547
diff changeset
   664
    using centralStrong by force
545
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   665
  then 
546
6e97f4aa7cd0 beforeBig changes
Chengsong
parents: 545
diff changeset
   666
  show "bmkeps (bders r s) = bmkeps (bdersStrong6 r s)" 
548
e5db23c100ea before removing distinctWith
Chengsong
parents: 547
diff changeset
   667
    using assms rewrites_bmkeps by blast
545
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   668
qed
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   669
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   670
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   671
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   672
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   673
theorem blexerStrong_correct :
548
e5db23c100ea before removing distinctWith
Chengsong
parents: 547
diff changeset
   674
  shows "blexerStrong r s = blexer r s"
e5db23c100ea before removing distinctWith
Chengsong
parents: 547
diff changeset
   675
  unfolding blexerStrong_def blexer_def
e5db23c100ea before removing distinctWith
Chengsong
parents: 547
diff changeset
   676
  by (metis centralStrong mainStrong rewritesnullable)
545
333013923c5a more changes to blexersimp.thy
Chengsong
parents: 544
diff changeset
   677
544
Chengsong
parents:
diff changeset
   678
Chengsong
parents:
diff changeset
   679
Chengsong
parents:
diff changeset
   680
end