Myhill.thy
changeset 30 f5db9e08effc
parent 29 c64241fa4dff
child 31 b6815473ee2e
equal deleted inserted replaced
29:c64241fa4dff 30:f5db9e08effc
     1 theory MyhillNerode
     1 theory Myhill
     2   imports "Main" "List_Prefix"
     2   imports Main List_Prefix
     3 begin
     3 begin
     4 
     4 
     5 text {* sequential composition of languages *}
     5 section {* Preliminary definitions *}
       
     6 
       
     7 text {* Sequential composition of two languages @{text "L1"} and @{text "L2"} *}
     6 definition Seq :: "string set \<Rightarrow> string set \<Rightarrow> string set" ("_ ;; _" [100,100] 100)
     8 definition Seq :: "string set \<Rightarrow> string set \<Rightarrow> string set" ("_ ;; _" [100,100] 100)
     7 where 
     9 where 
     8   "L1 ;; L2 = {s1 @ s2 | s1 s2. s1 \<in> L1 \<and> s2 \<in> L2}"
    10   "L1 ;; L2 = {s1 @ s2 | s1 s2. s1 \<in> L1 \<and> s2 \<in> L2}"
     9 
    11 
       
    12 text {* Transitive closure of language @{text "L"}. *}
    10 inductive_set
    13 inductive_set
    11   Star :: "string set \<Rightarrow> string set" ("_\<star>" [101] 102)
    14   Star :: "string set \<Rightarrow> string set" ("_\<star>" [101] 102)
    12   for L :: "string set"
    15   for L :: "string set"
    13 where
    16 where
    14   start[intro]: "[] \<in> L\<star>"
    17   start[intro]: "[] \<in> L\<star>"
    15 | step[intro]:  "\<lbrakk>s1 \<in> L; s2 \<in> L\<star>\<rbrakk> \<Longrightarrow> s1@s2 \<in> L\<star>" 
    18 | step[intro]:  "\<lbrakk>s1 \<in> L; s2 \<in> L\<star>\<rbrakk> \<Longrightarrow> s1@s2 \<in> L\<star>" 
    16 
    19 
       
    20 text {* Some properties of operator @{text ";;"}.*}
       
    21 
    17 lemma seq_union_distrib:
    22 lemma seq_union_distrib:
    18   "(A \<union> B) ;; C = (A ;; C) \<union> (B ;; C)"
    23   "(A \<union> B) ;; C = (A ;; C) \<union> (B ;; C)"
    19 by (auto simp:Seq_def)
    24 by (auto simp:Seq_def)
    20 
    25 
    21 lemma seq_intro:
    26 lemma seq_intro:
    26   "(A ;; B) ;; C = A ;; (B ;; C)"
    31   "(A ;; B) ;; C = A ;; (B ;; C)"
    27 apply(auto simp:Seq_def)
    32 apply(auto simp:Seq_def)
    28 apply blast
    33 apply blast
    29 by (metis append_assoc)
    34 by (metis append_assoc)
    30 
    35 
       
    36 lemma star_intro1[rule_format]: "x \<in> lang\<star> \<Longrightarrow> \<forall> y. y \<in> lang\<star> \<longrightarrow> x @ y \<in> lang\<star>"
       
    37 by (erule Star.induct, auto)
       
    38 
       
    39 lemma star_intro2: "y \<in> lang \<Longrightarrow> y \<in> lang\<star>"
       
    40 by (drule step[of y lang "[]"], auto simp:start)
       
    41 
       
    42 lemma star_intro3[rule_format]: 
       
    43   "x \<in> lang\<star> \<Longrightarrow> \<forall>y . y \<in> lang \<longrightarrow> x @ y \<in> lang\<star>"
       
    44 by (erule Star.induct, auto intro:star_intro2)
       
    45 
       
    46 lemma star_decom: 
       
    47   "\<lbrakk>x \<in> lang\<star>; x \<noteq> []\<rbrakk> \<Longrightarrow>(\<exists> a b. x = a @ b \<and> a \<noteq> [] \<and> a \<in> lang \<and> b \<in> lang\<star>)"
       
    48 by (induct x rule: Star.induct, simp, blast)
       
    49 
       
    50 lemma star_decom': 
       
    51   "\<lbrakk>x \<in> lang\<star>; x \<noteq> []\<rbrakk> \<Longrightarrow> \<exists>a b. x = a @ b \<and> a \<in> lang\<star> \<and> b \<in> lang"
       
    52 apply (induct x rule:Star.induct, simp)
       
    53 apply (case_tac "s2 = []")
       
    54 apply (rule_tac x = "[]" in exI, rule_tac x = s1 in exI, simp add:start)
       
    55 apply (simp, (erule exE| erule conjE)+)
       
    56 by (rule_tac x = "s1 @ a" in exI, rule_tac x = b in exI, simp add:step)
       
    57 
       
    58 text {* Ardens lemma expressed at the level of language, rather than the level of regular expression. *}
       
    59 
    31 theorem ardens_revised:
    60 theorem ardens_revised:
    32   assumes nemp: "[] \<notin> A"
    61   assumes nemp: "[] \<notin> A"
    33   shows "(X = X ;; A \<union> B) \<longleftrightarrow> (X = B ;; A\<star>)"
    62   shows "(X = X ;; A \<union> B) \<longleftrightarrow> (X = B ;; A\<star>)"
    34 proof
    63 proof
    35   assume eq: "X = B ;; A\<star>"
    64   assume eq: "X = B ;; A\<star>"
    36   have "A\<star> =  {[]} \<union> A\<star> ;; A" sorry 
    65   have "A\<star> =  {[]} \<union> A\<star> ;; A" 
    37   then have "B ;; A\<star> = B ;; ({[]} \<union> A\<star> ;; A)" unfolding Seq_def by simp
    66     by (auto simp:Seq_def star_intro3 star_decom')  
    38   also have "\<dots> = B \<union> B ;; (A\<star> ;; A)"  unfolding Seq_def by auto
    67   then have "B ;; A\<star> = B ;; ({[]} \<union> A\<star> ;; A)" 
    39   also have "\<dots> = B \<union> (B ;; A\<star>) ;; A"  unfolding Seq_def
    68     unfolding Seq_def by simp
    40     by (auto) (metis append_assoc)+
    69   also have "\<dots> = B \<union> B ;; (A\<star> ;; A)"  
    41   finally show "X = X ;; A \<union> B" using eq by auto
    70     unfolding Seq_def by auto
       
    71   also have "\<dots> = B \<union> (B ;; A\<star>) ;; A" 
       
    72     by (simp only:seq_assoc)
       
    73   finally show "X = X ;; A \<union> B" 
       
    74     using eq by blast 
    42 next
    75 next
    43   assume "X = X ;; A \<union> B"
    76   assume eq': "X = X ;; A \<union> B"
    44   then have "B \<subseteq> X" "X ;; A \<subseteq> X" by auto
    77   hence c1': "\<And> x. x \<in> B \<Longrightarrow> x \<in> X" 
    45   thus "X = B ;; A\<star>" sorry
    78     and c2': "\<And> x y. \<lbrakk>x \<in> X; y \<in> A\<rbrakk> \<Longrightarrow> x @ y \<in> X" 
    46 qed
    79     using Seq_def by auto
    47 
    80   show "X = B ;; A\<star>" 
       
    81   proof
       
    82     show "B ;; A\<star> \<subseteq> X"
       
    83     proof-
       
    84       { fix x y
       
    85         have "\<lbrakk>y \<in> A\<star>; x \<in> X\<rbrakk> \<Longrightarrow> x @ y \<in> X "
       
    86           apply (induct arbitrary:x rule:Star.induct, simp)
       
    87           by (auto simp only:append_assoc[THEN sym] dest:c2')
       
    88       } thus ?thesis using c1' by (auto simp:Seq_def) 
       
    89     qed
       
    90   next
       
    91     show "X \<subseteq> B ;; A\<star>"
       
    92     proof-
       
    93       { fix x 
       
    94         have "x \<in> X \<Longrightarrow> x \<in> B ;; A\<star>"
       
    95         proof (induct x taking:length rule:measure_induct)
       
    96           fix z
       
    97           assume hyps: 
       
    98             "\<forall>y. length y < length z \<longrightarrow> y \<in> X \<longrightarrow> y \<in> B ;; A\<star>" 
       
    99             and z_in: "z \<in> X"
       
   100           show "z \<in> B ;; A\<star>"
       
   101           proof (cases "z \<in> B")
       
   102             case True thus ?thesis by (auto simp:Seq_def start)
       
   103           next
       
   104             case False hence "z \<in> X ;; A" using eq' z_in by auto
       
   105             then obtain za zb where za_in: "za \<in> X" 
       
   106               and zab: "z = za @ zb \<and> zb \<in> A" and zbne: "zb \<noteq> []" 
       
   107               using nemp unfolding Seq_def by blast
       
   108             from zbne zab have "length za < length z" by auto
       
   109             with za_in hyps have "za \<in> B ;; A\<star>" by blast
       
   110             hence "za @ zb \<in> B ;; A\<star>" using zab 
       
   111               by (clarsimp simp:Seq_def, blast dest:star_intro3)
       
   112             thus ?thesis using zab by simp       
       
   113           qed
       
   114         qed 
       
   115       } thus ?thesis by blast
       
   116     qed
       
   117   qed
       
   118 qed
       
   119 
       
   120 
       
   121 text {* The syntax of regular expressions is defined by the datatype @{text "rexp"}. *}
    48 datatype rexp =
   122 datatype rexp =
    49   NULL
   123   NULL
    50 | EMPTY
   124 | EMPTY
    51 | CHAR char
   125 | CHAR char
    52 | SEQ rexp rexp
   126 | SEQ rexp rexp
    53 | ALT rexp rexp
   127 | ALT rexp rexp
    54 | STAR rexp
   128 | STAR rexp
    55 
   129 
       
   130 
       
   131 text {* 
       
   132   The following @{text "L"} is an overloaded operator, where @{text "L(x)"} evaluates to 
       
   133   the language represented by the syntactic object @{text "x"}.
       
   134 *}
    56 consts L:: "'a \<Rightarrow> string set"
   135 consts L:: "'a \<Rightarrow> string set"
    57 
   136 
       
   137 
       
   138 text {* 
       
   139   The @{text "L(rexp)"} for regular expression @{text "rexp"} is defined by the 
       
   140   following overloading function @{text "L_rexp"}.
       
   141 *}
    58 overloading L_rexp \<equiv> "L::  rexp \<Rightarrow> string set"
   142 overloading L_rexp \<equiv> "L::  rexp \<Rightarrow> string set"
    59 begin
   143 begin
    60 
       
    61 fun
   144 fun
    62   L_rexp :: "rexp \<Rightarrow> string set"
   145   L_rexp :: "rexp \<Rightarrow> string set"
    63 where
   146 where
    64     "L_rexp (NULL) = {}"
   147     "L_rexp (NULL) = {}"
    65   | "L_rexp (EMPTY) = {[]}"
   148   | "L_rexp (EMPTY) = {[]}"
    67   | "L_rexp (SEQ r1 r2) = (L_rexp r1) ;; (L_rexp r2)"
   150   | "L_rexp (SEQ r1 r2) = (L_rexp r1) ;; (L_rexp r2)"
    68   | "L_rexp (ALT r1 r2) = (L_rexp r1) \<union> (L_rexp r2)"
   151   | "L_rexp (ALT r1 r2) = (L_rexp r1) \<union> (L_rexp r2)"
    69   | "L_rexp (STAR r) = (L_rexp r)\<star>"
   152   | "L_rexp (STAR r) = (L_rexp r)\<star>"
    70 end
   153 end
    71 
   154 
       
   155 text {*
       
   156   To obtain equational system out of finite set of equivalent classes, a fold operation
       
   157   on finite set @{text "folds"} is defined. The use of @{text "SOME"} makes @{text "fold"}
       
   158   more robust than the @{text "fold"} in Isabelle library. The expression @{text "folds f"}
       
   159   makes sense when @{text "f"} is not @{text "associative"} and @{text "commutitive"},
       
   160   while @{text "fold f"} does not.  
       
   161 *}
       
   162 
    72 definition 
   163 definition 
    73   folds :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'b \<Rightarrow> 'a set \<Rightarrow> 'b"
   164   folds :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'b \<Rightarrow> 'a set \<Rightarrow> 'b"
    74 where
   165 where
    75   "folds f z S \<equiv> SOME x. fold_graph f z S x"
   166   "folds f z S \<equiv> SOME x. fold_graph f z S x"
    76 
   167 
       
   168 text {* 
       
   169   The following lemma assures that the arbitrary choice made by the @{text "SOME"} in @{text "folds"}
       
   170   does not affect the @{text "L"}-value of the resultant regular expression. 
       
   171   *}
    77 lemma folds_alt_simp [simp]:
   172 lemma folds_alt_simp [simp]:
    78   "finite rs \<Longrightarrow> L (folds ALT NULL rs) = \<Union> (L ` rs)"
   173   "finite rs \<Longrightarrow> L (folds ALT NULL rs) = \<Union> (L ` rs)"
    79 apply (rule set_ext, simp add:folds_def)
   174 apply (rule set_ext, simp add:folds_def)
    80 apply (rule someI2_ex, erule finite_imp_fold_graph)
   175 apply (rule someI2_ex, erule finite_imp_fold_graph)
    81 by (erule fold_graph.induct, auto)
   176 by (erule fold_graph.induct, auto)
    82 
   177 
       
   178 (* Just a technical lemma. *)
    83 lemma [simp]:
   179 lemma [simp]:
    84   shows "(x, y) \<in> {(x, y). P x y} \<longleftrightarrow> P x y"
   180   shows "(x, y) \<in> {(x, y). P x y} \<longleftrightarrow> P x y"
    85 by simp
   181 by simp
    86 
   182 
    87 definition
   183 
    88   str_eq ("_ \<approx>_ _")
   184 text {*
    89 where
   185   @{text "\<approx>L"} is an equivalent class defined by language @{text "Lang"}.
    90   "x \<approx>Lang y \<equiv> (\<forall>z. x @ z \<in> Lang \<longleftrightarrow> y @ z \<in> Lang)"
   186 *}
    91 
       
    92 definition
   187 definition
    93   str_eq_rel ("\<approx>_")
   188   str_eq_rel ("\<approx>_")
    94 where
   189 where
    95   "\<approx>Lang \<equiv> {(x, y). x \<approx>Lang y}"
   190   "\<approx>Lang \<equiv> {(x, y).  (\<forall>z. x @ z \<in> Lang \<longleftrightarrow> y @ z \<in> Lang)}"
    96 
   191 
    97 definition
   192 text {* 
    98   final :: "string set \<Rightarrow> string set \<Rightarrow> bool"
   193   Among equivlant clases of @{text "\<approx>Lang"}, the set @{text "finals(Lang)"} singles out 
    99 where
   194   those which contains strings from @{text "Lang"}.
   100   "final X Lang \<equiv> (X \<in> UNIV // \<approx>Lang) \<and> (\<forall>s \<in> X. s \<in> Lang)"
   195 *}
   101 
   196 
       
   197 definition 
       
   198    "finals Lang \<equiv> {\<approx>Lang `` {x} | x . x \<in> Lang}"
       
   199 
       
   200 text {* 
       
   201   The following lemma show the relationshipt between @{text "finals(Lang)"} and @{text "Lang"}.
       
   202 *}
   102 lemma lang_is_union_of_finals: 
   203 lemma lang_is_union_of_finals: 
   103   "Lang = \<Union> {X. final X Lang}"
   204   "Lang = \<Union> finals(Lang)"
   104 proof 
   205 proof 
   105   show "Lang \<subseteq> \<Union> {X. final X Lang}"
   206   show "Lang \<subseteq> \<Union> (finals Lang)"
   106   proof
   207   proof
   107     fix x
   208     fix x
   108     assume "x \<in> Lang"   
   209     assume "x \<in> Lang"   
   109     thus "x \<in> \<Union> {X. final X Lang}"
   210     thus "x \<in> \<Union> (finals Lang)"
   110       apply (simp, rule_tac x = "(\<approx>Lang) `` {x}" in exI)      
   211       apply (simp add:finals_def, rule_tac x = "(\<approx>Lang) `` {x}" in exI)
   111       apply (auto simp:final_def quotient_def Image_def str_eq_rel_def str_eq_def)
   212       by (auto simp:Image_def str_eq_rel_def)    
   112       by (drule_tac x = "[]" in spec, simp)
       
   113   qed
   213   qed
   114 next
   214 next
   115   show "\<Union>{X. final X Lang} \<subseteq> Lang"
   215   show "\<Union> (finals Lang) \<subseteq> Lang"
   116     by (auto simp:final_def)
   216     apply (clarsimp simp:finals_def str_eq_rel_def)
   117 qed
   217     by (drule_tac x = "[]" in spec, auto)
   118 
   218 qed
   119 section {* finite \<Rightarrow> regular *}
   219 
       
   220 section {* Direction @{text "finite partition \<Rightarrow> regular language"}*}
       
   221 
       
   222 text {* 
       
   223   The relationship between equivalent classes can be described by an
       
   224   equational system.
       
   225   For example, in equational system \eqref{example_eqns},  $X_0, X_1$ are equivalent 
       
   226   classes. The first equation says every string in $X_0$ is obtained either by
       
   227   appending one $b$ to a string in $X_0$ or by appending one $a$ to a string in
       
   228   $X_1$ or just be an empty string (represented by the regular expression $\lambda$). Similary,
       
   229   the second equation tells how the strings inside $X_1$ are composed.
       
   230   \begin{equation}\label{example_eqns}
       
   231     \begin{aligned}
       
   232       X_0 & = X_0 b + X_1 a + \lambda \\
       
   233       X_1 & = X_0 a + X_1 b
       
   234     \end{aligned}
       
   235   \end{equation}
       
   236   The summands on the right hand side is represented by the following data type
       
   237   @{text "rhs_item"}, mnemonic for 'right hand side item'.
       
   238   Generally, there are two kinds of right hand side items, one kind corresponds to
       
   239   pure regular expressions, like the $\lambda$ in \eqref{example_eqns}, the other kind corresponds to
       
   240   transitions from one one equivalent class to another, like the $X_0 b, X_1 a$ etc.
       
   241   *}
   120 
   242 
   121 datatype rhs_item = 
   243 datatype rhs_item = 
   122    Lam "rexp"                           (* Lambda *)
   244    Lam "rexp"                           (* Lambda *)
   123  | Trn "string set" "rexp"              (* Transition *)
   245  | Trn "(string set)" "rexp"              (* Transition *)
       
   246 
       
   247 text {*
       
   248   In this formalization, pure regular expressions like $\lambda$ is 
       
   249   repsented by @{text "Lam(EMPTY)"}, while transitions like $X_0 a$ is represented by $Trn~X_0~(CHAR~a)$.
       
   250   *}
       
   251 
       
   252 text {*
       
   253   The functions @{text "the_r"} and @{text "the_Trn"} are used to extract
       
   254   subcomponents from right hand side items.
       
   255   *}
       
   256 
       
   257 fun the_r :: "rhs_item \<Rightarrow> rexp"
       
   258 where "the_r (Lam r) = r"
   124 
   259 
   125 fun the_Trn:: "rhs_item \<Rightarrow> (string set \<times> rexp)"
   260 fun the_Trn:: "rhs_item \<Rightarrow> (string set \<times> rexp)"
   126 where "the_Trn (Trn Y r) = (Y, r)"
   261 where "the_Trn (Trn Y r) = (Y, r)"
   127 
   262 
   128 fun the_r :: "rhs_item \<Rightarrow> rexp"
   263 text {*
   129 where "the_r (Lam r) = r"
   264   Every right hand side item @{text "itm"} defines a string set given 
   130 
   265   @{text "L(itm)"}, defined as:
       
   266 *}
   131 overloading L_rhs_e \<equiv> "L:: rhs_item \<Rightarrow> string set"
   267 overloading L_rhs_e \<equiv> "L:: rhs_item \<Rightarrow> string set"
   132 begin
   268 begin
   133 fun L_rhs_e:: "rhs_item \<Rightarrow> string set"
   269   fun L_rhs_e:: "rhs_item \<Rightarrow> string set"
   134 where
   270   where
   135   "L_rhs_e (Lam r) = L r" |
   271      "L_rhs_e (Lam r) = L r" |
   136   "L_rhs_e (Trn X r) = X ;; L r"
   272      "L_rhs_e (Trn X r) = X ;; L r"
   137 end
   273 end
       
   274 
       
   275 text {*
       
   276   The right hand side of every equation is represented by a set of
       
   277   items. The string set defined by such a set @{text "itms"} is given
       
   278   by @{text "L(itms)"}, defined as:
       
   279 *}
   138 
   280 
   139 overloading L_rhs \<equiv> "L:: rhs_item set \<Rightarrow> string set"
   281 overloading L_rhs \<equiv> "L:: rhs_item set \<Rightarrow> string set"
   140 begin
   282 begin
   141 fun L_rhs:: "rhs_item set \<Rightarrow> string set"
   283    fun L_rhs:: "rhs_item set \<Rightarrow> string set"
   142 where
   284    where "L_rhs rhs = \<Union> (L ` rhs)"
   143   "L_rhs rhs = \<Union> (L ` rhs)"
       
   144 end
   285 end
   145 
   286 
       
   287 text {* 
       
   288   Given a set of equivalent classses @{text "CS"} and one equivalent class @{text "X"} among
       
   289   @{text "CS"}, the term @{text "init_rhs CS X"} is used to extract the right hand side of
       
   290   the equation describing the formation of @{text "X"}. The definition of @{text "init_rhs"}
       
   291   is:
       
   292   *}
       
   293 
   146 definition
   294 definition
   147   "init_rhs CS X \<equiv>  if ([] \<in> X)
   295   "init_rhs CS X \<equiv>  
   148                     then {Lam EMPTY} \<union> {Trn Y (CHAR c)| Y c. Y \<in> CS \<and> Y ;; {[c]} \<subseteq> X}
   296       if ([] \<in> X) then 
   149                     else {Trn Y (CHAR c)| Y c. Y \<in> CS \<and> Y ;; {[c]} \<subseteq> X}"
   297           {Lam(EMPTY)} \<union> {Trn Y (CHAR c) | Y c. Y \<in> CS \<and> Y ;; {[c]} \<subseteq> X}
   150 
   298       else 
   151 definition
   299           {Trn Y (CHAR c)| Y c. Y \<in> CS \<and> Y ;; {[c]} \<subseteq> X}"
   152   "eqs CS \<equiv> {(X, init_rhs CS X)|X.  X \<in> CS}"
   300 
   153 
   301 text {*
       
   302   In the definition of @{text "init_rhs"}, the term 
       
   303   @{text "{Trn Y (CHAR c)| Y c. Y \<in> CS \<and> Y ;; {[c]} \<subseteq> X}"} appearing on both branches
       
   304   describes the formation of strings in @{text "X"} out of transitions, while 
       
   305   the term @{text "{Lam(EMPTY)}"} describes the empty string which is intrinsically contained in
       
   306   @{text "X"} rather than by transition. This @{text "{Lam(EMPTY)}"} corresponds to 
       
   307   the $\lambda$ in \eqref{example_eqns}.
       
   308 
       
   309   With the help of @{text "init_rhs"}, the equitional system descrbing the formation of every
       
   310   equivalent class inside @{text "CS"} is given by the following @{text "eqs(CS)"}.
       
   311   *}
       
   312 
       
   313 definition "eqs CS \<equiv> {(X, init_rhs CS X) | X.  X \<in> CS}"
   154 (************ arden's lemma variation ********************)
   314 (************ arden's lemma variation ********************)
   155 
   315 
       
   316 text {* 
       
   317   The following @{text "items_of rhs X"} returns all @{text "X"}-items in @{text "rhs"}.
       
   318   *}
   156 definition
   319 definition
   157   "items_of rhs X \<equiv> {Trn X r | r. (Trn X r) \<in> rhs}"
   320   "items_of rhs X \<equiv> {Trn X r | r. (Trn X r) \<in> rhs}"
   158 
   321 
       
   322 text {* 
       
   323   The following @{text "rexp_of rhs X"} combines all regular expressions in @{text "X"}-items
       
   324   using @{text "ALT"} to form a single regular expression. 
       
   325   It will be used later to implement @{text "arden_variate"} and @{text "rhs_subst"}.
       
   326   *}
       
   327 
       
   328 definition 
       
   329   "rexp_of rhs X \<equiv> folds ALT NULL ((snd o the_Trn) ` items_of rhs X)"
       
   330 
       
   331 text {* 
       
   332   The following @{text "lam_of rhs"} returns all pure regular expression items in @{text "rhs"}.
       
   333   *}
       
   334 
   159 definition
   335 definition
   160   "lam_of rhs \<equiv> {Lam r | r. Lam r \<in> rhs}"
   336   "lam_of rhs \<equiv> {Lam r | r. Lam r \<in> rhs}"
   161 
   337 
   162 definition 
   338 text {*
   163   "rexp_of rhs X \<equiv> folds ALT NULL ((snd o the_Trn) ` items_of rhs X)"
   339   The following @{text "rexp_of_lam rhs"} combines pure regular expression items in @{text "rhs"}
       
   340   using @{text "ALT"} to form a single regular expression. 
       
   341   When all variables inside @{text "rhs"} are eliminated, @{text "rexp_of_lam rhs"}
       
   342   is used to compute compute the regular expression corresponds to @{text "rhs"}.
       
   343   *}
   164 
   344 
   165 definition
   345 definition
   166   "rexp_of_lam rhs \<equiv> folds ALT NULL (the_r ` lam_of rhs)"
   346   "rexp_of_lam rhs \<equiv> folds ALT NULL (the_r ` lam_of rhs)"
   167 
   347 
       
   348 text {*
       
   349   The following @{text "attach_rexp rexp' itm"} attach 
       
   350   the regular expression @{text "rexp'"} to
       
   351   the right of right hand side item @{text "itm"}.
       
   352   *}
       
   353 
   168 fun attach_rexp :: "rexp \<Rightarrow> rhs_item \<Rightarrow> rhs_item"
   354 fun attach_rexp :: "rexp \<Rightarrow> rhs_item \<Rightarrow> rhs_item"
   169 where
   355 where
   170   "attach_rexp r' (Lam r)   = Lam (SEQ r r')"
   356   "attach_rexp rexp' (Lam rexp)   = Lam (SEQ rexp rexp')"
   171 | "attach_rexp r' (Trn X r) = Trn X (SEQ r r')"
   357 | "attach_rexp rexp' (Trn X rexp) = Trn X (SEQ rexp rexp')"
       
   358 
       
   359 text {* 
       
   360   The following @{text "append_rhs_rexp rhs rexp"} attaches 
       
   361   @{text "rexp"} to every item in @{text "rhs"}.
       
   362   *}
   172 
   363 
   173 definition
   364 definition
   174   "append_rhs_rexp rhs r \<equiv> (attach_rexp r) ` rhs"
   365   "append_rhs_rexp rhs rexp \<equiv> (attach_rexp rexp) ` rhs"
   175 
   366 
       
   367 text {*
       
   368   With the help of the two functions immediately above, Ardens'
       
   369   transformation on right hand side @{text "rhs"} is implemented
       
   370   by the following function @{text "arden_variate X rhs"}.
       
   371   After this transformation, the recursive occurent of @{text "X"}
       
   372   in @{text "rhs"} will be eliminated, while the 
       
   373   string set defined by @{text "rhs"} is kept unchanged.
       
   374   *}
   176 definition 
   375 definition 
   177   "arden_variate X rhs \<equiv> append_rhs_rexp (rhs - items_of rhs X) (STAR (rexp_of rhs X))"
   376   "arden_variate X rhs \<equiv> 
       
   377         append_rhs_rexp (rhs - items_of rhs X) (STAR (rexp_of rhs X))"
   178 
   378 
   179 
   379 
   180 (*********** substitution of ES *************)
   380 (*********** substitution of ES *************)
   181 
   381 
   182 text {* rhs_subst rhs X xrhs: substitude all occurence of X in rhs with xrhs *}
   382 text {* 
       
   383   Suppose the equation defining @{text "X"} is $X = xrhs$,
       
   384   the purpose of @{text "rhs_subst"} is to substitute all occurences of @{text "X"} in
       
   385   @{text "rhs"} by @{text "xrhs"}.
       
   386   A litte thought may reveal that the final result
       
   387   should be: first append $(a_1 | a_2 | \ldots | a_n)$ to every item of @{text "xrhs"} and then
       
   388   union the result with all non-@{text "X"}-items of @{text "rhs"}.
       
   389  *}
   183 definition 
   390 definition 
   184   "rhs_subst rhs X xrhs \<equiv> (rhs - (items_of rhs X)) \<union> (append_rhs_rexp xrhs (rexp_of rhs X))"
   391   "rhs_subst rhs X xrhs \<equiv> 
       
   392         (rhs - (items_of rhs X)) \<union> (append_rhs_rexp xrhs (rexp_of rhs X))"
       
   393 
       
   394 text {*
       
   395   Suppose the equation defining @{text "X"} is $X = xrhs$, the follwing
       
   396   @{text "eqs_subst ES X xrhs"} substitute @{text "xrhs"} into every equation
       
   397   of the equational system @{text "ES"}.
       
   398   *}
   185 
   399 
   186 definition
   400 definition
   187   "eqs_subst ES X xrhs \<equiv> {(Y, rhs_subst yrhs X xrhs) | Y yrhs. (Y, yrhs) \<in> ES}"
   401   "eqs_subst ES X xrhs \<equiv> {(Y, rhs_subst yrhs X xrhs) | Y yrhs. (Y, yrhs) \<in> ES}"
   188 
   402 
   189 text {*
   403 text {*
   190   Inv: Invairance of the equation-system, during the decrease of the equation-system, Inv holds.
   404   The computation of regular expressions for equivalent classes is accomplished
   191 *}
   405   using a iteration principle given by the following lemma.
   192 
   406   *}
   193 definition 
       
   194   "distinct_equas ES \<equiv> \<forall> X rhs rhs'. (X, rhs) \<in> ES \<and> (X, rhs') \<in> ES \<longrightarrow> rhs = rhs'"
       
   195 
       
   196 definition 
       
   197   "valid_eqns ES \<equiv> \<forall> X rhs. (X, rhs) \<in> ES \<longrightarrow> (X = L rhs)"
       
   198 
       
   199 definition 
       
   200   "rhs_nonempty rhs \<equiv> (\<forall> Y r. Trn Y r \<in> rhs \<longrightarrow> [] \<notin> L r)"
       
   201 
       
   202 definition 
       
   203   "ardenable ES \<equiv> \<forall> X rhs. (X, rhs) \<in> ES \<longrightarrow> rhs_nonempty rhs"
       
   204 
       
   205 definition 
       
   206   "non_empty ES \<equiv> \<forall> X rhs. (X, rhs) \<in> ES \<longrightarrow> X \<noteq> {}"
       
   207 
       
   208 definition
       
   209   "finite_rhs ES \<equiv> \<forall> X rhs. (X, rhs) \<in> ES \<longrightarrow> finite rhs"
       
   210 
       
   211 definition 
       
   212   "classes_of rhs \<equiv> {X. \<exists> r. Trn X r \<in> rhs}"
       
   213 
       
   214 definition
       
   215   "lefts_of ES \<equiv> {Y | Y yrhs. (Y, yrhs) \<in> ES}"
       
   216 
       
   217 definition 
       
   218   "self_contained ES \<equiv> \<forall> (X, xrhs) \<in> ES. classes_of xrhs \<subseteq> lefts_of ES"
       
   219 
       
   220 definition 
       
   221   "Inv ES \<equiv> valid_eqns ES \<and> finite ES \<and> distinct_equas ES \<and> ardenable ES \<and> 
       
   222             non_empty ES \<and> finite_rhs ES \<and> self_contained ES"
       
   223 
   407 
   224 lemma wf_iter [rule_format]: 
   408 lemma wf_iter [rule_format]: 
   225   fixes f
   409   fixes f
   226   assumes step: "\<And> e. \<lbrakk>P e; \<not> Q e\<rbrakk> \<Longrightarrow> (\<exists> e'. P e' \<and>  (f(e'), f(e)) \<in> less_than)"
   410   assumes step: "\<And> e. \<lbrakk>P e; \<not> Q e\<rbrakk> \<Longrightarrow> (\<exists> e'. P e' \<and>  (f(e'), f(e)) \<in> less_than)"
   227   shows pe:     "P e \<longrightarrow> (\<exists> e'. P e' \<and>  Q e')"
   411   shows pe:     "P e \<longrightarrow> (\<exists> e'. P e' \<and>  Q e')"
   246       from pe' show "P e'" .
   430       from pe' show "P e'" .
   247     qed
   431     qed
   248   qed
   432   qed
   249 qed
   433 qed
   250 
   434 
   251 text {* ************* basic properties of definitions above ************************ *}
   435 text {*
       
   436   The @{text "P"} in lemma @{text "wf_iter"} is an invaiant kept throughout the iteration procedure.
       
   437   The particular invariant used to solve our problem is defined by function @{text "Inv(ES)"},
       
   438   an invariant over equal system @{text "ES"}.
       
   439   Every definition starting next till @{text "Inv"} stipulates a property to be satisfied by @{text "ES"}.
       
   440 *}
       
   441 
       
   442 text {* 
       
   443   Every variable is defined at most onece in @{text "ES"}.
       
   444   *}
       
   445 definition 
       
   446   "distinct_equas ES \<equiv> 
       
   447             \<forall> X rhs rhs'. (X, rhs) \<in> ES \<and> (X, rhs') \<in> ES \<longrightarrow> rhs = rhs'"
       
   448 text {* 
       
   449   Every equation in @{text "ES"} (represented by @{text "(X, rhs)"}) is valid, i.e. @{text "(X = L rhs)"}.
       
   450   *}
       
   451 definition 
       
   452   "valid_eqns ES \<equiv> \<forall> X rhs. (X, rhs) \<in> ES \<longrightarrow> (X = L rhs)"
       
   453 
       
   454 text {*
       
   455   @{text "rhs_nonempty rhs"} requires regular expressions occuring in transitional 
       
   456   items of @{text "rhs"} does not contain empty string. This is necessary for
       
   457   the application of Arden's transformation to @{text "rhs"}.
       
   458   *}
       
   459 definition 
       
   460   "rhs_nonempty rhs \<equiv> (\<forall> Y r. Trn Y r \<in> rhs \<longrightarrow> [] \<notin> L r)"
       
   461 
       
   462 text {*
       
   463   @{text "ardenable ES"} requires that Arden's transformation is applicable
       
   464   to every equation of equational system @{text "ES"}.
       
   465   *}
       
   466 definition 
       
   467   "ardenable ES \<equiv> \<forall> X rhs. (X, rhs) \<in> ES \<longrightarrow> rhs_nonempty rhs"
       
   468 
       
   469 (* The following non_empty seems useless. *)
       
   470 definition 
       
   471   "non_empty ES \<equiv> \<forall> X rhs. (X, rhs) \<in> ES \<longrightarrow> X \<noteq> {}"
       
   472 
       
   473 text {*
       
   474   The following @{text "finite_rhs ES"} requires every equation in @{text "rhs"} be finite.
       
   475   *}
       
   476 definition
       
   477   "finite_rhs ES \<equiv> \<forall> X rhs. (X, rhs) \<in> ES \<longrightarrow> finite rhs"
       
   478 
       
   479 text {*
       
   480   The following @{text "classes_of rhs"} returns all variables (or equivalent classes)
       
   481   occuring in @{text "rhs"}.
       
   482   *}
       
   483 definition 
       
   484   "classes_of rhs \<equiv> {X. \<exists> r. Trn X r \<in> rhs}"
       
   485 
       
   486 text {*
       
   487   The following @{text "lefts_of ES"} returns all variables 
       
   488   defined by equational system @{text "ES"}.
       
   489   *}
       
   490 definition
       
   491   "lefts_of ES \<equiv> {Y | Y yrhs. (Y, yrhs) \<in> ES}"
       
   492 
       
   493 text {*
       
   494   The following @{text "self_contained ES"} requires that every
       
   495   variable occuring on the right hand side of equations is already defined by some
       
   496   equation in @{text "ES"}.
       
   497   *}
       
   498 definition 
       
   499   "self_contained ES \<equiv> \<forall> (X, xrhs) \<in> ES. classes_of xrhs \<subseteq> lefts_of ES"
       
   500 
       
   501 
       
   502 text {*
       
   503   The invariant @{text "Inv(ES)"} is obtained by conjunctioning all the previous
       
   504   defined constaints on @{text "ES"}.
       
   505   *}
       
   506 definition 
       
   507   "Inv ES \<equiv> valid_eqns ES \<and> finite ES \<and> distinct_equas ES \<and> ardenable ES \<and> 
       
   508                 non_empty ES \<and> finite_rhs ES \<and> self_contained ES"
       
   509 
       
   510 subsection {* Proof for this direction *}
       
   511 
       
   512 
       
   513 
       
   514 text {*
       
   515   The following are some basic properties of the above definitions.
       
   516 *}
   252 
   517 
   253 lemma L_rhs_union_distrib:
   518 lemma L_rhs_union_distrib:
   254   " L (A::rhs_item set) \<union> L B = L (A \<union> B)"
   519   " L (A::rhs_item set) \<union> L B = L (A \<union> B)"
   255 by simp
   520 by simp
   256 
   521 
   317 lemma lefts_of_union_distrib:
   582 lemma lefts_of_union_distrib:
   318   "lefts_of A \<union> lefts_of B = lefts_of (A \<union> B)"
   583   "lefts_of A \<union> lefts_of B = lefts_of (A \<union> B)"
   319 by (auto simp:lefts_of_def)
   584 by (auto simp:lefts_of_def)
   320 
   585 
   321 
   586 
   322 text {* ******BEGIN: proving the initial equation-system satisfies Inv ****** *}
   587 text {*
       
   588   The following several lemmas until @{text "init_ES_satisfy_Inv"} are
       
   589   to prove that initial equational system satisfies invariant @{text "Inv"}.
       
   590   *}
   323 
   591 
   324 lemma defined_by_str:
   592 lemma defined_by_str:
   325   "\<lbrakk>s \<in> X; X \<in> UNIV // (\<approx>Lang)\<rbrakk> \<Longrightarrow> X = (\<approx>Lang) `` {s}"
   593   "\<lbrakk>s \<in> X; X \<in> UNIV // (\<approx>Lang)\<rbrakk> \<Longrightarrow> X = (\<approx>Lang) `` {s}"
   326 by (auto simp:quotient_def Image_def str_eq_rel_def str_eq_def)
   594 by (auto simp:quotient_def Image_def str_eq_rel_def)
   327 
   595 
   328 lemma every_eqclass_has_transition:
   596 lemma every_eqclass_has_transition:
   329   assumes has_str: "s @ [c] \<in> X"
   597   assumes has_str: "s @ [c] \<in> X"
   330   and     in_CS:   "X \<in> UNIV // (\<approx>Lang)"
   598   and     in_CS:   "X \<in> UNIV // (\<approx>Lang)"
   331   obtains Y where "Y \<in> UNIV // (\<approx>Lang)" and "Y ;; {[c]} \<subseteq> X" and "s \<in> Y"
   599   obtains Y where "Y \<in> UNIV // (\<approx>Lang)" and "Y ;; {[c]} \<subseteq> X" and "s \<in> Y"
   337   have "X = (\<approx>Lang) `` {s @ [c]}" 
   605   have "X = (\<approx>Lang) `` {s @ [c]}" 
   338     using has_str in_CS defined_by_str by blast
   606     using has_str in_CS defined_by_str by blast
   339   then have "Y ;; {[c]} \<subseteq> X" 
   607   then have "Y ;; {[c]} \<subseteq> X" 
   340     unfolding Y_def Image_def Seq_def
   608     unfolding Y_def Image_def Seq_def
   341     unfolding str_eq_rel_def
   609     unfolding str_eq_rel_def
   342     by (auto) (simp add: str_eq_def)
   610     by clarsimp
   343   moreover
   611   moreover
   344   have "s \<in> Y" unfolding Y_def 
   612   have "s \<in> Y" unfolding Y_def 
   345     unfolding Image_def str_eq_rel_def str_eq_def by simp
   613     unfolding Image_def str_eq_rel_def by simp
   346   ultimately show thesis by (blast intro: that)
   614   ultimately show thesis by (blast intro: that)
   347 qed
   615 qed
   348 
   616 
   349 lemma l_eq_r_in_eqs:
   617 lemma l_eq_r_in_eqs:
   350   assumes X_in_eqs: "(X, xrhs) \<in> (eqs (UNIV // (\<approx>Lang)))"
   618   assumes X_in_eqs: "(X, xrhs) \<in> (eqs (UNIV // (\<approx>Lang)))"
   367       then obtain Y 
   635       then obtain Y 
   368         where "Y \<in> UNIV // (\<approx>Lang)" 
   636         where "Y \<in> UNIV // (\<approx>Lang)" 
   369         and "Y ;; {[c]} \<subseteq> X"
   637         and "Y ;; {[c]} \<subseteq> X"
   370         and "clist \<in> Y"
   638         and "clist \<in> Y"
   371         using decom "(1)" every_eqclass_has_transition by blast
   639         using decom "(1)" every_eqclass_has_transition by blast
   372       hence "x \<in> L {Trn Y (CHAR c)| Y c. Y \<in> UNIV // (\<approx>Lang) \<and> Y ;; {[c]} \<subseteq> X}"
   640       hence 
       
   641         "x \<in> L {Trn Y (CHAR c)| Y c. Y \<in> UNIV // (\<approx>Lang) \<and> Y ;; {[c]} \<subseteq> X}"
   373         using "(1)" decom
   642         using "(1)" decom
   374         by (simp, rule_tac x = "Trn Y (CHAR c)" in exI, simp add:Seq_def)
   643         by (simp, rule_tac x = "Trn Y (CHAR c)" in exI, simp add:Seq_def)
   375       thus ?thesis using X_in_eqs "(1)"
   644       thus ?thesis using X_in_eqs "(1)"
   376         by (simp add:eqs_def init_rhs_def)
   645         by (simp add:eqs_def init_rhs_def)
   377     qed
   646     qed
   410   moreover have "ardenable (eqs (UNIV // (\<approx>Lang)))"
   679   moreover have "ardenable (eqs (UNIV // (\<approx>Lang)))"
   411     by (auto simp add:ardenable_def eqs_def init_rhs_def rhs_nonempty_def del:L_rhs.simps)
   680     by (auto simp add:ardenable_def eqs_def init_rhs_def rhs_nonempty_def del:L_rhs.simps)
   412   moreover have "valid_eqns (eqs (UNIV // (\<approx>Lang)))"
   681   moreover have "valid_eqns (eqs (UNIV // (\<approx>Lang)))"
   413     using l_eq_r_in_eqs by (simp add:valid_eqns_def)
   682     using l_eq_r_in_eqs by (simp add:valid_eqns_def)
   414   moreover have "non_empty (eqs (UNIV // (\<approx>Lang)))"
   683   moreover have "non_empty (eqs (UNIV // (\<approx>Lang)))"
   415     by (auto simp:non_empty_def eqs_def quotient_def Image_def str_eq_rel_def str_eq_def)
   684     by (auto simp:non_empty_def eqs_def quotient_def Image_def str_eq_rel_def)
   416   moreover have "finite_rhs (eqs (UNIV // (\<approx>Lang)))"
   685   moreover have "finite_rhs (eqs (UNIV // (\<approx>Lang)))"
   417     using finite_init_rhs[OF finite_CS] 
   686     using finite_init_rhs[OF finite_CS] 
   418     by (auto simp:finite_rhs_def eqs_def)
   687     by (auto simp:finite_rhs_def eqs_def)
   419   moreover have "self_contained (eqs (UNIV // (\<approx>Lang)))"
   688   moreover have "self_contained (eqs (UNIV // (\<approx>Lang)))"
   420     by (auto simp:self_contained_def eqs_def init_rhs_def classes_of_def lefts_of_def)
   689     by (auto simp:self_contained_def eqs_def init_rhs_def classes_of_def lefts_of_def)
   421   ultimately show ?thesis by (simp add:Inv_def)
   690   ultimately show ?thesis by (simp add:Inv_def)
   422 qed
   691 qed
   423 
   692 
   424 text {* ****** BEGIN: proving every equation-system's iteration step satisfies Inv ***** *}
   693 text {*
   425 
   694   From this point until @{text "iteration_step"}, we are trying to prove 
       
   695   that there exists iteration steps which keep @{text "Inv(ES)"} while
       
   696   decreasing the size of @{text "ES"} with every iteration.
       
   697   *}
   426 lemma arden_variate_keeps_eq:
   698 lemma arden_variate_keeps_eq:
   427   assumes l_eq_r: "X = L rhs"
   699   assumes l_eq_r: "X = L rhs"
   428   and not_empty: "[] \<notin> L (rexp_of rhs X)"
   700   and not_empty: "[] \<notin> L (rexp_of rhs X)"
   429   and finite: "finite rhs"
   701   and finite: "finite rhs"
   430   shows "X = L (arden_variate X rhs)"
   702   shows "X = L (arden_variate X rhs)"
   504 
   776 
   505 lemma eqs_subst_keeps_finite:
   777 lemma eqs_subst_keeps_finite:
   506   assumes finite:"finite (ES:: (string set \<times> rhs_item set) set)"
   778   assumes finite:"finite (ES:: (string set \<times> rhs_item set) set)"
   507   shows "finite (eqs_subst ES Y yrhs)"
   779   shows "finite (eqs_subst ES Y yrhs)"
   508 proof -
   780 proof -
   509   have "finite {(Ya, rhs_subst yrhsa Y yrhs) |Ya yrhsa. (Ya, yrhsa) \<in> ES}" (is "finite ?A")
   781   have "finite {(Ya, rhs_subst yrhsa Y yrhs) |Ya yrhsa. (Ya, yrhsa) \<in> ES}" 
       
   782                                                                   (is "finite ?A")
   510   proof-
   783   proof-
   511     def eqns' \<equiv> "{((Ya::string set), yrhsa)| Ya yrhsa. (Ya, yrhsa) \<in> ES}"
   784     def eqns' \<equiv> "{((Ya::string set), yrhsa)| Ya yrhsa. (Ya, yrhsa) \<in> ES}"
   512     def h \<equiv> "\<lambda> ((Ya::string set), yrhsa). (Ya, rhs_subst yrhsa Y yrhs)"
   785     def h \<equiv> "\<lambda> ((Ya::string set), yrhsa). (Ya, rhs_subst yrhsa Y yrhs)"
   513     have "finite (h ` eqns')" using finite h_def eqns'_def by auto
   786     have "finite (h ` eqns')" using finite h_def eqns'_def by auto
   514     moreover have "?A = h ` eqns'" by (auto simp:h_def eqns'_def)
   787     moreover have "?A = h ` eqns'" by (auto simp:h_def eqns'_def)
   535 lemma lefts_of_keeps_cls:
   808 lemma lefts_of_keeps_cls:
   536   "lefts_of (eqs_subst ES Y yrhs) = lefts_of ES"
   809   "lefts_of (eqs_subst ES Y yrhs) = lefts_of ES"
   537 by (auto simp:lefts_of_def eqs_subst_def)
   810 by (auto simp:lefts_of_def eqs_subst_def)
   538 
   811 
   539 lemma rhs_subst_updates_cls:
   812 lemma rhs_subst_updates_cls:
   540   "X \<notin> classes_of xrhs \<Longrightarrow> classes_of (rhs_subst rhs X xrhs) = classes_of rhs \<union> classes_of xrhs - {X}"
   813   "X \<notin> classes_of xrhs \<Longrightarrow> 
   541 apply (simp only:rhs_subst_def append_rhs_keeps_cls classes_of_union_distrib[THEN sym])
   814       classes_of (rhs_subst rhs X xrhs) = classes_of rhs \<union> classes_of xrhs - {X}"
       
   815 apply (simp only:rhs_subst_def append_rhs_keeps_cls 
       
   816                               classes_of_union_distrib[THEN sym])
   542 by (auto simp:classes_of_def items_of_def)
   817 by (auto simp:classes_of_def items_of_def)
   543 
   818 
   544 lemma eqs_subst_keeps_self_contained:
   819 lemma eqs_subst_keeps_self_contained:
   545   fixes Y
   820   fixes Y
   546   assumes sc: "self_contained (ES \<union> {(Y, yrhs)})" (is "self_contained ?A")
   821   assumes sc: "self_contained (ES \<union> {(Y, yrhs)})" (is "self_contained ?A")
   547   shows "self_contained (eqs_subst ES Y (arden_variate Y yrhs))" (is "self_contained ?B")
   822   shows "self_contained (eqs_subst ES Y (arden_variate Y yrhs))" 
       
   823                                                    (is "self_contained ?B")
   548 proof-
   824 proof-
   549   { fix X xrhs'
   825   { fix X xrhs'
   550     assume "(X, xrhs') \<in> ?B"
   826     assume "(X, xrhs') \<in> ?B"
   551     then obtain xrhs 
   827     then obtain xrhs 
   552       where xrhs_xrhs': "xrhs' = rhs_subst xrhs Y (arden_variate Y yrhs)"
   828       where xrhs_xrhs': "xrhs' = rhs_subst xrhs Y (arden_variate Y yrhs)"
   554     have "classes_of xrhs' \<subseteq> lefts_of ?B"
   830     have "classes_of xrhs' \<subseteq> lefts_of ?B"
   555     proof-
   831     proof-
   556       have "lefts_of ?B = lefts_of ES" by (auto simp add:lefts_of_def eqs_subst_def)
   832       have "lefts_of ?B = lefts_of ES" by (auto simp add:lefts_of_def eqs_subst_def)
   557       moreover have "classes_of xrhs' \<subseteq> lefts_of ES"
   833       moreover have "classes_of xrhs' \<subseteq> lefts_of ES"
   558       proof-
   834       proof-
   559         have "classes_of xrhs' \<subseteq> classes_of xrhs \<union> classes_of (arden_variate Y yrhs) - {Y}"
   835         have "classes_of xrhs' \<subseteq> 
       
   836                         classes_of xrhs \<union> classes_of (arden_variate Y yrhs) - {Y}"
   560         proof-
   837         proof-
   561           have "Y \<notin> classes_of (arden_variate Y yrhs)" using arden_variate_removes_cl by simp
   838           have "Y \<notin> classes_of (arden_variate Y yrhs)" 
       
   839             using arden_variate_removes_cl by simp
   562           thus ?thesis using xrhs_xrhs' by (auto simp:rhs_subst_updates_cls)
   840           thus ?thesis using xrhs_xrhs' by (auto simp:rhs_subst_updates_cls)
   563         qed
   841         qed
   564         moreover have "classes_of xrhs \<subseteq> lefts_of ES \<union> {Y}" using X_in sc
   842         moreover have "classes_of xrhs \<subseteq> lefts_of ES \<union> {Y}" using X_in sc
   565           apply (simp only:self_contained_def lefts_of_union_distrib[THEN sym])
   843           apply (simp only:self_contained_def lefts_of_union_distrib[THEN sym])
   566           by (drule_tac x = "(X, xrhs)" in bspec, auto simp:lefts_of_def)
   844           by (drule_tac x = "(X, xrhs)" in bspec, auto simp:lefts_of_def)
   567         moreover have "classes_of (arden_variate Y yrhs) \<subseteq> lefts_of ES \<union> {Y}" using sc
   845         moreover have "classes_of (arden_variate Y yrhs) \<subseteq> lefts_of ES \<union> {Y}" 
       
   846           using sc 
   568           by (auto simp add:arden_variate_removes_cl self_contained_def lefts_of_def)
   847           by (auto simp add:arden_variate_removes_cl self_contained_def lefts_of_def)
   569         ultimately show ?thesis by auto
   848         ultimately show ?thesis by auto
   570       qed
   849       qed
   571       ultimately show ?thesis by simp
   850       ultimately show ?thesis by simp
   572     qed
   851     qed
   575 
   854 
   576 lemma eqs_subst_satisfy_Inv:
   855 lemma eqs_subst_satisfy_Inv:
   577   assumes Inv_ES: "Inv (ES \<union> {(Y, yrhs)})"
   856   assumes Inv_ES: "Inv (ES \<union> {(Y, yrhs)})"
   578   shows "Inv (eqs_subst ES Y (arden_variate Y yrhs))"
   857   shows "Inv (eqs_subst ES Y (arden_variate Y yrhs))"
   579 proof -  
   858 proof -  
   580   have finite_yrhs: "finite yrhs" using Inv_ES by (auto simp:Inv_def finite_rhs_def)
   859   have finite_yrhs: "finite yrhs" 
   581   have nonempty_yrhs: "rhs_nonempty yrhs" using Inv_ES by (auto simp:Inv_def ardenable_def)
   860     using Inv_ES by (auto simp:Inv_def finite_rhs_def)
   582   have Y_eq_yrhs: "Y = L yrhs" using Inv_ES by (simp only:Inv_def valid_eqns_def, blast)
   861   have nonempty_yrhs: "rhs_nonempty yrhs" 
   583 
   862     using Inv_ES by (auto simp:Inv_def ardenable_def)
   584   have "distinct_equas (eqs_subst ES Y (arden_variate Y yrhs))" using Inv_ES
   863   have Y_eq_yrhs: "Y = L yrhs" 
       
   864     using Inv_ES by (simp only:Inv_def valid_eqns_def, blast)
       
   865   have "distinct_equas (eqs_subst ES Y (arden_variate Y yrhs))" 
       
   866     using Inv_ES
   585     by (auto simp:distinct_equas_def eqs_subst_def Inv_def)
   867     by (auto simp:distinct_equas_def eqs_subst_def Inv_def)
   586   moreover have "finite (eqs_subst ES Y (arden_variate Y yrhs))" using Inv_ES 
   868   moreover have "finite (eqs_subst ES Y (arden_variate Y yrhs))" 
   587     by (simp add:Inv_def eqs_subst_keeps_finite)
   869     using Inv_ES by (simp add:Inv_def eqs_subst_keeps_finite)
   588   moreover have "finite_rhs (eqs_subst ES Y (arden_variate Y yrhs))"
   870   moreover have "finite_rhs (eqs_subst ES Y (arden_variate Y yrhs))"
   589   proof-
   871   proof-
   590     have "finite_rhs ES" using Inv_ES by (simp add:Inv_def finite_rhs_def)
   872     have "finite_rhs ES" using Inv_ES 
       
   873       by (simp add:Inv_def finite_rhs_def)
   591     moreover have "finite (arden_variate Y yrhs)"
   874     moreover have "finite (arden_variate Y yrhs)"
   592     proof -
   875     proof -
   593       have "finite yrhs" using Inv_ES by (auto simp:Inv_def finite_rhs_def)
   876       have "finite yrhs" using Inv_ES 
       
   877         by (auto simp:Inv_def finite_rhs_def)
   594       thus ?thesis using arden_variate_keeps_finite by simp
   878       thus ?thesis using arden_variate_keeps_finite by simp
   595     qed
   879     qed
   596     ultimately show ?thesis by (simp add:eqs_subst_keeps_finite_rhs)
   880     ultimately show ?thesis 
       
   881       by (simp add:eqs_subst_keeps_finite_rhs)
   597   qed
   882   qed
   598   moreover have "ardenable (eqs_subst ES Y (arden_variate Y yrhs))"
   883   moreover have "ardenable (eqs_subst ES Y (arden_variate Y yrhs))"
   599   proof - 
   884   proof - 
   600     { fix X rhs
   885     { fix X rhs
   601       assume "(X, rhs) \<in> ES"
   886       assume "(X, rhs) \<in> ES"
   602       hence "rhs_nonempty rhs"  using prems Inv_ES  by (simp add:Inv_def ardenable_def)
   887       hence "rhs_nonempty rhs"  using prems Inv_ES  
   603       with nonempty_yrhs have "rhs_nonempty (rhs_subst rhs Y (arden_variate Y yrhs))"
   888         by (simp add:Inv_def ardenable_def)
   604         by (simp add:nonempty_yrhs rhs_subst_keeps_nonempty arden_variate_keeps_nonempty)
   889       with nonempty_yrhs 
       
   890       have "rhs_nonempty (rhs_subst rhs Y (arden_variate Y yrhs))"
       
   891         by (simp add:nonempty_yrhs 
       
   892                rhs_subst_keeps_nonempty arden_variate_keeps_nonempty)
   605     } thus ?thesis by (auto simp add:ardenable_def eqs_subst_def)
   893     } thus ?thesis by (auto simp add:ardenable_def eqs_subst_def)
   606   qed
   894   qed
   607   moreover have "valid_eqns (eqs_subst ES Y (arden_variate Y yrhs))"
   895   moreover have "valid_eqns (eqs_subst ES Y (arden_variate Y yrhs))"
   608   proof-
   896   proof-
   609     have "Y = L (arden_variate Y yrhs)" using Y_eq_yrhs Inv_ES finite_yrhs nonempty_yrhs      
   897     have "Y = L (arden_variate Y yrhs)" 
   610         by (rule_tac arden_variate_keeps_eq, (simp add:rexp_of_empty)+)
   898       using Y_eq_yrhs Inv_ES finite_yrhs nonempty_yrhs      
       
   899       by (rule_tac arden_variate_keeps_eq, (simp add:rexp_of_empty)+)
   611     thus ?thesis using Inv_ES 
   900     thus ?thesis using Inv_ES 
   612       by (clarsimp simp add:valid_eqns_def eqs_subst_def rhs_subst_keeps_eq Inv_def finite_rhs_def
   901       by (clarsimp simp add:valid_eqns_def 
       
   902               eqs_subst_def rhs_subst_keeps_eq Inv_def finite_rhs_def
   613                    simp del:L_rhs.simps)
   903                    simp del:L_rhs.simps)
   614   qed
   904   qed
   615   moreover have non_empty_subst: "non_empty (eqs_subst ES Y (arden_variate Y yrhs))"
   905   moreover have 
       
   906     non_empty_subst: "non_empty (eqs_subst ES Y (arden_variate Y yrhs))"
   616     using Inv_ES by (auto simp:Inv_def non_empty_def eqs_subst_def)
   907     using Inv_ES by (auto simp:Inv_def non_empty_def eqs_subst_def)
   617   moreover have self_subst: "self_contained (eqs_subst ES Y (arden_variate Y yrhs))"
   908   moreover 
       
   909   have self_subst: "self_contained (eqs_subst ES Y (arden_variate Y yrhs))"
   618     using Inv_ES eqs_subst_keeps_self_contained by (simp add:Inv_def)
   910     using Inv_ES eqs_subst_keeps_self_contained by (simp add:Inv_def)
   619   ultimately show ?thesis using Inv_ES by (simp add:Inv_def)
   911   ultimately show ?thesis using Inv_ES by (simp add:Inv_def)
   620 qed
   912 qed
   621 
   913 
   622 lemma eqs_subst_card_le: 
   914 lemma eqs_subst_card_le: 
   640   and finite: "finite S"
   932   and finite: "finite S"
   641   obtains e' where "e' \<in> S \<and> e \<noteq> e'" 
   933   obtains e' where "e' \<in> S \<and> e \<noteq> e'" 
   642 proof-
   934 proof-
   643   have "card (S - {e}) > 0"
   935   have "card (S - {e}) > 0"
   644   proof -
   936   proof -
   645     have "card S > 1" using card e_in finite  by (case_tac "card S", auto) 
   937     have "card S > 1" using card e_in finite  
       
   938       by (case_tac "card S", auto) 
   646     thus ?thesis using finite e_in by auto
   939     thus ?thesis using finite e_in by auto
   647   qed
   940   qed
   648   hence "S - {e} \<noteq> {}" using finite by (rule_tac notI, simp)
   941   hence "S - {e} \<noteq> {}" using finite by (rule_tac notI, simp)
   649   thus "(\<And>e'. e' \<in> S \<and> e \<noteq> e' \<Longrightarrow> thesis) \<Longrightarrow> thesis" by auto
   942   thus "(\<And>e'. e' \<in> S \<and> e \<noteq> e' \<Longrightarrow> thesis) \<Longrightarrow> thesis" by auto
   650 qed
   943 qed
   651 
   944 
   652 lemma iteration_step: 
   945 lemma iteration_step: 
   653   assumes Inv_ES: "Inv ES"
   946   assumes Inv_ES: "Inv ES"
   654   and    X_in_ES: "(X, xrhs) \<in> ES"
   947   and    X_in_ES: "(X, xrhs) \<in> ES"
   655   and    not_T: "card ES \<noteq> 1"
   948   and    not_T: "card ES \<noteq> 1"
   656   shows "\<exists> ES'. (Inv ES' \<and> (\<exists> xrhs'.(X, xrhs') \<in> ES')) \<and> (card ES', card ES) \<in> less_than" (is "\<exists> ES'. ?P ES'")
   949   shows "\<exists> ES'. (Inv ES' \<and> (\<exists> xrhs'.(X, xrhs') \<in> ES')) \<and> 
       
   950                 (card ES', card ES) \<in> less_than" (is "\<exists> ES'. ?P ES'")
   657 proof -
   951 proof -
   658   have finite_ES: "finite ES" using Inv_ES by (simp add:Inv_def)
   952   have finite_ES: "finite ES" using Inv_ES by (simp add:Inv_def)
   659   then obtain Y yrhs where Y_in_ES: "(Y, yrhs) \<in> ES" and not_eq: "(X, xrhs) \<noteq> (Y, yrhs)" 
   953   then obtain Y yrhs 
       
   954     where Y_in_ES: "(Y, yrhs) \<in> ES" and not_eq: "(X, xrhs) \<noteq> (Y, yrhs)" 
   660     using not_T X_in_ES by (drule_tac card_noteq_1_has_more, auto)
   955     using not_T X_in_ES by (drule_tac card_noteq_1_has_more, auto)
   661   def ES' == "ES - {(Y, yrhs)}"
   956   def ES' == "ES - {(Y, yrhs)}"
   662   let ?ES'' = "eqs_subst ES' Y (arden_variate Y yrhs)"
   957   let ?ES'' = "eqs_subst ES' Y (arden_variate Y yrhs)"
   663   have "?P ?ES''"
   958   have "?P ?ES''"
   664   proof -
   959   proof -
   677     ultimately show ?thesis by simp
   972     ultimately show ?thesis by simp
   678   qed
   973   qed
   679   thus ?thesis by blast
   974   thus ?thesis by blast
   680 qed
   975 qed
   681 
   976 
   682 text {* ***** END: proving every equation-system's iteration step satisfies Inv ************** *}
   977 text {*
       
   978   From this point until @{text "hard_direction"}, the hard direction is proved
       
   979   through a simple application of the iteration principle.
       
   980 *}
   683 
   981 
   684 lemma iteration_conc: 
   982 lemma iteration_conc: 
   685   assumes history: "Inv ES"
   983   assumes history: "Inv ES"
   686   and    X_in_ES: "\<exists> xrhs. (X, xrhs) \<in> ES"
   984   and    X_in_ES: "\<exists> xrhs. (X, xrhs) \<in> ES"
   687   shows "\<exists> ES'. (Inv ES' \<and> (\<exists> xrhs'. (X, xrhs') \<in> ES')) \<and> card ES' = 1" (is "\<exists> ES'. ?P ES'")
   985   shows 
       
   986   "\<exists> ES'. (Inv ES' \<and> (\<exists> xrhs'. (X, xrhs') \<in> ES')) \<and> card ES' = 1" 
       
   987                                                           (is "\<exists> ES'. ?P ES'")
   688 proof (cases "card ES = 1")
   988 proof (cases "card ES = 1")
   689   case True
   989   case True
   690   thus ?thesis using history X_in_ES
   990   thus ?thesis using history X_in_ES
   691     by blast
   991     by blast
   692 next
   992 next
   704   have "?P (rexp_of_lam ?A)"
  1004   have "?P (rexp_of_lam ?A)"
   705   proof -
  1005   proof -
   706     have "L (rexp_of_lam ?A) = L (lam_of ?A)"
  1006     have "L (rexp_of_lam ?A) = L (lam_of ?A)"
   707     proof(rule rexp_of_lam_eq_lam_set)
  1007     proof(rule rexp_of_lam_eq_lam_set)
   708       show "finite (arden_variate X xrhs)" using Inv_ES ES_single 
  1008       show "finite (arden_variate X xrhs)" using Inv_ES ES_single 
   709         by (rule_tac arden_variate_keeps_finite, auto simp add:Inv_def finite_rhs_def)
  1009         by (rule_tac arden_variate_keeps_finite, 
       
  1010                        auto simp add:Inv_def finite_rhs_def)
   710     qed
  1011     qed
   711     also have "\<dots> = L ?A"
  1012     also have "\<dots> = L ?A"
   712     proof-
  1013     proof-
   713       have "lam_of ?A = ?A"
  1014       have "lam_of ?A = ?A"
   714       proof-
  1015       proof-
   715         have "classes_of ?A = {}" using Inv_ES ES_single
  1016         have "classes_of ?A = {}" using Inv_ES ES_single
   716           by (simp add:arden_variate_removes_cl self_contained_def Inv_def lefts_of_def) 
  1017           by (simp add:arden_variate_removes_cl 
   717         thus ?thesis by (auto simp only:lam_of_def classes_of_def, case_tac x, auto)
  1018                        self_contained_def Inv_def lefts_of_def) 
       
  1019         thus ?thesis 
       
  1020           by (auto simp only:lam_of_def classes_of_def, case_tac x, auto)
   718       qed
  1021       qed
   719       thus ?thesis by simp
  1022       thus ?thesis by simp
   720     qed
  1023     qed
   721     also have "\<dots> = X"
  1024     also have "\<dots> = X"
   722     proof(rule arden_variate_keeps_eq [THEN sym])
  1025     proof(rule arden_variate_keeps_eq [THEN sym])
   723       show "X = L xrhs" using Inv_ES ES_single by (auto simp only:Inv_def valid_eqns_def)  
  1026       show "X = L xrhs" using Inv_ES ES_single 
       
  1027         by (auto simp only:Inv_def valid_eqns_def)  
   724     next
  1028     next
   725       from Inv_ES ES_single show "[] \<notin> L (rexp_of xrhs X)"
  1029       from Inv_ES ES_single show "[] \<notin> L (rexp_of xrhs X)"
   726         by(simp add:Inv_def ardenable_def rexp_of_empty finite_rhs_def)
  1030         by(simp add:Inv_def ardenable_def rexp_of_empty finite_rhs_def)
   727     next
  1031     next
   728       from Inv_ES ES_single show "finite xrhs" by (simp add:Inv_def finite_rhs_def)
  1032       from Inv_ES ES_single show "finite xrhs" 
       
  1033         by (simp add:Inv_def finite_rhs_def)
   729     qed
  1034     qed
   730     finally show ?thesis by simp
  1035     finally show ?thesis by simp
   731   qed
  1036   qed
   732   thus ?thesis by auto
  1037   thus ?thesis by auto
   733 qed
  1038 qed
   748     by (auto simp:Inv_def dest!:card_Suc_Diff1 simp:card_eq_0_iff) 
  1053     by (auto simp:Inv_def dest!:card_Suc_Diff1 simp:card_eq_0_iff) 
   749   thus ?thesis using Inv_ES
  1054   thus ?thesis using Inv_ES
   750     by (rule last_cl_exists_rexp)
  1055     by (rule last_cl_exists_rexp)
   751 qed
  1056 qed
   752 
  1057 
       
  1058 lemma finals_in_partitions:
       
  1059   "finals Lang \<subseteq> (UNIV // (\<approx>Lang))"
       
  1060   by (auto simp:finals_def quotient_def)   
       
  1061 
   753 theorem hard_direction: 
  1062 theorem hard_direction: 
   754   assumes finite_CS: "finite (UNIV // (\<approx>Lang))"
  1063   assumes finite_CS: "finite (UNIV // (\<approx>Lang))"
   755   shows   "\<exists> (reg::rexp). Lang = L reg"
  1064   shows   "\<exists> (reg::rexp). Lang = L reg"
   756 proof -
  1065 proof -
   757   have "\<forall> X \<in> (UNIV // (\<approx>Lang)). \<exists> (reg::rexp). X = L reg" 
  1066   have "\<forall> X \<in> (UNIV // (\<approx>Lang)). \<exists> (reg::rexp). X = L reg" 
   758     using finite_CS every_eqcl_has_reg by blast
  1067     using finite_CS every_eqcl_has_reg by blast
   759   then obtain f where f_prop: "\<forall> X \<in> (UNIV // (\<approx>Lang)). X = L ((f X)::rexp)" 
  1068   then obtain f 
       
  1069     where f_prop: "\<forall> X \<in> (UNIV // (\<approx>Lang)). X = L ((f X)::rexp)" 
   760     by (auto dest:bchoice)
  1070     by (auto dest:bchoice)
   761   def rs \<equiv> "f ` {X. final X Lang}"  
  1071   def rs \<equiv> "f ` (finals Lang)"  
   762   have "Lang = \<Union> {X. final X Lang}" using lang_is_union_of_finals by simp
  1072   have "Lang = \<Union> (finals Lang)" using lang_is_union_of_finals by auto
   763   also have "\<dots> = L (folds ALT NULL rs)" 
  1073   also have "\<dots> = L (folds ALT NULL rs)" 
   764   proof -
  1074   proof -
   765     have "finite {X. final X Lang}" using finite_CS by (auto simp:final_def)
  1075     have "finite rs"
   766     thus ?thesis  using f_prop by (auto simp:rs_def final_def)
  1076     proof -
       
  1077       have "finite (finals Lang)" 
       
  1078         using finite_CS finals_in_partitions[of "Lang"]   
       
  1079         by (erule_tac finite_subset, simp)
       
  1080       thus ?thesis using rs_def by auto
       
  1081     qed
       
  1082     thus ?thesis 
       
  1083       using f_prop rs_def finals_in_partitions[of "Lang"] by auto
   767   qed
  1084   qed
   768   finally show ?thesis by blast
  1085   finally show ?thesis by blast
   769 qed 
  1086 qed 
   770 
  1087 
   771 section {* regular \<Rightarrow> finite*}
  1088 section {* Direction: @{text "regular language \<Rightarrow>finite partition"} *}
   772 
  1089 
   773 lemma quot_empty_subset:
  1090 subsection {* The scheme for this direction *}
   774   "UNIV // (\<approx>{[]}) \<subseteq> {{[]}, UNIV - {[]}}"
  1091 
   775 proof
  1092 text {* 
   776   fix x
  1093   The following convenient notation @{text "x \<approx>Lang y"} means:
   777   assume "x \<in> UNIV // \<approx>{[]}"
  1094   string @{text "x"} and @{text "y"} are equivalent with respect to 
   778   then obtain y where h: "x = {z. (y, z) \<in> \<approx>{[]}}" unfolding quotient_def Image_def by blast
  1095   language @{text "Lang"}.
   779   show "x \<in> {{[]}, UNIV - {[]}}" 
  1096   *}
   780   proof (cases "y = []")
  1097 
   781     case True with h
  1098 definition
   782     have "x = {[]}" by (auto simp:str_eq_rel_def str_eq_def)
  1099   str_eq ("_ \<approx>_ _")
   783     thus ?thesis by simp
  1100 where
   784   next
  1101   "x \<approx>Lang y \<equiv> (x, y) \<in> (\<approx>Lang)"
   785     case False with h
  1102 
   786     have "x = UNIV - {[]}" by (auto simp:str_eq_rel_def str_eq_def)
  1103 text {*
   787     thus ?thesis by simp
  1104   The very basic scheme to show the finiteness of the partion generated by a language @{text "Lang"}
   788   qed
  1105   is by attaching tags to every string. The set of tags are carfully choosen to make it finite.
   789 qed
  1106   If it can be proved that strings with the same tag are equivlent with respect @{text "Lang"},
   790 
  1107   then the partition given rise by @{text "Lang"} must be finite. The reason for this is a lemma 
   791 lemma quot_char_subset:
  1108   in standard library (@{text "finite_imageD"}), which says: if the image of an injective 
   792   "UNIV // (\<approx>{[c]}) \<subseteq> {{[]},{[c]}, UNIV - {[], [c]}}"
  1109   function on a set @{text "A"} is finite, then @{text "A"} is finite. It can be shown that
   793 proof 
  1110   the function obtained by llifting @{text "tag"}
   794   fix x 
  1111   to the level of equalent classes (i.e. @{text "((op `) tag)"}) is injective 
   795   assume "x \<in> UNIV // \<approx>{[c]}"
  1112   (by lemma @{text "tag_image_injI"}) and the image of this function is finite 
   796   then obtain y where h: "x = {z. (y, z) \<in> \<approx>{[c]}}" unfolding quotient_def Image_def by blast
  1113   (with the help of lemma @{text "finite_tag_imageI"}).
   797   show "x \<in> {{[]},{[c]}, UNIV - {[], [c]}}"
  1114 
   798   proof -
  1115   BUT, I think this argument can be encapsulated by one lemma instead of the current presentation.
   799     { assume "y = []" hence "x = {[]}" using h by (auto simp:str_eq_rel_def str_eq_def)
  1116   *}
   800     } moreover {
       
   801       assume "y = [c]" hence "x = {[c]}" using h 
       
   802         by (auto dest!:spec[where x = "[]"] simp:str_eq_rel_def str_eq_def)
       
   803     } moreover {
       
   804       assume "y \<noteq> []" and "y \<noteq> [c]"
       
   805       hence "\<forall> z. (y @ z) \<noteq> [c]" by (case_tac y, auto)
       
   806       moreover have "\<And> p. (p \<noteq> [] \<and> p \<noteq> [c]) = (\<forall> q. p @ q \<noteq> [c])" by (case_tac p, auto)
       
   807       ultimately have "x = UNIV - {[],[c]}" using h
       
   808         by (auto simp add:str_eq_rel_def str_eq_def)
       
   809     } ultimately show ?thesis by blast
       
   810   qed
       
   811 qed
       
   812 
       
   813 text {* *************** Some common lemmas for following ALT, SEQ & STAR cases ******************* *}
       
   814 
       
   815 lemma finite_tag_imageI: 
       
   816   "finite (range tag) \<Longrightarrow> finite (((op `) tag) ` S)"
       
   817 apply (rule_tac B = "Pow (tag ` UNIV)" in finite_subset)
       
   818 by (auto simp add:image_def Pow_def)
       
   819 
  1117 
   820 lemma eq_class_equalI:
  1118 lemma eq_class_equalI:
   821   "\<lbrakk>X \<in> UNIV // \<approx>lang; Y \<in> UNIV // \<approx>lang; x \<in> X; y \<in> Y; x \<approx>lang y\<rbrakk> \<Longrightarrow> X = Y"
  1119   "\<lbrakk>X \<in> UNIV // \<approx>lang; Y \<in> UNIV // \<approx>lang; x \<in> X; y \<in> Y; x \<approx>lang y\<rbrakk> 
       
  1120                          \<Longrightarrow> X = Y"
   822 by (auto simp:quotient_def str_eq_rel_def str_eq_def)
  1121 by (auto simp:quotient_def str_eq_rel_def str_eq_def)
   823 
  1122 
   824 lemma tag_image_injI:
  1123 lemma tag_image_injI:
   825   assumes str_inj: "\<And> m n. tag m = tag (n::string) \<Longrightarrow> m \<approx>lang n"
  1124   assumes str_inj: "\<And> x y. tag x = tag (y::string) \<Longrightarrow> x \<approx>lang y"
   826   shows "inj_on ((op `) tag) (UNIV // \<approx>lang)"
  1125   shows "inj_on ((op `) tag) (UNIV // \<approx>lang)"
   827 proof-
  1126 proof-
   828   { fix X Y
  1127   { fix X Y
   829     assume X_in: "X \<in> UNIV // \<approx>lang"
  1128     assume X_in: "X \<in> UNIV // \<approx>lang"
   830       and  Y_in: "Y \<in> UNIV // \<approx>lang"
  1129       and  Y_in: "Y \<in> UNIV // \<approx>lang"
   836     have "X = Y" by (rule_tac eq_class_equalI, simp+)
  1135     have "X = Y" by (rule_tac eq_class_equalI, simp+)
   837   }
  1136   }
   838   thus ?thesis unfolding inj_on_def by auto
  1137   thus ?thesis unfolding inj_on_def by auto
   839 qed
  1138 qed
   840 
  1139 
   841 text {* **************** the SEQ case ************************ *}
  1140 lemma finite_tag_imageI: 
       
  1141   "finite (range tag) \<Longrightarrow> finite (((op `) tag) ` S)"
       
  1142 apply (rule_tac B = "Pow (tag ` UNIV)" in finite_subset)
       
  1143 by (auto simp add:image_def Pow_def)
       
  1144 
       
  1145 
       
  1146 subsection {* A small theory for list difference *}
       
  1147 
       
  1148 text {*
       
  1149   The notion of list diffrence is need to make proofs more readable.
       
  1150   *}
   842 
  1151 
   843 (* list_diff:: list substract, once different return tailer *)
  1152 (* list_diff:: list substract, once different return tailer *)
   844 fun list_diff :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" (infix "-" 51)
  1153 fun list_diff :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" (infix "-" 51)
   845 where
  1154 where
   846   "list_diff []  xs = []" |
  1155   "list_diff []  xs = []" |
   882 apply (induct y, simp)
  1191 apply (induct y, simp)
   883 apply (clarify, drule_tac x = "x @ [a]" in spec)
  1192 apply (clarify, drule_tac x = "x @ [a]" in spec)
   884 by (clarsimp, auto simp:prefix_def)
  1193 by (clarsimp, auto simp:prefix_def)
   885 
  1194 
   886 lemma app_eq_dest:
  1195 lemma app_eq_dest:
   887   "x @ y = m @ n \<Longrightarrow> (x \<le> m \<and> (m - x) @ n = y) \<or> (m \<le> x \<and> (x - m) @ y = n)"
  1196   "x @ y = m @ n \<Longrightarrow> 
       
  1197                (x \<le> m \<and> (m - x) @ n = y) \<or> (m \<le> x \<and> (x - m) @ y = n)"
   888 by (frule_tac app_eq_cases, auto elim:prefixE)
  1198 by (frule_tac app_eq_cases, auto elim:prefixE)
   889 
  1199 
       
  1200 subsection {* Lemmas for basic cases *}
       
  1201 
       
  1202 text {*
       
  1203   The the final result of this direction is in @{text "easier_direction"}, which
       
  1204   is an induction on the structure of regular expressions. There is one case 
       
  1205   for each regular expression operator. For basic operators such as @{text "NULL, EMPTY, CHAR c"},
       
  1206   the finiteness of their language partition can be established directly with no need
       
  1207   of taggiing. This section contains several technical lemma for these base cases.
       
  1208 
       
  1209   The inductive cases involve operators @{text "ALT, SEQ"} and @{text "STAR"}. 
       
  1210   Tagging functions need to be defined individually for each of them. There will be one
       
  1211   dedicated section for each of these cases, and each section goes virtually the same way:
       
  1212   gives definition of the tagging function and prove that strings 
       
  1213   with the same tag are equivalent.
       
  1214   *}
       
  1215 
       
  1216 lemma quot_empty_subset:
       
  1217   "UNIV // (\<approx>{[]}) \<subseteq> {{[]}, UNIV - {[]}}"
       
  1218 proof
       
  1219   fix x
       
  1220   assume "x \<in> UNIV // \<approx>{[]}"
       
  1221   then obtain y where h: "x = {z. (y, z) \<in> \<approx>{[]}}" 
       
  1222     unfolding quotient_def Image_def by blast
       
  1223   show "x \<in> {{[]}, UNIV - {[]}}" 
       
  1224   proof (cases "y = []")
       
  1225     case True with h
       
  1226     have "x = {[]}" by (auto simp:str_eq_rel_def)
       
  1227     thus ?thesis by simp
       
  1228   next
       
  1229     case False with h
       
  1230     have "x = UNIV - {[]}" by (auto simp:str_eq_rel_def)
       
  1231     thus ?thesis by simp
       
  1232   qed
       
  1233 qed
       
  1234 
       
  1235 lemma quot_char_subset:
       
  1236   "UNIV // (\<approx>{[c]}) \<subseteq> {{[]},{[c]}, UNIV - {[], [c]}}"
       
  1237 proof 
       
  1238   fix x 
       
  1239   assume "x \<in> UNIV // \<approx>{[c]}"
       
  1240   then obtain y where h: "x = {z. (y, z) \<in> \<approx>{[c]}}" 
       
  1241     unfolding quotient_def Image_def by blast
       
  1242   show "x \<in> {{[]},{[c]}, UNIV - {[], [c]}}"
       
  1243   proof -
       
  1244     { assume "y = []" hence "x = {[]}" using h 
       
  1245         by (auto simp:str_eq_rel_def)
       
  1246     } moreover {
       
  1247       assume "y = [c]" hence "x = {[c]}" using h 
       
  1248         by (auto dest!:spec[where x = "[]"] simp:str_eq_rel_def)
       
  1249     } moreover {
       
  1250       assume "y \<noteq> []" and "y \<noteq> [c]"
       
  1251       hence "\<forall> z. (y @ z) \<noteq> [c]" by (case_tac y, auto)
       
  1252       moreover have "\<And> p. (p \<noteq> [] \<and> p \<noteq> [c]) = (\<forall> q. p @ q \<noteq> [c])" 
       
  1253         by (case_tac p, auto)
       
  1254       ultimately have "x = UNIV - {[],[c]}" using h
       
  1255         by (auto simp add:str_eq_rel_def)
       
  1256     } ultimately show ?thesis by blast
       
  1257   qed
       
  1258 qed
       
  1259 
       
  1260 subsection {* The case for @{text "SEQ"}*}
       
  1261 
   890 definition 
  1262 definition 
   891   "tag_str_SEQ L\<^isub>1 L\<^isub>2 x \<equiv> ((\<approx>L\<^isub>1) `` {x}, {(\<approx>L\<^isub>2) `` {x - xa}| xa.  xa \<le> x \<and> xa \<in> L\<^isub>1})"
  1263   "tag_str_SEQ L\<^isub>1 L\<^isub>2 x \<equiv> 
       
  1264        ((\<approx>L\<^isub>1) `` {x}, {(\<approx>L\<^isub>2) `` {x - xa}| xa.  xa \<le> x \<and> xa \<in> L\<^isub>1})"
   892 
  1265 
   893 lemma tag_str_seq_range_finite:
  1266 lemma tag_str_seq_range_finite:
   894   "\<lbrakk>finite (UNIV // \<approx>L\<^isub>1); finite (UNIV // \<approx>L\<^isub>2)\<rbrakk> \<Longrightarrow> finite (range (tag_str_SEQ L\<^isub>1 L\<^isub>2))"
  1267   "\<lbrakk>finite (UNIV // \<approx>L\<^isub>1); finite (UNIV // \<approx>L\<^isub>2)\<rbrakk> 
       
  1268                               \<Longrightarrow> finite (range (tag_str_SEQ L\<^isub>1 L\<^isub>2))"
   895 apply (rule_tac B = "(UNIV // \<approx>L\<^isub>1) \<times> (Pow (UNIV // \<approx>L\<^isub>2))" in finite_subset)
  1269 apply (rule_tac B = "(UNIV // \<approx>L\<^isub>1) \<times> (Pow (UNIV // \<approx>L\<^isub>2))" in finite_subset)
   896 by (auto simp:tag_str_SEQ_def Image_def quotient_def split:if_splits)
  1270 by (auto simp:tag_str_SEQ_def Image_def quotient_def split:if_splits)
   897 
  1271 
   898 lemma append_seq_elim:
  1272 lemma append_seq_elim:
   899   assumes "x @ y \<in> L\<^isub>1 ;; L\<^isub>2"
  1273   assumes "x @ y \<in> L\<^isub>1 ;; L\<^isub>2"
   900   shows "(\<exists> xa \<le> x. xa \<in> L\<^isub>1 \<and> (x - xa) @ y \<in> L\<^isub>2) \<or> (\<exists> ya \<le> y. (x @ ya) \<in> L\<^isub>1 \<and> (y - ya) \<in> L\<^isub>2)"
  1274   shows "(\<exists> xa \<le> x. xa \<in> L\<^isub>1 \<and> (x - xa) @ y \<in> L\<^isub>2) \<or> 
       
  1275           (\<exists> ya \<le> y. (x @ ya) \<in> L\<^isub>1 \<and> (y - ya) \<in> L\<^isub>2)"
   901 proof-
  1276 proof-
   902   from assms obtain s\<^isub>1 s\<^isub>2 where "x @ y = s\<^isub>1 @ s\<^isub>2" and in_seq: "s\<^isub>1 \<in> L\<^isub>1 \<and> s\<^isub>2 \<in> L\<^isub>2" 
  1277   from assms obtain s\<^isub>1 s\<^isub>2 
       
  1278     where "x @ y = s\<^isub>1 @ s\<^isub>2" 
       
  1279     and in_seq: "s\<^isub>1 \<in> L\<^isub>1 \<and> s\<^isub>2 \<in> L\<^isub>2" 
   903     by (auto simp:Seq_def)
  1280     by (auto simp:Seq_def)
   904   hence "(x \<le> s\<^isub>1 \<and> (s\<^isub>1 - x) @ s\<^isub>2 = y) \<or> (s\<^isub>1 \<le> x \<and> (x - s\<^isub>1) @ y = s\<^isub>2)"
  1281   hence "(x \<le> s\<^isub>1 \<and> (s\<^isub>1 - x) @ s\<^isub>2 = y) \<or> (s\<^isub>1 \<le> x \<and> (x - s\<^isub>1) @ y = s\<^isub>2)"
   905     using app_eq_dest by auto
  1282     using app_eq_dest by auto
   906   moreover have "\<lbrakk>x \<le> s\<^isub>1; (s\<^isub>1 - x) @ s\<^isub>2 = y\<rbrakk> \<Longrightarrow> \<exists> ya \<le> y. (x @ ya) \<in> L\<^isub>1 \<and> (y - ya) \<in> L\<^isub>2" using in_seq
  1283   moreover have "\<lbrakk>x \<le> s\<^isub>1; (s\<^isub>1 - x) @ s\<^isub>2 = y\<rbrakk> \<Longrightarrow> 
   907     by (rule_tac x = "s\<^isub>1 - x" in exI, auto elim:prefixE)
  1284                        \<exists> ya \<le> y. (x @ ya) \<in> L\<^isub>1 \<and> (y - ya) \<in> L\<^isub>2" 
   908   moreover have "\<lbrakk>s\<^isub>1 \<le> x; (x - s\<^isub>1) @ y = s\<^isub>2\<rbrakk> \<Longrightarrow> \<exists> xa \<le> x. xa \<in> L\<^isub>1 \<and> (x - xa) @ y \<in> L\<^isub>2" using in_seq
  1285     using in_seq by (rule_tac x = "s\<^isub>1 - x" in exI, auto elim:prefixE)
   909     by (rule_tac x = s\<^isub>1 in exI, auto)
  1286   moreover have "\<lbrakk>s\<^isub>1 \<le> x; (x - s\<^isub>1) @ y = s\<^isub>2\<rbrakk> \<Longrightarrow> 
       
  1287                     \<exists> xa \<le> x. xa \<in> L\<^isub>1 \<and> (x - xa) @ y \<in> L\<^isub>2" 
       
  1288     using in_seq by (rule_tac x = s\<^isub>1 in exI, auto)
   910   ultimately show ?thesis by blast
  1289   ultimately show ?thesis by blast
   911 qed
  1290 qed
   912 
  1291 
   913 lemma tag_str_SEQ_injI:
  1292 lemma tag_str_SEQ_injI:
   914   "tag_str_SEQ L\<^isub>1 L\<^isub>2 m = tag_str_SEQ L\<^isub>1 L\<^isub>2 n \<Longrightarrow> m \<approx>(L\<^isub>1 ;; L\<^isub>2) n"
  1293   "tag_str_SEQ L\<^isub>1 L\<^isub>2 m = tag_str_SEQ L\<^isub>1 L\<^isub>2 n \<Longrightarrow> m \<approx>(L\<^isub>1 ;; L\<^isub>2) n"
   916   { fix x y z
  1295   { fix x y z
   917     assume xz_in_seq: "x @ z \<in> L\<^isub>1 ;; L\<^isub>2"
  1296     assume xz_in_seq: "x @ z \<in> L\<^isub>1 ;; L\<^isub>2"
   918     and tag_xy: "tag_str_SEQ L\<^isub>1 L\<^isub>2 x = tag_str_SEQ L\<^isub>1 L\<^isub>2 y"
  1297     and tag_xy: "tag_str_SEQ L\<^isub>1 L\<^isub>2 x = tag_str_SEQ L\<^isub>1 L\<^isub>2 y"
   919     have"y @ z \<in> L\<^isub>1 ;; L\<^isub>2" 
  1298     have"y @ z \<in> L\<^isub>1 ;; L\<^isub>2" 
   920     proof-
  1299     proof-
   921       have "(\<exists> xa \<le> x. xa \<in> L\<^isub>1 \<and> (x - xa) @ z \<in> L\<^isub>2) \<or> (\<exists> za \<le> z. (x @ za) \<in> L\<^isub>1 \<and> (z - za) \<in> L\<^isub>2)"
  1300       have "(\<exists> xa \<le> x. xa \<in> L\<^isub>1 \<and> (x - xa) @ z \<in> L\<^isub>2) \<or> 
       
  1301                (\<exists> za \<le> z. (x @ za) \<in> L\<^isub>1 \<and> (z - za) \<in> L\<^isub>2)"
   922         using xz_in_seq append_seq_elim by simp
  1302         using xz_in_seq append_seq_elim by simp
   923       moreover {
  1303       moreover {
   924         fix xa
  1304         fix xa
   925         assume h1: "xa \<le> x" and h2: "xa \<in> L\<^isub>1" and h3: "(x - xa) @ z \<in> L\<^isub>2"
  1305         assume h1: "xa \<le> x" and h2: "xa \<in> L\<^isub>1" and h3: "(x - xa) @ z \<in> L\<^isub>2"
   926         obtain ya where "ya \<le> y" and "ya \<in> L\<^isub>1" and "(y - ya) @ z \<in> L\<^isub>2" 
  1306         obtain ya where "ya \<le> y" and "ya \<in> L\<^isub>1" and "(y - ya) @ z \<in> L\<^isub>2" 
   927         proof -
  1307         proof -
   928           have "\<exists> ya.  ya \<le> y \<and> ya \<in> L\<^isub>1 \<and> (x - xa) \<approx>L\<^isub>2 (y - ya)"
  1308           have "\<exists> ya.  ya \<le> y \<and> ya \<in> L\<^isub>1 \<and> (x - xa) \<approx>L\<^isub>2 (y - ya)"
   929           proof -
  1309           proof -
   930             have "{\<approx>L\<^isub>2 `` {x - xa} |xa. xa \<le> x \<and> xa \<in> L\<^isub>1} = 
  1310             have "{\<approx>L\<^isub>2 `` {x - xa} |xa. xa \<le> x \<and> xa \<in> L\<^isub>1} = 
   931                   {\<approx>L\<^isub>2 `` {y - xa} |xa. xa \<le> y \<and> xa \<in> L\<^isub>1}" (is "?Left = ?Right") 
  1311                   {\<approx>L\<^isub>2 `` {y - xa} |xa. xa \<le> y \<and> xa \<in> L\<^isub>1}" 
       
  1312                           (is "?Left = ?Right") 
   932               using h1 tag_xy by (auto simp:tag_str_SEQ_def)
  1313               using h1 tag_xy by (auto simp:tag_str_SEQ_def)
   933             moreover have "\<approx>L\<^isub>2 `` {x - xa} \<in> ?Left" using h1 h2 by auto
  1314             moreover have "\<approx>L\<^isub>2 `` {x - xa} \<in> ?Left" using h1 h2 by auto
   934             ultimately have "\<approx>L\<^isub>2 `` {x - xa} \<in> ?Right" by simp
  1315             ultimately have "\<approx>L\<^isub>2 `` {x - xa} \<in> ?Right" by simp
   935             thus ?thesis by (auto simp:Image_def str_eq_rel_def str_eq_def)
  1316             thus ?thesis by (auto simp:Image_def str_eq_rel_def str_eq_def)
   936           qed
  1317           qed
   940       } moreover {
  1321       } moreover {
   941         fix za
  1322         fix za
   942         assume h1: "za \<le> z" and h2: "(x @ za) \<in> L\<^isub>1" and h3: "z - za \<in> L\<^isub>2"
  1323         assume h1: "za \<le> z" and h2: "(x @ za) \<in> L\<^isub>1" and h3: "z - za \<in> L\<^isub>2"
   943         hence "y @ za \<in> L\<^isub>1"
  1324         hence "y @ za \<in> L\<^isub>1"
   944         proof-
  1325         proof-
   945           have "\<approx>L\<^isub>1 `` {x} = \<approx>L\<^isub>1 `` {y}" using h1 tag_xy by (auto simp:tag_str_SEQ_def)
  1326           have "\<approx>L\<^isub>1 `` {x} = \<approx>L\<^isub>1 `` {y}" 
   946           with h2 show ?thesis by (auto simp:Image_def str_eq_rel_def str_eq_def) 
  1327             using h1 tag_xy by (auto simp:tag_str_SEQ_def)
       
  1328           with h2 show ?thesis 
       
  1329             by (auto simp:Image_def str_eq_rel_def str_eq_def) 
   947         qed
  1330         qed
   948         with h1 h3 have "y @ z \<in> L\<^isub>1 ;; L\<^isub>2" by (drule_tac A = L\<^isub>1 in seq_intro, auto elim:prefixE)
  1331         with h1 h3 have "y @ z \<in> L\<^isub>1 ;; L\<^isub>2" 
       
  1332           by (drule_tac A = L\<^isub>1 in seq_intro, auto elim:prefixE)
   949       }
  1333       }
   950       ultimately show ?thesis by blast
  1334       ultimately show ?thesis by blast
   951     qed
  1335     qed
   952   } thus "tag_str_SEQ L\<^isub>1 L\<^isub>2 m = tag_str_SEQ L\<^isub>1 L\<^isub>2 n \<Longrightarrow> m \<approx>(L\<^isub>1 ;; L\<^isub>2) n" 
  1336   } thus "tag_str_SEQ L\<^isub>1 L\<^isub>2 m = tag_str_SEQ L\<^isub>1 L\<^isub>2 n \<Longrightarrow> m \<approx>(L\<^isub>1 ;; L\<^isub>2) n" 
   953     by (auto simp add: str_eq_def str_eq_rel_def)
  1337     by (auto simp add: str_eq_def str_eq_rel_def)
   956 lemma quot_seq_finiteI:
  1340 lemma quot_seq_finiteI:
   957   assumes finite1: "finite (UNIV // \<approx>(L\<^isub>1::string set))"
  1341   assumes finite1: "finite (UNIV // \<approx>(L\<^isub>1::string set))"
   958   and finite2: "finite (UNIV // \<approx>L\<^isub>2)"
  1342   and finite2: "finite (UNIV // \<approx>L\<^isub>2)"
   959   shows "finite (UNIV // \<approx>(L\<^isub>1 ;; L\<^isub>2))"
  1343   shows "finite (UNIV // \<approx>(L\<^isub>1 ;; L\<^isub>2))"
   960 proof(rule_tac f = "(op `) (tag_str_SEQ L\<^isub>1 L\<^isub>2)" in finite_imageD)
  1344 proof(rule_tac f = "(op `) (tag_str_SEQ L\<^isub>1 L\<^isub>2)" in finite_imageD)
   961   show "finite (op ` (tag_str_SEQ L\<^isub>1 L\<^isub>2) ` UNIV // \<approx>L\<^isub>1 ;; L\<^isub>2)" using finite1 finite2
  1345   show "finite (op ` (tag_str_SEQ L\<^isub>1 L\<^isub>2) ` UNIV // \<approx>L\<^isub>1 ;; L\<^isub>2)" 
       
  1346     using finite1 finite2
   962     by (auto intro:finite_tag_imageI tag_str_seq_range_finite)
  1347     by (auto intro:finite_tag_imageI tag_str_seq_range_finite)
   963 next
  1348 next
   964   show  "inj_on (op ` (tag_str_SEQ L\<^isub>1 L\<^isub>2)) (UNIV // \<approx>L\<^isub>1 ;; L\<^isub>2)"
  1349   show  "inj_on (op ` (tag_str_SEQ L\<^isub>1 L\<^isub>2)) (UNIV // \<approx>L\<^isub>1 ;; L\<^isub>2)"
   965     apply (rule tag_image_injI)
  1350     apply (rule tag_image_injI)
   966     apply (rule tag_str_SEQ_injI)
  1351     apply (rule tag_str_SEQ_injI)
   967     by (auto intro:tag_image_injI tag_str_SEQ_injI simp:)
  1352     by (auto intro:tag_image_injI tag_str_SEQ_injI simp:)
   968 qed
  1353 qed
   969 
  1354 
   970 text {* **************** the ALT case ************************ *}
  1355 subsection {* The case for @{text "ALT"} *}
   971 
  1356 
   972 definition 
  1357 definition 
   973   "tag_str_ALT L\<^isub>1 L\<^isub>2 (x::string) \<equiv> ((\<approx>L\<^isub>1) `` {x}, (\<approx>L\<^isub>2) `` {x})"
  1358   "tag_str_ALT L\<^isub>1 L\<^isub>2 (x::string) \<equiv> ((\<approx>L\<^isub>1) `` {x}, (\<approx>L\<^isub>2) `` {x})"
   974 
  1359 
   975 lemma tag_str_alt_range_finite:
  1360 lemma tag_str_alt_range_finite:
   976   "\<lbrakk>finite (UNIV // \<approx>L\<^isub>1); finite (UNIV // \<approx>L\<^isub>2)\<rbrakk> \<Longrightarrow> finite (range (tag_str_ALT L\<^isub>1 L\<^isub>2))"
  1361   "\<lbrakk>finite (UNIV // \<approx>L\<^isub>1); finite (UNIV // \<approx>L\<^isub>2)\<rbrakk> 
       
  1362                               \<Longrightarrow> finite (range (tag_str_ALT L\<^isub>1 L\<^isub>2))"
   977 apply (rule_tac B = "(UNIV // \<approx>L\<^isub>1) \<times> (UNIV // \<approx>L\<^isub>2)" in finite_subset)
  1363 apply (rule_tac B = "(UNIV // \<approx>L\<^isub>1) \<times> (UNIV // \<approx>L\<^isub>2)" in finite_subset)
   978 by (auto simp:tag_str_ALT_def Image_def quotient_def)
  1364 by (auto simp:tag_str_ALT_def Image_def quotient_def)
   979 
  1365 
   980 lemma quot_union_finiteI:
  1366 lemma quot_union_finiteI:
   981   assumes finite1: "finite (UNIV // \<approx>(L\<^isub>1::string set))"
  1367   assumes finite1: "finite (UNIV // \<approx>(L\<^isub>1::string set))"
   982   and finite2: "finite (UNIV // \<approx>L\<^isub>2)"
  1368   and finite2: "finite (UNIV // \<approx>L\<^isub>2)"
   983   shows "finite (UNIV // \<approx>(L\<^isub>1 \<union> L\<^isub>2))"
  1369   shows "finite (UNIV // \<approx>(L\<^isub>1 \<union> L\<^isub>2))"
   984 proof(rule_tac f = "(op `) (tag_str_ALT L\<^isub>1 L\<^isub>2)" in finite_imageD)
  1370 proof(rule_tac f = "(op `) (tag_str_ALT L\<^isub>1 L\<^isub>2)" in finite_imageD)
   985   show "finite (op ` (tag_str_ALT L\<^isub>1 L\<^isub>2) ` UNIV // \<approx>L\<^isub>1 \<union> L\<^isub>2)" using finite1 finite2
  1371   show "finite (op ` (tag_str_ALT L\<^isub>1 L\<^isub>2) ` UNIV // \<approx>L\<^isub>1 \<union> L\<^isub>2)" 
       
  1372     using finite1 finite2
   986     by (auto intro:finite_tag_imageI tag_str_alt_range_finite)
  1373     by (auto intro:finite_tag_imageI tag_str_alt_range_finite)
   987 next
  1374 next
   988   show "inj_on (op ` (tag_str_ALT L\<^isub>1 L\<^isub>2)) (UNIV // \<approx>L\<^isub>1 \<union> L\<^isub>2)"
  1375   show "inj_on (op ` (tag_str_ALT L\<^isub>1 L\<^isub>2)) (UNIV // \<approx>L\<^isub>1 \<union> L\<^isub>2)"
   989   proof-
  1376   proof-
   990     have "\<And>m n. tag_str_ALT L\<^isub>1 L\<^isub>2 m = tag_str_ALT L\<^isub>1 L\<^isub>2 n \<Longrightarrow> m \<approx>(L\<^isub>1 \<union> L\<^isub>2) n"
  1377     have "\<And>m n. tag_str_ALT L\<^isub>1 L\<^isub>2 m = tag_str_ALT L\<^isub>1 L\<^isub>2 n 
       
  1378                          \<Longrightarrow> m \<approx>(L\<^isub>1 \<union> L\<^isub>2) n"
   991       unfolding tag_str_ALT_def str_eq_def Image_def str_eq_rel_def by auto
  1379       unfolding tag_str_ALT_def str_eq_def Image_def str_eq_rel_def by auto
   992     thus ?thesis by (auto intro:tag_image_injI)
  1380     thus ?thesis by (auto intro:tag_image_injI)
   993   qed
  1381   qed
   994 qed
  1382 qed
   995 
  1383 
   996 text {* **************** the Star case ****************** *}
  1384 
   997 
  1385 subsection {*
   998 lemma finite_set_has_max: "\<lbrakk>finite A; A \<noteq> {}\<rbrakk> \<Longrightarrow> (\<exists> max \<in> A. \<forall> a \<in> A. f a <= (f max :: nat))"
  1386   The case for @{text "STAR"}
       
  1387   *}
       
  1388 
       
  1389 text {* 
       
  1390   This turned out to be the most tricky case. 
       
  1391   *} (* I will make some illustrations for it. *)
       
  1392 
       
  1393 definition 
       
  1394   "tag_str_STAR L\<^isub>1 x \<equiv> {(\<approx>L\<^isub>1) `` {x - xa} | xa. xa < x \<and> xa \<in> L\<^isub>1\<star>}"
       
  1395 
       
  1396 lemma finite_set_has_max: "\<lbrakk>finite A; A \<noteq> {}\<rbrakk> \<Longrightarrow> 
       
  1397            (\<exists> max \<in> A. \<forall> a \<in> A. f a <= (f max :: nat))"
   999 proof (induct rule:finite.induct)
  1398 proof (induct rule:finite.induct)
  1000   case emptyI thus ?case by simp
  1399   case emptyI thus ?case by simp
  1001 next
  1400 next
  1002   case (insertI A a)
  1401   case (insertI A a)
  1003   show ?case
  1402   show ?case
  1004   proof (cases "A = {}")
  1403   proof (cases "A = {}")
  1005     case True thus ?thesis by (rule_tac x = a in bexI, auto)
  1404     case True thus ?thesis by (rule_tac x = a in bexI, auto)
  1006   next
  1405   next
  1007     case False
  1406     case False
  1008     with prems obtain max where h1: "max \<in> A" and h2: "\<forall>a\<in>A. f a \<le> f max" by blast
  1407     with prems obtain max 
       
  1408       where h1: "max \<in> A" 
       
  1409       and h2: "\<forall>a\<in>A. f a \<le> f max" by blast
  1009     show ?thesis
  1410     show ?thesis
  1010     proof (cases "f a \<le> f max")
  1411     proof (cases "f a \<le> f max")
  1011       assume "f a \<le> f max"
  1412       assume "f a \<le> f max"
  1012       with h1 h2 show ?thesis by (rule_tac x = max in bexI, auto)
  1413       with h1 h2 show ?thesis by (rule_tac x = max in bexI, auto)
  1013     next
  1414     next
  1015       thus ?thesis using h2 by (rule_tac x = a in bexI, auto)
  1416       thus ?thesis using h2 by (rule_tac x = a in bexI, auto)
  1016     qed
  1417     qed
  1017   qed
  1418   qed
  1018 qed
  1419 qed
  1019 
  1420 
  1020 lemma star_intro1[rule_format]: "x \<in> lang\<star> \<Longrightarrow> \<forall> y. y \<in> lang\<star> \<longrightarrow> x @ y \<in> lang\<star>"
       
  1021 by (erule Star.induct, auto)
       
  1022 
       
  1023 lemma star_intro2: "y \<in> lang \<Longrightarrow> y \<in> lang\<star>"
       
  1024 by (drule step[of y lang "[]"], auto simp:start)
       
  1025 
       
  1026 lemma star_intro3[rule_format]: "x \<in> lang\<star> \<Longrightarrow> \<forall>y . y \<in> lang \<longrightarrow> x @ y \<in> lang\<star>"
       
  1027 by (erule Star.induct, auto intro:star_intro2)
       
  1028 
       
  1029 lemma star_decom: "\<lbrakk>x \<in> lang\<star>; x \<noteq> []\<rbrakk> \<Longrightarrow>(\<exists> a b. x = a @ b \<and> a \<noteq> [] \<and> a \<in> lang \<and> b \<in> lang\<star>)"
       
  1030 by (induct x rule: Star.induct, simp, blast)
       
  1031 
       
  1032 lemma finite_strict_prefix_set: "finite {xa. xa < (x::string)}"
  1421 lemma finite_strict_prefix_set: "finite {xa. xa < (x::string)}"
  1033 apply (induct x rule:rev_induct, simp)
  1422 apply (induct x rule:rev_induct, simp)
  1034 apply (subgoal_tac "{xa. xa < xs @ [x]} = {xa. xa < xs} \<union> {xs}")
  1423 apply (subgoal_tac "{xa. xa < xs @ [x]} = {xa. xa < xs} \<union> {xs}")
  1035 by (auto simp:strict_prefix_def)
  1424 by (auto simp:strict_prefix_def)
  1036 
  1425 
  1037 definition 
       
  1038   "tag_str_STAR L\<^isub>1 x \<equiv> {(\<approx>L\<^isub>1) `` {x - xa} | xa. xa < x \<and> xa \<in> L\<^isub>1\<star>}"
       
  1039 
  1426 
  1040 lemma tag_str_star_range_finite:
  1427 lemma tag_str_star_range_finite:
  1041   "finite (UNIV // \<approx>L\<^isub>1) \<Longrightarrow> finite (range (tag_str_STAR L\<^isub>1))"
  1428   "finite (UNIV // \<approx>L\<^isub>1) \<Longrightarrow> finite (range (tag_str_STAR L\<^isub>1))"
  1042 apply (rule_tac B = "Pow (UNIV // \<approx>L\<^isub>1)" in finite_subset)
  1429 apply (rule_tac B = "Pow (UNIV // \<approx>L\<^isub>1)" in finite_subset)
  1043 by (auto simp:tag_str_STAR_def Image_def quotient_def split:if_splits)
  1430 by (auto simp:tag_str_STAR_def Image_def 
       
  1431                        quotient_def split:if_splits)
  1044 
  1432 
  1045 lemma tag_str_STAR_injI:
  1433 lemma tag_str_STAR_injI:
  1046   "tag_str_STAR L\<^isub>1 m = tag_str_STAR L\<^isub>1 n \<Longrightarrow> m \<approx>(L\<^isub>1\<star>) n"
  1434   "tag_str_STAR L\<^isub>1 m = tag_str_STAR L\<^isub>1 n \<Longrightarrow> m \<approx>(L\<^isub>1\<star>) n"
  1047 proof-
  1435 proof-
  1048   { fix x y z
  1436   { fix x y z
  1049     assume xz_in_star: "x @ z \<in> L\<^isub>1\<star>"
  1437     assume xz_in_star: "x @ z \<in> L\<^isub>1\<star>"
  1050     and tag_xy: "tag_str_STAR L\<^isub>1 x = tag_str_STAR L\<^isub>1 y"
  1438     and tag_xy: "tag_str_STAR L\<^isub>1 x = tag_str_STAR L\<^isub>1 y"
  1051     have "y @ z \<in> L\<^isub>1\<star>"
  1439     have "y @ z \<in> L\<^isub>1\<star>"
  1052     proof(cases "x = []")
  1440     proof(cases "x = []")
  1053       case True
  1441       case True
  1054       with tag_xy have "y = []" by (auto simp:tag_str_STAR_def strict_prefix_def)
  1442       with tag_xy have "y = []" 
       
  1443         by (auto simp:tag_str_STAR_def strict_prefix_def)
  1055       thus ?thesis using xz_in_star True by simp
  1444       thus ?thesis using xz_in_star True by simp
  1056     next
  1445     next
  1057       case False
  1446       case False
  1058       obtain x_max where h1: "x_max < x" and h2: "x_max \<in> L\<^isub>1\<star>" and h3: "(x - x_max) @ z \<in> L\<^isub>1\<star>" 
  1447       obtain x_max 
  1059         and h4:"\<forall> xa < x. xa \<in> L\<^isub>1\<star> \<and> (x - xa) @ z \<in> L\<^isub>1\<star> \<longrightarrow> length xa \<le> length x_max"
  1448         where h1: "x_max < x" 
       
  1449         and h2: "x_max \<in> L\<^isub>1\<star>" 
       
  1450         and h3: "(x - x_max) @ z \<in> L\<^isub>1\<star>" 
       
  1451         and h4:"\<forall> xa < x. xa \<in> L\<^isub>1\<star> \<and> (x - xa) @ z \<in> L\<^isub>1\<star> 
       
  1452                                      \<longrightarrow> length xa \<le> length x_max"
  1060       proof-
  1453       proof-
  1061         let ?S = "{xa. xa < x \<and> xa \<in> L\<^isub>1\<star> \<and> (x - xa) @ z \<in> L\<^isub>1\<star>}"
  1454         let ?S = "{xa. xa < x \<and> xa \<in> L\<^isub>1\<star> \<and> (x - xa) @ z \<in> L\<^isub>1\<star>}"
  1062         have "finite ?S"
  1455         have "finite ?S"
  1063           by (rule_tac B = "{xa. xa < x}" in finite_subset, auto simp:finite_strict_prefix_set)
  1456           by (rule_tac B = "{xa. xa < x}" in finite_subset, 
       
  1457                                 auto simp:finite_strict_prefix_set)
  1064         moreover have "?S \<noteq> {}" using False xz_in_star
  1458         moreover have "?S \<noteq> {}" using False xz_in_star
  1065           by (simp, rule_tac x = "[]" in exI, auto simp:strict_prefix_def)
  1459           by (simp, rule_tac x = "[]" in exI, auto simp:strict_prefix_def)
  1066         ultimately have "\<exists> max \<in> ?S. \<forall> a \<in> ?S. length a \<le> length max" using finite_set_has_max by blast
  1460         ultimately have "\<exists> max \<in> ?S. \<forall> a \<in> ?S. length a \<le> length max" 
       
  1461           using finite_set_has_max by blast
  1067         with prems show ?thesis by blast
  1462         with prems show ?thesis by blast
  1068       qed
  1463       qed
  1069       obtain ya where h5: "ya < y" and h6: "ya \<in> L\<^isub>1\<star>" and h7: "(x - x_max) \<approx>L\<^isub>1 (y - ya)"
  1464       obtain ya 
       
  1465         where h5: "ya < y" and h6: "ya \<in> L\<^isub>1\<star>" and h7: "(x - x_max) \<approx>L\<^isub>1 (y - ya)"
  1070       proof-
  1466       proof-
  1071         from tag_xy have "{\<approx>L\<^isub>1 `` {x - xa} |xa. xa < x \<and> xa \<in> L\<^isub>1\<star>} = 
  1467         from tag_xy have "{\<approx>L\<^isub>1 `` {x - xa} |xa. xa < x \<and> xa \<in> L\<^isub>1\<star>} = 
  1072           {\<approx>L\<^isub>1 `` {y - xa} |xa. xa < y \<and> xa \<in> L\<^isub>1\<star>}" (is "?left = ?right")
  1468           {\<approx>L\<^isub>1 `` {y - xa} |xa. xa < y \<and> xa \<in> L\<^isub>1\<star>}" (is "?left = ?right")
  1073           by (auto simp:tag_str_STAR_def)
  1469           by (auto simp:tag_str_STAR_def)
  1074         moreover have "\<approx>L\<^isub>1 `` {x - x_max} \<in> ?left" using h1 h2 by auto
  1470         moreover have "\<approx>L\<^isub>1 `` {x - x_max} \<in> ?left" using h1 h2 by auto
  1075         ultimately have "\<approx>L\<^isub>1 `` {x - x_max} \<in> ?right" by simp
  1471         ultimately have "\<approx>L\<^isub>1 `` {x - x_max} \<in> ?right" by simp
  1076         with prems show ?thesis apply (simp add:Image_def str_eq_rel_def str_eq_def) by blast
  1472         with prems show ?thesis apply 
       
  1473           (simp add:Image_def str_eq_rel_def str_eq_def) by blast
  1077       qed      
  1474       qed      
  1078       have "(y - ya) @ z \<in> L\<^isub>1\<star>" 
  1475       have "(y - ya) @ z \<in> L\<^isub>1\<star>" 
  1079       proof-
  1476       proof-
  1080         from h3 h1 obtain a b where a_in: "a \<in> L\<^isub>1" and a_neq: "a \<noteq> []" and b_in: "b \<in> L\<^isub>1\<star>" 
  1477         from h3 h1 obtain a b where a_in: "a \<in> L\<^isub>1" 
       
  1478           and a_neq: "a \<noteq> []" and b_in: "b \<in> L\<^isub>1\<star>" 
  1081           and ab_max: "(x - x_max) @ z = a @ b" 
  1479           and ab_max: "(x - x_max) @ z = a @ b" 
  1082           by (drule_tac star_decom, auto simp:strict_prefix_def elim:prefixE)
  1480           by (drule_tac star_decom, auto simp:strict_prefix_def elim:prefixE)
  1083         have "(x - x_max) \<le> a \<and> (a - (x - x_max)) @ b = z" 
  1481         have "(x - x_max) \<le> a \<and> (a - (x - x_max)) @ b = z" 
  1084         proof -
  1482         proof -
  1085           have "((x - x_max) \<le> a \<and> (a - (x - x_max)) @ b = z) \<or> (a < (x - x_max) \<and> ((x - x_max) - a) @ z = b)" 
  1483           have "((x - x_max) \<le> a \<and> (a - (x - x_max)) @ b = z) \<or> 
       
  1484                             (a < (x - x_max) \<and> ((x - x_max) - a) @ z = b)" 
  1086             using app_eq_dest[OF ab_max] by (auto simp:strict_prefix_def)
  1485             using app_eq_dest[OF ab_max] by (auto simp:strict_prefix_def)
  1087           moreover { 
  1486           moreover { 
  1088             assume np: "a < (x - x_max)" and b_eqs: " ((x - x_max) - a) @ z = b"
  1487             assume np: "a < (x - x_max)" and b_eqs: " ((x - x_max) - a) @ z = b"
  1089             have "False"
  1488             have "False"
  1090             proof -
  1489             proof -
  1091               let ?x_max' = "x_max @ a"
  1490               let ?x_max' = "x_max @ a"
  1092               have "?x_max' < x" using np h1 by (clarsimp simp:strict_prefix_def diff_prefix) 
  1491               have "?x_max' < x" 
  1093               moreover have "?x_max' \<in> L\<^isub>1\<star>" using a_in h2 by (simp add:star_intro3) 
  1492                 using np h1 by (clarsimp simp:strict_prefix_def diff_prefix) 
  1094               moreover have "(x - ?x_max') @ z \<in> L\<^isub>1\<star>" using b_eqs b_in np h1 by (simp add:diff_diff_appd)
  1493               moreover have "?x_max' \<in> L\<^isub>1\<star>" 
  1095               moreover have "\<not> (length ?x_max' \<le> length x_max)" using a_neq by simp
  1494                 using a_in h2 by (simp add:star_intro3) 
       
  1495               moreover have "(x - ?x_max') @ z \<in> L\<^isub>1\<star>" 
       
  1496                 using b_eqs b_in np h1 by (simp add:diff_diff_appd)
       
  1497               moreover have "\<not> (length ?x_max' \<le> length x_max)" 
       
  1498                 using a_neq by simp
  1096               ultimately show ?thesis using h4 by blast
  1499               ultimately show ?thesis using h4 by blast
  1097             qed 
  1500             qed 
  1098           } ultimately show ?thesis by blast
  1501           } ultimately show ?thesis by blast
  1099         qed
  1502         qed
  1100         then obtain za where z_decom: "z = za @ b" and x_za: "(x - x_max) @ za \<in> L\<^isub>1" 
  1503         then obtain za where z_decom: "z = za @ b" 
       
  1504           and x_za: "(x - x_max) @ za \<in> L\<^isub>1" 
  1101           using a_in by (auto elim:prefixE)        
  1505           using a_in by (auto elim:prefixE)        
  1102         from x_za h7 have "(y - ya) @ za \<in> L\<^isub>1" by (auto simp:str_eq_def)
  1506         from x_za h7 have "(y - ya) @ za \<in> L\<^isub>1" 
       
  1507           by (auto simp:str_eq_def str_eq_rel_def)
  1103         with z_decom b_in show ?thesis by (auto dest!:step[of "(y - ya) @ za"])
  1508         with z_decom b_in show ?thesis by (auto dest!:step[of "(y - ya) @ za"])
  1104       qed
  1509       qed
  1105       with h5 h6 show ?thesis by (drule_tac star_intro1, auto simp:strict_prefix_def elim:prefixE)
  1510       with h5 h6 show ?thesis 
       
  1511         by (drule_tac star_intro1, auto simp:strict_prefix_def elim:prefixE)
  1106     qed      
  1512     qed      
  1107   } thus "tag_str_STAR L\<^isub>1 m = tag_str_STAR L\<^isub>1 n \<Longrightarrow> m \<approx>(L\<^isub>1\<star>) n"
  1513   } thus "tag_str_STAR L\<^isub>1 m = tag_str_STAR L\<^isub>1 n \<Longrightarrow> m \<approx>(L\<^isub>1\<star>) n"
  1108     by (auto simp add:str_eq_def str_eq_rel_def)
  1514     by (auto simp add:str_eq_def str_eq_rel_def)
  1109 qed
  1515 qed
  1110 
  1516 
  1117 next
  1523 next
  1118   show "inj_on (op ` (tag_str_STAR L\<^isub>1)) (UNIV // \<approx>L\<^isub>1\<star>)"
  1524   show "inj_on (op ` (tag_str_STAR L\<^isub>1)) (UNIV // \<approx>L\<^isub>1\<star>)"
  1119     by (auto intro:tag_image_injI tag_str_STAR_injI)
  1525     by (auto intro:tag_image_injI tag_str_STAR_injI)
  1120 qed
  1526 qed
  1121 
  1527 
  1122 text {* **************** the Other Direction ************ *}
  1528 subsection {*
  1123 
  1529   The main lemma
  1124 lemma other_direction:
  1530   *}
       
  1531 
       
  1532 lemma easier_directio\<nu>:
  1125   "Lang = L (r::rexp) \<Longrightarrow> finite (UNIV // (\<approx>Lang))"
  1533   "Lang = L (r::rexp) \<Longrightarrow> finite (UNIV // (\<approx>Lang))"
  1126 proof (induct arbitrary:Lang rule:rexp.induct)
  1534 proof (induct arbitrary:Lang rule:rexp.induct)
  1127   case NULL
  1535   case NULL
  1128   have "UNIV // (\<approx>{}) \<subseteq> {UNIV} "
  1536   have "UNIV // (\<approx>{}) \<subseteq> {UNIV} "
  1129     by (auto simp:quotient_def str_eq_rel_def str_eq_def)
  1537     by (auto simp:quotient_def str_eq_rel_def str_eq_def)
  1130   with prems show "?case" by (auto intro:finite_subset)
  1538   with prems show "?case" by (auto intro:finite_subset)
  1131 next
  1539 next
  1132   case EMPTY
  1540   case EMPTY
  1133   have "UNIV // (\<approx>{[]}) \<subseteq> {{[]}, UNIV - {[]}}" by (rule quot_empty_subset)
  1541   have "UNIV // (\<approx>{[]}) \<subseteq> {{[]}, UNIV - {[]}}" 
       
  1542     by (rule quot_empty_subset)
  1134   with prems show ?case by (auto intro:finite_subset)
  1543   with prems show ?case by (auto intro:finite_subset)
  1135 next
  1544 next
  1136   case (CHAR c)
  1545   case (CHAR c)
  1137   have "UNIV // (\<approx>{[c]}) \<subseteq> {{[]},{[c]}, UNIV - {[], [c]}}" by (rule quot_char_subset)
  1546   have "UNIV // (\<approx>{[c]}) \<subseteq> {{[]},{[c]}, UNIV - {[], [c]}}" 
       
  1547     by (rule quot_char_subset)
  1138   with prems show ?case by (auto intro:finite_subset)
  1548   with prems show ?case by (auto intro:finite_subset)
  1139 next
  1549 next
  1140   case (SEQ r\<^isub>1 r\<^isub>2)
  1550   case (SEQ r\<^isub>1 r\<^isub>2)
  1141   have "\<lbrakk>finite (UNIV // \<approx>(L r\<^isub>1)); finite (UNIV // \<approx>(L r\<^isub>2))\<rbrakk> \<Longrightarrow> finite (UNIV // \<approx>(L r\<^isub>1 ;; L r\<^isub>2))"
  1551   have "\<lbrakk>finite (UNIV // \<approx>(L r\<^isub>1)); finite (UNIV // \<approx>(L r\<^isub>2))\<rbrakk> 
       
  1552             \<Longrightarrow> finite (UNIV // \<approx>(L r\<^isub>1 ;; L r\<^isub>2))"
  1142     by (erule quot_seq_finiteI, simp)
  1553     by (erule quot_seq_finiteI, simp)
  1143   with prems show ?case by simp
  1554   with prems show ?case by simp
  1144 next
  1555 next
  1145   case (ALT r\<^isub>1 r\<^isub>2)
  1556   case (ALT r\<^isub>1 r\<^isub>2)
  1146   have "\<lbrakk>finite (UNIV // \<approx>(L r\<^isub>1)); finite (UNIV // \<approx>(L r\<^isub>2))\<rbrakk> \<Longrightarrow> finite (UNIV // \<approx>(L r\<^isub>1 \<union> L r\<^isub>2))"
  1557   have "\<lbrakk>finite (UNIV // \<approx>(L r\<^isub>1)); finite (UNIV // \<approx>(L r\<^isub>2))\<rbrakk> 
       
  1558             \<Longrightarrow> finite (UNIV // \<approx>(L r\<^isub>1 \<union> L r\<^isub>2))"
  1147     by (erule quot_union_finiteI, simp)
  1559     by (erule quot_union_finiteI, simp)
  1148   with prems show ?case by simp  
  1560   with prems show ?case by simp  
  1149 next
  1561 next
  1150   case (STAR r)
  1562   case (STAR r)
  1151   have "finite (UNIV // \<approx>(L r)) \<Longrightarrow> finite (UNIV // \<approx>((L r)\<star>))"
  1563   have "finite (UNIV // \<approx>(L r)) 
       
  1564             \<Longrightarrow> finite (UNIV // \<approx>((L r)\<star>))"
  1152     by (erule quot_star_finiteI)
  1565     by (erule quot_star_finiteI)
  1153   with prems show ?case by simp
  1566   with prems show ?case by simp
  1154 qed 
  1567 qed 
  1155 
  1568 
  1156 end
  1569 end
       
  1570