header {* Normalization of $\Pi$-Extended Regular Expressions*}
theory Smart_Constructors_Normalization
imports Equivalence_Checking
begin
subsection {* Normalizing Constructors *}
lemma not_less_Zero[elim!]: "r < Zero ==> P"
by (induct r) (auto simp: less_rexp_def)
fun nPlus :: "'a::linorder rexp => 'a rexp => 'a rexp"
where
"nPlus Zero r = r"
| "nPlus r Zero = r"
| "nPlus (Plus r1 r2) (Plus s1 s2) =
(if r1 < s1 then Plus r1 (nPlus r2 (Plus s1 s2))
else if s1 < r1 then Plus s1 (nPlus (Plus r1 r2) s2)
else nPlus (Plus r1 r2) s2)"
| "nPlus (Plus r1 r2) s =
(if s = Not Zero then Not Zero
else if r1 < s then Plus r1 (nPlus r2 s)
else if s < r1 then Plus s (Plus r1 r2)
else Plus r1 r2)"
| "nPlus r (Plus s1 s2) =
(if r = Not Zero then Not Zero
else if r < s1 then Plus r (Plus s1 s2)
else if s1 < r then Plus s1 (nPlus r s2)
else Plus s1 s2)"
| "nPlus r s =
(if r = Not Zero ∨ s = Not Zero then Not Zero
else if r < s then Plus r s
else if s < r then Plus s r
else r)"
fun nTimes :: "'a rexp => 'a rexp => 'a rexp"
where
"nTimes Zero _ = Zero"
| "nTimes _ Zero = Zero"
| "nTimes One r = r"
| "nTimes r One = r"
| "nTimes (Times r s) t = Times r (nTimes s t)"
| "nTimes r s = Times r s"
fun nStar :: "'a rexp => 'a rexp"
where
"nStar Zero = One"
| "nStar One = One"
| "nStar (Star r) = nStar r"
| "nStar r = Star r"
fun nInter :: "'a::linorder rexp => 'a rexp => 'a rexp"
where
"nInter Zero _ = Zero"
| "nInter _ Zero = Zero"
| "nInter (Inter r1 r2) (Inter s1 s2) =
(if r1 < s1 then Inter r1 (nInter r2 (Inter s1 s2))
else if s1 < r1 then Inter s1 (nInter (Inter r1 r2) s2)
else nInter (Inter r1 r2) s2)"
| "nInter (Inter r1 r2) s =
(if s = Not Zero then Inter r1 r2
else if r1 < s then Inter r1 (nInter r2 s)
else if s < r1 then Inter s (Inter r1 r2)
else Inter r1 r2)"
| "nInter r (Inter s1 s2) =
(if r = Not Zero then Inter s1 s2
else if r < s1 then Inter r (Inter s1 s2)
else if s1 < r then Inter s1 (nInter r s2)
else Inter s1 s2)"
| "nInter r s =
(if r = Not Zero then s
else if s = Not Zero then r
else if r < s then Inter r s
else if s < r then Inter s r
else r)"
fun nNot :: "'a::linorder rexp => 'a rexp"
where
"nNot (Not r) = r"
| "nNot (Plus r s) = nInter (nNot r) (nNot s)"
| "nNot (Inter r s) = nPlus (nNot r) (nNot s)"
| "nNot r = Not r"
fun nPr :: "'a rexp => 'a rexp"
where
"nPr Zero = Zero"
| "nPr One = One"
| "nPr (Plus r s) = Plus (nPr r) (nPr s)"
| "nPr (Times r s) = Times (nPr r) (nPr s)"
| "nPr (Star r) = Star (nPr r)"
| "nPr r = Pr r"
fun norm :: "('a::linorder) rexp => 'a rexp" where
"norm Zero = Zero"
| "norm One = One"
| "norm (Atom a) = Atom a"
| "norm (Plus r s) = nPlus (norm r) (norm s)"
| "norm (Times r s) = nTimes (norm r) (norm s)"
| "norm (Star r) = nStar (norm r)"
| "norm (Not r) = nNot (norm r)"
| "norm (Inter r s) = nInter (norm r) (norm s)"
| "norm (Pr r) = nPr (norm r)"
context alphabet
begin
lemma wf_nPlus[simp]: "[|wf n r; wf n s|] ==> wf n (nPlus r s)"
by (induct r s rule: nPlus.induct) auto
lemma wf_nTimes[simp]: "[|wf n r; wf n s|] ==> wf n (nTimes r s)"
by (induct r s rule: nTimes.induct) auto
lemma wf_nStar[simp]: "wf n r ==> wf n (nStar r)"
by (induct r rule: nStar.induct) auto
lemma wf_nInter[simp]: "[|wf n r; wf n s|] ==> wf n (nInter r s)"
by (induct r s rule: nInter.induct) auto
lemma wf_nNot[simp]: "wf n r ==> wf n (nNot r)"
by (induct r rule: nNot.induct) auto
lemma wf_nPr[simp]: "wf (Suc n) r ==> wf n (nPr r)"
by (induct r rule: nPr.induct) auto
lemma wf_norm[simp]: "wf n r ==> wf n (norm r)"
by (induct r arbitrary: n) auto
end
context project
begin
lemma Plus_Not_Zero:
"wf n r ==> lang n (Plus (Not Zero) r) = lang n (Not Zero)"
"wf n r ==> lang n (Plus r (Not Zero)) = lang n (Not Zero)"
by (auto dest!: lang_subset_lists)
lemma Inter_Not_Zero:
"wf n r ==> lang n (Inter (Not Zero) r) = lang n r"
"wf n r ==> lang n (Inter r (Not Zero)) = lang n r"
by (auto dest!: lang_subset_lists)
lemma lang_nPlus[simp]: "[|wf n r; wf n s|] ==> lang n (nPlus r s) = lang n (Plus r s)"
by (induct r s rule: nPlus.induct)
(auto, auto dest!: lang_subset_lists dest: project
subsetD[OF conc_subset_lists, unfolded in_lists_conv_set, rotated -1]
subsetD[OF star_subset_lists, unfolded in_lists_conv_set, rotated -1])
lemma lang_nTimes[simp]: "lang n (nTimes r s) = lang n (Times r s)"
by (induct r s rule: nTimes.induct) (auto simp: conc_assoc conc_Un_distrib)
lemma lang_nStar[simp]: "lang n (nStar r) = lang n (Star r)"
by (induct r rule: nStar.induct) auto
lemma lang_nInter[simp]: "[|wf n r; wf n s|] ==> lang n (nInter r s) = lang n (Inter r s)"
by (induct r s rule: nInter.induct)
(auto, auto dest!: lang_subset_lists dest: project
subsetD[OF conc_subset_lists, unfolded in_lists_conv_set, rotated -1]
subsetD[OF star_subset_lists, unfolded in_lists_conv_set, rotated -1])
lemma lang_nNot[simp]: "wf n r ==> lang n (nNot r) = lang n (Not r)"
by (induct r rule: nNot.induct) (auto dest!: lang_subset_lists)
lemma lang_nPr[simp]: "lang n (nPr r) = lang n (Pr r)"
by (induct r rule: nPr.induct) auto
lemma lang_norm[simp]: "wf n r ==> lang n (norm r) = lang n r"
by (induct r arbitrary: n) auto
end
end