thys/Spec.thy
changeset 311 8b8db9558ecf
parent 295 c6ec5f369037
child 359 fedc16924b76
equal deleted inserted replaced
310:c090baa7059d 311:8b8db9558ecf
     1    
     1    
     2 theory Spec
     2 theory Spec
     3   imports Main "~~/src/HOL/Library/Sublist"
     3   imports RegLangs
     4 begin
     4 begin
     5 
     5 
     6 section {* Sequential Composition of Languages *}
     6 
     7 
     7 section {* "Plain" Values *}
     8 definition
       
     9   Sequ :: "string set \<Rightarrow> string set \<Rightarrow> string set" ("_ ;; _" [100,100] 100)
       
    10 where 
       
    11   "A ;; B = {s1 @ s2 | s1 s2. s1 \<in> A \<and> s2 \<in> B}"
       
    12 
       
    13 text {* Two Simple Properties about Sequential Composition *}
       
    14 
       
    15 lemma Sequ_empty_string [simp]:
       
    16   shows "A ;; {[]} = A"
       
    17   and   "{[]} ;; A = A"
       
    18 by (simp_all add: Sequ_def)
       
    19 
       
    20 lemma Sequ_empty [simp]:
       
    21   shows "A ;; {} = {}"
       
    22   and   "{} ;; A = {}"
       
    23 by (simp_all add: Sequ_def)
       
    24 
       
    25 
       
    26 section {* Semantic Derivative (Left Quotient) of Languages *}
       
    27 
       
    28 definition
       
    29   Der :: "char \<Rightarrow> string set \<Rightarrow> string set"
       
    30 where
       
    31   "Der c A \<equiv> {s. c # s \<in> A}"
       
    32 
       
    33 definition
       
    34   Ders :: "string \<Rightarrow> string set \<Rightarrow> string set"
       
    35 where
       
    36   "Ders s A \<equiv> {s'. s @ s' \<in> A}"
       
    37 
       
    38 lemma Der_null [simp]:
       
    39   shows "Der c {} = {}"
       
    40 unfolding Der_def
       
    41 by auto
       
    42 
       
    43 lemma Der_empty [simp]:
       
    44   shows "Der c {[]} = {}"
       
    45 unfolding Der_def
       
    46 by auto
       
    47 
       
    48 lemma Der_char [simp]:
       
    49   shows "Der c {[d]} = (if c = d then {[]} else {})"
       
    50 unfolding Der_def
       
    51 by auto
       
    52 
       
    53 lemma Der_union [simp]:
       
    54   shows "Der c (A \<union> B) = Der c A \<union> Der c B"
       
    55 unfolding Der_def
       
    56 by auto
       
    57 
       
    58 lemma Der_Sequ [simp]:
       
    59   shows "Der c (A ;; B) = (Der c A) ;; B \<union> (if [] \<in> A then Der c B else {})"
       
    60 unfolding Der_def Sequ_def
       
    61 by (auto simp add: Cons_eq_append_conv)
       
    62 
       
    63 
       
    64 section {* Kleene Star for Languages *}
       
    65 
       
    66 inductive_set
       
    67   Star :: "string set \<Rightarrow> string set" ("_\<star>" [101] 102)
       
    68   for A :: "string set"
       
    69 where
       
    70   start[intro]: "[] \<in> A\<star>"
       
    71 | step[intro]:  "\<lbrakk>s1 \<in> A; s2 \<in> A\<star>\<rbrakk> \<Longrightarrow> s1 @ s2 \<in> A\<star>"
       
    72 
       
    73 (* Arden's lemma *)
       
    74 
       
    75 lemma Star_cases:
       
    76   shows "A\<star> = {[]} \<union> A ;; A\<star>"
       
    77 unfolding Sequ_def
       
    78 by (auto) (metis Star.simps)
       
    79 
       
    80 lemma Star_decomp: 
       
    81   assumes "c # x \<in> A\<star>" 
       
    82   shows "\<exists>s1 s2. x = s1 @ s2 \<and> c # s1 \<in> A \<and> s2 \<in> A\<star>"
       
    83 using assms
       
    84 by (induct x\<equiv>"c # x" rule: Star.induct) 
       
    85    (auto simp add: append_eq_Cons_conv)
       
    86 
       
    87 lemma Star_Der_Sequ: 
       
    88   shows "Der c (A\<star>) \<subseteq> (Der c A) ;; A\<star>"
       
    89 unfolding Der_def Sequ_def
       
    90 by(auto simp add: Star_decomp)
       
    91 
       
    92 
       
    93 lemma Der_star [simp]:
       
    94   shows "Der c (A\<star>) = (Der c A) ;; A\<star>"
       
    95 proof -    
       
    96   have "Der c (A\<star>) = Der c ({[]} \<union> A ;; A\<star>)"  
       
    97     by (simp only: Star_cases[symmetric])
       
    98   also have "... = Der c (A ;; A\<star>)"
       
    99     by (simp only: Der_union Der_empty) (simp)
       
   100   also have "... = (Der c A) ;; A\<star> \<union> (if [] \<in> A then Der c (A\<star>) else {})"
       
   101     by simp
       
   102   also have "... =  (Der c A) ;; A\<star>"
       
   103     using Star_Der_Sequ by auto
       
   104   finally show "Der c (A\<star>) = (Der c A) ;; A\<star>" .
       
   105 qed
       
   106 
       
   107 
       
   108 section {* Regular Expressions *}
       
   109 
       
   110 datatype rexp =
       
   111   ZERO
       
   112 | ONE
       
   113 | CHAR char
       
   114 | SEQ rexp rexp
       
   115 | ALT rexp rexp
       
   116 | STAR rexp
       
   117 
       
   118 section {* Semantics of Regular Expressions *}
       
   119  
       
   120 fun
       
   121   L :: "rexp \<Rightarrow> string set"
       
   122 where
       
   123   "L (ZERO) = {}"
       
   124 | "L (ONE) = {[]}"
       
   125 | "L (CHAR c) = {[c]}"
       
   126 | "L (SEQ r1 r2) = (L r1) ;; (L r2)"
       
   127 | "L (ALT r1 r2) = (L r1) \<union> (L r2)"
       
   128 | "L (STAR r) = (L r)\<star>"
       
   129 
       
   130 
       
   131 section {* Nullable, Derivatives *}
       
   132 
       
   133 fun
       
   134  nullable :: "rexp \<Rightarrow> bool"
       
   135 where
       
   136   "nullable (ZERO) = False"
       
   137 | "nullable (ONE) = True"
       
   138 | "nullable (CHAR c) = False"
       
   139 | "nullable (ALT r1 r2) = (nullable r1 \<or> nullable r2)"
       
   140 | "nullable (SEQ r1 r2) = (nullable r1 \<and> nullable r2)"
       
   141 | "nullable (STAR r) = True"
       
   142 
       
   143 
       
   144 fun
       
   145  der :: "char \<Rightarrow> rexp \<Rightarrow> rexp"
       
   146 where
       
   147   "der c (ZERO) = ZERO"
       
   148 | "der c (ONE) = ZERO"
       
   149 | "der c (CHAR d) = (if c = d then ONE else ZERO)"
       
   150 | "der c (ALT r1 r2) = ALT (der c r1) (der c r2)"
       
   151 | "der c (SEQ r1 r2) = 
       
   152      (if nullable r1
       
   153       then ALT (SEQ (der c r1) r2) (der c r2)
       
   154       else SEQ (der c r1) r2)"
       
   155 | "der c (STAR r) = SEQ (der c r) (STAR r)"
       
   156 
       
   157 fun 
       
   158  ders :: "string \<Rightarrow> rexp \<Rightarrow> rexp"
       
   159 where
       
   160   "ders [] r = r"
       
   161 | "ders (c # s) r = ders s (der c r)"
       
   162 
       
   163 
       
   164 lemma nullable_correctness:
       
   165   shows "nullable r  \<longleftrightarrow> [] \<in> (L r)"
       
   166 by (induct r) (auto simp add: Sequ_def) 
       
   167 
       
   168 lemma der_correctness:
       
   169   shows "L (der c r) = Der c (L r)"
       
   170 by (induct r) (simp_all add: nullable_correctness)
       
   171 
       
   172 lemma ders_correctness:
       
   173   shows "L (ders s r) = Ders s (L r)"
       
   174 by (induct s arbitrary: r)
       
   175    (simp_all add: Ders_def der_correctness Der_def)
       
   176 
       
   177 lemma ders_append:
       
   178   shows "ders (s1 @ s2) r = ders s2 (ders s1 r)"
       
   179   apply(induct s1 arbitrary: s2 r)
       
   180   apply(auto)
       
   181   done
       
   182 
       
   183 
       
   184 section {* Values *}
       
   185 
     8 
   186 datatype val = 
     9 datatype val = 
   187   Void
    10   Void
   188 | Char char
    11 | Char char
   189 | Seq val val
    12 | Seq val val
   210 
    33 
   211 lemma flat_Stars [simp]:
    34 lemma flat_Stars [simp]:
   212  "flat (Stars vs) = flats vs"
    35  "flat (Stars vs) = flats vs"
   213 by (induct vs) (auto)
    36 by (induct vs) (auto)
   214 
    37 
   215 lemma Star_concat:
       
   216   assumes "\<forall>s \<in> set ss. s \<in> A"  
       
   217   shows "concat ss \<in> A\<star>"
       
   218 using assms by (induct ss) (auto)
       
   219 
       
   220 lemma Star_cstring:
       
   221   assumes "s \<in> A\<star>"
       
   222   shows "\<exists>ss. concat ss = s \<and> (\<forall>s \<in> set ss. s \<in> A \<and> s \<noteq> [])"
       
   223 using assms
       
   224 apply(induct rule: Star.induct)
       
   225 apply(auto)[1]
       
   226 apply(rule_tac x="[]" in exI)
       
   227 apply(simp)
       
   228 apply(erule exE)
       
   229 apply(clarify)
       
   230 apply(case_tac "s1 = []")
       
   231 apply(rule_tac x="ss" in exI)
       
   232 apply(simp)
       
   233 apply(rule_tac x="s1#ss" in exI)
       
   234 apply(simp)
       
   235 done
       
   236 
       
   237 
    38 
   238 section {* Lexical Values *}
    39 section {* Lexical Values *}
   239 
    40 
   240 inductive 
    41 inductive 
   241   Prf :: "val \<Rightarrow> rexp \<Rightarrow> bool" ("\<Turnstile> _ : _" [100, 100] 100)
    42   Prf :: "val \<Rightarrow> rexp \<Rightarrow> bool" ("\<Turnstile> _ : _" [100, 100] 100)
   260   shows "\<Turnstile> Stars vs1 : STAR r \<and> \<Turnstile> Stars vs2 : STAR r" 
    61   shows "\<Turnstile> Stars vs1 : STAR r \<and> \<Turnstile> Stars vs2 : STAR r" 
   261 using assms
    62 using assms
   262 by (auto intro: Prf.intros elim!: Prf_elims)
    63 by (auto intro: Prf.intros elim!: Prf_elims)
   263 
    64 
   264 
    65 
   265 lemma Star_cval:
    66 lemma flats_Prf_value:
   266   assumes "\<forall>s\<in>set ss. \<exists>v. s = flat v \<and> \<Turnstile> v : r"
    67   assumes "\<forall>s\<in>set ss. \<exists>v. s = flat v \<and> \<Turnstile> v : r"
   267   shows "\<exists>vs. flats vs = concat ss \<and> (\<forall>v\<in>set vs. \<Turnstile> v : r \<and> flat v \<noteq> [])"
    68   shows "\<exists>vs. flats vs = concat ss \<and> (\<forall>v\<in>set vs. \<Turnstile> v : r \<and> flat v \<noteq> [])"
   268 using assms
    69 using assms
   269 apply(induct ss)
    70 apply(induct ss)
   270 apply(auto)
    71 apply(auto)
   291 proof(induct r arbitrary: s)
    92 proof(induct r arbitrary: s)
   292   case (STAR r s)
    93   case (STAR r s)
   293   have IH: "\<And>s. s \<in> L r \<Longrightarrow> \<exists>v. \<Turnstile> v : r \<and> flat v = s" by fact
    94   have IH: "\<And>s. s \<in> L r \<Longrightarrow> \<exists>v. \<Turnstile> v : r \<and> flat v = s" by fact
   294   have "s \<in> L (STAR r)" by fact
    95   have "s \<in> L (STAR r)" by fact
   295   then obtain ss where "concat ss = s" "\<forall>s \<in> set ss. s \<in> L r \<and> s \<noteq> []"
    96   then obtain ss where "concat ss = s" "\<forall>s \<in> set ss. s \<in> L r \<and> s \<noteq> []"
   296   using Star_cstring by auto  
    97   using Star_split by auto  
   297   then obtain vs where "flats vs = s" "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> flat v \<noteq> []"
    98   then obtain vs where "flats vs = s" "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> flat v \<noteq> []"
   298   using IH Star_cval by metis 
    99   using IH flats_Prf_value by metis 
   299   then show "\<exists>v. \<Turnstile> v : STAR r \<and> flat v = s"
   100   then show "\<exists>v. \<Turnstile> v : STAR r \<and> flat v = s"
   300   using Prf.intros(6) flat_Stars by blast
   101   using Prf.intros(6) flat_Stars by blast
   301 next 
   102 next 
   302   case (SEQ r1 r2 s)
   103   case (SEQ r1 r2 s)
   303   then show "\<exists>v. \<Turnstile> v : SEQ r1 r2 \<and> flat v = s"
   104   then show "\<exists>v. \<Turnstile> v : SEQ r1 r2 \<and> flat v = s"
   453   then show "finite (LV (STAR r) s)" by (simp add: LV_STAR_finite)
   254   then show "finite (LV (STAR r) s)" by (simp add: LV_STAR_finite)
   454 qed
   255 qed
   455 
   256 
   456 
   257 
   457 
   258 
   458 section {* Our POSIX Definition *}
   259 section {* Our inductive POSIX Definition *}
   459 
   260 
   460 inductive 
   261 inductive 
   461   Posix :: "string \<Rightarrow> rexp \<Rightarrow> val \<Rightarrow> bool" ("_ \<in> _ \<rightarrow> _" [100, 100, 100] 100)
   262   Posix :: "string \<Rightarrow> rexp \<Rightarrow> val \<Rightarrow> bool" ("_ \<in> _ \<rightarrow> _" [100, 100, 100] 100)
   462 where
   263 where
   463   Posix_ONE: "[] \<in> ONE \<rightarrow> Void"
   264   Posix_ONE: "[] \<in> ONE \<rightarrow> Void"
   486 using assms
   287 using assms
   487 by (induct s r v rule: Posix.induct)
   288 by (induct s r v rule: Posix.induct)
   488    (auto simp add: Sequ_def)
   289    (auto simp add: Sequ_def)
   489 
   290 
   490 text {*
   291 text {*
   491   Our Posix definition determines a unique value.
   292   For a give value and string, our Posix definition 
       
   293   determines a unique value.
   492 *}
   294 *}
   493 
   295 
   494 lemma Posix_determ:
   296 lemma Posix_determ:
   495   assumes "s \<in> r \<rightarrow> v1" "s \<in> r \<rightarrow> v2"
   297   assumes "s \<in> r \<rightarrow> v1" "s \<in> r \<rightarrow> v2"
   496   shows "v1 = v2"
   298   shows "v1 = v2"