thys3/RegLangs.thy
changeset 647 70c10dc41606
parent 642 6c13f76c070b
equal deleted inserted replaced
646:56057198e4f5 647:70c10dc41606
     1 
       
     2 theory RegLangs
     1 theory RegLangs
     3   imports Main "HOL-Library.Sublist"
     2   imports Main "HOL-Library.Sublist"
     4 begin
     3 begin
     5 
     4 
     6 section \<open>Sequential Composition of Languages\<close>
     5 section \<open>Sequential Composition of Languages\<close>
    20 lemma Sequ_empty [simp]:
    19 lemma Sequ_empty [simp]:
    21   shows "A ;; {} = {}"
    20   shows "A ;; {} = {}"
    22   and   "{} ;; A = {}"
    21   and   "{} ;; A = {}"
    23   by (simp_all add: Sequ_def)
    22   by (simp_all add: Sequ_def)
    24 
    23 
       
    24 lemma concI[simp,intro]: "u : A \<Longrightarrow> v : B \<Longrightarrow> u@v : A ;; B"
       
    25 by (auto simp add: Sequ_def)
       
    26 
       
    27 lemma concE[elim]: 
       
    28 assumes "w \<in> A ;; B"
       
    29 obtains u v where "u \<in> A" "v \<in> B" "w = u@v"
       
    30 using assms by (auto simp: Sequ_def)
       
    31 
       
    32 lemma concI_if_Nil2: "[] \<in> B \<Longrightarrow> xs : A \<Longrightarrow> xs \<in> A ;; B"
       
    33 by (metis append_Nil2 concI)
       
    34 
       
    35 lemma conc_assoc: "(A ;; B) ;; C = A ;; (B ;; C)"
       
    36 by (auto elim!: concE) (simp only: append_assoc[symmetric] concI)
       
    37 
       
    38 
       
    39 text \<open>Language power operations\<close>
       
    40 
       
    41 overloading lang_pow == "compow :: nat \<Rightarrow> string set \<Rightarrow> string set"
       
    42 begin
       
    43   primrec lang_pow :: "nat \<Rightarrow> string set \<Rightarrow> string set" where
       
    44   "lang_pow 0 A = {[]}" |
       
    45   "lang_pow (Suc n) A = A ;; (lang_pow n A)"
       
    46 end
       
    47 
       
    48 
       
    49 lemma conc_pow_comm:
       
    50   shows "A ;; (A ^^ n) = (A ^^ n) ;; A"
       
    51 by (induct n) (simp_all add: conc_assoc[symmetric])
       
    52 
       
    53 lemma lang_pow_add: "A ^^ (n + m) = (A ^^ n) ;; (A ^^ m)"
       
    54   by (induct n) (auto simp: conc_assoc)
       
    55 
       
    56 lemma lang_empty: 
       
    57   fixes A::"string set"
       
    58   shows "A ^^ 0 = {[]}"
       
    59   by simp
    25 
    60 
    26 section \<open>Semantic Derivative (Left Quotient) of Languages\<close>
    61 section \<open>Semantic Derivative (Left Quotient) of Languages\<close>
    27 
    62 
    28 definition
    63 definition
    29   Der :: "char \<Rightarrow> string set \<Rightarrow> string set"
    64   Der :: "char \<Rightarrow> string set \<Rightarrow> string set"
    87 lemma Star_Der_Sequ: 
   122 lemma Star_Der_Sequ: 
    88   shows "Der c (A\<star>) \<subseteq> (Der c A) ;; A\<star>"
   123   shows "Der c (A\<star>) \<subseteq> (Der c A) ;; A\<star>"
    89 unfolding Der_def Sequ_def
   124 unfolding Der_def Sequ_def
    90 by(auto simp add: Star_decomp)
   125 by(auto simp add: Star_decomp)
    91 
   126 
       
   127 lemma Der_inter[simp]:   "Der a (A \<inter> B) = Der a A \<inter> Der a B"
       
   128   and Der_compl[simp]:   "Der a (-A) = - Der a A"
       
   129   and Der_Union[simp]:   "Der a (Union M) = Union(Der a ` M)"
       
   130   and Der_UN[simp]:      "Der a (UN x:I. S x) = (UN x:I. Der a (S x))"
       
   131 by (auto simp: Der_def)
    92 
   132 
    93 lemma Der_star[simp]:
   133 lemma Der_star[simp]:
    94   shows "Der c (A\<star>) = (Der c A) ;; A\<star>"
   134   shows "Der c (A\<star>) = (Der c A) ;; A\<star>"
    95 proof -    
   135 proof -    
    96   have "Der c (A\<star>) = Der c ({[]} \<union> A ;; A\<star>)"  
   136   have "Der c (A\<star>) = Der c ({[]} \<union> A ;; A\<star>)"  
   102   also have "... =  (Der c A) ;; A\<star>"
   142   also have "... =  (Der c A) ;; A\<star>"
   103     using Star_Der_Sequ by auto
   143     using Star_Der_Sequ by auto
   104   finally show "Der c (A\<star>) = (Der c A) ;; A\<star>" .
   144   finally show "Der c (A\<star>) = (Der c A) ;; A\<star>" .
   105 qed
   145 qed
   106 
   146 
       
   147 lemma Der_pow[simp]:
       
   148   shows "Der c (A ^^ n) = (if n = 0 then {} else (Der c A) ;; (A ^^ (n - 1)))"
       
   149   apply(induct n arbitrary: A)
       
   150    apply(auto simp add: Cons_eq_append_conv)
       
   151   by (metis Suc_pred concI_if_Nil2 conc_assoc conc_pow_comm lang_pow.simps(2))
       
   152 
       
   153 
   107 lemma Star_concat:
   154 lemma Star_concat:
   108   assumes "\<forall>s \<in> set ss. s \<in> A"  
   155   assumes "\<forall>s \<in> set ss. s \<in> A"  
   109   shows "concat ss \<in> A\<star>"
   156   shows "concat ss \<in> A\<star>"
   110 using assms by (induct ss) (auto)
   157 using assms by (induct ss) (auto)
   111 
   158 
   127 | ONE
   174 | ONE
   128 | CH char
   175 | CH char
   129 | SEQ rexp rexp
   176 | SEQ rexp rexp
   130 | ALT rexp rexp
   177 | ALT rexp rexp
   131 | STAR rexp
   178 | STAR rexp
       
   179 | NTIMES rexp nat
   132 
   180 
   133 section \<open>Semantics of Regular Expressions\<close>
   181 section \<open>Semantics of Regular Expressions\<close>
   134  
   182  
   135 fun
   183 fun
   136   L :: "rexp \<Rightarrow> string set"
   184   L :: "rexp \<Rightarrow> string set"
   139 | "L (ONE) = {[]}"
   187 | "L (ONE) = {[]}"
   140 | "L (CH c) = {[c]}"
   188 | "L (CH c) = {[c]}"
   141 | "L (SEQ r1 r2) = (L r1) ;; (L r2)"
   189 | "L (SEQ r1 r2) = (L r1) ;; (L r2)"
   142 | "L (ALT r1 r2) = (L r1) \<union> (L r2)"
   190 | "L (ALT r1 r2) = (L r1) \<union> (L r2)"
   143 | "L (STAR r) = (L r)\<star>"
   191 | "L (STAR r) = (L r)\<star>"
   144 
   192 | "L (NTIMES r n) = (L r) ^^ n"
   145 
   193 
   146 section \<open>Nullable, Derivatives\<close>
   194 section \<open>Nullable, Derivatives\<close>
   147 
   195 
   148 fun
   196 fun
   149  nullable :: "rexp \<Rightarrow> bool"
   197  nullable :: "rexp \<Rightarrow> bool"
   152 | "nullable (ONE) = True"
   200 | "nullable (ONE) = True"
   153 | "nullable (CH c) = False"
   201 | "nullable (CH c) = False"
   154 | "nullable (ALT r1 r2) = (nullable r1 \<or> nullable r2)"
   202 | "nullable (ALT r1 r2) = (nullable r1 \<or> nullable r2)"
   155 | "nullable (SEQ r1 r2) = (nullable r1 \<and> nullable r2)"
   203 | "nullable (SEQ r1 r2) = (nullable r1 \<and> nullable r2)"
   156 | "nullable (STAR r) = True"
   204 | "nullable (STAR r) = True"
   157 
   205 | "nullable (NTIMES r n) = (if n = 0 then True else nullable r)"
   158 
   206 
   159 fun
   207 fun
   160  der :: "char \<Rightarrow> rexp \<Rightarrow> rexp"
   208  der :: "char \<Rightarrow> rexp \<Rightarrow> rexp"
   161 where
   209 where
   162   "der c (ZERO) = ZERO"
   210   "der c (ZERO) = ZERO"
   166 | "der c (SEQ r1 r2) = 
   214 | "der c (SEQ r1 r2) = 
   167      (if nullable r1
   215      (if nullable r1
   168       then ALT (SEQ (der c r1) r2) (der c r2)
   216       then ALT (SEQ (der c r1) r2) (der c r2)
   169       else SEQ (der c r1) r2)"
   217       else SEQ (der c r1) r2)"
   170 | "der c (STAR r) = SEQ (der c r) (STAR r)"
   218 | "der c (STAR r) = SEQ (der c r) (STAR r)"
       
   219 | "der c (NTIMES r n) = (if n = 0 then ZERO else SEQ (der c r) (NTIMES r (n - 1)))"
       
   220 
   171 
   221 
   172 fun 
   222 fun 
   173  ders :: "string \<Rightarrow> rexp \<Rightarrow> rexp"
   223  ders :: "string \<Rightarrow> rexp \<Rightarrow> rexp"
   174 where
   224 where
   175   "ders [] r = r"
   225   "ders [] r = r"
   176 | "ders (c # s) r = ders s (der c r)"
   226 | "ders (c # s) r = ders s (der c r)"
   177 
   227 
   178 
   228 
       
   229 lemma pow_empty_iff:
       
   230   shows "[] \<in> (L r) ^^ n \<longleftrightarrow> (if n = 0 then True else [] \<in> (L r))"
       
   231   by (induct n) (auto simp add: Sequ_def)
       
   232 
   179 lemma nullable_correctness:
   233 lemma nullable_correctness:
   180   shows "nullable r  \<longleftrightarrow> [] \<in> (L r)"
   234   shows "nullable r  \<longleftrightarrow> [] \<in> (L r)"
   181 by (induct r) (auto simp add: Sequ_def) 
   235   by (induct r) (auto simp add: Sequ_def pow_empty_iff) 
   182 
   236 
   183 lemma der_correctness:
   237 lemma der_correctness:
   184   shows "L (der c r) = Der c (L r)"
   238   shows "L (der c r) = Der c (L r)"
   185 by (induct r) (simp_all add: nullable_correctness)
   239   apply (induct r) 
       
   240         apply(auto simp add: nullable_correctness Sequ_def)
       
   241   using Der_def apply force
       
   242   using Der_def apply auto[1]
       
   243   apply (smt (verit, ccfv_SIG) Der_def append_eq_Cons_conv mem_Collect_eq)
       
   244   using Der_def apply force
       
   245   using Der_Sequ Sequ_def by auto
   186 
   246 
   187 lemma ders_correctness:
   247 lemma ders_correctness:
   188   shows "L (ders s r) = Ders s (L r)"
   248   shows "L (ders s r) = Ders s (L r)"
   189   by (induct s arbitrary: r)
   249   by (induct s arbitrary: r)
   190      (simp_all add: Ders_def der_correctness Der_def)
   250      (simp_all add: Ders_def der_correctness Der_def)
   196 lemma ders_snoc:
   256 lemma ders_snoc:
   197   shows "ders (s @ [c]) r = der c (ders s r)"
   257   shows "ders (s @ [c]) r = der c (ders s r)"
   198   by (simp add: ders_append)
   258   by (simp add: ders_append)
   199 
   259 
   200 
   260 
   201 (*
       
   202 datatype ctxt = 
       
   203     SeqC rexp bool
       
   204   | AltCL rexp
       
   205   | AltCH rexp 
       
   206   | StarC rexp 
       
   207 
       
   208 function
       
   209      down :: "char \<Rightarrow> rexp \<Rightarrow> ctxt list \<Rightarrow> rexp * ctxt list"
       
   210 and  up :: "char \<Rightarrow> rexp \<Rightarrow> ctxt list \<Rightarrow> rexp * ctxt list"
       
   211 where
       
   212   "down c (SEQ r1 r2) ctxts =
       
   213      (if (nullable r1) then down c r1 (SeqC r2 True # ctxts) 
       
   214       else down c r1 (SeqC r2 False # ctxts))"
       
   215 | "down c (CH d) ctxts = 
       
   216      (if c = d then up c ONE ctxts else up c ZERO ctxts)"
       
   217 | "down c ONE ctxts = up c ZERO ctxts"
       
   218 | "down c ZERO ctxts = up c ZERO ctxts"
       
   219 | "down c (ALT r1 r2) ctxts = down c r1 (AltCH r2 # ctxts)"
       
   220 | "down c (STAR r1) ctxts = down c r1 (StarC r1 # ctxts)"
       
   221 | "up c r [] = (r, [])"
       
   222 | "up c r (SeqC r2 False # ctxts) = up c (SEQ r r2) ctxts"
       
   223 | "up c r (SeqC r2 True # ctxts) = down c r2 (AltCL (SEQ r r2) # ctxts)"
       
   224 | "up c r (AltCL r1 # ctxts) = up c (ALT r1 r) ctxts"
       
   225 | "up c r (AltCH r2 # ctxts) = down c r2 (AltCL r # ctxts)"
       
   226 | "up c r (StarC r1 # ctxts) = up c (SEQ r (STAR r1)) ctxts"
       
   227   apply(pat_completeness)
       
   228   apply(auto)
       
   229   done
       
   230 
       
   231 termination
       
   232   sorry
       
   233 
       
   234 *)
       
   235 
       
   236 
       
   237 end
   261 end