--- a/thys/Journal/Paper.thy Sun Oct 10 09:56:01 2021 +0100
+++ b/thys/Journal/Paper.thy Sun Oct 10 18:35:21 2021 +0100
@@ -5,6 +5,7 @@
"../Simplifying"
"../Positions"
"../Sulzmann"
+(* "../SizeBound" *)
"HOL-Library.LaTeXsugar"
begin
@@ -1385,6 +1386,8 @@
section \<open>Bitcoded Lexing\<close>
+
+
text \<open>
Incremental calculation of the value. To simplify the proof we first define the function
@@ -1412,12 +1415,13 @@
@{term areg} & $::=$ & @{term "AZERO"}\\
& $\mid$ & @{term "AONE bs"}\\
& $\mid$ & @{term "ACH bs c"}\\
- & $\mid$ & @{term "AALT bs r\<^sub>1 r\<^sub>2"}\\
+ & $\mid$ & @{term "AALT bs r1 r2"}\\
& $\mid$ & @{term "ASEQ bs r\<^sub>1 r\<^sub>2"}\\
& $\mid$ & @{term "ASTAR bs r"}
\end{tabular}
\end{center}
+
\begin{center}
\begin{tabular}{lcl}
@{thm (lhs) intern.simps(1)} & $\dn$ & @{thm (rhs) intern.simps(1)}\\
--- a/thys/Journal/llncs.cls Sun Oct 10 09:56:01 2021 +0100
+++ b/thys/Journal/llncs.cls Sun Oct 10 18:35:21 2021 +0100
@@ -1,4 +1,4 @@
-% LLNCS DOCUMENT CLASS -- version 2.19 (31-Mar-2014)
+% LLNCS DOCUMENT CLASS -- version 2.13 (28-Jan-2002)
% Springer Verlag LaTeX2e support for Lecture Notes in Computer Science
%
%%
@@ -19,7 +19,7 @@
%% Right brace \} Tilde \~}
%%
\NeedsTeXFormat{LaTeX2e}[1995/12/01]
-\ProvidesClass{llncs}[2014/03/31 v2.19
+\ProvidesClass{llncs}[2002/01/28 v2.13
^^J LaTeX document class for Lecture Notes in Computer Science]
% Options
\let\if@envcntreset\iffalse
@@ -35,7 +35,6 @@
\let\if@runhead\iffalse
\DeclareOption{runningheads}{\let\if@runhead\iftrue}
-\let\if@openright\iftrue
\let\if@openbib\iffalse
\DeclareOption{openbib}{\let\if@openbib\iftrue}
@@ -50,7 +49,6 @@
\LoadClass[twoside]{article}
\RequirePackage{multicol} % needed for the list of participants, index
-\RequirePackage{aliascnt}
\setlength{\textwidth}{12.2cm}
\setlength{\textheight}{19.3cm}
@@ -77,40 +75,40 @@
\fi}
%
\def\switcht@albion{%
-\def\abstractname{Abstract.}%
-\def\ackname{Acknowledgement.}%
-\def\andname{and}%
-\def\lastandname{\unskip, and}%
-\def\appendixname{Appendix}%
-\def\chaptername{Chapter}%
-\def\claimname{Claim}%
-\def\conjecturename{Conjecture}%
-\def\contentsname{Table of Contents}%
-\def\corollaryname{Corollary}%
-\def\definitionname{Definition}%
-\def\examplename{Example}%
-\def\exercisename{Exercise}%
-\def\figurename{Fig.}%
-\def\keywordname{{\bf Keywords:}}%
-\def\indexname{Index}%
-\def\lemmaname{Lemma}%
-\def\contriblistname{List of Contributors}%
-\def\listfigurename{List of Figures}%
-\def\listtablename{List of Tables}%
-\def\mailname{{\it Correspondence to\/}:}%
-\def\noteaddname{Note added in proof}%
-\def\notename{Note}%
-\def\partname{Part}%
-\def\problemname{Problem}%
-\def\proofname{Proof}%
-\def\propertyname{Property}%
-\def\propositionname{Proposition}%
-\def\questionname{Question}%
-\def\remarkname{Remark}%
-\def\seename{see}%
-\def\solutionname{Solution}%
-\def\subclassname{{\it Subject Classifications\/}:}%
-\def\tablename{Table}%
+\def\abstractname{Abstract.}
+\def\ackname{Acknowledgement.}
+\def\andname{and}
+\def\lastandname{\unskip, and}
+\def\appendixname{Appendix}
+\def\chaptername{Chapter}
+\def\claimname{Claim}
+\def\conjecturename{Conjecture}
+\def\contentsname{Table of Contents}
+\def\corollaryname{Corollary}
+\def\definitionname{Definition}
+\def\examplename{Example}
+\def\exercisename{Exercise}
+\def\figurename{Fig.}
+\def\keywordname{{\bf Key words:}}
+\def\indexname{Index}
+\def\lemmaname{Lemma}
+\def\contriblistname{List of Contributors}
+\def\listfigurename{List of Figures}
+\def\listtablename{List of Tables}
+\def\mailname{{\it Correspondence to\/}:}
+\def\noteaddname{Note added in proof}
+\def\notename{Note}
+\def\partname{Part}
+\def\problemname{Problem}
+\def\proofname{Proof}
+\def\propertyname{Property}
+\def\propositionname{Proposition}
+\def\questionname{Question}
+\def\remarkname{Remark}
+\def\seename{see}
+\def\solutionname{Solution}
+\def\subclassname{{\it Subject Classifications\/}:}
+\def\tablename{Table}
\def\theoremname{Theorem}}
\switcht@albion
% Names of theorem like environments are already defined
@@ -122,7 +120,7 @@
\def\ackname{Remerciements.}%
\def\andname{et}%
\def\lastandname{ et}%
- \def\appendixname{Appendice}%
+ \def\appendixname{Appendice}
\def\chaptername{Chapitre}%
\def\claimname{Pr\'etention}%
\def\conjecturename{Hypoth\`ese}%
@@ -132,13 +130,13 @@
\def\examplename{Exemple}%
\def\exercisename{Exercice}%
\def\figurename{Fig.}%
- \def\keywordname{{\bf Mots-cl\'e:}}%
- \def\indexname{Index}%
+ \def\keywordname{{\bf Mots-cl\'e:}}
+ \def\indexname{Index}
\def\lemmaname{Lemme}%
- \def\contriblistname{Liste des contributeurs}%
+ \def\contriblistname{Liste des contributeurs}
\def\listfigurename{Liste des figures}%
\def\listtablename{Liste des tables}%
- \def\mailname{{\it Correspondence to\/}:}%
+ \def\mailname{{\it Correspondence to\/}:}
\def\noteaddname{Note ajout\'ee \`a l'\'epreuve}%
\def\notename{Remarque}%
\def\partname{Partie}%
@@ -148,9 +146,9 @@
%\def\propositionname{Proposition}%
\def\questionname{Question}%
\def\remarkname{Remarque}%
- \def\seename{voir}%
+ \def\seename{voir}
\def\solutionname{Solution}%
- \def\subclassname{{\it Subject Classifications\/}:}%
+ \def\subclassname{{\it Subject Classifications\/}:}
\def\tablename{Tableau}%
\def\theoremname{Th\'eor\`eme}%
}
@@ -171,13 +169,13 @@
\def\examplename{Beispiel}%
\def\exercisename{\"Ubung}%
\def\figurename{Abb.}%
- \def\keywordname{{\bf Schl\"usselw\"orter:}}%
- \def\indexname{Index}%
+ \def\keywordname{{\bf Schl\"usselw\"orter:}}
+ \def\indexname{Index}
%\def\lemmaname{Lemma}%
- \def\contriblistname{Mitarbeiter}%
+ \def\contriblistname{Mitarbeiter}
\def\listfigurename{Abbildungsverzeichnis}%
\def\listtablename{Tabellenverzeichnis}%
- \def\mailname{{\it Correspondence to\/}:}%
+ \def\mailname{{\it Correspondence to\/}:}
\def\noteaddname{Nachtrag}%
\def\notename{Anmerkung}%
\def\partname{Teil}%
@@ -187,9 +185,9 @@
%\def\propositionname{Proposition}%
\def\questionname{Frage}%
\def\remarkname{Anmerkung}%
- \def\seename{siehe}%
+ \def\seename{siehe}
\def\solutionname{L\"osung}%
- \def\subclassname{{\it Subject Classifications\/}:}%
+ \def\subclassname{{\it Subject Classifications\/}:}
\def\tablename{Tabelle}%
%\def\theoremname{Theorem}%
}
@@ -541,29 +539,23 @@
\def\@dotsep{2}
-\let\phantomsection=\relax
-
\def\hyperhrefextend{\ifx\hyper@anchor\@undefined\else
-{}\fi}
+{chapter.\thechapter}\fi}
\def\addnumcontentsmark#1#2#3{%
\addtocontents{#1}{\protect\contentsline{#2}{\protect\numberline
- {\thechapter}#3}{\thepage}\hyperhrefextend}}%
+ {\thechapter}#3}{\thepage}\hyperhrefextend}}
\def\addcontentsmark#1#2#3{%
-\addtocontents{#1}{\protect\contentsline{#2}{#3}{\thepage}\hyperhrefextend}}%
+\addtocontents{#1}{\protect\contentsline{#2}{#3}{\thepage}\hyperhrefextend}}
\def\addcontentsmarkwop#1#2#3{%
-\addtocontents{#1}{\protect\contentsline{#2}{#3}{0}\hyperhrefextend}}%
+\addtocontents{#1}{\protect\contentsline{#2}{#3}{0}\hyperhrefextend}}
\def\@adcmk[#1]{\ifcase #1 \or
\def\@gtempa{\addnumcontentsmark}%
\or \def\@gtempa{\addcontentsmark}%
\or \def\@gtempa{\addcontentsmarkwop}%
- \fi\@gtempa{toc}{chapter}%
-}
-\def\addtocmark{%
-\phantomsection
-\@ifnextchar[{\@adcmk}{\@adcmk[3]}%
-}
+ \fi\@gtempa{toc}{chapter}}
+\def\addtocmark{\@ifnextchar[{\@adcmk}{\@adcmk[3]}}
\def\l@chapter#1#2{\addpenalty{-\@highpenalty}
\vskip 1.0em plus 1pt \@tempdima 1.5em \begingroup
@@ -595,7 +587,7 @@
\penalty\@highpenalty \endgroup}
\def\l@author#1#2{\addpenalty{\@highpenalty}
- \@tempdima=15\p@ %\z@
+ \@tempdima=\z@ %15\p@
\begingroup
\parindent \z@ \rightskip \@tocrmarg
\advance\rightskip by 0pt plus 2cm
@@ -604,7 +596,7 @@
\textit{#1}\par
\penalty\@highpenalty \endgroup}
-\setcounter{tocdepth}{0}
+%\setcounter{tocdepth}{0}
\newdimen\tocchpnum
\newdimen\tocsecnum
\newdimen\tocsectotal
@@ -787,7 +779,6 @@
\llap{\hb@xt@1em{\hss\@makefnmark\ }}\ignorespaces#1}
\long\def\@makecaption#1#2{%
- \small
\vskip\abovecaptionskip
\sbox\@tempboxa{{\bfseries #1.} #2}%
\ifdim \wd\@tempboxa >\hsize
@@ -882,23 +873,14 @@
\@ifundefined{extrasenglish}{}{\addto\extrasenglish{\switcht@albion}}%
\@ifundefined{extrasfrenchb}{}{\addto\extrasfrenchb{\switcht@francais}}%
\@ifundefined{extrasgerman}{}{\addto\extrasgerman{\switcht@deutsch}}%
-\@ifundefined{extrasngerman}{}{\addto\extrasngerman{\switcht@deutsch}}%
}{\switcht@@therlang}%
-\providecommand{\keywords}[1]{\par\addvspace\baselineskip
-\noindent\keywordname\enspace\ignorespaces#1}%
}
\def\homedir{\~{ }}
\def\subtitle#1{\gdef\@subtitle{#1}}
\clearheadinfo
-%
-%%% to avoid hyperref warnings
-\providecommand*{\toclevel@author}{999}
-%%% to make title-entry parent of section-entries
-\providecommand*{\toclevel@title}{0}
-%
+
\renewcommand\maketitle{\newpage
-\phantomsection
\refstepcounter{chapter}%
\stepcounter{section}%
\setcounter{section}{0}%
@@ -927,8 +909,8 @@
\def\thanks##1{\unskip{}}\def\fnmsep{\unskip}%
\instindent=\hsize
\advance\instindent by-\headlineindent
- \if!\the\toctitle!\addcontentsline{toc}{title}{\@title}\else
- \addcontentsline{toc}{title}{\the\toctitle}\fi
+% \if!\the\toctitle!\addcontentsline{toc}{title}{\@title}\else
+% \addcontentsline{toc}{title}{\the\toctitle}\fi
\if@runhead
\if!\the\titlerunning!\else
\edef\@title{\the\titlerunning}%
@@ -952,8 +934,7 @@
\protected@xdef\scratch{\the\tocauthor}%
\protected@xdef\toc@uthor{\scratch}%
\fi
- \addtocontents{toc}{\noexpand\protect\noexpand\authcount{\the\c@auco}}%
- \addcontentsline{toc}{author}{\toc@uthor}%
+% \addcontentsline{toc}{author}{\toc@uthor}%
\if@runhead
\if!\the\authorrunning!
\value{@inst}=\value{@auth}%
@@ -1057,9 +1038,9 @@
\def\@spothm#1[#2]#3#4#5{%
\@ifundefined{c@#2}{\@latexerr{No theorem environment `#2' defined}\@eha}%
{\expandafter\@ifdefinable\csname #1\endcsname
- {\newaliascnt{#1}{#2}%
+ {\global\@namedef{the#1}{\@nameuse{the#2}}%
\expandafter\xdef\csname #1name\endcsname{#3}%
- \global\@namedef{#1}{\@spthm{#1}{\csname #1name\endcsname}{#4}{#5}}%
+ \global\@namedef{#1}{\@spthm{#2}{\csname #1name\endcsname}{#4}{#5}}%
\global\@namedef{end#1}{\@endtheorem}}}}
\def\@spthm#1#2#3#4{\topsep 7\p@ \@plus2\p@ \@minus4\p@
--- a/thys/RegLangs.thy Sun Oct 10 09:56:01 2021 +0100
+++ b/thys/RegLangs.thy Sun Oct 10 18:35:21 2021 +0100
@@ -201,7 +201,7 @@
datatype ctxt =
SeqC rexp bool
| AltCL rexp
- | AltCR rexp
+ | AltCH rexp
| StarC rexp
function
@@ -215,13 +215,13 @@
(if c = d then up c ONE ctxts else up c ZERO ctxts)"
| "down c ONE ctxts = up c ZERO ctxts"
| "down c ZERO ctxts = up c ZERO ctxts"
-| "down c (ALT r1 r2) ctxts = down c r1 (AltCR r2 # ctxts)"
+| "down c (ALT r1 r2) ctxts = down c r1 (AltCH r2 # ctxts)"
| "down c (STAR r1) ctxts = down c r1 (StarC r1 # ctxts)"
| "up c r [] = (r, [])"
| "up c r (SeqC r2 False # ctxts) = up c (SEQ r r2) ctxts"
| "up c r (SeqC r2 True # ctxts) = down c r2 (AltCL (SEQ r r2) # ctxts)"
| "up c r (AltCL r1 # ctxts) = up c (ALT r1 r) ctxts"
-| "up c r (AltCR r2 # ctxts) = down c r2 (AltCL r # ctxts)"
+| "up c r (AltCH r2 # ctxts) = down c r2 (AltCL r # ctxts)"
| "up c r (StarC r1 # ctxts) = up c (SEQ r (STAR r1)) ctxts"
apply(pat_completeness)
apply(auto)
--- a/thys/Spec.thy Sun Oct 10 09:56:01 2021 +0100
+++ b/thys/Spec.thy Sun Oct 10 18:35:21 2021 +0100
@@ -377,4 +377,4 @@
using assms Posix_LV LV_def
by simp
-end
\ No newline at end of file
+end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys2/BitCoded.thy Sun Oct 10 18:35:21 2021 +0100
@@ -0,0 +1,3369 @@
+
+theory BitCodedCT
+ imports "Lexer"
+begin
+
+section \<open>Bit-Encodings\<close>
+
+datatype bit = Z | S
+
+fun
+ code :: "val \<Rightarrow> bit list"
+where
+ "code Void = []"
+| "code (Char c) = []"
+| "code (Left v) = Z # (code v)"
+| "code (Right v) = S # (code v)"
+| "code (Seq v1 v2) = (code v1) @ (code v2)"
+| "code (Stars []) = [S]"
+| "code (Stars (v # vs)) = (Z # code v) @ code (Stars vs)"
+
+
+fun
+ Stars_add :: "val \<Rightarrow> val \<Rightarrow> val"
+where
+ "Stars_add v (Stars vs) = Stars (v # vs)"
+
+function
+ decode' :: "bit list \<Rightarrow> rexp \<Rightarrow> (val * bit list)"
+where
+ "decode' ds ZERO = (Void, [])"
+| "decode' ds ONE = (Void, ds)"
+| "decode' ds (CHAR d) = (Char d, ds)"
+| "decode' [] (ALT r1 r2) = (Void, [])"
+| "decode' (Z # ds) (ALT r1 r2) = (let (v, ds') = decode' ds r1 in (Left v, ds'))"
+| "decode' (S # ds) (ALT r1 r2) = (let (v, ds') = decode' ds r2 in (Right v, ds'))"
+| "decode' ds (SEQ r1 r2) = (let (v1, ds') = decode' ds r1 in
+ let (v2, ds'') = decode' ds' r2 in (Seq v1 v2, ds''))"
+| "decode' [] (STAR r) = (Void, [])"
+| "decode' (S # ds) (STAR r) = (Stars [], ds)"
+| "decode' (Z # ds) (STAR r) = (let (v, ds') = decode' ds r in
+ let (vs, ds'') = decode' ds' (STAR r)
+ in (Stars_add v vs, ds''))"
+by pat_completeness auto
+
+lemma decode'_smaller:
+ assumes "decode'_dom (ds, r)"
+ shows "length (snd (decode' ds r)) \<le> length ds"
+using assms
+apply(induct ds r)
+apply(auto simp add: decode'.psimps split: prod.split)
+using dual_order.trans apply blast
+by (meson dual_order.trans le_SucI)
+
+termination "decode'"
+apply(relation "inv_image (measure(%cs. size cs) <*lex*> measure(%s. size s)) (%(ds,r). (r,ds))")
+apply(auto dest!: decode'_smaller)
+by (metis less_Suc_eq_le snd_conv)
+
+definition
+ decode :: "bit list \<Rightarrow> rexp \<Rightarrow> val option"
+where
+ "decode ds r \<equiv> (let (v, ds') = decode' ds r
+ in (if ds' = [] then Some v else None))"
+
+lemma decode'_code_Stars:
+ assumes "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> (\<forall>x. decode' (code v @ x) r = (v, x)) \<and> flat v \<noteq> []"
+ shows "decode' (code (Stars vs) @ ds) (STAR r) = (Stars vs, ds)"
+ using assms
+ apply(induct vs)
+ apply(auto)
+ done
+
+lemma decode'_code:
+ assumes "\<Turnstile> v : r"
+ shows "decode' ((code v) @ ds) r = (v, ds)"
+using assms
+ apply(induct v r arbitrary: ds)
+ apply(auto)
+ using decode'_code_Stars by blast
+
+lemma decode_code:
+ assumes "\<Turnstile> v : r"
+ shows "decode (code v) r = Some v"
+ using assms unfolding decode_def
+ by (smt append_Nil2 decode'_code old.prod.case)
+
+
+section {* Annotated Regular Expressions *}
+
+datatype arexp =
+ AZERO
+| AONE "bit list"
+| ACHAR "bit list" char
+| ASEQ "bit list" arexp arexp
+| AALTs "bit list" "arexp list"
+| ASTAR "bit list" arexp
+
+abbreviation
+ "AALT bs r1 r2 \<equiv> AALTs bs [r1, r2]"
+
+fun asize :: "arexp \<Rightarrow> nat" where
+ "asize AZERO = 1"
+| "asize (AONE cs) = 1"
+| "asize (ACHAR cs c) = 1"
+| "asize (AALTs cs rs) = Suc (sum_list (map asize rs))"
+| "asize (ASEQ cs r1 r2) = Suc (asize r1 + asize r2)"
+| "asize (ASTAR cs r) = Suc (asize r)"
+
+fun
+ erase :: "arexp \<Rightarrow> rexp"
+where
+ "erase AZERO = ZERO"
+| "erase (AONE _) = ONE"
+| "erase (ACHAR _ c) = CHAR c"
+| "erase (AALTs _ []) = ZERO"
+| "erase (AALTs _ [r]) = (erase r)"
+| "erase (AALTs bs (r#rs)) = ALT (erase r) (erase (AALTs bs rs))"
+| "erase (ASEQ _ r1 r2) = SEQ (erase r1) (erase r2)"
+| "erase (ASTAR _ r) = STAR (erase r)"
+
+lemma decode_code_erase:
+ assumes "\<Turnstile> v : (erase a)"
+ shows "decode (code v) (erase a) = Some v"
+ using assms
+ by (simp add: decode_code)
+
+
+fun nonalt :: "arexp \<Rightarrow> bool"
+ where
+ "nonalt (AALTs bs2 rs) = False"
+| "nonalt r = True"
+
+
+fun good :: "arexp \<Rightarrow> bool" where
+ "good AZERO = False"
+| "good (AONE cs) = True"
+| "good (ACHAR cs c) = True"
+| "good (AALTs cs []) = False"
+| "good (AALTs cs [r]) = False"
+| "good (AALTs cs (r1#r2#rs)) = (\<forall>r' \<in> set (r1#r2#rs). good r' \<and> nonalt r')"
+| "good (ASEQ _ AZERO _) = False"
+| "good (ASEQ _ (AONE _) _) = False"
+| "good (ASEQ _ _ AZERO) = False"
+| "good (ASEQ cs r1 r2) = (good r1 \<and> good r2)"
+| "good (ASTAR cs r) = True"
+
+
+
+
+fun fuse :: "bit list \<Rightarrow> arexp \<Rightarrow> arexp" where
+ "fuse bs AZERO = AZERO"
+| "fuse bs (AONE cs) = AONE (bs @ cs)"
+| "fuse bs (ACHAR cs c) = ACHAR (bs @ cs) c"
+| "fuse bs (AALTs cs rs) = AALTs (bs @ cs) rs"
+| "fuse bs (ASEQ cs r1 r2) = ASEQ (bs @ cs) r1 r2"
+| "fuse bs (ASTAR cs r) = ASTAR (bs @ cs) r"
+
+lemma fuse_append:
+ shows "fuse (bs1 @ bs2) r = fuse bs1 (fuse bs2 r)"
+ apply(induct r)
+ apply(auto)
+ done
+
+
+fun intern :: "rexp \<Rightarrow> arexp" where
+ "intern ZERO = AZERO"
+| "intern ONE = AONE []"
+| "intern (CHAR c) = ACHAR [] c"
+| "intern (ALT r1 r2) = AALT [] (fuse [Z] (intern r1))
+ (fuse [S] (intern r2))"
+| "intern (SEQ r1 r2) = ASEQ [] (intern r1) (intern r2)"
+| "intern (STAR r) = ASTAR [] (intern r)"
+
+
+fun retrieve :: "arexp \<Rightarrow> val \<Rightarrow> bit list" where
+ "retrieve (AONE bs) Void = bs"
+| "retrieve (ACHAR bs c) (Char d) = bs"
+| "retrieve (AALTs bs [r]) v = bs @ retrieve r v"
+| "retrieve (AALTs bs (r#rs)) (Left v) = bs @ retrieve r v"
+| "retrieve (AALTs bs (r#rs)) (Right v) = bs @ retrieve (AALTs [] rs) v"
+| "retrieve (ASEQ bs r1 r2) (Seq v1 v2) = bs @ retrieve r1 v1 @ retrieve r2 v2"
+| "retrieve (ASTAR bs r) (Stars []) = bs @ [S]"
+| "retrieve (ASTAR bs r) (Stars (v#vs)) =
+ bs @ [Z] @ retrieve r v @ retrieve (ASTAR [] r) (Stars vs)"
+
+
+
+fun
+ bnullable :: "arexp \<Rightarrow> bool"
+where
+ "bnullable (AZERO) = False"
+| "bnullable (AONE bs) = True"
+| "bnullable (ACHAR bs c) = False"
+| "bnullable (AALTs bs rs) = (\<exists>r \<in> set rs. bnullable r)"
+| "bnullable (ASEQ bs r1 r2) = (bnullable r1 \<and> bnullable r2)"
+| "bnullable (ASTAR bs r) = True"
+
+fun
+ bmkeps :: "arexp \<Rightarrow> bit list"
+where
+ "bmkeps(AONE bs) = bs"
+| "bmkeps(ASEQ bs r1 r2) = bs @ (bmkeps r1) @ (bmkeps r2)"
+| "bmkeps(AALTs bs [r]) = bs @ (bmkeps r)"
+| "bmkeps(AALTs bs (r#rs)) = (if bnullable(r) then bs @ (bmkeps r) else (bmkeps (AALTs bs rs)))"
+| "bmkeps(ASTAR bs r) = bs @ [S]"
+
+
+fun
+ bder :: "char \<Rightarrow> arexp \<Rightarrow> arexp"
+where
+ "bder c (AZERO) = AZERO"
+| "bder c (AONE bs) = AZERO"
+| "bder c (ACHAR bs d) = (if c = d then AONE bs else AZERO)"
+| "bder c (AALTs bs rs) = AALTs bs (map (bder c) rs)"
+| "bder c (ASEQ bs r1 r2) =
+ (if bnullable r1
+ then AALT bs (ASEQ [] (bder c r1) r2) (fuse (bmkeps r1) (bder c r2))
+ else ASEQ bs (bder c r1) r2)"
+| "bder c (ASTAR bs r) = ASEQ bs (fuse [Z] (bder c r)) (ASTAR [] r)"
+
+
+fun
+ bders :: "arexp \<Rightarrow> string \<Rightarrow> arexp"
+where
+ "bders r [] = r"
+| "bders r (c#s) = bders (bder c r) s"
+
+lemma bders_append:
+ "bders r (s1 @ s2) = bders (bders r s1) s2"
+ apply(induct s1 arbitrary: r s2)
+ apply(simp_all)
+ done
+
+lemma bnullable_correctness:
+ shows "nullable (erase r) = bnullable r"
+ apply(induct r rule: erase.induct)
+ apply(simp_all)
+ done
+
+lemma erase_fuse:
+ shows "erase (fuse bs r) = erase r"
+ apply(induct r rule: erase.induct)
+ apply(simp_all)
+ done
+
+lemma erase_intern [simp]:
+ shows "erase (intern r) = r"
+ apply(induct r)
+ apply(simp_all add: erase_fuse)
+ done
+
+lemma erase_bder [simp]:
+ shows "erase (bder a r) = der a (erase r)"
+ apply(induct r rule: erase.induct)
+ apply(simp_all add: erase_fuse bnullable_correctness)
+ done
+
+lemma erase_bders [simp]:
+ shows "erase (bders r s) = ders s (erase r)"
+ apply(induct s arbitrary: r )
+ apply(simp_all)
+ done
+
+lemma retrieve_encode_STARS:
+ assumes "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> code v = retrieve (intern r) v"
+ shows "code (Stars vs) = retrieve (ASTAR [] (intern r)) (Stars vs)"
+ using assms
+ apply(induct vs)
+ apply(simp_all)
+ done
+
+lemma retrieve_fuse2:
+ assumes "\<Turnstile> v : (erase r)"
+ shows "retrieve (fuse bs r) v = bs @ retrieve r v"
+ using assms
+ apply(induct r arbitrary: v bs)
+ apply(auto elim: Prf_elims)[4]
+ defer
+ using retrieve_encode_STARS
+ apply(auto elim!: Prf_elims)[1]
+ apply(case_tac vs)
+ apply(simp)
+ apply(simp)
+ (* AALTs case *)
+ apply(simp)
+ apply(case_tac x2a)
+ apply(simp)
+ apply(auto elim!: Prf_elims)[1]
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ apply(auto)
+ apply(auto elim!: Prf_elims)[1]
+ done
+
+lemma retrieve_fuse:
+ assumes "\<Turnstile> v : r"
+ shows "retrieve (fuse bs (intern r)) v = bs @ retrieve (intern r) v"
+ using assms
+ by (simp_all add: retrieve_fuse2)
+
+
+lemma retrieve_code:
+ assumes "\<Turnstile> v : r"
+ shows "code v = retrieve (intern r) v"
+ using assms
+ apply(induct v r )
+ apply(simp_all add: retrieve_fuse retrieve_encode_STARS)
+ done
+
+lemma r:
+ assumes "bnullable (AALTs bs (a # rs))"
+ shows "bnullable a \<or> (\<not> bnullable a \<and> bnullable (AALTs bs rs))"
+ using assms
+ apply(induct rs)
+ apply(auto)
+ done
+
+lemma r0:
+ assumes "bnullable a"
+ shows "bmkeps (AALTs bs (a # rs)) = bs @ (bmkeps a)"
+ using assms
+ by (metis bmkeps.simps(3) bmkeps.simps(4) list.exhaust)
+
+lemma r1:
+ assumes "\<not> bnullable a" "bnullable (AALTs bs rs)"
+ shows "bmkeps (AALTs bs (a # rs)) = bmkeps (AALTs bs rs)"
+ using assms
+ apply(induct rs)
+ apply(auto)
+ done
+
+lemma r2:
+ assumes "x \<in> set rs" "bnullable x"
+ shows "bnullable (AALTs bs rs)"
+ using assms
+ apply(induct rs)
+ apply(auto)
+ done
+
+lemma r3:
+ assumes "\<not> bnullable r"
+ " \<exists> x \<in> set rs. bnullable x"
+ shows "retrieve (AALTs bs rs) (mkeps (erase (AALTs bs rs))) =
+ retrieve (AALTs bs (r # rs)) (mkeps (erase (AALTs bs (r # rs))))"
+ using assms
+ apply(induct rs arbitrary: r bs)
+ apply(auto)[1]
+ apply(auto)
+ using bnullable_correctness apply blast
+ apply(auto simp add: bnullable_correctness mkeps_nullable retrieve_fuse2)
+ apply(subst retrieve_fuse2[symmetric])
+ apply (smt bnullable.simps(4) bnullable_correctness erase.simps(5) erase.simps(6) insert_iff list.exhaust list.set(2) mkeps.simps(3) mkeps_nullable)
+ apply(simp)
+ apply(case_tac "bnullable a")
+ apply (smt append_Nil2 bnullable.simps(4) bnullable_correctness erase.simps(5) erase.simps(6) fuse.simps(4) insert_iff list.exhaust list.set(2) mkeps.simps(3) mkeps_nullable retrieve_fuse2)
+ apply(drule_tac x="a" in meta_spec)
+ apply(drule_tac x="bs" in meta_spec)
+ apply(drule meta_mp)
+ apply(simp)
+ apply(drule meta_mp)
+ apply(auto)
+ apply(subst retrieve_fuse2[symmetric])
+ apply(case_tac rs)
+ apply(simp)
+ apply(auto)[1]
+ apply (simp add: bnullable_correctness)
+ apply (metis append_Nil2 bnullable_correctness erase_fuse fuse.simps(4) list.set_intros(1) mkeps.simps(3) mkeps_nullable nullable.simps(4) r2)
+ apply (simp add: bnullable_correctness)
+ apply (metis append_Nil2 bnullable_correctness erase.simps(6) erase_fuse fuse.simps(4) list.set_intros(2) mkeps.simps(3) mkeps_nullable r2)
+ apply(simp)
+ done
+
+
+lemma t:
+ assumes "\<forall>r \<in> set rs. nullable (erase r) \<longrightarrow> bmkeps r = retrieve r (mkeps (erase r))"
+ "nullable (erase (AALTs bs rs))"
+ shows " bmkeps (AALTs bs rs) = retrieve (AALTs bs rs) (mkeps (erase (AALTs bs rs)))"
+ using assms
+ apply(induct rs arbitrary: bs)
+ apply(simp)
+ apply(auto simp add: bnullable_correctness)
+ apply(case_tac rs)
+ apply(auto simp add: bnullable_correctness)[2]
+ apply(subst r1)
+ apply(simp)
+ apply(rule r2)
+ apply(assumption)
+ apply(simp)
+ apply(drule_tac x="bs" in meta_spec)
+ apply(drule meta_mp)
+ apply(auto)[1]
+ prefer 2
+ apply(case_tac "bnullable a")
+ apply(subst r0)
+ apply blast
+ apply(subgoal_tac "nullable (erase a)")
+ prefer 2
+ using bnullable_correctness apply blast
+ apply (metis (no_types, lifting) erase.simps(5) erase.simps(6) list.exhaust mkeps.simps(3) retrieve.simps(3) retrieve.simps(4))
+ apply(subst r1)
+ apply(simp)
+ using r2 apply blast
+ apply(drule_tac x="bs" in meta_spec)
+ apply(drule meta_mp)
+ apply(auto)[1]
+ apply(simp)
+ using r3 apply blast
+ apply(auto)
+ using r3 by blast
+
+lemma bmkeps_retrieve:
+ assumes "nullable (erase r)"
+ shows "bmkeps r = retrieve r (mkeps (erase r))"
+ using assms
+ apply(induct r)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ defer
+ apply(simp)
+ apply(rule t)
+ apply(auto)
+ done
+
+lemma bder_retrieve:
+ assumes "\<Turnstile> v : der c (erase r)"
+ shows "retrieve (bder c r) v = retrieve r (injval (erase r) c v)"
+ using assms
+ apply(induct r arbitrary: v rule: erase.induct)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(case_tac "c = ca")
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(simp)
+ apply(rename_tac "r\<^sub>1" "r\<^sub>2" rs v)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(simp)
+ apply(case_tac rs)
+ apply(simp)
+ apply(simp)
+ apply (smt Prf_elims(3) injval.simps(2) injval.simps(3) retrieve.simps(4) retrieve.simps(5) same_append_eq)
+ apply(simp)
+ apply(case_tac "nullable (erase r1)")
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(subgoal_tac "bnullable r1")
+ prefer 2
+ using bnullable_correctness apply blast
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(subgoal_tac "bnullable r1")
+ prefer 2
+ using bnullable_correctness apply blast
+ apply(simp)
+ apply(simp add: retrieve_fuse2)
+ apply(simp add: bmkeps_retrieve)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ using bnullable_correctness apply blast
+ apply(rename_tac bs r v)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(clarify)
+ apply(erule Prf_elims)
+ apply(clarify)
+ apply(subst injval.simps)
+ apply(simp del: retrieve.simps)
+ apply(subst retrieve.simps)
+ apply(subst retrieve.simps)
+ apply(simp)
+ apply(simp add: retrieve_fuse2)
+ done
+
+
+
+lemma MAIN_decode:
+ assumes "\<Turnstile> v : ders s r"
+ shows "Some (flex r id s v) = decode (retrieve (bders (intern r) s) v) r"
+ using assms
+proof (induct s arbitrary: v rule: rev_induct)
+ case Nil
+ have "\<Turnstile> v : ders [] r" by fact
+ then have "\<Turnstile> v : r" by simp
+ then have "Some v = decode (retrieve (intern r) v) r"
+ using decode_code retrieve_code by auto
+ then show "Some (flex r id [] v) = decode (retrieve (bders (intern r) []) v) r"
+ by simp
+next
+ case (snoc c s v)
+ have IH: "\<And>v. \<Turnstile> v : ders s r \<Longrightarrow>
+ Some (flex r id s v) = decode (retrieve (bders (intern r) s) v) r" by fact
+ have asm: "\<Turnstile> v : ders (s @ [c]) r" by fact
+ then have asm2: "\<Turnstile> injval (ders s r) c v : ders s r"
+ by (simp add: Prf_injval ders_append)
+ have "Some (flex r id (s @ [c]) v) = Some (flex r id s (injval (ders s r) c v))"
+ by (simp add: flex_append)
+ also have "... = decode (retrieve (bders (intern r) s) (injval (ders s r) c v)) r"
+ using asm2 IH by simp
+ also have "... = decode (retrieve (bder c (bders (intern r) s)) v) r"
+ using asm by (simp_all add: bder_retrieve ders_append)
+ finally show "Some (flex r id (s @ [c]) v) =
+ decode (retrieve (bders (intern r) (s @ [c])) v) r" by (simp add: bders_append)
+qed
+
+
+definition blex where
+ "blex a s \<equiv> if bnullable (bders a s) then Some (bmkeps (bders a s)) else None"
+
+
+
+definition blexer where
+ "blexer r s \<equiv> if bnullable (bders (intern r) s) then
+ decode (bmkeps (bders (intern r) s)) r else None"
+
+lemma blexer_correctness:
+ shows "blexer r s = lexer r s"
+proof -
+ { define bds where "bds \<equiv> bders (intern r) s"
+ define ds where "ds \<equiv> ders s r"
+ assume asm: "nullable ds"
+ have era: "erase bds = ds"
+ unfolding ds_def bds_def by simp
+ have mke: "\<Turnstile> mkeps ds : ds"
+ using asm by (simp add: mkeps_nullable)
+ have "decode (bmkeps bds) r = decode (retrieve bds (mkeps ds)) r"
+ using bmkeps_retrieve
+ using asm era by (simp add: bmkeps_retrieve)
+ also have "... = Some (flex r id s (mkeps ds))"
+ using mke by (simp_all add: MAIN_decode ds_def bds_def)
+ finally have "decode (bmkeps bds) r = Some (flex r id s (mkeps ds))"
+ unfolding bds_def ds_def .
+ }
+ then show "blexer r s = lexer r s"
+ unfolding blexer_def lexer_flex
+ apply(subst bnullable_correctness[symmetric])
+ apply(simp)
+ done
+qed
+
+
+fun distinctBy :: "'a list \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'b set \<Rightarrow> 'a list"
+ where
+ "distinctBy [] f acc = []"
+| "distinctBy (x#xs) f acc =
+ (if (f x) \<in> acc then distinctBy xs f acc
+ else x # (distinctBy xs f ({f x} \<union> acc)))"
+
+fun flts :: "arexp list \<Rightarrow> arexp list"
+ where
+ "flts [] = []"
+| "flts (AZERO # rs) = flts rs"
+| "flts ((AALTs bs rs1) # rs) = (map (fuse bs) rs1) @ flts rs"
+| "flts (r1 # rs) = r1 # flts rs"
+
+
+
+
+fun li :: "bit list \<Rightarrow> arexp list \<Rightarrow> arexp"
+ where
+ "li _ [] = AZERO"
+| "li bs [a] = fuse bs a"
+| "li bs as = AALTs bs as"
+
+
+
+
+fun bsimp_ASEQ :: "bit list \<Rightarrow> arexp \<Rightarrow> arexp \<Rightarrow> arexp"
+ where
+ "bsimp_ASEQ _ AZERO _ = AZERO"
+| "bsimp_ASEQ _ _ AZERO = AZERO"
+| "bsimp_ASEQ bs1 (AONE bs2) r2 = fuse (bs1 @ bs2) r2"
+| "bsimp_ASEQ bs1 r1 r2 = ASEQ bs1 r1 r2"
+
+
+fun bsimp_AALTs :: "bit list \<Rightarrow> arexp list \<Rightarrow> arexp"
+ where
+ "bsimp_AALTs _ [] = AZERO"
+| "bsimp_AALTs bs1 [r] = fuse bs1 r"
+| "bsimp_AALTs bs1 rs = AALTs bs1 rs"
+
+
+fun bsimp :: "arexp \<Rightarrow> arexp"
+ where
+ "bsimp (ASEQ bs1 r1 r2) = bsimp_ASEQ bs1 (bsimp r1) (bsimp r2)"
+| "bsimp (AALTs bs1 rs) = bsimp_AALTs bs1 (flts (map bsimp rs))"
+| "bsimp r = r"
+
+
+
+
+fun
+ bders_simp :: "arexp \<Rightarrow> string \<Rightarrow> arexp"
+where
+ "bders_simp r [] = r"
+| "bders_simp r (c # s) = bders_simp (bsimp (bder c r)) s"
+
+definition blexer_simp where
+ "blexer_simp r s \<equiv> if bnullable (bders_simp (intern r) s) then
+ decode (bmkeps (bders_simp (intern r) s)) r else None"
+
+
+lemma asize0:
+ shows "0 < asize r"
+ apply(induct r)
+ apply(auto)
+ done
+
+
+lemma bders_simp_append:
+ shows "bders_simp r (s1 @ s2) = bders_simp (bders_simp r s1) s2"
+ apply(induct s1 arbitrary: r s2)
+ apply(simp)
+ apply(simp)
+ done
+
+lemma bsimp_ASEQ_size:
+ shows "asize (bsimp_ASEQ bs r1 r2) \<le> Suc (asize r1 + asize r2)"
+ apply(induct bs r1 r2 rule: bsimp_ASEQ.induct)
+ apply(auto)
+ done
+
+lemma fuse_size:
+ shows "asize (fuse bs r) = asize r"
+ apply(induct r)
+ apply(auto)
+ done
+
+lemma flts_size:
+ shows "sum_list (map asize (flts rs)) \<le> sum_list (map asize rs)"
+ apply(induct rs rule: flts.induct)
+ apply(simp_all)
+ by (metis (mono_tags, lifting) add_mono comp_apply eq_imp_le fuse_size le_SucI map_eq_conv)
+
+
+lemma bsimp_AALTs_size:
+ shows "asize (bsimp_AALTs bs rs) \<le> Suc (sum_list (map asize rs))"
+ apply(induct rs rule: bsimp_AALTs.induct)
+ apply(auto simp add: fuse_size)
+ done
+
+
+lemma bsimp_size:
+ shows "asize (bsimp r) \<le> asize r"
+ apply(induct r)
+ apply(simp_all)
+ apply (meson Suc_le_mono add_mono_thms_linordered_semiring(1) bsimp_ASEQ_size le_trans)
+ apply(rule le_trans)
+ apply(rule bsimp_AALTs_size)
+ apply(simp)
+ apply(rule le_trans)
+ apply(rule flts_size)
+ by (simp add: sum_list_mono)
+
+lemma bsimp_asize0:
+ shows "(\<Sum>x\<leftarrow>rs. asize (bsimp x)) \<le> sum_list (map asize rs)"
+ apply(induct rs)
+ apply(auto)
+ by (simp add: add_mono bsimp_size)
+
+lemma bsimp_AALTs_size2:
+ assumes "\<forall>r \<in> set rs. nonalt r"
+ shows "asize (bsimp_AALTs bs rs) \<ge> sum_list (map asize rs)"
+ using assms
+ apply(induct rs rule: bsimp_AALTs.induct)
+ apply(simp_all add: fuse_size)
+ done
+
+
+lemma qq:
+ shows "map (asize \<circ> fuse bs) rs = map asize rs"
+ apply(induct rs)
+ apply(auto simp add: fuse_size)
+ done
+
+lemma flts_size2:
+ assumes "\<exists>bs rs'. AALTs bs rs' \<in> set rs"
+ shows "sum_list (map asize (flts rs)) < sum_list (map asize rs)"
+ using assms
+ apply(induct rs)
+ apply(auto simp add: qq)
+ apply (simp add: flts_size less_Suc_eq_le)
+ apply(case_tac a)
+ apply(auto simp add: qq)
+ prefer 2
+ apply (simp add: flts_size le_imp_less_Suc)
+ using less_Suc_eq by auto
+
+lemma bsimp_AALTs_size3:
+ assumes "\<exists>r \<in> set (map bsimp rs). \<not>nonalt r"
+ shows "asize (bsimp (AALTs bs rs)) < asize (AALTs bs rs)"
+ using assms flts_size2
+ apply -
+ apply(clarify)
+ apply(simp)
+ apply(drule_tac x="map bsimp rs" in meta_spec)
+ apply(drule meta_mp)
+ apply (metis list.set_map nonalt.elims(3))
+ apply(simp)
+ apply(rule order_class.order.strict_trans1)
+ apply(rule bsimp_AALTs_size)
+ apply(simp)
+ by (smt Suc_leI bsimp_asize0 comp_def le_imp_less_Suc le_trans map_eq_conv not_less_eq)
+
+
+
+
+lemma L_bsimp_ASEQ:
+ "L (SEQ (erase r1) (erase r2)) = L (erase (bsimp_ASEQ bs r1 r2))"
+ apply(induct bs r1 r2 rule: bsimp_ASEQ.induct)
+ apply(simp_all)
+ by (metis erase_fuse fuse.simps(4))
+
+lemma L_bsimp_AALTs:
+ "L (erase (AALTs bs rs)) = L (erase (bsimp_AALTs bs rs))"
+ apply(induct bs rs rule: bsimp_AALTs.induct)
+ apply(simp_all add: erase_fuse)
+ done
+
+lemma L_erase_AALTs:
+ shows "L (erase (AALTs bs rs)) = \<Union> (L ` erase ` (set rs))"
+ apply(induct rs)
+ apply(simp)
+ apply(simp)
+ apply(case_tac rs)
+ apply(simp)
+ apply(simp)
+ done
+
+lemma L_erase_flts:
+ shows "\<Union> (L ` erase ` (set (flts rs))) = \<Union> (L ` erase ` (set rs))"
+ apply(induct rs rule: flts.induct)
+ apply(simp_all)
+ apply(auto)
+ using L_erase_AALTs erase_fuse apply auto[1]
+ by (simp add: L_erase_AALTs erase_fuse)
+
+
+lemma L_bsimp_erase:
+ shows "L (erase r) = L (erase (bsimp r))"
+ apply(induct r)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(auto simp add: Sequ_def)[1]
+ apply(subst L_bsimp_ASEQ[symmetric])
+ apply(auto simp add: Sequ_def)[1]
+ apply(subst (asm) L_bsimp_ASEQ[symmetric])
+ apply(auto simp add: Sequ_def)[1]
+ apply(simp)
+ apply(subst L_bsimp_AALTs[symmetric])
+ defer
+ apply(simp)
+ apply(subst (2)L_erase_AALTs)
+ apply(subst L_erase_flts)
+ apply(auto)
+ apply (simp add: L_erase_AALTs)
+ using L_erase_AALTs by blast
+
+lemma bsimp_ASEQ0:
+ shows "bsimp_ASEQ bs r1 AZERO = AZERO"
+ apply(induct r1)
+ apply(auto)
+ done
+
+
+
+lemma bsimp_ASEQ1:
+ assumes "r1 \<noteq> AZERO" "r2 \<noteq> AZERO" "\<forall>bs. r1 \<noteq> AONE bs"
+ shows "bsimp_ASEQ bs r1 r2 = ASEQ bs r1 r2"
+ using assms
+ apply(induct bs r1 r2 rule: bsimp_ASEQ.induct)
+ apply(auto)
+ done
+
+lemma bsimp_ASEQ2:
+ shows "bsimp_ASEQ bs (AONE bs1) r2 = fuse (bs @ bs1) r2"
+ apply(induct r2)
+ apply(auto)
+ done
+
+
+lemma L_bders_simp:
+ shows "L (erase (bders_simp r s)) = L (erase (bders r s))"
+ apply(induct s arbitrary: r rule: rev_induct)
+ apply(simp)
+ apply(simp)
+ apply(simp add: ders_append)
+ apply(simp add: bders_simp_append)
+ apply(simp add: L_bsimp_erase[symmetric])
+ by (simp add: der_correctness)
+
+lemma b1:
+ "bsimp_ASEQ bs1 (AONE bs) r = fuse (bs1 @ bs) r"
+ apply(induct r)
+ apply(auto)
+ done
+
+lemma b2:
+ assumes "bnullable r"
+ shows "bmkeps (fuse bs r) = bs @ bmkeps r"
+ by (simp add: assms bmkeps_retrieve bnullable_correctness erase_fuse mkeps_nullable retrieve_fuse2)
+
+lemma b3:
+ shows "bnullable r = bnullable (bsimp r)"
+ using L_bsimp_erase bnullable_correctness nullable_correctness by auto
+
+
+lemma b4:
+ shows "bnullable (bders_simp r s) = bnullable (bders r s)"
+ by (metis L_bders_simp bnullable_correctness lexer.simps(1) lexer_correct_None option.distinct(1))
+
+lemma q1:
+ assumes "\<forall>r \<in> set rs. bmkeps(bsimp r) = bmkeps r"
+ shows "map (\<lambda>r. bmkeps(bsimp r)) rs = map bmkeps rs"
+ using assms
+ apply(induct rs)
+ apply(simp)
+ apply(simp)
+ done
+
+lemma q3:
+ assumes "\<exists>r \<in> set rs. bnullable r"
+ shows "bmkeps (AALTs bs rs) = bmkeps (bsimp_AALTs bs rs)"
+ using assms
+ apply(induct bs rs rule: bsimp_AALTs.induct)
+ apply(simp)
+ apply(simp)
+ apply (simp add: b2)
+ apply(simp)
+ done
+
+lemma qq1:
+ assumes "\<exists>r \<in> set rs. bnullable r"
+ shows "bmkeps (AALTs bs (rs @ rs1)) = bmkeps (AALTs bs rs)"
+ using assms
+ apply(induct rs arbitrary: rs1 bs)
+ apply(simp)
+ apply(simp)
+ by (metis Nil_is_append_conv bmkeps.simps(4) neq_Nil_conv r0 split_list_last)
+
+lemma qq2:
+ assumes "\<forall>r \<in> set rs. \<not> bnullable r" "\<exists>r \<in> set rs1. bnullable r"
+ shows "bmkeps (AALTs bs (rs @ rs1)) = bmkeps (AALTs bs rs1)"
+ using assms
+ apply(induct rs arbitrary: rs1 bs)
+ apply(simp)
+ apply(simp)
+ by (metis append_assoc in_set_conv_decomp r1 r2)
+
+lemma qq3:
+ shows "bnullable (AALTs bs rs) = (\<exists>r \<in> set rs. bnullable r)"
+ apply(induct rs arbitrary: bs)
+ apply(simp)
+ apply(simp)
+ done
+
+lemma fuse_empty:
+ shows "fuse [] r = r"
+ apply(induct r)
+ apply(auto)
+ done
+
+lemma flts_fuse:
+ shows "map (fuse bs) (flts rs) = flts (map (fuse bs) rs)"
+ apply(induct rs arbitrary: bs rule: flts.induct)
+ apply(auto simp add: fuse_append)
+ done
+
+lemma bsimp_ASEQ_fuse:
+ shows "fuse bs1 (bsimp_ASEQ bs2 r1 r2) = bsimp_ASEQ (bs1 @ bs2) r1 r2"
+ apply(induct r1 r2 arbitrary: bs1 bs2 rule: bsimp_ASEQ.induct)
+ apply(auto)
+ done
+
+lemma bsimp_AALTs_fuse:
+ assumes "\<forall>r \<in> set rs. fuse bs1 (fuse bs2 r) = fuse (bs1 @ bs2) r"
+ shows "fuse bs1 (bsimp_AALTs bs2 rs) = bsimp_AALTs (bs1 @ bs2) rs"
+ using assms
+ apply(induct bs2 rs arbitrary: bs1 rule: bsimp_AALTs.induct)
+ apply(auto)
+ done
+
+
+
+lemma bsimp_fuse:
+ shows "fuse bs (bsimp r) = bsimp (fuse bs r)"
+apply(induct r arbitrary: bs)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 3
+ apply(simp)
+ apply(simp)
+ apply (simp add: bsimp_ASEQ_fuse)
+ apply(simp)
+ by (simp add: bsimp_AALTs_fuse fuse_append)
+
+lemma bsimp_fuse_AALTs:
+ shows "fuse bs (bsimp (AALTs [] rs)) = bsimp (AALTs bs rs)"
+ apply(subst bsimp_fuse)
+ apply(simp)
+ done
+
+lemma bsimp_fuse_AALTs2:
+ shows "fuse bs (bsimp_AALTs [] rs) = bsimp_AALTs bs rs"
+ using bsimp_AALTs_fuse fuse_append by auto
+
+
+lemma bsimp_ASEQ_idem:
+ assumes "bsimp (bsimp r1) = bsimp r1" "bsimp (bsimp r2) = bsimp r2"
+ shows "bsimp (bsimp_ASEQ x1 (bsimp r1) (bsimp r2)) = bsimp_ASEQ x1 (bsimp r1) (bsimp r2)"
+ using assms
+ apply(case_tac "bsimp r1 = AZERO")
+ apply(simp)
+ apply(case_tac "bsimp r2 = AZERO")
+ apply(simp)
+ apply (metis bnullable.elims(2) bnullable.elims(3) bsimp.simps(3) bsimp_ASEQ.simps(2) bsimp_ASEQ.simps(3) bsimp_ASEQ.simps(4) bsimp_ASEQ.simps(5) bsimp_ASEQ.simps(6))
+ apply(case_tac "\<exists>bs. bsimp r1 = AONE bs")
+ apply(auto)[1]
+ apply(subst bsimp_ASEQ2)
+ apply(subst bsimp_ASEQ2)
+ apply (metis assms(2) bsimp_fuse)
+ apply(subst bsimp_ASEQ1)
+ apply(auto)
+ done
+
+
+fun nonnested :: "arexp \<Rightarrow> bool"
+ where
+ "nonnested (AALTs bs2 []) = True"
+| "nonnested (AALTs bs2 ((AALTs bs1 rs1) # rs2)) = False"
+| "nonnested (AALTs bs2 (r # rs2)) = nonnested (AALTs bs2 rs2)"
+| "nonnested r = True"
+
+
+lemma k0:
+ shows "flts (r # rs1) = flts [r] @ flts rs1"
+ apply(induct r arbitrary: rs1)
+ apply(auto)
+ done
+
+lemma k00:
+ shows "flts (rs1 @ rs2) = flts rs1 @ flts rs2"
+ apply(induct rs1 arbitrary: rs2)
+ apply(auto)
+ by (metis append.assoc k0)
+
+lemma k0a:
+ shows "flts [AALTs bs rs] = map (fuse bs) rs"
+ apply(simp)
+ done
+
+
+lemma k0b:
+ assumes "nonalt r" "r \<noteq> AZERO"
+ shows "flts [r] = [r]"
+ using assms
+ apply(case_tac r)
+ apply(simp_all)
+ done
+
+lemma nn1:
+ assumes "nonnested (AALTs bs rs)"
+ shows "\<nexists>bs1 rs1. flts rs = [AALTs bs1 rs1]"
+ using assms
+ apply(induct rs rule: flts.induct)
+ apply(auto)
+ done
+
+lemma nn1q:
+ assumes "nonnested (AALTs bs rs)"
+ shows "\<nexists>bs1 rs1. AALTs bs1 rs1 \<in> set (flts rs)"
+ using assms
+ apply(induct rs rule: flts.induct)
+ apply(auto)
+ done
+
+lemma nn1qq:
+ assumes "nonnested (AALTs bs rs)"
+ shows "\<nexists>bs1 rs1. AALTs bs1 rs1 \<in> set rs"
+ using assms
+ apply(induct rs rule: flts.induct)
+ apply(auto)
+ done
+
+lemma nn10:
+ assumes "nonnested (AALTs cs rs)"
+ shows "nonnested (AALTs (bs @ cs) rs)"
+ using assms
+ apply(induct rs arbitrary: cs bs)
+ apply(simp_all)
+ apply(case_tac a)
+ apply(simp_all)
+ done
+
+lemma nn11a:
+ assumes "nonalt r"
+ shows "nonalt (fuse bs r)"
+ using assms
+ apply(induct r)
+ apply(auto)
+ done
+
+
+lemma nn1a:
+ assumes "nonnested r"
+ shows "nonnested (fuse bs r)"
+ using assms
+ apply(induct bs r arbitrary: rule: fuse.induct)
+ apply(simp_all add: nn10)
+ done
+
+lemma n0:
+ shows "nonnested (AALTs bs rs) \<longleftrightarrow> (\<forall>r \<in> set rs. nonalt r)"
+ apply(induct rs arbitrary: bs)
+ apply(auto)
+ apply (metis list.set_intros(1) nn1qq nonalt.elims(3))
+ apply (metis list.set_intros(2) nn1qq nonalt.elims(3))
+ by (metis nonalt.elims(2) nonnested.simps(3) nonnested.simps(4) nonnested.simps(5) nonnested.simps(6) nonnested.simps(7))
+
+
+
+
+lemma nn1c:
+ assumes "\<forall>r \<in> set rs. nonnested r"
+ shows "\<forall>r \<in> set (flts rs). nonalt r"
+ using assms
+ apply(induct rs rule: flts.induct)
+ apply(auto)
+ apply(rule nn11a)
+ by (metis nn1qq nonalt.elims(3))
+
+lemma nn1bb:
+ assumes "\<forall>r \<in> set rs. nonalt r"
+ shows "nonnested (bsimp_AALTs bs rs)"
+ using assms
+ apply(induct bs rs rule: bsimp_AALTs.induct)
+ apply(auto)
+ apply (metis nn11a nonalt.simps(1) nonnested.elims(3))
+ using n0 by auto
+
+lemma nn1b:
+ shows "nonnested (bsimp r)"
+ apply(induct r)
+ apply(simp_all)
+ apply(case_tac "bsimp r1 = AZERO")
+ apply(simp)
+ apply(case_tac "bsimp r2 = AZERO")
+ apply(simp)
+ apply(subst bsimp_ASEQ0)
+ apply(simp)
+ apply(case_tac "\<exists>bs. bsimp r1 = AONE bs")
+ apply(auto)[1]
+ apply(subst bsimp_ASEQ2)
+ apply (simp add: nn1a)
+ apply(subst bsimp_ASEQ1)
+ apply(auto)
+ apply(rule nn1bb)
+ apply(auto)
+ by (metis (mono_tags, hide_lams) imageE nn1c set_map)
+
+lemma nn1d:
+ assumes "bsimp r = AALTs bs rs"
+ shows "\<forall>r1 \<in> set rs. \<forall> bs. r1 \<noteq> AALTs bs rs2"
+ using nn1b assms
+ by (metis nn1qq)
+
+lemma nn_flts:
+ assumes "nonnested (AALTs bs rs)"
+ shows "\<forall>r \<in> set (flts rs). nonalt r"
+ using assms
+ apply(induct rs arbitrary: bs rule: flts.induct)
+ apply(auto)
+ done
+
+
+
+lemma rt:
+ shows "sum_list (map asize (flts (map bsimp rs))) \<le> sum_list (map asize rs)"
+ apply(induct rs)
+ apply(simp)
+ apply(simp)
+ apply(subst k0)
+ apply(simp)
+ by (smt add_le_cancel_right add_mono bsimp_size flts.simps(1) flts_size k0 le_iff_add list.simps(9) map_append sum_list.Cons sum_list.append trans_le_add1)
+
+lemma bsimp_AALTs_qq:
+ assumes "1 < length rs"
+ shows "bsimp_AALTs bs rs = AALTs bs rs"
+ using assms
+ apply(case_tac rs)
+ apply(simp)
+ apply(case_tac list)
+ apply(simp_all)
+ done
+
+
+lemma bsimp_AALTs1:
+ assumes "nonalt r"
+ shows "bsimp_AALTs bs (flts [r]) = fuse bs r"
+ using assms
+ apply(case_tac r)
+ apply(simp_all)
+ done
+
+lemma bbbbs:
+ assumes "good r" "r = AALTs bs1 rs"
+ shows "bsimp_AALTs bs (flts [r]) = AALTs bs (map (fuse bs1) rs)"
+ using assms
+ by (metis (no_types, lifting) Nil_is_map_conv append.left_neutral append_butlast_last_id bsimp_AALTs.elims butlast.simps(2) good.simps(4) good.simps(5) k0a map_butlast)
+
+lemma bbbbs1:
+ shows "nonalt r \<or> (\<exists>bs rs. r = AALTs bs rs)"
+ using nonalt.elims(3) by auto
+
+
+lemma good_fuse:
+ shows "good (fuse bs r) = good r"
+ apply(induct r arbitrary: bs)
+ apply(auto)
+ apply(case_tac r1)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r1)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac x2a)
+ apply(simp_all)
+ apply(case_tac list)
+ apply(simp_all)
+ apply(case_tac x2a)
+ apply(simp_all)
+ apply(case_tac list)
+ apply(simp_all)
+ done
+
+lemma good0:
+ assumes "rs \<noteq> Nil" "\<forall>r \<in> set rs. nonalt r"
+ shows "good (bsimp_AALTs bs rs) \<longleftrightarrow> (\<forall>r \<in> set rs. good r)"
+ using assms
+ apply(induct bs rs rule: bsimp_AALTs.induct)
+ apply(auto simp add: good_fuse)
+ done
+
+lemma good0a:
+ assumes "flts (map bsimp rs) \<noteq> Nil" "\<forall>r \<in> set (flts (map bsimp rs)). nonalt r"
+ shows "good (bsimp (AALTs bs rs)) \<longleftrightarrow> (\<forall>r \<in> set (flts (map bsimp rs)). good r)"
+ using assms
+ apply(simp)
+ apply(auto)
+ apply(subst (asm) good0)
+ apply(simp)
+ apply(auto)
+ apply(subst good0)
+ apply(simp)
+ apply(auto)
+ done
+
+lemma flts0:
+ assumes "r \<noteq> AZERO" "nonalt r"
+ shows "flts [r] \<noteq> []"
+ using assms
+ apply(induct r)
+ apply(simp_all)
+ done
+
+lemma flts1:
+ assumes "good r"
+ shows "flts [r] \<noteq> []"
+ using assms
+ apply(induct r)
+ apply(simp_all)
+ apply(case_tac x2a)
+ apply(simp)
+ apply(simp)
+ done
+
+lemma flts2:
+ assumes "good r"
+ shows "\<forall>r' \<in> set (flts [r]). good r' \<and> nonalt r'"
+ using assms
+ apply(induct r)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 2
+ apply(simp)
+ apply(auto)[1]
+ apply (metis bsimp_AALTs.elims good.simps(4) good.simps(5) good.simps(6) good_fuse)
+ apply (metis bsimp_AALTs.elims good.simps(4) good.simps(5) good.simps(6) nn11a)
+ apply fastforce
+ apply(simp)
+ done
+
+
+lemma flts3:
+ assumes "\<forall>r \<in> set rs. good r \<or> r = AZERO"
+ shows "\<forall>r \<in> set (flts rs). good r"
+ using assms
+ apply(induct rs arbitrary: rule: flts.induct)
+ apply(simp_all)
+ by (metis UnE flts2 k0a set_map)
+
+lemma flts3b:
+ assumes "\<exists>r\<in>set rs. good r"
+ shows "flts rs \<noteq> []"
+ using assms
+ apply(induct rs arbitrary: rule: flts.induct)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(auto)
+ done
+
+lemma flts4:
+ assumes "bsimp_AALTs bs (flts rs) = AZERO"
+ shows "\<forall>r \<in> set rs. \<not> good r"
+ using assms
+ apply(induct rs arbitrary: bs rule: flts.induct)
+ apply(auto)
+ defer
+ apply (metis (no_types, lifting) Nil_is_append_conv append_self_conv2 bsimp_AALTs.elims butlast.simps(2) butlast_append flts3b nonalt.simps(1) nonalt.simps(2))
+ apply (metis arexp.distinct(7) bsimp_AALTs.elims flts2 good.simps(1) good.simps(2) good0 k0b list.distinct(1) list.inject nonalt.simps(3))
+ apply (metis arexp.distinct(3) arexp.distinct(7) bsimp_AALTs.elims fuse.simps(3) list.distinct(1) list.inject)
+ apply (metis arexp.distinct(7) bsimp_AALTs.elims good.simps(1) good_fuse list.distinct(1) list.inject)
+ apply (metis arexp.distinct(7) bsimp_AALTs.elims list.distinct(1) list.inject)
+ apply (metis arexp.distinct(7) bsimp_AALTs.elims flts2 good.simps(1) good.simps(33) good0 k0b list.distinct(1) list.inject nonalt.simps(6))
+ by (metis (no_types, lifting) Nil_is_append_conv append_Nil2 arexp.distinct(7) bsimp_AALTs.elims butlast.simps(2) butlast_append flts1 flts2 good.simps(1) good0 k0a)
+
+
+lemma flts_nil:
+ assumes "\<forall>y. asize y < Suc (sum_list (map asize rs)) \<longrightarrow>
+ good (bsimp y) \<or> bsimp y = AZERO"
+ and "\<forall>r\<in>set rs. \<not> good (bsimp r)"
+ shows "flts (map bsimp rs) = []"
+ using assms
+ apply(induct rs)
+ apply(simp)
+ apply(simp)
+ apply(subst k0)
+ apply(simp)
+ by force
+
+lemma flts_nil2:
+ assumes "\<forall>y. asize y < Suc (sum_list (map asize rs)) \<longrightarrow>
+ good (bsimp y) \<or> bsimp y = AZERO"
+ and "bsimp_AALTs bs (flts (map bsimp rs)) = AZERO"
+ shows "flts (map bsimp rs) = []"
+ using assms
+ apply(induct rs arbitrary: bs)
+ apply(simp)
+ apply(simp)
+ apply(subst k0)
+ apply(simp)
+ apply(subst (asm) k0)
+ apply(auto)
+ apply (metis flts.simps(1) flts.simps(2) flts4 k0 less_add_Suc1 list.set_intros(1))
+ by (metis flts.simps(2) flts4 k0 less_add_Suc1 list.set_intros(1))
+
+
+
+lemma good_SEQ:
+ assumes "r1 \<noteq> AZERO" "r2 \<noteq> AZERO" "\<forall>bs. r1 \<noteq> AONE bs"
+ shows "good (ASEQ bs r1 r2) = (good r1 \<and> good r2)"
+ using assms
+ apply(case_tac r1)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ done
+
+lemma good1:
+ shows "good (bsimp a) \<or> bsimp a = AZERO"
+ apply(induct a taking: asize rule: measure_induct)
+ apply(case_tac x)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 3
+ apply(simp)
+ prefer 2
+ (* AALTs case *)
+ apply(simp only:)
+ apply(case_tac "x52")
+ apply(simp)
+ thm good0a
+ (* AALTs list at least one - case *)
+ apply(simp only: )
+ apply(frule_tac x="a" in spec)
+ apply(drule mp)
+ apply(simp)
+ (* either first element is good, or AZERO *)
+ apply(erule disjE)
+ prefer 2
+ apply(simp)
+ (* in the AZERO case, the size is smaller *)
+ apply(drule_tac x="AALTs x51 list" in spec)
+ apply(drule mp)
+ apply(simp add: asize0)
+ apply(subst (asm) bsimp.simps)
+ apply(subst (asm) bsimp.simps)
+ apply(assumption)
+ (* in the good case *)
+ apply(frule_tac x="AALTs x51 list" in spec)
+ apply(drule mp)
+ apply(simp add: asize0)
+ apply(erule disjE)
+ apply(rule disjI1)
+ apply(simp add: good0)
+ apply(subst good0)
+ apply (metis Nil_is_append_conv flts1 k0)
+ apply (metis ex_map_conv list.simps(9) nn1b nn1c)
+ apply(simp)
+ apply(subst k0)
+ apply(simp)
+ apply(auto)[1]
+ using flts2 apply blast
+ apply(subst (asm) good0)
+ prefer 3
+ apply(auto)[1]
+ apply auto[1]
+ apply (metis ex_map_conv nn1b nn1c)
+ (* in the AZERO case *)
+ apply(simp)
+ apply(frule_tac x="a" in spec)
+ apply(drule mp)
+ apply(simp)
+ apply(erule disjE)
+ apply(rule disjI1)
+ apply(subst good0)
+ apply(subst k0)
+ using flts1 apply blast
+ apply(auto)[1]
+ apply (metis (no_types, hide_lams) ex_map_conv list.simps(9) nn1b nn1c)
+ apply(auto)[1]
+ apply(subst (asm) k0)
+ apply(auto)[1]
+ using flts2 apply blast
+ apply(frule_tac x="AALTs x51 list" in spec)
+ apply(drule mp)
+ apply(simp add: asize0)
+ apply(erule disjE)
+ apply(simp)
+ apply(simp)
+ apply (metis add.left_commute flts_nil2 less_add_Suc1 less_imp_Suc_add list.distinct(1) list.set_cases nat.inject)
+ apply(subst (2) k0)
+ apply(simp)
+ (* SEQ case *)
+ apply(simp)
+ apply(case_tac "bsimp x42 = AZERO")
+ apply(simp)
+ apply(case_tac "bsimp x43 = AZERO")
+ apply(simp)
+ apply(subst (2) bsimp_ASEQ0)
+ apply(simp)
+ apply(case_tac "\<exists>bs. bsimp x42 = AONE bs")
+ apply(auto)[1]
+ apply(subst bsimp_ASEQ2)
+ using good_fuse apply force
+ apply(subst bsimp_ASEQ1)
+ apply(auto)
+ apply(subst good_SEQ)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ using less_add_Suc1 less_add_Suc2 by blast
+
+lemma good1a:
+ assumes "L(erase a) \<noteq> {}"
+ shows "good (bsimp a)"
+ using good1 assms
+ using L_bsimp_erase by force
+
+
+
+lemma flts_append:
+ "flts (xs1 @ xs2) = flts xs1 @ flts xs2"
+ apply(induct xs1 arbitrary: xs2 rule: rev_induct)
+ apply(auto)
+ apply(case_tac xs)
+ apply(auto)
+ apply(case_tac x)
+ apply(auto)
+ apply(case_tac x)
+ apply(auto)
+ done
+
+lemma g1:
+ assumes "good (bsimp_AALTs bs rs)"
+ shows "bsimp_AALTs bs rs = AALTs bs rs \<or> (\<exists>r. rs = [r] \<and> bsimp_AALTs bs [r] = fuse bs r)"
+using assms
+ apply(induct rs arbitrary: bs)
+ apply(simp)
+ apply(case_tac rs)
+ apply(simp only:)
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ by simp
+
+lemma flts_0:
+ assumes "nonnested (AALTs bs rs)"
+ shows "\<forall>r \<in> set (flts rs). r \<noteq> AZERO"
+ using assms
+ apply(induct rs arbitrary: bs rule: flts.induct)
+ apply(simp)
+ apply(simp)
+ defer
+ apply(simp)
+ apply(simp)
+ apply(simp)
+apply(simp)
+ apply(rule ballI)
+ apply(simp)
+ done
+
+lemma flts_0a:
+ assumes "nonnested (AALTs bs rs)"
+ shows "AZERO \<notin> set (flts rs)"
+ using assms
+ using flts_0 by blast
+
+lemma qqq1:
+ shows "AZERO \<notin> set (flts (map bsimp rs))"
+ by (metis ex_map_conv flts3 good.simps(1) good1)
+
+
+fun nonazero :: "arexp \<Rightarrow> bool"
+ where
+ "nonazero AZERO = False"
+| "nonazero r = True"
+
+lemma flts_concat:
+ shows "flts rs = concat (map (\<lambda>r. flts [r]) rs)"
+ apply(induct rs)
+ apply(auto)
+ apply(subst k0)
+ apply(simp)
+ done
+
+lemma flts_single1:
+ assumes "nonalt r" "nonazero r"
+ shows "flts [r] = [r]"
+ using assms
+ apply(induct r)
+ apply(auto)
+ done
+
+lemma flts_qq:
+ assumes "\<forall>y. asize y < Suc (sum_list (map asize rs)) \<longrightarrow> good y \<longrightarrow> bsimp y = y"
+ "\<forall>r'\<in>set rs. good r' \<and> nonalt r'"
+ shows "flts (map bsimp rs) = rs"
+ using assms
+ apply(induct rs)
+ apply(simp)
+ apply(simp)
+ apply(subst k0)
+ apply(subgoal_tac "flts [bsimp a] = [a]")
+ prefer 2
+ apply(drule_tac x="a" in spec)
+ apply(drule mp)
+ apply(simp)
+ apply(auto)[1]
+ using good.simps(1) k0b apply blast
+ apply(auto)[1]
+ done
+
+lemma test:
+ assumes "good r"
+ shows "bsimp r = r"
+ using assms
+ apply(induct r taking: "asize" rule: measure_induct)
+ apply(erule good.elims)
+ apply(simp_all)
+ apply(subst k0)
+ apply(subst (2) k0)
+ apply(subst flts_qq)
+ apply(auto)[1]
+ apply(auto)[1]
+ apply (metis append_Cons append_Nil bsimp_AALTs.simps(3) good.simps(1) k0b)
+ apply force+
+ apply (metis (no_types, lifting) add_Suc add_Suc_right asize.simps(5) bsimp.simps(1) bsimp_ASEQ.simps(19) less_add_Suc1 less_add_Suc2)
+ apply (metis add_Suc add_Suc_right arexp.distinct(5) arexp.distinct(7) asize.simps(4) asize.simps(5) bsimp.simps(1) bsimp.simps(2) bsimp_ASEQ1 good.simps(21) good.simps(8) less_add_Suc1 less_add_Suc2)
+ apply force+
+ apply (metis (no_types, lifting) add_Suc add_Suc_right arexp.distinct(5) arexp.distinct(7) asize.simps(4) asize.simps(5) bsimp.simps(1) bsimp.simps(2) bsimp_ASEQ1 good.simps(25) good.simps(8) less_add_Suc1 less_add_Suc2)
+ apply (metis add_Suc add_Suc_right arexp.distinct(7) asize.simps(4) bsimp.simps(2) bsimp_ASEQ1 good.simps(26) good.simps(8) less_add_Suc1 less_add_Suc2)
+ apply force+
+ done
+
+lemma test2:
+ assumes "good r"
+ shows "bsimp r = r"
+ using assms
+ apply(induct r taking: "asize" rule: measure_induct)
+ apply(case_tac x)
+ apply(simp_all)
+ defer
+ (* AALT case *)
+ apply(subgoal_tac "1 < length x52")
+ prefer 2
+ apply(case_tac x52)
+ apply(simp)
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ apply(simp)
+ apply(subst bsimp_AALTs_qq)
+ prefer 2
+ apply(subst flts_qq)
+ apply(auto)[1]
+ apply(auto)[1]
+ apply(case_tac x52)
+ apply(simp)
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ apply(simp)
+ apply(auto)[1]
+ apply (metis (no_types, lifting) bsimp_AALTs.elims good.simps(6) length_Cons length_pos_if_in_set list.size(3) nat_neq_iff)
+ apply(simp)
+ apply(case_tac x52)
+ apply(simp)
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ apply(simp)
+ apply(subst k0)
+ apply(simp)
+ apply(subst (2) k0)
+ apply(simp)
+ apply (simp add: Suc_lessI flts1 one_is_add)
+ (* SEQ case *)
+ apply(case_tac "bsimp x42 = AZERO")
+ apply simp
+ apply (metis asize.elims good.simps(10) good.simps(11) good.simps(12) good.simps(2) good.simps(7) good.simps(9) good_SEQ less_add_Suc1)
+ apply(case_tac "\<exists>bs'. bsimp x42 = AONE bs'")
+ apply(auto)[1]
+ defer
+ apply(case_tac "bsimp x43 = AZERO")
+ apply(simp)
+ apply (metis bsimp.elims bsimp.simps(3) good.simps(10) good.simps(11) good.simps(12) good.simps(8) good.simps(9) good_SEQ less_add_Suc2)
+ apply(auto)
+ apply (subst bsimp_ASEQ1)
+ apply(auto)[3]
+ apply(auto)[1]
+ apply (metis bsimp.simps(3) good.simps(2) good_SEQ less_add_Suc1)
+ apply (metis bsimp.simps(3) good.simps(2) good_SEQ less_add_Suc1 less_add_Suc2)
+ apply (subst bsimp_ASEQ2)
+ apply(drule_tac x="x42" in spec)
+ apply(drule mp)
+ apply(simp)
+ apply(drule mp)
+ apply (metis bsimp.elims bsimp.simps(3) good.simps(10) good.simps(11) good.simps(2) good_SEQ)
+ apply(simp)
+ done
+
+
+lemma bsimp_idem:
+ shows "bsimp (bsimp r) = bsimp r"
+ using test good1
+ by force
+
+
+lemma q3a:
+ assumes "\<exists>r \<in> set rs. bnullable r"
+ shows "bmkeps (AALTs bs (map (fuse bs1) rs)) = bmkeps (AALTs (bs@bs1) rs)"
+ using assms
+ apply(induct rs arbitrary: bs bs1)
+ apply(simp)
+ apply(simp)
+ apply(auto)
+ apply (metis append_assoc b2 bnullable_correctness erase_fuse r0)
+ apply(case_tac "bnullable a")
+ apply (metis append.assoc b2 bnullable_correctness erase_fuse r0)
+ apply(case_tac rs)
+ apply(simp)
+ apply(simp)
+ apply(auto)[1]
+ apply (metis bnullable_correctness erase_fuse)+
+ done
+
+lemma qq4:
+ assumes "\<exists>x\<in>set list. bnullable x"
+ shows "\<exists>x\<in>set (flts list). bnullable x"
+ using assms
+ apply(induct list rule: flts.induct)
+ apply(auto)
+ by (metis UnCI bnullable_correctness erase_fuse imageI)
+
+
+lemma qs3:
+ assumes "\<exists>r \<in> set rs. bnullable r"
+ shows "bmkeps (AALTs bs rs) = bmkeps (AALTs bs (flts rs))"
+ using assms
+ apply(induct rs arbitrary: bs taking: size rule: measure_induct)
+ apply(case_tac x)
+ apply(simp)
+ apply(simp)
+ apply(case_tac a)
+ apply(simp)
+ apply (simp add: r1)
+ apply(simp)
+ apply (simp add: r0)
+ apply(simp)
+ apply(case_tac "flts list")
+ apply(simp)
+ apply (metis L_erase_AALTs L_erase_flts L_flat_Prf1 L_flat_Prf2 Prf_elims(1) bnullable_correctness erase.simps(4) mkeps_nullable r2)
+ apply(simp)
+ apply (simp add: r1)
+ prefer 3
+ apply(simp)
+ apply (simp add: r0)
+ prefer 2
+ apply(simp)
+ apply(case_tac "\<exists>x\<in>set x52. bnullable x")
+ apply(case_tac "list")
+ apply(simp)
+ apply (metis b2 fuse.simps(4) q3a r2)
+ apply(erule disjE)
+ apply(subst qq1)
+ apply(auto)[1]
+ apply (metis bnullable_correctness erase_fuse)
+ apply(simp)
+ apply (metis b2 fuse.simps(4) q3a r2)
+ apply(simp)
+ apply(auto)[1]
+ apply(subst qq1)
+ apply (metis bnullable_correctness erase_fuse image_eqI set_map)
+ apply (metis b2 fuse.simps(4) q3a r2)
+ apply(subst qq1)
+ apply (metis bnullable_correctness erase_fuse image_eqI set_map)
+ apply (metis b2 fuse.simps(4) q3a r2)
+ apply(simp)
+ apply(subst qq2)
+ apply (metis bnullable_correctness erase_fuse imageE set_map)
+ prefer 2
+ apply(case_tac "list")
+ apply(simp)
+ apply(simp)
+ apply (simp add: qq4)
+ apply(simp)
+ apply(auto)
+ apply(case_tac list)
+ apply(simp)
+ apply(simp)
+ apply (simp add: r0)
+ apply(case_tac "bnullable (ASEQ x41 x42 x43)")
+ apply(case_tac list)
+ apply(simp)
+ apply(simp)
+ apply (simp add: r0)
+ apply(simp)
+ using qq4 r1 r2 by auto
+
+
+
+lemma k1:
+ assumes "\<And>x2aa. \<lbrakk>x2aa \<in> set x2a; bnullable x2aa\<rbrakk> \<Longrightarrow> bmkeps x2aa = bmkeps (bsimp x2aa)"
+ "\<exists>x\<in>set x2a. bnullable x"
+ shows "bmkeps (AALTs x1 (flts x2a)) = bmkeps (AALTs x1 (flts (map bsimp x2a)))"
+ using assms
+ apply(induct x2a)
+ apply fastforce
+ apply(simp)
+ apply(subst k0)
+ apply(subst (2) k0)
+ apply(auto)[1]
+ apply (metis b3 k0 list.set_intros(1) qs3 r0)
+ by (smt b3 imageI insert_iff k0 list.set(2) qq3 qs3 r0 r1 set_map)
+
+
+
+lemma bmkeps_simp:
+ assumes "bnullable r"
+ shows "bmkeps r = bmkeps (bsimp r)"
+ using assms
+ apply(induct r)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 3
+ apply(simp)
+ apply(case_tac "bsimp r1 = AZERO")
+ apply(simp)
+ apply(auto)[1]
+ apply (metis L_bsimp_erase L_flat_Prf1 L_flat_Prf2 Prf_elims(1) bnullable_correctness erase.simps(1) mkeps_nullable)
+ apply(case_tac "bsimp r2 = AZERO")
+ apply(simp)
+ apply(auto)[1]
+ apply (metis L_bsimp_erase L_flat_Prf1 L_flat_Prf2 Prf_elims(1) bnullable_correctness erase.simps(1) mkeps_nullable)
+ apply(case_tac "\<exists>bs. bsimp r1 = AONE bs")
+ apply(auto)[1]
+ apply(subst b1)
+ apply(subst b2)
+ apply(simp add: b3[symmetric])
+ apply(simp)
+ apply(subgoal_tac "bsimp_ASEQ x1 (bsimp r1) (bsimp r2) = ASEQ x1 (bsimp r1) (bsimp r2)")
+ prefer 2
+ apply (smt b3 bnullable.elims(2) bsimp_ASEQ.simps(17) bsimp_ASEQ.simps(19) bsimp_ASEQ.simps(20) bsimp_ASEQ.simps(21) bsimp_ASEQ.simps(22) bsimp_ASEQ.simps(24) bsimp_ASEQ.simps(25) bsimp_ASEQ.simps(26) bsimp_ASEQ.simps(27) bsimp_ASEQ.simps(29) bsimp_ASEQ.simps(30) bsimp_ASEQ.simps(31))
+ apply(simp)
+ apply(simp)
+ thm q3
+ apply(subst q3[symmetric])
+ apply simp
+ using b3 qq4 apply auto[1]
+ apply(subst qs3)
+ apply simp
+ using k1 by blast
+
+thm bmkeps_retrieve bmkeps_simp bder_retrieve
+
+lemma bmkeps_bder_AALTs:
+ assumes "\<exists>r \<in> set rs. bnullable (bder c r)"
+ shows "bmkeps (bder c (bsimp_AALTs bs rs)) = bmkeps (bsimp_AALTs bs (map (bder c) rs))"
+ using assms
+ apply(induct rs)
+ apply(simp)
+ apply(simp)
+ apply(auto)
+ apply(case_tac rs)
+ apply(simp)
+ apply (metis (full_types) Prf_injval bder_retrieve bmkeps_retrieve bnullable_correctness erase_bder erase_fuse mkeps_nullable retrieve_fuse2)
+ apply(simp)
+ apply(case_tac rs)
+ apply(simp_all)
+ done
+
+lemma bbs0:
+ shows "blexer_simp r [] = blexer r []"
+ apply(simp add: blexer_def blexer_simp_def)
+ done
+
+lemma bbs1:
+ shows "blexer_simp r [c] = blexer r [c]"
+ apply(simp add: blexer_def blexer_simp_def)
+ apply(auto)
+ defer
+ using b3 apply auto[1]
+ using b3 apply auto[1]
+ apply(subst bmkeps_simp[symmetric])
+ apply(simp)
+ apply(simp)
+ done
+
+lemma oo:
+ shows "(case (blexer (der c r) s) of None \<Rightarrow> None | Some v \<Rightarrow> Some (injval r c v)) = blexer r (c # s)"
+ apply(simp add: blexer_correctness)
+ done
+
+
+lemma bder_fuse:
+ shows "bder c (fuse bs a) = fuse bs (bder c a)"
+ apply(induct a arbitrary: bs c)
+ apply(simp_all)
+ done
+
+
+fun flts2 :: "char \<Rightarrow> arexp list \<Rightarrow> arexp list"
+ where
+ "flts2 _ [] = []"
+| "flts2 c (AZERO # rs) = flts2 c rs"
+| "flts2 c (AONE _ # rs) = flts2 c rs"
+| "flts2 c (ACHAR bs d # rs) = (if c = d then (ACHAR bs d # flts2 c rs) else flts2 c rs)"
+| "flts2 c ((AALTs bs rs1) # rs) = (map (fuse bs) rs1) @ flts2 c rs"
+| "flts2 c (ASEQ bs r1 r2 # rs) = (if (bnullable(r1) \<and> r2 = AZERO) then
+ flts2 c rs
+ else ASEQ bs r1 r2 # flts2 c rs)"
+| "flts2 c (r1 # rs) = r1 # flts2 c rs"
+
+lemma flts2_k0:
+ shows "flts2 c (r # rs1) = flts2 c [r] @ flts2 c rs1"
+ apply(induct r arbitrary: c rs1)
+ apply(auto)
+ done
+
+lemma flts2_k00:
+ shows "flts2 c (rs1 @ rs2) = flts2 c rs1 @ flts2 c rs2"
+ apply(induct rs1 arbitrary: rs2 c)
+ apply(auto)
+ by (metis append.assoc flts2_k0)
+
+
+lemma
+ shows "flts (map (bder c) rs) = (map (bder c) (flts2 c rs))"
+ apply(induct c rs rule: flts2.induct)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(auto simp add: bder_fuse)[1]
+ defer
+ apply(simp)
+ apply(simp del: flts2.simps)
+ apply(rule conjI)
+ prefer 2
+ apply(auto)[1]
+ apply(rule impI)
+ apply(subst flts2_k0)
+ apply(subst map_append)
+ apply(subst flts2.simps)
+ apply(simp only: flts2.simps)
+ apply(auto)
+
+
+
+lemma XXX2_helper:
+ assumes "\<forall>y. asize y < Suc (sum_list (map asize rs)) \<longrightarrow> good y \<longrightarrow> bsimp y = y"
+ "\<forall>r'\<in>set rs. good r' \<and> nonalt r'"
+ shows "flts (map (bsimp \<circ> bder c) (flts (map bsimp rs))) = flts (map (bsimp \<circ> bder c) rs)"
+ using assms
+ apply(induct rs arbitrary: c)
+ apply(simp)
+ apply(simp)
+ apply(subst k0)
+ apply(simp add: flts_append)
+ apply(subst (2) k0)
+ apply(simp add: flts_append)
+ apply(subgoal_tac "flts [a] = [a]")
+ prefer 2
+ using good.simps(1) k0b apply blast
+ apply(simp)
+ done
+
+lemma bmkeps_good:
+ assumes "good a"
+ shows "bmkeps (bsimp a) = bmkeps a"
+ using assms
+ using test2 by auto
+
+
+lemma xxx_bder:
+ assumes "good r"
+ shows "L (erase r) \<noteq> {}"
+ using assms
+ apply(induct r rule: good.induct)
+ apply(auto simp add: Sequ_def)
+ done
+
+lemma xxx_bder2:
+ assumes "L (erase (bsimp r)) = {}"
+ shows "bsimp r = AZERO"
+ using assms xxx_bder test2 good1
+ by blast
+
+lemma XXX2aa:
+ assumes "good a"
+ shows "bsimp (bder c (bsimp a)) = bsimp (bder c a)"
+ using assms
+ by (simp add: test2)
+
+lemma XXX2aa_ders:
+ assumes "good a"
+ shows "bsimp (bders (bsimp a) s) = bsimp (bders a s)"
+ using assms
+ by (simp add: test2)
+
+lemma XXX4a:
+ shows "good (bders_simp (bsimp r) s) \<or> bders_simp (bsimp r) s = AZERO"
+ apply(induct s arbitrary: r rule: rev_induct)
+ apply(simp)
+ apply (simp add: good1)
+ apply(simp add: bders_simp_append)
+ apply (simp add: good1)
+ done
+
+lemma XXX4a_good:
+ assumes "good a"
+ shows "good (bders_simp a s) \<or> bders_simp a s = AZERO"
+ using assms
+ apply(induct s arbitrary: a rule: rev_induct)
+ apply(simp)
+ apply(simp add: bders_simp_append)
+ apply (simp add: good1)
+ done
+
+lemma XXX4a_good_cons:
+ assumes "s \<noteq> []"
+ shows "good (bders_simp a s) \<or> bders_simp a s = AZERO"
+ using assms
+ apply(case_tac s)
+ apply(auto)
+ using XXX4a by blast
+
+lemma XXX4b:
+ assumes "good a" "L (erase (bders_simp a s)) \<noteq> {}"
+ shows "good (bders_simp a s)"
+ using assms
+ apply(induct s arbitrary: a)
+ apply(simp)
+ apply(simp)
+ apply(subgoal_tac "L (erase (bder a aa)) = {} \<or> L (erase (bder a aa)) \<noteq> {}")
+ prefer 2
+ apply(auto)[1]
+ apply(erule disjE)
+ apply(subgoal_tac "bsimp (bder a aa) = AZERO")
+ prefer 2
+ using L_bsimp_erase xxx_bder2 apply auto[1]
+ apply(simp)
+ apply (metis L.simps(1) XXX4a erase.simps(1))
+ apply(drule_tac x="bsimp (bder a aa)" in meta_spec)
+ apply(drule meta_mp)
+ apply simp
+ apply(rule good1a)
+ apply(auto)
+ done
+
+lemma bders_AZERO:
+ shows "bders AZERO s = AZERO"
+ and "bders_simp AZERO s = AZERO"
+ apply (induct s)
+ apply(auto)
+ done
+
+lemma LA:
+ assumes "\<Turnstile> v : ders s (erase r)"
+ shows "retrieve (bders r s) v = retrieve r (flex (erase r) id s v)"
+ using assms
+ apply(induct s arbitrary: r v rule: rev_induct)
+ apply(simp)
+ apply(simp add: bders_append ders_append)
+ apply(subst bder_retrieve)
+ apply(simp)
+ apply(drule Prf_injval)
+ by (simp add: flex_append)
+
+
+lemma LB:
+ assumes "s \<in> (erase r) \<rightarrow> v"
+ shows "retrieve r v = retrieve r (flex (erase r) id s (mkeps (ders s (erase r))))"
+ using assms
+ apply(induct s arbitrary: r v rule: rev_induct)
+ apply(simp)
+ apply(subgoal_tac "v = mkeps (erase r)")
+ prefer 2
+ apply (simp add: Posix1(1) Posix_determ Posix_mkeps nullable_correctness)
+ apply(simp)
+ apply(simp add: flex_append ders_append)
+ by (metis Posix_determ Posix_flex Posix_injval Posix_mkeps ders_snoc lexer_correctness(2) lexer_flex)
+
+lemma LB_sym:
+ assumes "s \<in> (erase r) \<rightarrow> v"
+ shows "retrieve r v = retrieve r (flex (erase r) id s (mkeps (erase (bders r s))))"
+ using assms
+ by (simp add: LB)
+
+
+lemma LC:
+ assumes "s \<in> (erase r) \<rightarrow> v"
+ shows "retrieve r v = retrieve (bders r s) (mkeps (erase (bders r s)))"
+ apply(simp)
+ by (metis LA LB Posix1(1) assms lexer_correct_None lexer_flex mkeps_nullable)
+
+
+lemma L0:
+ assumes "bnullable a"
+ shows "retrieve (bsimp a) (mkeps (erase (bsimp a))) = retrieve a (mkeps (erase a))"
+ using assms
+ by (metis b3 bmkeps_retrieve bmkeps_simp bnullable_correctness)
+
+thm bmkeps_retrieve
+
+lemma L0a:
+ assumes "s \<in> L(erase a)"
+ shows "retrieve (bsimp (bders a s)) (mkeps (erase (bsimp (bders a s)))) =
+ retrieve (bders a s) (mkeps (erase (bders a s)))"
+ using assms
+ by (metis L0 bnullable_correctness erase_bders lexer_correct_None lexer_flex)
+
+lemma L0aa:
+ assumes "s \<in> L (erase a)"
+ shows "[] \<in> erase (bsimp (bders a s)) \<rightarrow> mkeps (erase (bsimp (bders a s)))"
+ using assms
+ by (metis Posix_mkeps b3 bnullable_correctness erase_bders lexer_correct_None lexer_flex)
+
+lemma L0aaa:
+ assumes "[c] \<in> L (erase a)"
+ shows "[c] \<in> (erase a) \<rightarrow> flex (erase a) id [c] (mkeps (erase (bder c a)))"
+ using assms
+ by (metis bders.simps(1) bders.simps(2) erase_bders lexer_correct_None lexer_correct_Some lexer_flex option.inject)
+
+lemma L0aaaa:
+ assumes "[c] \<in> L (erase a)"
+ shows "[c] \<in> (erase a) \<rightarrow> flex (erase a) id [c] (mkeps (erase (bders a [c])))"
+ using assms
+ using L0aaa by auto
+
+
+lemma L02:
+ assumes "bnullable (bder c a)"
+ shows "retrieve (bsimp a) (flex (erase (bsimp a)) id [c] (mkeps (erase (bder c (bsimp a))))) =
+ retrieve (bder c (bsimp a)) (mkeps (erase (bder c (bsimp a))))"
+ using assms
+ apply(simp)
+ using bder_retrieve L0 bmkeps_simp bmkeps_retrieve L0 LA LB
+ apply(subst bder_retrieve[symmetric])
+ apply (metis L_bsimp_erase bnullable_correctness der_correctness erase_bder mkeps_nullable nullable_correctness)
+ apply(simp)
+ done
+
+lemma L02_bders:
+ assumes "bnullable (bders a s)"
+ shows "retrieve (bsimp a) (flex (erase (bsimp a)) id s (mkeps (erase (bders (bsimp a) s)))) =
+ retrieve (bders (bsimp a) s) (mkeps (erase (bders (bsimp a) s)))"
+ using assms
+ by (metis LA L_bsimp_erase bnullable_correctness ders_correctness erase_bders mkeps_nullable nullable_correctness)
+
+
+
+
+lemma L03:
+ assumes "bnullable (bder c a)"
+ shows "retrieve (bder c (bsimp a)) (mkeps (erase (bder c (bsimp a)))) =
+ bmkeps (bsimp (bder c (bsimp a)))"
+ using assms
+ by (metis L0 L_bsimp_erase bmkeps_retrieve bnullable_correctness der_correctness erase_bder nullable_correctness)
+
+lemma L04:
+ assumes "bnullable (bder c a)"
+ shows "retrieve (bder c (bsimp a)) (mkeps (erase (bder c (bsimp a)))) =
+ retrieve (bsimp (bder c (bsimp a))) (mkeps (erase (bsimp (bder c (bsimp a)))))"
+ using assms
+ by (metis L0 L_bsimp_erase bnullable_correctness der_correctness erase_bder nullable_correctness)
+
+lemma L05:
+ assumes "bnullable (bder c a)"
+ shows "retrieve (bder c (bsimp a)) (mkeps (erase (bder c (bsimp a)))) =
+ retrieve (bsimp (bder c (bsimp a))) (mkeps (erase (bsimp (bder c (bsimp a)))))"
+ using assms
+ using L04 by auto
+
+lemma L06:
+ assumes "bnullable (bder c a)"
+ shows "bmkeps (bder c (bsimp a)) = bmkeps (bsimp (bder c (bsimp a)))"
+ using assms
+ by (metis L03 L_bsimp_erase bmkeps_retrieve bnullable_correctness der_correctness erase_bder nullable_correctness)
+
+lemma L07:
+ assumes "s \<in> L (erase r)"
+ shows "retrieve r (flex (erase r) id s (mkeps (ders s (erase r))))
+ = retrieve (bders r s) (mkeps (erase (bders r s)))"
+ using assms
+ using LB LC lexer_correct_Some by auto
+
+lemma LXXX:
+ assumes "s \<in> (erase r) \<rightarrow> v" "s \<in> (erase (bsimp r)) \<rightarrow> v'"
+ shows "retrieve r v = retrieve (bsimp r) v'"
+ using assms
+ apply -
+ thm LC
+ apply(subst LC)
+ apply(assumption)
+ apply(subst L0[symmetric])
+ using bnullable_correctness lexer_correctness(2) lexer_flex apply fastforce
+ apply(subst (2) LC)
+ apply(assumption)
+ apply(subst (2) L0[symmetric])
+ using bnullable_correctness lexer_correctness(2) lexer_flex apply fastforce
+
+ oops
+
+
+lemma L07a:
+ assumes "s \<in> L (erase r)"
+ shows "retrieve (bsimp r) (flex (erase (bsimp r)) id s (mkeps (ders s (erase (bsimp r)))))
+ = retrieve r (flex (erase r) id s (mkeps (ders s (erase r))))"
+ using assms
+ apply(induct s arbitrary: r)
+ apply(simp)
+ using L0a apply force
+ apply(drule_tac x="(bder a r)" in meta_spec)
+ apply(drule meta_mp)
+ apply (metis L_bsimp_erase erase_bder lexer.simps(2) lexer_correct_None option.case(1))
+ apply(drule sym)
+ apply(simp)
+ apply(subst (asm) bder_retrieve)
+ apply (metis Posix_Prf Posix_flex Posix_mkeps ders.simps(2) lexer_correct_None lexer_flex)
+ apply(simp only: flex_fun_apply)
+ apply(simp)
+ using L0[no_vars] bder_retrieve[no_vars] LA[no_vars] LC[no_vars] L07[no_vars]
+ oops
+
+lemma L08:
+ assumes "s \<in> L (erase r)"
+ shows "retrieve (bders (bsimp r) s) (mkeps (erase (bders (bsimp r) s)))
+ = retrieve (bders r s) (mkeps (erase (bders r s)))"
+ using assms
+ apply(induct s arbitrary: r)
+ apply(simp)
+ using L0 bnullable_correctness nullable_correctness apply blast
+ apply(simp add: bders_append)
+ apply(drule_tac x="(bder a (bsimp r))" in meta_spec)
+ apply(drule meta_mp)
+ apply (metis L_bsimp_erase erase_bder lexer.simps(2) lexer_correct_None option.case(1))
+ apply(drule sym)
+ apply(simp)
+ apply(subst LA)
+ apply (metis L0aa L_bsimp_erase Posix1(1) ders.simps(2) ders_correctness erase_bder erase_bders mkeps_nullable nullable_correctness)
+ apply(subst LA)
+ using lexer_correct_None lexer_flex mkeps_nullable apply force
+
+ using L0[no_vars] bder_retrieve[no_vars] LA[no_vars] LC[no_vars] L07[no_vars]
+
+thm L0[no_vars] bder_retrieve[no_vars] LA[no_vars] LC[no_vars] L07[no_vars]
+ oops
+
+lemma test:
+ assumes "s = [c]"
+ shows "retrieve (bders r s) v = XXX" and "YYY = retrieve r (flex (erase r) id s v)"
+ using assms
+ apply(simp only: bders.simps)
+ defer
+ using assms
+ apply(simp only: flex.simps id_simps)
+ using L0[no_vars] bder_retrieve[no_vars] LA[no_vars] LC[no_vars]
+ find_theorems "retrieve (bders _ _) _"
+ find_theorems "retrieve _ (mkeps _)"
+ oops
+
+lemma L06X:
+ assumes "bnullable (bder c a)"
+ shows "bmkeps (bder c (bsimp a)) = bmkeps (bder c a)"
+ using assms
+ apply(induct a arbitrary: c)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 3
+ apply(simp)
+ prefer 2
+ apply(simp)
+
+ defer
+ oops
+
+lemma L06_2:
+ assumes "bnullable (bders a [c,d])"
+ shows "bmkeps (bders (bsimp a) [c,d]) = bmkeps (bsimp (bders (bsimp a) [c,d]))"
+ using assms
+ apply(simp)
+ by (metis L_bsimp_erase bmkeps_simp bnullable_correctness der_correctness erase_bder nullable_correctness)
+
+lemma L06_bders:
+ assumes "bnullable (bders a s)"
+ shows "bmkeps (bders (bsimp a) s) = bmkeps (bsimp (bders (bsimp a) s))"
+ using assms
+ by (metis L_bsimp_erase bmkeps_simp bnullable_correctness ders_correctness erase_bders nullable_correctness)
+
+lemma LLLL:
+ shows "L (erase a) = L (erase (bsimp a))"
+ and "L (erase a) = {flat v | v. \<Turnstile> v: (erase a)}"
+ and "L (erase a) = {flat v | v. \<Turnstile> v: (erase (bsimp a))}"
+ using L_bsimp_erase apply(blast)
+ apply (simp add: L_flat_Prf)
+ using L_bsimp_erase L_flat_Prf apply(auto)[1]
+ done
+
+
+
+lemma L07XX:
+ assumes "s \<in> L (erase a)"
+ shows "s \<in> erase a \<rightarrow> flex (erase a) id s (mkeps (ders s (erase a)))"
+ using assms
+ by (meson lexer_correct_None lexer_correctness(1) lexer_flex)
+
+lemma LX0:
+ assumes "s \<in> L r"
+ shows "decode (bmkeps (bders (intern r) s)) r = Some(flex r id s (mkeps (ders s r)))"
+ by (metis assms blexer_correctness blexer_def lexer_correct_None lexer_flex)
+
+
+lemma L02_bders2:
+ assumes "bnullable (bders a s)" "s = [c]"
+ shows "retrieve (bders (bsimp a) s) (mkeps (erase (bders (bsimp a) s))) =
+ retrieve (bders a s) (mkeps (erase (bders a s)))"
+ using assms
+ apply(simp)
+
+ apply(induct s arbitrary: a)
+ apply(simp)
+ using L0 apply auto[1]
+ oops
+
+thm bmkeps_retrieve bmkeps_simp Posix_mkeps
+
+lemma WQ1:
+ assumes "s \<in> L (der c r)"
+ shows "s \<in> der c r \<rightarrow> mkeps (ders s (der c r))"
+ using assms
+ oops
+
+lemma L02_bsimp:
+ assumes "bnullable (bders a s)"
+ shows "retrieve (bsimp a) (flex (erase (bsimp a)) id s (mkeps (erase (bders (bsimp a) s)))) =
+ retrieve a (flex (erase a) id s (mkeps (erase (bders a s))))"
+ using assms
+ apply(induct s arbitrary: a)
+ apply(simp)
+ apply (simp add: L0)
+ apply(simp)
+ apply(drule_tac x="bder a aa" in meta_spec)
+ apply(simp)
+ apply(subst (asm) bder_retrieve)
+ using Posix_Prf Posix_flex Posix_mkeps bnullable_correctness apply fastforce
+ apply(simp add: flex_fun_apply)
+ apply(drule sym)
+ apply(simp)
+ apply(subst flex_injval)
+ apply(subst bder_retrieve[symmetric])
+ apply (metis L_bsimp_erase Posix_Prf Posix_flex Posix_mkeps bders.simps(2) bnullable_correctness ders.simps(2) erase_bders lexer_correct_None lexer_flex option.distinct(1))
+ apply(simp only: erase_bder[symmetric] erase_bders[symmetric])
+ apply(subst LB_sym[symmetric])
+ apply(simp)
+ oops
+
+lemma L1:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "decode (bmkeps (bders (intern r) s)) r = Some v"
+ using assms
+ by (metis blexer_correctness blexer_def lexer_correctness(1) option.distinct(1))
+
+lemma L2:
+ assumes "s \<in> (der c r) \<rightarrow> v"
+ shows "decode (bmkeps (bders (intern r) (c # s))) r = Some (injval r c v)"
+ using assms
+ apply(subst bmkeps_retrieve)
+ using Posix1(1) lexer_correct_None lexer_flex apply fastforce
+ using MAIN_decode
+ apply(subst MAIN_decode[symmetric])
+ apply(simp)
+ apply (meson Posix1(1) lexer_correct_None lexer_flex mkeps_nullable)
+ apply(simp)
+ apply(subgoal_tac "v = flex (der c r) id s (mkeps (ders s (der c r)))")
+ prefer 2
+ apply (metis Posix_determ lexer_correctness(1) lexer_flex option.distinct(1))
+ apply(simp)
+ apply(subgoal_tac "injval r c (flex (der c r) id s (mkeps (ders s (der c r)))) =
+ (flex (der c r) ((\<lambda>v. injval r c v) o id) s (mkeps (ders s (der c r))))")
+ apply(simp)
+ using flex_fun_apply by blast
+
+lemma L3:
+ assumes "s2 \<in> (ders s1 r) \<rightarrow> v"
+ shows "decode (bmkeps (bders (intern r) (s1 @ s2))) r = Some (flex r id s1 v)"
+ using assms
+ apply(induct s1 arbitrary: r s2 v rule: rev_induct)
+ apply(simp)
+ using L1 apply blast
+ apply(simp add: ders_append)
+ apply(drule_tac x="r" in meta_spec)
+ apply(drule_tac x="x # s2" in meta_spec)
+ apply(drule_tac x="injval (ders xs r) x v" in meta_spec)
+ apply(drule meta_mp)
+ defer
+ apply(simp)
+ apply(simp add: flex_append)
+ by (simp add: Posix_injval)
+
+
+
+lemma bders_snoc:
+ "bder c (bders a s) = bders a (s @ [c])"
+ apply(simp add: bders_append)
+ done
+
+
+lemma QQ1:
+ shows "bsimp (bders (bsimp a) []) = bders_simp (bsimp a) []"
+ apply(simp)
+ apply(simp add: bsimp_idem)
+ done
+
+lemma QQ2:
+ shows "bsimp (bders (bsimp a) [c]) = bders_simp (bsimp a) [c]"
+ apply(simp)
+ done
+
+lemma XXX2a_long:
+ assumes "good a"
+ shows "bsimp (bder c (bsimp a)) = bsimp (bder c a)"
+ using assms
+ apply(induct a arbitrary: c taking: asize rule: measure_induct)
+ apply(case_tac x)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 3
+ apply(simp)
+ apply(simp)
+ apply(auto)[1]
+apply(case_tac "x42 = AZERO")
+ apply(simp)
+ apply(case_tac "x43 = AZERO")
+ apply(simp)
+ using test2 apply force
+ apply(case_tac "\<exists>bs. x42 = AONE bs")
+ apply(clarify)
+ apply(simp)
+ apply(subst bsimp_ASEQ1)
+ apply(simp)
+ using b3 apply force
+ using bsimp_ASEQ0 test2 apply force
+ thm good_SEQ test2
+ apply (simp add: good_SEQ test2)
+ apply (simp add: good_SEQ test2)
+ apply(case_tac "x42 = AZERO")
+ apply(simp)
+ apply(case_tac "x43 = AZERO")
+ apply(simp)
+ apply (simp add: bsimp_ASEQ0)
+ apply(case_tac "\<exists>bs. x42 = AONE bs")
+ apply(clarify)
+ apply(simp)
+ apply(subst bsimp_ASEQ1)
+ apply(simp)
+ using bsimp_ASEQ0 test2 apply force
+ apply (simp add: good_SEQ test2)
+ apply (simp add: good_SEQ test2)
+ apply (simp add: good_SEQ test2)
+ (* AALTs case *)
+ apply(simp)
+ using test2 by fastforce
+
+lemma XXX2a_long_without_good:
+ assumes "a = AALTs bs0 [AALTs bs1 [AALTs bs2 [ASTAR [] (AONE bs7), AONE bs6, ASEQ bs3 (ACHAR bs4 d) (AONE bs5)]]]"
+ shows "bsimp (bder c (bsimp a)) = bsimp (bder c a)"
+ "bsimp (bder c (bsimp a)) = XXX"
+ "bsimp (bder c a) = YYY"
+ using assms
+ apply(simp)
+ using assms
+ apply(simp)
+ prefer 2
+ using assms
+ apply(simp)
+ oops
+
+lemma bder_bsimp_AALTs:
+ shows "bder c (bsimp_AALTs bs rs) = bsimp_AALTs bs (map (bder c) rs)"
+ apply(induct bs rs rule: bsimp_AALTs.induct)
+ apply(simp)
+ apply(simp)
+ apply (simp add: bder_fuse)
+ apply(simp)
+ done
+
+lemma flts_nothing:
+ assumes "\<forall>r \<in> set rs. r \<noteq> AZERO" "\<forall>r \<in> set rs. nonalt r"
+ shows "flts rs = rs"
+ using assms
+ apply(induct rs rule: flts.induct)
+ apply(auto)
+ done
+
+lemma flts_flts:
+ assumes "\<forall>r \<in> set rs. good r"
+ shows "flts (flts rs) = flts rs"
+ using assms
+ apply(induct rs taking: "\<lambda>rs. sum_list (map asize rs)" rule: measure_induct)
+ apply(case_tac x)
+ apply(simp)
+ apply(simp)
+ apply(case_tac a)
+ apply(simp_all add: bder_fuse flts_append)
+ apply(subgoal_tac "\<forall>r \<in> set x52. r \<noteq> AZERO")
+ prefer 2
+ apply (metis Nil_is_append_conv bsimp_AALTs.elims good.simps(1) good.simps(5) good0 list.distinct(1) n0 nn1b split_list_last test2)
+ apply(subgoal_tac "\<forall>r \<in> set x52. nonalt r")
+ prefer 2
+ apply (metis n0 nn1b test2)
+ by (metis flts_fuse flts_nothing)
+
+
+lemma PP:
+ assumes "bnullable (bders r s)"
+ shows "bmkeps (bders (bsimp r) s) = bmkeps (bders r s)"
+ using assms
+ apply(induct s arbitrary: r)
+ apply(simp)
+ using bmkeps_simp apply auto[1]
+ apply(simp add: bders_append bders_simp_append)
+ oops
+
+lemma PP:
+ assumes "bnullable (bders r s)"
+ shows "bmkeps (bders_simp (bsimp r) s) = bmkeps (bders r s)"
+ using assms
+ apply(induct s arbitrary: r rule: rev_induct)
+ apply(simp)
+ using bmkeps_simp apply auto[1]
+ apply(simp add: bders_append bders_simp_append)
+ apply(drule_tac x="bder a (bsimp r)" in meta_spec)
+ apply(drule_tac meta_mp)
+ defer
+ oops
+
+
+lemma
+ assumes "asize (bsimp a) = asize a" "a = AALTs bs [AALTs bs2 [], AZERO, AONE bs3]"
+ shows "bsimp a = a"
+ using assms
+ apply(simp)
+ oops
+
+
+lemma iii:
+ assumes "bsimp_AALTs bs rs \<noteq> AZERO"
+ shows "rs \<noteq> []"
+ using assms
+ apply(induct bs rs rule: bsimp_AALTs.induct)
+ apply(auto)
+ done
+
+lemma CT1_SEQ:
+ shows "bsimp (ASEQ bs a1 a2) = bsimp (ASEQ bs (bsimp a1) (bsimp a2))"
+ apply(simp add: bsimp_idem)
+ done
+
+lemma CT1:
+ shows "bsimp (AALTs bs as) = bsimp (AALTs bs (map bsimp as))"
+ apply(induct as arbitrary: bs)
+ apply(simp)
+ apply(simp)
+ by (simp add: bsimp_idem comp_def)
+
+lemma CT1a:
+ shows "bsimp (AALT bs a1 a2) = bsimp(AALT bs (bsimp a1) (bsimp a2))"
+ by (metis CT1 list.simps(8) list.simps(9))
+
+lemma WWW2:
+ shows "bsimp (bsimp_AALTs bs1 (flts (map bsimp as1))) =
+ bsimp_AALTs bs1 (flts (map bsimp as1))"
+ by (metis bsimp.simps(2) bsimp_idem)
+
+lemma CT1b:
+ shows "bsimp (bsimp_AALTs bs as) = bsimp (bsimp_AALTs bs (map bsimp as))"
+ apply(induct bs as rule: bsimp_AALTs.induct)
+ apply(auto simp add: bsimp_idem)
+ apply (simp add: bsimp_fuse bsimp_idem)
+ by (metis bsimp_idem comp_apply)
+
+
+
+
+(* CT *)
+
+lemma CTU:
+ shows "bsimp_AALTs bs as = li bs as"
+ apply(induct bs as rule: li.induct)
+ apply(auto)
+ done
+
+find_theorems "bder _ (bsimp_AALTs _ _)"
+
+lemma CTa:
+ assumes "\<forall>r \<in> set as. nonalt r \<and> r \<noteq> AZERO"
+ shows "flts as = as"
+ using assms
+ apply(induct as)
+ apply(simp)
+ apply(case_tac as)
+ apply(simp)
+ apply (simp add: k0b)
+ using flts_nothing by auto
+
+lemma CT0:
+ assumes "\<forall>r \<in> set as1. nonalt r \<and> r \<noteq> AZERO"
+ shows "flts [bsimp_AALTs bs1 as1] = flts (map (fuse bs1) as1)"
+ using assms CTa
+ apply(induct as1 arbitrary: bs1)
+ apply(simp)
+ apply(simp)
+ apply(case_tac as1)
+ apply(simp)
+ apply(simp)
+proof -
+fix a :: arexp and as1a :: "arexp list" and bs1a :: "bit list" and aa :: arexp and list :: "arexp list"
+ assume a1: "nonalt a \<and> a \<noteq> AZERO \<and> nonalt aa \<and> aa \<noteq> AZERO \<and> (\<forall>r\<in>set list. nonalt r \<and> r \<noteq> AZERO)"
+ assume a2: "\<And>as. \<forall>r\<in>set as. nonalt r \<and> r \<noteq> AZERO \<Longrightarrow> flts as = as"
+ assume a3: "as1a = aa # list"
+ have "flts [a] = [a]"
+using a1 k0b by blast
+then show "fuse bs1a a # fuse bs1a aa # map (fuse bs1a) list = flts (fuse bs1a a # fuse bs1a aa # map (fuse bs1a) list)"
+ using a3 a2 a1 by (metis (no_types) append.left_neutral append_Cons flts_fuse k00 k0b list.simps(9))
+qed
+
+
+lemma CT01:
+ assumes "\<forall>r \<in> set as1. nonalt r \<and> r \<noteq> AZERO" "\<forall>r \<in> set as2. nonalt r \<and> r \<noteq> AZERO"
+ shows "flts [bsimp_AALTs bs1 as1, bsimp_AALTs bs2 as2] = flts ((map (fuse bs1) as1) @ (map (fuse bs2) as2))"
+ using assms CT0
+ by (metis k0 k00)
+
+
+
+lemma CT_exp:
+ assumes "\<forall>a \<in> set as. bsimp (bder c (bsimp a)) = bsimp (bder c a)"
+ shows "map bsimp (map (bder c) as) = map bsimp (map (bder c) (map bsimp as))"
+ using assms
+ apply(induct as)
+ apply(auto)
+ done
+
+lemma asize_set:
+ assumes "a \<in> set as"
+ shows "asize a < Suc (sum_list (map asize as))"
+ using assms
+ apply(induct as arbitrary: a)
+ apply(auto)
+ using le_add2 le_less_trans not_less_eq by blast
+
+
+lemma XXX2a_long_without_good:
+ shows "bsimp (bder c (bsimp a)) = bsimp (bder c a)"
+ apply(induct a arbitrary: c taking: "\<lambda>a. asize a" rule: measure_induct)
+ apply(case_tac x)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 3
+ apply(simp)
+ (* AALT case *)
+ prefer 2
+ apply(simp del: bsimp.simps)
+ apply(subst (2) CT1)
+ apply(subst CT_exp)
+ apply(auto)[1]
+ using asize_set apply blast
+ apply(subst CT1[symmetric])
+ apply(simp)
+ oops
+
+lemma YY:
+ assumes "flts (map bsimp as1) = xs"
+ shows "flts (map bsimp (map (fuse bs1) as1)) = map (fuse bs1) xs"
+ using assms
+ apply(induct as1 arbitrary: bs1 xs)
+ apply(simp)
+ apply(auto)
+ by (metis bsimp_fuse flts_fuse k0 list.simps(9))
+
+
+lemma flts_nonalt:
+ assumes "flts (map bsimp xs) = ys"
+ shows "\<forall>y \<in> set ys. nonalt y"
+ using assms
+ apply(induct xs arbitrary: ys)
+ apply(auto)
+ apply(case_tac xs)
+ apply(auto)
+ using flts2 good1 apply fastforce
+ by (smt ex_map_conv list.simps(9) nn1b nn1c)
+
+
+lemma WWW3:
+ shows "flts [bsimp_AALTs bs1 (flts (map bsimp as1))] =
+ flts (map bsimp (map (fuse bs1) as1))"
+ by (metis CT0 YY flts_nonalt flts_nothing qqq1)
+
+lemma WWW4:
+ shows "map (bder c \<circ> fuse bs1) as1 = map (fuse bs1) (map (bder c) as1)"
+ apply(induct as1)
+ apply(auto)
+ using bder_fuse by blast
+
+lemma WWW5:
+ shows "map (bsimp \<circ> bder c) as1 = map bsimp (map (bder c) as1)"
+ apply(induct as1)
+ apply(auto)
+ done
+
+lemma WWW6:
+ shows "bsimp (bder c (bsimp_AALTs x51 (flts [bsimp a1, bsimp a2]) ) ) =
+ bsimp(bsimp_AALTs x51 (map (bder c) (flts [bsimp a1, bsimp a2]))) "
+ using bder_bsimp_AALTs by auto
+
+lemma WWW7:
+ shows "bsimp (bsimp_AALTs x51 (map (bder c) (flts [bsimp a1, bsimp a2]))) =
+ bsimp(bsimp_AALTs x51 (flts (map (bder c) [bsimp a1, bsimp a2])))"
+ sorry
+
+
+lemma stupid:
+ assumes "a = b"
+ shows "bsimp(a) = bsimp(b)"
+ using assms
+ apply(auto)
+ done
+(*
+proving idea:
+bsimp_AALTs x51 (map (bder c) (flts [a1, a2])) = bsimp_AALTs x51 (map (bder c) (flts [a1]++[a2]))
+= bsimp_AALTs x51 (map (bder c) ((flts [a1])++(flts [a2]))) =
+bsimp_AALTs x51 (map (bder c) (flts [a1]))++(map (bder c) (flts [a2])) = A
+and then want to prove that
+map (bder c) (flts [a]) = flts [bder c a] under the condition
+that a is either a seq with the first elem being not nullable, or a character equal to c,
+or an AALTs, or a star
+Then, A = bsimp_AALTs x51 (flts [bder c a]) ++ (map (bder c) (flts [a2])) = A1
+Using the same condition for a2, we get
+A1 = bsimp_AALTs x51 (flts [bder c a1]) ++ (flts [bder c a2])
+=bsimp_AALTs x51 flts ([bder c a1] ++ [bder c a2])
+=bsimp_AALTs x51 flts ([bder c a1, bder c a2])
+ *)
+lemma manipulate_flts:
+ shows "bsimp_AALTs x51 (map (bder c) (flts [a1, a2])) =
+bsimp_AALTs x51 ((map (bder c) (flts [a1])) @ (map (bder c) (flts [a2])))"
+ by (metis k0 map_append)
+
+lemma go_inside_flts:
+ assumes " (bder c a1 \<noteq> AZERO) "
+ "\<not>(\<exists> a01 a02 x02. ( (a1 = ASEQ x02 a01 a02) \<and> bnullable(a01) ) )"
+shows "map (bder c) (flts [a1]) = flts [bder c a1]"
+ using assms
+ apply -
+ apply(case_tac a1)
+ apply(simp)
+ apply(simp)
+ apply(case_tac "x32 = c")
+ prefer 2
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply (simp add: WWW4)
+ apply(simp add: bder_fuse)
+ done
+
+lemma medium010:
+ assumes " (bder c a1 = AZERO) "
+ shows "map (bder c) (flts [a1]) = [AZERO] \<or> map (bder c) (flts [a1]) = []"
+ using assms
+ apply -
+ apply(case_tac a1)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ done
+
+lemma medium011:
+ assumes " (bder c a1 = AZERO) "
+ shows "flts (map (bder c) [a1, a2]) = flts [bder c a2]"
+ using assms
+ apply -
+ apply(simp)
+ done
+
+lemma medium01central:
+ shows "bsimp(bsimp_AALTs x51 (map (bder c) (flts [a2])) ) = bsimp(bsimp_AALTs x51 (flts [bder c a2]))"
+ sorry
+
+
+lemma plus_bsimp:
+ assumes "bsimp( bsimp a) = bsimp (bsimp b)"
+ shows "bsimp a = bsimp b"
+ using assms
+ apply -
+ by (simp add: bsimp_idem)
+lemma patience_good5:
+ assumes "bsimp r = AALTs x y"
+ shows " \<exists> a aa list. y = a#aa#list"
+ by (metis Nil_is_map_conv arexp.simps(13) assms bsimp_AALTs.elims flts1 good.simps(5) good1 k0a)
+
+(*SAD*)
+(*this does not hold actually
+lemma bsimp_equiv0:
+ shows "bsimp(bsimp r) = bsimp(bsimp (AALTs [] [r]))"
+ apply(simp)
+ apply(case_tac "bsimp r")
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ thm good1
+ using good1
+ apply -
+ apply(drule_tac x="r" in meta_spec)
+ apply(erule disjE)
+
+ apply(simp only: bsimp_AALTs.simps)
+ apply(simp only:flts.simps)
+ apply(drule patience_good5)
+ apply(clarify)
+ apply(subst bsimp_AALTs_qq)
+ apply simp
+ prefer 2
+ sorry*)
+
+(*exercise: try multiple ways of proving this*)
+(*this lemma does not hold.........
+lemma bsimp_equiv1:
+ shows "bsimp r = bsimp (AALTs [] [r])"
+ using plus_bsimp
+ apply -
+ using bsimp_equiv0 by blast
+ (*apply(simp)
+ apply(case_tac "bsimp r")
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+(*use lemma good1*)
+ thm good1
+ using good1
+ apply -
+ apply(drule_tac x="r" in meta_spec)
+ apply(erule disjE)
+
+ apply(subst flts_single1)
+ apply(simp only: bsimp_AALTs.simps)
+ prefer 2
+
+ thm flts_single1
+
+ find_theorems "flts _ = _"*)
+*)
+lemma bsimp_equiv2:
+ shows "bsimp (AALTs x51 [r]) = bsimp (AALT x51 AZERO r)"
+ sorry
+
+lemma medium_stupid_isabelle:
+ assumes "rs = a # list"
+ shows "bsimp_AALTs x51 (AZERO # rs) = AALTs x51 (AZERO#rs)"
+ using assms
+ apply -
+ apply(simp)
+ done
+(*
+lemma mediumlittle:
+ shows "bsimp(bsimp_AALTs x51 rs) = bsimp(bsimp_AALTs x51 (AZERO # rs))"
+ apply(case_tac rs)
+ apply(simp)
+ apply(case_tac list)
+ apply(subst medium_stupid_isabelle)
+ apply(simp)
+ prefer 2
+ apply simp
+ apply(rule_tac s="a#list" and t="rs" in subst)
+ apply(simp)
+ apply(rule_tac t="list" and s= "[]" in subst)
+ apply(simp)
+ (*dunno what is the rule for x#nil = x*)
+ apply(case_tac a)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 3
+ apply simp
+ apply(simp only:bsimp_AALTs.simps)
+
+ apply simp
+ apply(case_tac "bsimp x42")
+ apply(simp)
+ apply simp
+ apply(case_tac "bsimp x43")
+ apply simp
+ apply simp
+ apply simp
+ apply simp
+ apply(simp only:bsimp_ASEQ.simps)
+ using good1
+ apply -
+ apply(drule_tac x="x43" in meta_spec)
+ apply(erule disjE)
+ apply(subst bsimp_AALTs_qq)
+ using patience_good5 apply force
+ apply(simp only:bsimp_AALTs.simps)
+ apply(simp only:fuse.simps)
+ apply(simp only:flts.simps)
+(*OK from here you actually realize this lemma doesnt hold*)
+ apply(simp)
+ apply(simp)
+ apply(rule_tac t="rs" and s="a#list" in subst)
+ apply(simp)
+ apply(rule_tac t="list" and s="[]" in subst)
+ apply(simp)
+ (*apply(simp only:bsimp_AALTs.simps)*)
+ (*apply(simp only:fuse.simps)*)
+ sorry
+*)
+lemma singleton_list_map:
+ shows"map f [a] = [f a]"
+ apply simp
+ done
+lemma map_application2:
+ shows"map f [a,b] = [f a, f b]"
+ apply simp
+ done
+(*SAD*)
+(* bsimp (bder c (bsimp_AALTs x51 (flts [bsimp a1, bsimp a2]))) =
+ bsimp (AALT x51 (bder c (bsimp a1)) (bder c (bsimp a2)))*)
+(*This equality does not hold*)
+lemma medium01:
+ assumes " (bder c a1 = AZERO) "
+ shows "bsimp(bsimp_AALTs x51 (map (bder c) (flts [ a1, a2]))) =
+ bsimp(bsimp_AALTs x51 (flts (map (bder c) [ a1, a2])))"
+ apply(subst manipulate_flts)
+ using assms
+ apply -
+ apply(subst medium011)
+ apply(simp)
+ apply(case_tac "map (bder c) (flts [a1]) = []")
+ apply(simp)
+ using medium01central apply blast
+apply(frule medium010)
+ apply(erule disjE)
+ prefer 2
+ apply(simp)
+ apply(simp)
+ apply(case_tac a2)
+ apply simp
+ apply simp
+ apply simp
+ apply(simp only:flts.simps)
+(*HOW do i say here to replace ASEQ ..... back into a2*)
+(*how do i say here to use the definition of map function
+without lemma, of course*)
+(*how do i say here that AZERO#map (bder c) [ASEQ x41 x42 x43]'s list.len >1
+without a lemma, of course*)
+ apply(subst singleton_list_map)
+ apply(simp only: bsimp_AALTs.simps)
+ apply(case_tac "bder c (ASEQ x41 x42 x43)")
+ apply simp
+ apply simp
+ apply simp
+ prefer 3
+ apply simp
+ apply(rule_tac t="bder c (ASEQ x41 x42 x43)"
+and s="ASEQ x41a x42a x43a" in subst)
+ apply simp
+ apply(simp only: flts.simps)
+ apply(simp only: bsimp_AALTs.simps)
+ apply(simp only: fuse.simps)
+ apply(subst (2) bsimp_idem[symmetric])
+ apply(subst (1) bsimp_idem[symmetric])
+ apply(simp only:bsimp.simps)
+ apply(subst map_application2)
+ apply(simp only: bsimp.simps)
+ apply(simp only:flts.simps)
+(*want to happily change between a2 and ASEQ x41 42 43, and eliminate now
+redundant conditions such as map (bder c) (flts [a1]) = [AZERO] *)
+ apply(case_tac "bsimp x42a")
+ apply(simp)
+ apply(case_tac "bsimp x43a")
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 2
+ apply(simp)
+ apply(rule_tac t="bsimp x43a"
+and s="AALTs x51a x52" in subst)
+ apply simp
+ apply(simp only:bsimp_ASEQ.simps)
+ apply(simp only:fuse.simps)
+ apply(simp only:flts.simps)
+
+ using medium01central mediumlittle by auto
+
+
+
+lemma medium1:
+ assumes " (bder c a1 \<noteq> AZERO) "
+ "\<not>(\<exists> a01 a02 x02. ( (a1 = ASEQ x02 a01 a02) \<and> bnullable(a01) ) )"
+" (bder c a2 \<noteq> AZERO)"
+ "\<not>(\<exists> a11 a12 x12. ( (a2 = ASEQ x12 a11 a12) \<and> bnullable(a11) ) )"
+ shows "bsimp_AALTs x51 (map (bder c) (flts [ a1, a2])) =
+ bsimp_AALTs x51 (flts (map (bder c) [ a1, a2]))"
+ using assms
+ apply -
+ apply(subst manipulate_flts)
+ apply(case_tac "a1")
+ apply(simp)
+ apply(simp)
+ apply(case_tac "x32 = c")
+ prefer 2
+ apply(simp)
+ prefer 2
+ apply(case_tac "bnullable x42")
+ apply(simp)
+ apply(simp)
+
+ apply(case_tac "a2")
+ apply(simp)
+ apply(simp)
+ apply(case_tac "x32 = c")
+ prefer 2
+ apply(simp)
+ apply(simp)
+ apply(case_tac "bnullable x42a")
+ apply(simp)
+ apply(subst go_inside_flts)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply (simp add: WWW4)
+ apply(simp)
+ apply (simp add: WWW4)
+ apply (simp add: go_inside_flts)
+ apply (metis (no_types, lifting) go_inside_flts k0 list.simps(8) list.simps(9))
+ by (smt bder.simps(6) flts.simps(1) flts.simps(6) flts.simps(7) go_inside_flts k0 list.inject list.simps(9))
+
+lemma big0:
+ shows "bsimp (AALT x51 (AALTs bs1 as1) (AALTs bs2 as2)) =
+ bsimp (AALTs x51 ((map (fuse bs1) as1) @ (map (fuse bs2) as2)))"
+ by (smt WWW3 bsimp.simps(2) k0 k00 list.simps(8) list.simps(9) map_append)
+
+lemma bignA:
+ shows "bsimp (AALTs x51 (AALTs bs1 as1 # as2)) =
+ bsimp (AALTs x51 ((map (fuse bs1) as1) @ as2))"
+ apply(simp)
+ apply(subst k0)
+ apply(subst WWW3)
+ apply(simp add: flts_append)
+ done
+
+lemma XXX2a_long_without_good:
+ shows "bsimp (bder c (bsimp a)) = bsimp (bder c a)"
+ apply(induct a arbitrary: c taking: "\<lambda>a. asize a" rule: measure_induct)
+ apply(case_tac x)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 3
+ apply(simp)
+ (* SEQ case *)
+ apply(simp only:)
+ apply(subst CT1_SEQ)
+ apply(simp only: bsimp.simps)
+
+ (* AALT case *)
+ prefer 2
+ apply(simp only:)
+ apply(case_tac "\<exists>a1 a2. x52 = [a1, a2]")
+ apply(clarify)
+ apply(simp del: bsimp.simps)
+ apply(subst (2) CT1)
+ apply(simp del: bsimp.simps)
+ apply(rule_tac t="bsimp (bder c a1)" and s="bsimp (bder c (bsimp a1))" in subst)
+ apply(simp del: bsimp.simps)
+ apply(rule_tac t="bsimp (bder c a2)" and s="bsimp (bder c (bsimp a2))" in subst)
+ apply(simp del: bsimp.simps)
+ apply(subst CT1a[symmetric])
+ (* \<rightarrow> *)
+ apply(rule_tac t="AALT x51 (bder c (bsimp a1)) (bder c (bsimp a2))"
+ and s="bder c (AALT x51 (bsimp a1) (bsimp a2))" in subst)
+ apply(simp)
+ apply(subst bsimp.simps)
+ apply(simp del: bsimp.simps bder.simps)
+
+ apply(subst bder_bsimp_AALTs)
+ apply(subst bsimp.simps)
+ apply(subst WWW2[symmetric])
+ apply(subst bsimp_AALTs_qq)
+ defer
+ apply(subst bsimp.simps)
+
+ (* <- *)
+ apply(subst bsimp.simps)
+ apply(simp del: bsimp.simps)
+(*bsimp_AALTs x51 (map (bder c) (flts [a1, a2])) =
+ bsimp_AALTs x51 (flts (map (bder c) [a1, a2]))*)
+ apply(case_tac "\<exists>bs1 as1. bsimp a1 = AALTs bs1 as1")
+ apply(case_tac "\<exists>bs2 as2. bsimp a2 = AALTs bs2 as2")
+ apply(clarify)
+ apply(simp only:)
+ apply(simp del: bsimp.simps bder.simps)
+ apply(subst bsimp_AALTs_qq)
+ prefer 2
+ apply(simp del: bsimp.simps)
+ apply(subst big0)
+ apply(simp add: WWW4)
+ apply (m etis One_nat_def Suc_eq_plus1 Suc_lessI arexp.distinct(7) bsimp.simps(2) bsimp_AALTs.simps(1) bsimp_idem flts.simps(1) length_append length_greater_0_conv length_map not_add_less2 not_less_eq)
+ oops
+
+lemma XXX2a_long_without_good:
+ shows "bsimp (bder c (bsimp a)) = bsimp (bder c a)"
+ apply(induct a arbitrary: c taking: "\<lambda>a. asize a" rule: measure_induct)
+ apply(case_tac x)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 3
+ apply(simp)
+ (* AALT case *)
+ prefer 2
+ apply(subgoal_tac "nonnested (bsimp x)")
+ prefer 2
+ using nn1b apply blast
+ apply(simp only:)
+ apply(drule_tac x="AALTs x51 (flts x52)" in spec)
+ apply(drule mp)
+ defer
+ apply(drule_tac x="c" in spec)
+ apply(simp)
+ apply(rotate_tac 2)
+
+ apply(drule sym)
+ apply(simp)
+
+ apply(simp only: bder.simps)
+ apply(simp only: bsimp.simps)
+ apply(subst bder_bsimp_AALTs)
+ apply(case_tac x52)
+ apply(simp)
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ apply(case_tac a)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ defer
+ apply(simp)
+
+
+ (* case AALTs list is not empty *)
+ apply(simp)
+ apply(subst k0)
+ apply(subst (2) k0)
+ apply(simp)
+ apply(case_tac "bsimp a = AZERO")
+ apply(subgoal_tac "bsimp (bder c a) = AZERO")
+ prefer 2
+ using less_iff_Suc_add apply auto[1]
+ apply(simp)
+ apply(drule_tac x="AALTs x51 list" in spec)
+ apply(drule mp)
+ apply(simp add: asize0)
+ apply(drule_tac x="c" in spec)
+ apply(simp add: bder_bsimp_AALTs)
+ apply(case_tac "nonalt (bsimp a)")
+ prefer 2
+ apply(drule_tac x="bsimp (AALTs x51 (a#list))" in spec)
+ apply(drule mp)
+ apply(rule order_class.order.strict_trans2)
+ apply(rule bsimp_AALTs_size3)
+ apply(auto)[1]
+ apply(simp)
+ apply(subst (asm) bsimp_idem)
+ apply(drule_tac x="c" in spec)
+ apply(simp)
+ find_theorems "_ < _ \<Longrightarrow> _ \<le> _ \<Longrightarrow>_ < _"
+ apply(rule le_trans)
+ apply(subgoal_tac "flts [bsimp a] = [bsimp a]")
+ prefer 2
+ using k0b apply blast
+ apply(simp)
+ find_theorems "asize _ < asize _"
+
+ using bder_bsimp_AALTs
+ apply(case_tac list)
+ apply(simp)
+ sledgeha mmer [timeout=6000]
+
+ apply(case_tac "\<exists>r \<in> set (map bsimp x52). \<not>nonalt r")
+ apply(drule_tac x="bsimp (AALTs x51 x52)" in spec)
+ apply(drule mp)
+ using bsimp_AALTs_size3 apply blast
+ apply(drule_tac x="c" in spec)
+ apply(subst (asm) (2) test)
+
+ apply(case_tac x52)
+ apply(simp)
+ apply(simp)
+ apply(case_tac "bsimp a = AZERO")
+ apply(simp)
+ apply(subgoal_tac "bsimp (bder c a) = AZERO")
+ prefer 2
+ apply auto[1]
+ apply (metis L.simps(1) L_bsimp_erase der.simps(1) der_correctness erase.simps(1) erase_bder xxx_bder2)
+ apply(simp)
+ apply(drule_tac x="AALTs x51 list" in spec)
+ apply(drule mp)
+ apply(simp add: asize0)
+ apply(simp)
+ apply(case_tac list)
+ prefer 2
+ apply(simp)
+ apply(case_tac "bsimp aa = AZERO")
+ apply(simp)
+ apply(subgoal_tac "bsimp (bder c aa) = AZERO")
+ prefer 2
+ apply auto[1]
+ apply (metis add.left_commute bder.simps(1) bsimp.simps(3) less_add_Suc1)
+ apply(simp)
+ apply(drule_tac x="AALTs x51 (a#lista)" in spec)
+ apply(drule mp)
+ apply(simp add: asize0)
+ apply(simp)
+ apply (metis flts.simps(2) k0)
+ apply(subst k0)
+ apply(subst (2) k0)
+
+
+ using less_add_Suc1 apply fastforce
+ apply(subst k0)
+
+
+ apply(simp)
+ apply(case_tac "bsimp a = AZERO")
+ apply(simp)
+ apply(subgoal_tac "bsimp (bder c a) = AZERO")
+ prefer 2
+ apply auto[1]
+ apply(simp)
+ apply(case_tac "nonalt (bsimp a)")
+ apply(subst bsimp_AALTs1)
+ apply(simp)
+ using less_add_Suc1 apply fastforce
+
+ apply(subst bsimp_AALTs1)
+
+ using nn11a apply b last
+
+ (* SEQ case *)
+ apply(clarify)
+ apply(subst bsimp.simps)
+ apply(simp del: bsimp.simps)
+ apply(auto simp del: bsimp.simps)[1]
+ apply(subgoal_tac "bsimp x42 \<noteq> AZERO")
+ prefer 2
+ using b3 apply force
+ apply(case_tac "bsimp x43 = AZERO")
+ apply(simp)
+ apply (simp add: bsimp_ASEQ0)
+ apply (metis bder.simps(1) bsimp.simps(3) bsimp_AALTs.simps(1) bsimp_fuse flts.simps(1) flts.simps(2) fuse.simps(1) less_add_Suc2)
+ apply(case_tac "\<exists>bs. bsimp x42 = AONE bs")
+ apply(clarify)
+ apply(simp)
+ apply(subst bsimp_ASEQ2)
+ apply(subgoal_tac "bsimp (bder c x42) = AZERO")
+ prefer 2
+ using less_add_Suc1 apply fastforce
+ apply(simp)
+ apply(frule_tac x="x43" in spec)
+ apply(drule mp)
+ apply(simp)
+ apply(drule_tac x="c" in spec)
+ apply(subst bder_fuse)
+ apply(subst bsimp_fuse[symmetric])
+ apply(simp)
+ apply(subgoal_tac "bmkeps x42 = bs")
+ prefer 2
+ apply (simp add: bmkeps_simp)
+ apply(simp)
+ apply(subst bsimp_fuse[symmetric])
+ apply(case_tac "nonalt (bsimp (bder c x43))")
+ apply(subst bsimp_AALTs1)
+ using nn11a apply blast
+ using fuse_append apply blast
+ apply(subgoal_tac "\<exists>bs rs. bsimp (bder c x43) = AALTs bs rs")
+ prefer 2
+ using bbbbs1 apply blast
+ apply(clarify)
+ apply(simp)
+ apply(case_tac rs)
+ apply(simp)
+ apply (metis arexp.distinct(7) good.simps(4) good1)
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ apply (metis arexp.distinct(7) good.simps(5) good1)
+ apply(simp del: bsimp_AALTs.simps)
+ apply(simp only: bsimp_AALTs.simps)
+ apply(simp)
+
+
+
+
+(* HERE *)
+apply(case_tac "x42 = AZERO")
+ apply(simp)
+ apply(case_tac "bsimp x43 = AZERO")
+ apply(simp)
+ apply (simp add: bsimp_ASEQ0)
+ apply(subgoal_tac "bsimp (fuse (bmkeps x42) (bder c x43)) = AZERO")
+ apply(simp)
+ apply (met is bder.simps(1) bsimp.simps(3) bsimp_fuse fuse.simps(1) less_add_Suc2)
+ apply(case_tac "\<exists>bs. bsimp x42 = AONE bs")
+ apply(clarify)
+ apply(simp)
+ apply(subst bsimp_ASEQ2)
+ apply(subgoal_tac "bsimp (bder c x42) = AZERO")
+ apply(simp)
+ prefer 2
+ using less_add_Suc1 apply fastforce
+ apply(subgoal_tac "bmkeps x42 = bs")
+ prefer 2
+ apply (simp add: bmkeps_simp)
+ apply(simp)
+ apply(case_tac "nonalt (bsimp (bder c x43))")
+ apply (metis bder_fuse bsimp_AALTs.simps(1) bsimp_AALTs.simps(2) bsimp_fuse flts.simps(1) flts.simps(2) fuse.simps(1) fuse_append k0b less_add_Suc2 nn11a)
+ apply(subgoal_tac "nonnested (bsimp (bder c x43))")
+ prefer 2
+ using nn1b apply blast
+ apply(case_tac x43)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 3
+ apply(simp)
+ apply (metis arexp.distinct(25) arexp.distinct(7) arexp.distinct(9) bsimp_ASEQ.simps(1) bsimp_ASEQ.simps(11) bsimp_ASEQ1 nn11a nonalt.elims(3) nonalt.simps(6))
+ apply(simp)
+ apply(auto)[1]
+ apply(case_tac "(bsimp (bder c x42a)) = AZERO")
+ apply(simp)
+
+ apply(simp)
+
+
+
+ apply(subgoal_tac "(\<exists>bs1 rs1. 1 < length rs1 \<and> bsimp (bder c x43) = AALTs bs1 rs1 ) \<or>
+ (\<exists>bs1 r. bsimp (bder c x43) = fuse bs1 r)")
+ prefer 2
+ apply (metis fuse_empty)
+ apply(erule disjE)
+ prefer 2
+ apply(clarify)
+ apply(simp only:)
+ apply(simp)
+ apply(simp add: fuse_append)
+ apply(subst bder_fuse)
+ apply(subst bsimp_fuse[symmetric])
+ apply(subst bder_fuse)
+ apply(subst bsimp_fuse[symmetric])
+ apply(subgoal_tac "bsimp (bder c (bsimp x43)) = bsimp (bder c x43)")
+ prefer 2
+ using less_add_Suc2 apply bl ast
+ apply(simp only: )
+ apply(subst bsimp_fuse[symmetric])
+ apply(simp only: )
+
+ apply(simp only: fuse.simps)
+ apply(simp)
+ apply(case_tac rs1)
+ apply(simp)
+ apply (me tis arexp.distinct(7) fuse.simps(1) good.simps(4) good1 good_fuse)
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ apply (me tis arexp.distinct(7) fuse.simps(1) good.simps(5) good1 good_fuse)
+ apply(simp only: bsimp_AALTs.simps map_cons.simps)
+ apply(auto)[1]
+
+
+
+ apply(subst bsimp_fuse[symmetric])
+ apply(subgoal_tac "bmkeps x42 = bs")
+ prefer 2
+ apply (simp add: bmkeps_simp)
+
+
+ apply(simp)
+
+ using b3 apply force
+ using bsimp_ASEQ0 test2 apply fo rce
+ thm good_SEQ test2
+ apply (simp add: good_SEQ test2)
+ apply (simp add: good_SEQ test2)
+ apply(case_tac "x42 = AZERO")
+ apply(simp)
+ apply(case_tac "x43 = AZERO")
+ apply(simp)
+ apply (simp add: bsimp_ASEQ0)
+ apply(case_tac "\<exists>bs. x42 = AONE bs")
+ apply(clarify)
+ apply(simp)
+ apply(subst bsimp_ASEQ1)
+ apply(simp)
+ using bsimp_ASEQ0 test2 apply fo rce
+ apply (simp add: good_SEQ test2)
+ apply (simp add: good_SEQ test2)
+ apply (simp add: good_SEQ test2)
+ (* AALTs case *)
+ apply(simp)
+ using test2 by fa st force
+
+
+lemma XXX4ab:
+ shows "good (bders_simp (bsimp r) s) \<or> bders_simp (bsimp r) s = AZERO"
+ apply(induct s arbitrary: r rule: rev_induct)
+ apply(simp)
+ apply (simp add: good1)
+ apply(simp add: bders_simp_append)
+ apply (simp add: good1)
+ done
+
+lemma XXX4:
+ assumes "good a"
+ shows "bders_simp a s = bsimp (bders a s)"
+ using assms
+ apply(induct s arbitrary: a rule: rev_induct)
+ apply(simp)
+ apply (simp add: test2)
+ apply(simp add: bders_append bders_simp_append)
+ oops
+
+
+lemma MAINMAIN:
+ "blexer r s = blexer_simp r s"
+ apply(induct s arbitrary: r)
+ apply(simp add: blexer_def blexer_simp_def)
+ apply(simp add: blexer_def blexer_simp_def del: bders.simps bders_simp.simps)
+ apply(auto simp del: bders.simps bders_simp.simps)
+ prefer 2
+ apply (metis b4 bders.simps(2) bders_simp.simps(2))
+ prefer 2
+ apply (metis b4 bders.simps(2))
+ apply(subst bmkeps_simp)
+ apply(simp)
+ apply(case_tac s)
+ apply(simp only: bders.simps)
+ apply(subst bders_simp.simps)
+ apply(simp)
+ oops
+
+
+lemma
+ fixes n :: nat
+ shows "(\<Sum>i \<in> {0..n}. i) = n * (n + 1) div 2"
+ apply(induct n)
+ apply(simp)
+ apply(simp)
+ done
+
+
+
+
+
+end
\ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys2/BitCoded2.thy Sun Oct 10 18:35:21 2021 +0100
@@ -0,0 +1,4062 @@
+
+theory BitCoded2
+ imports "Lexer"
+begin
+
+section \<open>Bit-Encodings\<close>
+
+datatype bit = Z | S
+
+fun
+ code :: "val \<Rightarrow> bit list"
+where
+ "code Void = []"
+| "code (Char c) = []"
+| "code (Left v) = Z # (code v)"
+| "code (Right v) = S # (code v)"
+| "code (Seq v1 v2) = (code v1) @ (code v2)"
+| "code (Stars []) = [S]"
+| "code (Stars (v # vs)) = (Z # code v) @ code (Stars vs)"
+
+
+fun
+ Stars_add :: "val \<Rightarrow> val \<Rightarrow> val"
+where
+ "Stars_add v (Stars vs) = Stars (v # vs)"
+| "Stars_add v _ = Stars [v]"
+
+function
+ decode' :: "bit list \<Rightarrow> rexp \<Rightarrow> (val * bit list)"
+where
+ "decode' ds ZERO = (Void, [])"
+| "decode' ds ONE = (Void, ds)"
+| "decode' ds (CHAR d) = (Char d, ds)"
+| "decode' [] (ALT r1 r2) = (Void, [])"
+| "decode' (Z # ds) (ALT r1 r2) = (let (v, ds') = decode' ds r1 in (Left v, ds'))"
+| "decode' (S # ds) (ALT r1 r2) = (let (v, ds') = decode' ds r2 in (Right v, ds'))"
+| "decode' ds (SEQ r1 r2) = (let (v1, ds') = decode' ds r1 in
+ let (v2, ds'') = decode' ds' r2 in (Seq v1 v2, ds''))"
+| "decode' [] (STAR r) = (Void, [])"
+| "decode' (S # ds) (STAR r) = (Stars [], ds)"
+| "decode' (Z # ds) (STAR r) = (let (v, ds') = decode' ds r in
+ let (vs, ds'') = decode' ds' (STAR r)
+ in (Stars_add v vs, ds''))"
+by pat_completeness auto
+
+lemma decode'_smaller:
+ assumes "decode'_dom (ds, r)"
+ shows "length (snd (decode' ds r)) \<le> length ds"
+using assms
+apply(induct ds r)
+apply(auto simp add: decode'.psimps split: prod.split)
+using dual_order.trans apply blast
+by (meson dual_order.trans le_SucI)
+
+termination "decode'"
+apply(relation "inv_image (measure(%cs. size cs) <*lex*> measure(%s. size s)) (%(ds,r). (r,ds))")
+apply(auto dest!: decode'_smaller)
+by (metis less_Suc_eq_le snd_conv)
+
+definition
+ decode :: "bit list \<Rightarrow> rexp \<Rightarrow> val option"
+where
+ "decode ds r \<equiv> (let (v, ds') = decode' ds r
+ in (if ds' = [] then Some v else None))"
+
+lemma decode'_code_Stars:
+ assumes "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> (\<forall>x. decode' (code v @ x) r = (v, x)) \<and> flat v \<noteq> []"
+ shows "decode' (code (Stars vs) @ ds) (STAR r) = (Stars vs, ds)"
+ using assms
+ apply(induct vs)
+ apply(auto)
+ done
+
+lemma decode'_code:
+ assumes "\<Turnstile> v : r"
+ shows "decode' ((code v) @ ds) r = (v, ds)"
+using assms
+ apply(induct v r arbitrary: ds)
+ apply(auto)
+ using decode'_code_Stars by blast
+
+lemma decode_code:
+ assumes "\<Turnstile> v : r"
+ shows "decode (code v) r = Some v"
+ using assms unfolding decode_def
+ by (smt append_Nil2 decode'_code old.prod.case)
+
+
+section {* Annotated Regular Expressions *}
+
+datatype arexp =
+ AZERO
+| AONE "bit list"
+| ACHAR "bit list" char
+| ASEQ "bit list" arexp arexp
+| AALTs "bit list" "arexp list"
+| ASTAR "bit list" arexp
+
+abbreviation
+ "AALT bs r1 r2 \<equiv> AALTs bs [r1, r2]"
+
+fun asize :: "arexp \<Rightarrow> nat" where
+ "asize AZERO = 1"
+| "asize (AONE cs) = 1"
+| "asize (ACHAR cs c) = 1"
+| "asize (AALTs cs rs) = Suc (sum_list (map asize rs))"
+| "asize (ASEQ cs r1 r2) = Suc (asize r1 + asize r2)"
+| "asize (ASTAR cs r) = Suc (asize r)"
+
+fun
+ erase :: "arexp \<Rightarrow> rexp"
+where
+ "erase AZERO = ZERO"
+| "erase (AONE _) = ONE"
+| "erase (ACHAR _ c) = CHAR c"
+| "erase (AALTs _ []) = ZERO"
+| "erase (AALTs _ [r]) = (erase r)"
+| "erase (AALTs bs (r#rs)) = ALT (erase r) (erase (AALTs bs rs))"
+| "erase (ASEQ _ r1 r2) = SEQ (erase r1) (erase r2)"
+| "erase (ASTAR _ r) = STAR (erase r)"
+
+lemma decode_code_erase:
+ assumes "\<Turnstile> v : (erase a)"
+ shows "decode (code v) (erase a) = Some v"
+ using assms
+ by (simp add: decode_code)
+
+
+fun nonalt :: "arexp \<Rightarrow> bool"
+ where
+ "nonalt (AALTs bs2 rs) = False"
+| "nonalt r = True"
+
+
+fun good :: "arexp \<Rightarrow> bool" where
+ "good AZERO = False"
+| "good (AONE cs) = True"
+| "good (ACHAR cs c) = True"
+| "good (AALTs cs []) = False"
+| "good (AALTs cs [r]) = False"
+| "good (AALTs cs (r1#r2#rs)) = (\<forall>r' \<in> set (r1#r2#rs). good r' \<and> nonalt r')"
+| "good (ASEQ _ AZERO _) = False"
+| "good (ASEQ _ (AONE _) _) = False"
+| "good (ASEQ _ _ AZERO) = False"
+| "good (ASEQ cs r1 r2) = (good r1 \<and> good r2)"
+| "good (ASTAR cs r) = True"
+
+
+
+
+fun fuse :: "bit list \<Rightarrow> arexp \<Rightarrow> arexp" where
+ "fuse bs AZERO = AZERO"
+| "fuse bs (AONE cs) = AONE (bs @ cs)"
+| "fuse bs (ACHAR cs c) = ACHAR (bs @ cs) c"
+| "fuse bs (AALTs cs rs) = AALTs (bs @ cs) rs"
+| "fuse bs (ASEQ cs r1 r2) = ASEQ (bs @ cs) r1 r2"
+| "fuse bs (ASTAR cs r) = ASTAR (bs @ cs) r"
+
+lemma fuse_append:
+ shows "fuse (bs1 @ bs2) r = fuse bs1 (fuse bs2 r)"
+ apply(induct r)
+ apply(auto)
+ done
+
+
+fun intern :: "rexp \<Rightarrow> arexp" where
+ "intern ZERO = AZERO"
+| "intern ONE = AONE []"
+| "intern (CHAR c) = ACHAR [] c"
+| "intern (ALT r1 r2) = AALT [] (fuse [Z] (intern r1))
+ (fuse [S] (intern r2))"
+| "intern (SEQ r1 r2) = ASEQ [] (intern r1) (intern r2)"
+| "intern (STAR r) = ASTAR [S] (intern r)"
+
+
+
+
+fun retrieve :: "arexp \<Rightarrow> val \<Rightarrow> bit list" where
+ "retrieve (AONE bs) Void = bs"
+| "retrieve (ACHAR bs c) (Char d) = bs"
+| "retrieve (AALTs bs [r]) v = bs @ retrieve r v"
+| "retrieve (AALTs bs (r#rs)) (Left v) = bs @ retrieve r v"
+| "retrieve (AALTs bs (r#rs)) (Right v) = bs @ retrieve (AALTs [] rs) v"
+| "retrieve (ASEQ bs r1 r2) (Seq v1 v2) = bs @ retrieve r1 v1 @ retrieve r2 v2"
+| "retrieve (ASTAR bs r) (Stars []) = bs @ [S]"
+| "retrieve (ASTAR bs r) (Stars (v#vs)) =
+ bs @ [Z] @ retrieve r v @ retrieve (ASTAR [] r) (Stars vs)"
+
+
+
+fun
+ bnullable :: "arexp \<Rightarrow> bool"
+where
+ "bnullable (AZERO) = False"
+| "bnullable (AONE bs) = True"
+| "bnullable (ACHAR bs c) = False"
+| "bnullable (AALTs bs rs) = (\<exists>r \<in> set rs. bnullable r)"
+| "bnullable (ASEQ bs r1 r2) = (bnullable r1 \<and> bnullable r2)"
+| "bnullable (ASTAR bs r) = True"
+
+fun
+ bmkeps :: "arexp \<Rightarrow> bit list"
+where
+ "bmkeps(AONE bs) = bs"
+| "bmkeps(ASEQ bs r1 r2) = bs @ (bmkeps r1) @ (bmkeps r2)"
+| "bmkeps(AALTs bs [r]) = bs @ (bmkeps r)"
+| "bmkeps(AALTs bs (r#rs)) = (if bnullable(r) then bs @ (bmkeps r) else (bmkeps (AALTs bs rs)))"
+| "bmkeps(ASTAR bs r) = bs"
+
+
+fun
+ bder :: "char \<Rightarrow> arexp \<Rightarrow> arexp"
+where
+ "bder c (AZERO) = AZERO"
+| "bder c (AONE bs) = AZERO"
+| "bder c (ACHAR bs d) = (if c = d then AONE bs else AZERO)"
+| "bder c (AALTs bs rs) = AALTs bs (map (bder c) rs)"
+| "bder c (ASEQ bs r1 r2) =
+ (if bnullable r1
+ then AALT bs (ASEQ [] (bder c r1) r2) (fuse (bmkeps r1) (bder c r2))
+ else ASEQ bs (bder c r1) r2)"
+| "bder c (ASTAR bs r) = ASEQ (butlast bs) (fuse [Z] (bder c r)) (ASTAR [S] r)"
+
+
+
+lemma bder_fuse:
+ "fuse bs (bder c r) = bder c (fuse bs r)"
+ apply(induct r arbitrary: bs)
+ apply(simp_all)
+ done
+
+
+fun
+ bders :: "arexp \<Rightarrow> string \<Rightarrow> arexp"
+where
+ "bders r [] = r"
+| "bders r (c#s) = bders (bder c r) s"
+
+lemma bders_append:
+ "bders r (s1 @ s2) = bders (bders r s1) s2"
+ apply(induct s1 arbitrary: r s2)
+ apply(simp_all)
+ done
+
+lemma bnullable_correctness:
+ shows "nullable (erase r) = bnullable r"
+ apply(induct r rule: erase.induct)
+ apply(simp_all)
+ done
+
+lemma erase_fuse:
+ shows "erase (fuse bs r) = erase r"
+ apply(induct r rule: erase.induct)
+ apply(simp_all)
+ done
+
+lemma erase_intern [simp]:
+ shows "erase (intern r) = r"
+ apply(induct r)
+ apply(simp_all add: erase_fuse)
+ done
+
+lemma erase_bder [simp]:
+ shows "erase (bder a r) = der a (erase r)"
+ apply(induct r rule: erase.induct)
+ apply(simp_all add: erase_fuse bnullable_correctness)
+ done
+
+lemma erase_bders [simp]:
+ shows "erase (bders r s) = ders s (erase r)"
+ apply(induct s arbitrary: r )
+ apply(simp_all)
+ done
+
+lemma retrieve_encode_STARS:
+ assumes "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> code v = retrieve (intern r) v"
+ shows "code (Stars vs) = retrieve (ASTAR [] (intern r)) (Stars vs)"
+ using assms
+ apply(induct vs)
+ apply(simp_all)
+ done
+
+lemma retrieve_fuse2:
+ assumes "\<Turnstile> v : (erase r)"
+ shows "retrieve (fuse bs r) v = bs @ retrieve r v"
+ using assms
+ apply(induct r arbitrary: v bs)
+ apply(auto elim: Prf_elims)[4]
+ defer
+ using retrieve_encode_STARS
+ apply(auto elim!: Prf_elims)[1]
+ apply(case_tac vs)
+ apply(simp)
+ apply(simp)
+ (* AALTs case *)
+ apply(simp)
+ apply(case_tac x2a)
+ apply(simp)
+ apply(auto elim!: Prf_elims)[1]
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ apply(auto)
+ apply(auto elim!: Prf_elims)[1]
+ done
+
+lemma retrieve_fuse:
+ assumes "\<Turnstile> v : r"
+ shows "retrieve (fuse bs (intern r)) v = bs @ retrieve (intern r) v"
+ using assms
+ by (simp_all add: retrieve_fuse2)
+
+
+lemma r:
+ assumes "bnullable (AALTs bs (a # rs))"
+ shows "bnullable a \<or> (\<not> bnullable a \<and> bnullable (AALTs bs rs))"
+ using assms
+ apply(induct rs)
+ apply(auto)
+ done
+
+lemma r0:
+ assumes "bnullable a"
+ shows "bmkeps (AALTs bs (a # rs)) = bs @ (bmkeps a)"
+ using assms
+ by (metis bmkeps.simps(3) bmkeps.simps(4) list.exhaust)
+
+lemma r1:
+ assumes "\<not> bnullable a" "bnullable (AALTs bs rs)"
+ shows "bmkeps (AALTs bs (a # rs)) = bmkeps (AALTs bs rs)"
+ using assms
+ apply(induct rs)
+ apply(auto)
+ done
+
+lemma r2:
+ assumes "x \<in> set rs" "bnullable x"
+ shows "bnullable (AALTs bs rs)"
+ using assms
+ apply(induct rs)
+ apply(auto)
+ done
+
+lemma r3:
+ assumes "\<not> bnullable r"
+ " \<exists> x \<in> set rs. bnullable x"
+ shows "retrieve (AALTs bs rs) (mkeps (erase (AALTs bs rs))) =
+ retrieve (AALTs bs (r # rs)) (mkeps (erase (AALTs bs (r # rs))))"
+ using assms
+ apply(induct rs arbitrary: r bs)
+ apply(auto)[1]
+ apply(auto)
+ using bnullable_correctness apply blast
+ apply(auto simp add: bnullable_correctness mkeps_nullable retrieve_fuse2)
+ apply(subst retrieve_fuse2[symmetric])
+ apply (smt bnullable.simps(4) bnullable_correctness erase.simps(5) erase.simps(6) insert_iff list.exhaust list.set(2) mkeps.simps(3) mkeps_nullable)
+ apply(simp)
+ apply(case_tac "bnullable a")
+ apply (smt append_Nil2 bnullable.simps(4) bnullable_correctness erase.simps(5) erase.simps(6) fuse.simps(4) insert_iff list.exhaust list.set(2) mkeps.simps(3) mkeps_nullable retrieve_fuse2)
+ apply(drule_tac x="a" in meta_spec)
+ apply(drule_tac x="bs" in meta_spec)
+ apply(drule meta_mp)
+ apply(simp)
+ apply(drule meta_mp)
+ apply(auto)
+ apply(subst retrieve_fuse2[symmetric])
+ apply(case_tac rs)
+ apply(simp)
+ apply(auto)[1]
+ apply (simp add: bnullable_correctness)
+ apply (metis append_Nil2 bnullable_correctness erase_fuse fuse.simps(4) list.set_intros(1) mkeps.simps(3) mkeps_nullable nullable.simps(4) r2)
+ apply (simp add: bnullable_correctness)
+ apply (metis append_Nil2 bnullable_correctness erase.simps(6) erase_fuse fuse.simps(4) list.set_intros(2) mkeps.simps(3) mkeps_nullable r2)
+ apply(simp)
+ done
+
+
+lemma t:
+ assumes "\<forall>r \<in> set rs. nullable (erase r) \<longrightarrow> bmkeps r = retrieve r (mkeps (erase r))"
+ "nullable (erase (AALTs bs rs))"
+ shows " bmkeps (AALTs bs rs) = retrieve (AALTs bs rs) (mkeps (erase (AALTs bs rs)))"
+ using assms
+ apply(induct rs arbitrary: bs)
+ apply(simp)
+ apply(auto simp add: bnullable_correctness)
+ apply(case_tac rs)
+ apply(auto simp add: bnullable_correctness)[2]
+ apply(subst r1)
+ apply(simp)
+ apply(rule r2)
+ apply(assumption)
+ apply(simp)
+ apply(drule_tac x="bs" in meta_spec)
+ apply(drule meta_mp)
+ apply(auto)[1]
+ prefer 2
+ apply(case_tac "bnullable a")
+ apply(subst r0)
+ apply blast
+ apply(subgoal_tac "nullable (erase a)")
+ prefer 2
+ using bnullable_correctness apply blast
+ apply (metis (no_types, lifting) erase.simps(5) erase.simps(6) list.exhaust mkeps.simps(3) retrieve.simps(3) retrieve.simps(4))
+ apply(subst r1)
+ apply(simp)
+ using r2 apply blast
+ apply(drule_tac x="bs" in meta_spec)
+ apply(drule meta_mp)
+ apply(auto)[1]
+ apply(simp)
+ using r3 apply blast
+ apply(auto)
+ using r3 by blast
+
+
+lemma asize0:
+ shows "0 < asize r"
+ apply(induct r)
+ apply(auto)
+ done
+
+lemma asize_fuse:
+ shows "asize (fuse bs r) = asize r"
+ apply(induct r)
+ apply(auto)
+ done
+
+lemma TESTTEST:
+ shows "bder c (intern r) = intern (der c r)"
+ apply(induct r)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 2
+ apply(simp)
+ apply (simp add: bder_fuse[symmetric])
+ prefer 3
+ apply(simp only: intern.simps)
+ apply(simp only: der.simps)
+ apply(simp only: intern.simps)
+ apply(simp only: bder.simps)
+ apply(simp)
+ apply(simp only: intern.simps)
+ prefer 2
+ apply(simp)
+ prefer 2
+ apply(simp)
+ apply(auto)
+
+
+fun nonnested :: "arexp \<Rightarrow> bool"
+ where
+ "nonnested (AALTs bs2 []) = True"
+| "nonnested (AALTs bs2 ((AALTs bs1 rs1) # rs2)) = False"
+| "nonnested (AALTs bs2 (r # rs2)) = nonnested (AALTs bs2 rs2)"
+| "nonnested r = True"
+
+
+
+fun distinctBy :: "'a list \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'b set \<Rightarrow> 'a list"
+ where
+ "distinctBy [] f acc = []"
+| "distinctBy (x#xs) f acc =
+ (if (f x) \<in> acc then distinctBy xs f acc
+ else x # (distinctBy xs f ({f x} \<union> acc)))"
+
+fun flts :: "arexp list \<Rightarrow> arexp list"
+ where
+ "flts [] = []"
+| "flts (AZERO # rs) = flts rs"
+| "flts ((AALTs bs rs1) # rs) = (map (fuse bs) rs1) @ flts rs"
+| "flts (r1 # rs) = r1 # flts rs"
+
+
+fun spill :: "arexp list \<Rightarrow> arexp list"
+ where
+ "spill [] = []"
+| "spill ((AALTs bs rs1) # rs) = (map (fuse bs) rs1) @ spill rs"
+| "spill (r1 # rs) = r1 # spill rs"
+
+lemma spill_Cons:
+ shows "spill (r # rs1) = spill [r] @ spill rs1"
+ apply(induct r arbitrary: rs1)
+ apply(auto)
+ done
+
+lemma spill_append:
+ shows "spill (rs1 @ rs2) = spill rs1 @ spill rs2"
+ apply(induct rs1 arbitrary: rs2)
+ apply(auto)
+ by (metis append.assoc spill_Cons)
+
+fun bsimp_ASEQ :: "bit list \<Rightarrow> arexp \<Rightarrow> arexp \<Rightarrow> arexp"
+ where
+ "bsimp_ASEQ _ AZERO _ = AZERO"
+| "bsimp_ASEQ _ _ AZERO = AZERO"
+| "bsimp_ASEQ bs1 (AONE bs2) r2 = fuse (bs1 @ bs2) r2"
+| "bsimp_ASEQ bs1 r1 r2 = ASEQ bs1 r1 r2"
+
+
+fun bsimp_AALTs :: "bit list \<Rightarrow> arexp list \<Rightarrow> arexp"
+ where
+ "bsimp_AALTs _ [] = AZERO"
+| "bsimp_AALTs bs1 [r] = fuse bs1 r"
+| "bsimp_AALTs bs1 rs = AALTs bs1 rs"
+
+
+fun bsimp :: "arexp \<Rightarrow> arexp"
+ where
+ "bsimp (ASEQ bs1 r1 r2) = bsimp_ASEQ bs1 (bsimp r1) (bsimp r2)"
+| "bsimp (AALTs bs1 rs) = bsimp_AALTs bs1 (flts (map bsimp rs))"
+| "bsimp r = r"
+
+
+inductive contains2 :: "arexp \<Rightarrow> bit list \<Rightarrow> bool" ("_ >>2 _" [51, 50] 50)
+ where
+ "AONE bs >>2 bs"
+| "ACHAR bs c >>2 bs"
+| "\<lbrakk>a1 >>2 bs1; a2 >>2 bs2\<rbrakk> \<Longrightarrow> ASEQ bs a1 a2 >>2 bs @ bs1 @ bs2"
+| "r >>2 bs1 \<Longrightarrow> AALTs bs (r#rs) >>2 bs @ bs1"
+| "AALTs bs rs >>2 bs @ bs1 \<Longrightarrow> AALTs bs (r#rs) >>2 bs @ bs1"
+| "ASTAR bs r >>2 bs @ [S]"
+| "\<lbrakk>r >>2 bs1; ASTAR [] r >>2 bs2\<rbrakk> \<Longrightarrow> ASTAR bs r >>2 bs @ Z # bs1 @ bs2"
+| "r >>2 bs \<Longrightarrow> (bsimp r) >>2 bs"
+
+
+inductive contains :: "arexp \<Rightarrow> bit list \<Rightarrow> bool" ("_ >> _" [51, 50] 50)
+ where
+ "AONE bs >> bs"
+| "ACHAR bs c >> bs"
+| "\<lbrakk>a1 >> bs1; a2 >> bs2\<rbrakk> \<Longrightarrow> ASEQ bs a1 a2 >> bs @ bs1 @ bs2"
+| "r >> bs1 \<Longrightarrow> AALTs bs (r#rs) >> bs @ bs1"
+| "AALTs bs rs >> bs @ bs1 \<Longrightarrow> AALTs bs (r#rs) >> bs @ bs1"
+| "ASTAR bs r >> bs @ [S]"
+| "\<lbrakk>r >> bs1; ASTAR [] r >> bs2\<rbrakk> \<Longrightarrow> ASTAR bs r >> bs @ Z # bs1 @ bs2"
+
+
+
+lemma contains0:
+ assumes "a >> bs"
+ shows "(fuse bs1 a) >> bs1 @ bs"
+ using assms
+ apply(induct arbitrary: bs1)
+ apply(auto intro: contains.intros)
+ apply (metis append.assoc contains.intros(3))
+ apply (metis append.assoc contains.intros(4))
+ apply (metis append.assoc contains.intros(5))
+ apply (metis append.assoc contains.intros(6))
+ apply (metis append_assoc contains.intros(7))
+ done
+
+lemma contains1:
+ assumes "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> intern r >> code v"
+ shows "ASTAR [] (intern r) >> code (Stars vs)"
+ using assms
+ apply(induct vs)
+ apply(simp)
+ using contains.simps apply blast
+ apply(simp)
+ apply(subst (2) append_Nil[symmetric])
+ apply(rule contains.intros)
+ apply(auto)
+ done
+
+
+
+
+
+lemma contains2:
+ assumes "\<Turnstile> v : r"
+ shows "(intern r) >> code v"
+ using assms
+ apply(induct)
+ prefer 4
+ apply(simp)
+ apply(rule contains.intros)
+ prefer 4
+ apply(simp)
+ apply(rule contains.intros)
+ apply(simp)
+ apply(subst (3) append_Nil[symmetric])
+ apply(rule contains.intros)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(subst (9) append_Nil[symmetric])
+ apply(rule contains.intros)
+ apply (metis append_Cons append_self_conv2 contains0)
+ apply(simp)
+ apply(subst (9) append_Nil[symmetric])
+ apply(rule contains.intros)
+ back
+ apply(rule contains.intros)
+ apply(drule_tac ?bs1.0="[S]" in contains0)
+ apply(simp)
+ apply(simp)
+ apply(case_tac vs)
+ apply(simp)
+ apply (metis append_Nil contains.intros(6))
+ using contains1 by blast
+
+lemma qq1:
+ assumes "\<exists>r \<in> set rs. bnullable r"
+ shows "bmkeps (AALTs bs (rs @ rs1)) = bmkeps (AALTs bs rs)"
+ using assms
+ apply(induct rs arbitrary: rs1 bs)
+ apply(simp)
+ apply(simp)
+ by (metis Nil_is_append_conv bmkeps.simps(4) neq_Nil_conv r0 split_list_last)
+
+lemma qq2:
+ assumes "\<forall>r \<in> set rs. \<not> bnullable r" "\<exists>r \<in> set rs1. bnullable r"
+ shows "bmkeps (AALTs bs (rs @ rs1)) = bmkeps (AALTs bs rs1)"
+ using assms
+ apply(induct rs arbitrary: rs1 bs)
+ apply(simp)
+ apply(simp)
+ by (metis append_assoc in_set_conv_decomp r1 r2)
+
+lemma qq2a:
+ assumes "\<not> bnullable r" "\<exists>r \<in> set rs1. bnullable r"
+ shows "bmkeps (AALTs bs (r # rs1)) = bmkeps (AALTs bs rs1)"
+ using assms
+ by (simp add: r1)
+
+lemma qq3:
+ shows "bnullable (AALTs bs rs) = (\<exists>r \<in> set rs. bnullable r)"
+ apply(induct rs arbitrary: bs)
+ apply(simp)
+ apply(simp)
+ done
+
+lemma qq4:
+ assumes "bnullable (AALTs bs rs)"
+ shows "bmkeps (AALTs bs rs) = bs @ bmkeps (AALTs [] rs)"
+ by (metis append_Nil2 assms bmkeps_retrieve bnullable_correctness erase_fuse fuse.simps(4) mkeps_nullable retrieve_fuse2)
+
+
+lemma contains3a:
+ assumes "AALTs bs lst >> bs @ bs1"
+ shows "AALTs bs (a # lst) >> bs @ bs1"
+ using assms
+ apply -
+ by (simp add: contains.intros(5))
+
+
+lemma contains3b:
+ assumes "a >> bs1"
+ shows "AALTs bs (a # lst) >> bs @ bs1"
+ using assms
+ apply -
+ apply(rule contains.intros)
+ apply(simp)
+ done
+
+
+lemma contains3:
+ assumes "\<And>x. \<lbrakk>x \<in> set rs; bnullable x\<rbrakk> \<Longrightarrow> x >> bmkeps x" "x \<in> set rs" "bnullable x"
+ shows "AALTs bs rs >> bmkeps (AALTs bs rs)"
+ using assms
+ apply(induct rs arbitrary: bs x)
+ apply simp
+ by (metis contains.intros(4) contains.intros(5) list.set_intros(1) list.set_intros(2) qq3 qq4 r r0 r1)
+
+lemma cont1:
+ assumes "\<And>v. \<Turnstile> v : erase r \<Longrightarrow> r >> retrieve r v"
+ "\<forall>v\<in>set vs. \<Turnstile> v : erase r \<and> flat v \<noteq> []"
+ shows "ASTAR bs r >> retrieve (ASTAR bs r) (Stars vs)"
+ using assms
+ apply(induct vs arbitrary: bs r)
+ apply(simp)
+ using contains.intros(6) apply auto[1]
+ by (simp add: contains.intros(7))
+
+lemma contains4:
+ assumes "bnullable a"
+ shows "a >> bmkeps a"
+ using assms
+ apply(induct a rule: bnullable.induct)
+ apply(auto intro: contains.intros)
+ using contains3 by blast
+
+lemma contains5:
+ assumes "\<Turnstile> v : r"
+ shows "(intern r) >> retrieve (intern r) v"
+ using contains2[OF assms] retrieve_code[OF assms]
+ by (simp)
+
+
+lemma contains6:
+ assumes "\<Turnstile> v : (erase r)"
+ shows "r >> retrieve r v"
+ using assms
+ apply(induct r arbitrary: v rule: erase.induct)
+ apply(auto)[1]
+ using Prf_elims(1) apply blast
+ using Prf_elims(4) contains.intros(1) apply force
+ using Prf_elims(5) contains.intros(2) apply force
+ apply(auto)[1]
+ using Prf_elims(1) apply blast
+ apply(auto)[1]
+ using contains3b contains3a apply blast
+ prefer 2
+ apply(auto)[1]
+ apply (metis Prf_elims(2) contains.intros(3) retrieve.simps(6))
+ prefer 2
+ apply(auto)[1]
+ apply (metis Prf_elims(6) cont1)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(auto)
+ apply (simp add: contains3b)
+ using retrieve_fuse2 contains3b contains3a
+ apply(subst retrieve_fuse2[symmetric])
+ apply (metis append_Nil2 erase_fuse fuse.simps(4))
+ apply(simp)
+ by (metis append_Nil2 erase_fuse fuse.simps(4))
+
+lemma contains7:
+ assumes "\<Turnstile> v : der c (erase r)"
+ shows "(bder c r) >> retrieve r (injval (erase r) c v)"
+ using bder_retrieve[OF assms(1)] retrieve_code[OF assms(1)]
+ by (metis assms contains6 erase_bder)
+
+
+lemma contains7a:
+ assumes "\<Turnstile> v : der c (erase r)"
+ shows "r >> retrieve r (injval (erase r) c v)"
+ using assms
+ apply -
+ apply(drule Prf_injval)
+ apply(drule contains6)
+ apply(simp)
+ done
+
+lemma contains7b:
+ assumes "\<Turnstile> v : ders s (erase r)"
+ shows "(bders r s) >> retrieve r (flex (erase r) id s v)"
+ using assms
+ apply(induct s arbitrary: r v)
+ apply(simp)
+ apply (simp add: contains6)
+ apply(simp add: bders_append flex_append ders_append)
+ apply(drule_tac x="bder a r" in meta_spec)
+ apply(drule meta_spec)
+ apply(drule meta_mp)
+ apply(simp)
+ apply(simp)
+ apply(subst (asm) bder_retrieve)
+ defer
+ apply (simp add: flex_injval)
+ by (simp add: Prf_flex)
+
+lemma contains7_iff:
+ assumes "\<Turnstile> v : der c (erase r)"
+ shows "(bder c r) >> retrieve r (injval (erase r) c v) \<longleftrightarrow>
+ r >> retrieve r (injval (erase r) c v)"
+ by (simp add: assms contains7 contains7a)
+
+lemma contains8_iff:
+ assumes "\<Turnstile> v : ders s (erase r)"
+ shows "(bders r s) >> retrieve r (flex (erase r) id s v) \<longleftrightarrow>
+ r >> retrieve r (flex (erase r) id s v)"
+ using Prf_flex assms contains6 contains7b by blast
+
+
+
+
+fun
+ bders_simp :: "arexp \<Rightarrow> string \<Rightarrow> arexp"
+where
+ "bders_simp r [] = r"
+| "bders_simp r (c # s) = bders_simp (bsimp (bder c r)) s"
+
+definition blexer_simp where
+ "blexer_simp r s \<equiv> if bnullable (bders_simp (intern r) s) then
+ decode (bmkeps (bders_simp (intern r) s)) r else None"
+
+
+
+
+
+lemma bders_simp_append:
+ shows "bders_simp r (s1 @ s2) = bders_simp (bders_simp r s1) s2"
+ apply(induct s1 arbitrary: r s2)
+ apply(simp)
+ apply(simp)
+ done
+
+lemma bsimp_ASEQ_size:
+ shows "asize (bsimp_ASEQ bs r1 r2) \<le> Suc (asize r1 + asize r2)"
+ apply(induct bs r1 r2 rule: bsimp_ASEQ.induct)
+ apply(auto)
+ done
+
+
+
+lemma flts_size:
+ shows "sum_list (map asize (flts rs)) \<le> sum_list (map asize rs)"
+ apply(induct rs rule: flts.induct)
+ apply(simp_all)
+ by (simp add: asize_fuse comp_def)
+
+
+lemma bsimp_AALTs_size:
+ shows "asize (bsimp_AALTs bs rs) \<le> Suc (sum_list (map asize rs))"
+ apply(induct rs rule: bsimp_AALTs.induct)
+ apply(auto simp add: asize_fuse)
+ done
+
+
+lemma bsimp_size:
+ shows "asize (bsimp r) \<le> asize r"
+ apply(induct r)
+ apply(simp_all)
+ apply (meson Suc_le_mono add_mono_thms_linordered_semiring(1) bsimp_ASEQ_size le_trans)
+ apply(rule le_trans)
+ apply(rule bsimp_AALTs_size)
+ apply(simp)
+ apply(rule le_trans)
+ apply(rule flts_size)
+ by (simp add: sum_list_mono)
+
+lemma bsimp_asize0:
+ shows "(\<Sum>x\<leftarrow>rs. asize (bsimp x)) \<le> sum_list (map asize rs)"
+ apply(induct rs)
+ apply(auto)
+ by (simp add: add_mono bsimp_size)
+
+lemma bsimp_AALTs_size2:
+ assumes "\<forall>r \<in> set rs. nonalt r"
+ shows "asize (bsimp_AALTs bs rs) \<ge> sum_list (map asize rs)"
+ using assms
+ apply(induct rs rule: bsimp_AALTs.induct)
+ apply(simp_all add: asize_fuse)
+ done
+
+
+lemma qq:
+ shows "map (asize \<circ> fuse bs) rs = map asize rs"
+ apply(induct rs)
+ apply(auto simp add: asize_fuse)
+ done
+
+lemma flts_size2:
+ assumes "\<exists>bs rs'. AALTs bs rs' \<in> set rs"
+ shows "sum_list (map asize (flts rs)) < sum_list (map asize rs)"
+ using assms
+ apply(induct rs)
+ apply(auto simp add: qq)
+ apply (simp add: flts_size less_Suc_eq_le)
+ apply(case_tac a)
+ apply(auto simp add: qq)
+ prefer 2
+ apply (simp add: flts_size le_imp_less_Suc)
+ using less_Suc_eq by auto
+
+lemma bsimp_AALTs_size3:
+ assumes "\<exists>r \<in> set (map bsimp rs). \<not>nonalt r"
+ shows "asize (bsimp (AALTs bs rs)) < asize (AALTs bs rs)"
+ using assms flts_size2
+ apply -
+ apply(clarify)
+ apply(simp)
+ apply(drule_tac x="map bsimp rs" in meta_spec)
+ apply(drule meta_mp)
+ apply (metis list.set_map nonalt.elims(3))
+ apply(simp)
+ apply(rule order_class.order.strict_trans1)
+ apply(rule bsimp_AALTs_size)
+ apply(simp)
+ by (smt Suc_leI bsimp_asize0 comp_def le_imp_less_Suc le_trans map_eq_conv not_less_eq)
+
+
+
+
+lemma L_bsimp_ASEQ:
+ "L (SEQ (erase r1) (erase r2)) = L (erase (bsimp_ASEQ bs r1 r2))"
+ apply(induct bs r1 r2 rule: bsimp_ASEQ.induct)
+ apply(simp_all)
+ by (metis erase_fuse fuse.simps(4))
+
+lemma L_bsimp_AALTs:
+ "L (erase (AALTs bs rs)) = L (erase (bsimp_AALTs bs rs))"
+ apply(induct bs rs rule: bsimp_AALTs.induct)
+ apply(simp_all add: erase_fuse)
+ done
+
+lemma L_erase_AALTs:
+ shows "L (erase (AALTs bs rs)) = \<Union> (L ` erase ` (set rs))"
+ apply(induct rs)
+ apply(simp)
+ apply(simp)
+ apply(case_tac rs)
+ apply(simp)
+ apply(simp)
+ done
+
+lemma L_erase_flts:
+ shows "\<Union> (L ` erase ` (set (flts rs))) = \<Union> (L ` erase ` (set rs))"
+ apply(induct rs rule: flts.induct)
+ apply(simp_all)
+ apply(auto)
+ using L_erase_AALTs erase_fuse apply auto[1]
+ by (simp add: L_erase_AALTs erase_fuse)
+
+
+lemma L_bsimp_erase:
+ shows "L (erase r) = L (erase (bsimp r))"
+ apply(induct r)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(auto simp add: Sequ_def)[1]
+ apply(subst L_bsimp_ASEQ[symmetric])
+ apply(auto simp add: Sequ_def)[1]
+ apply(subst (asm) L_bsimp_ASEQ[symmetric])
+ apply(auto simp add: Sequ_def)[1]
+ apply(simp)
+ apply(subst L_bsimp_AALTs[symmetric])
+ defer
+ apply(simp)
+ apply(subst (2)L_erase_AALTs)
+ apply(subst L_erase_flts)
+ apply(auto)
+ apply (simp add: L_erase_AALTs)
+ using L_erase_AALTs by blast
+
+lemma bsimp_ASEQ0:
+ shows "bsimp_ASEQ bs r1 AZERO = AZERO"
+ apply(induct r1)
+ apply(auto)
+ done
+
+
+
+lemma bsimp_ASEQ1:
+ assumes "r1 \<noteq> AZERO" "r2 \<noteq> AZERO" "\<forall>bs. r1 \<noteq> AONE bs"
+ shows "bsimp_ASEQ bs r1 r2 = ASEQ bs r1 r2"
+ using assms
+ apply(induct bs r1 r2 rule: bsimp_ASEQ.induct)
+ apply(auto)
+ done
+
+lemma bsimp_ASEQ2:
+ shows "bsimp_ASEQ bs (AONE bs1) r2 = fuse (bs @ bs1) r2"
+ apply(induct r2)
+ apply(auto)
+ done
+
+
+lemma L_bders_simp:
+ shows "L (erase (bders_simp r s)) = L (erase (bders r s))"
+ apply(induct s arbitrary: r rule: rev_induct)
+ apply(simp)
+ apply(simp)
+ apply(simp add: ders_append)
+ apply(simp add: bders_simp_append)
+ apply(simp add: L_bsimp_erase[symmetric])
+ by (simp add: der_correctness)
+
+lemma b1:
+ "bsimp_ASEQ bs1 (AONE bs) r = fuse (bs1 @ bs) r"
+ apply(induct r)
+ apply(auto)
+ done
+
+lemma b2:
+ assumes "bnullable r"
+ shows "bmkeps (fuse bs r) = bs @ bmkeps r"
+ by (simp add: assms bmkeps_retrieve bnullable_correctness erase_fuse mkeps_nullable retrieve_fuse2)
+
+lemma b3:
+ shows "bnullable r = bnullable (bsimp r)"
+ using L_bsimp_erase bnullable_correctness nullable_correctness by auto
+
+
+lemma b4:
+ shows "bnullable (bders_simp r s) = bnullable (bders r s)"
+ by (metis L_bders_simp bnullable_correctness lexer.simps(1) lexer_correct_None option.distinct(1))
+
+lemma q1:
+ assumes "\<forall>r \<in> set rs. bmkeps(bsimp r) = bmkeps r"
+ shows "map (\<lambda>r. bmkeps(bsimp r)) rs = map bmkeps rs"
+ using assms
+ apply(induct rs)
+ apply(simp)
+ apply(simp)
+ done
+
+lemma q3:
+ assumes "\<exists>r \<in> set rs. bnullable r"
+ shows "bmkeps (AALTs bs rs) = bmkeps (bsimp_AALTs bs rs)"
+ using assms
+ apply(induct bs rs rule: bsimp_AALTs.induct)
+ apply(simp)
+ apply(simp)
+ apply (simp add: b2)
+ apply(simp)
+ done
+
+
+lemma fuse_empty:
+ shows "fuse [] r = r"
+ apply(induct r)
+ apply(auto)
+ done
+
+lemma flts_fuse:
+ shows "map (fuse bs) (flts rs) = flts (map (fuse bs) rs)"
+ apply(induct rs arbitrary: bs rule: flts.induct)
+ apply(auto simp add: fuse_append)
+ done
+
+lemma bsimp_ASEQ_fuse:
+ shows "fuse bs1 (bsimp_ASEQ bs2 r1 r2) = bsimp_ASEQ (bs1 @ bs2) r1 r2"
+ apply(induct r1 r2 arbitrary: bs1 bs2 rule: bsimp_ASEQ.induct)
+ apply(auto)
+ done
+
+lemma bsimp_AALTs_fuse:
+ assumes "\<forall>r \<in> set rs. fuse bs1 (fuse bs2 r) = fuse (bs1 @ bs2) r"
+ shows "fuse bs1 (bsimp_AALTs bs2 rs) = bsimp_AALTs (bs1 @ bs2) rs"
+ using assms
+ apply(induct bs2 rs arbitrary: bs1 rule: bsimp_AALTs.induct)
+ apply(auto)
+ done
+
+
+
+lemma bsimp_fuse:
+ shows "fuse bs (bsimp r) = bsimp (fuse bs r)"
+apply(induct r arbitrary: bs)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 3
+ apply(simp)
+ apply(simp)
+ apply (simp add: bsimp_ASEQ_fuse)
+ apply(simp)
+ by (simp add: bsimp_AALTs_fuse fuse_append)
+
+lemma bsimp_fuse_AALTs:
+ shows "fuse bs (bsimp (AALTs [] rs)) = bsimp (AALTs bs rs)"
+ apply(subst bsimp_fuse)
+ apply(simp)
+ done
+
+lemma bsimp_fuse_AALTs2:
+ shows "fuse bs (bsimp_AALTs [] rs) = bsimp_AALTs bs rs"
+ using bsimp_AALTs_fuse fuse_append by auto
+
+
+lemma bsimp_ASEQ_idem:
+ assumes "bsimp (bsimp r1) = bsimp r1" "bsimp (bsimp r2) = bsimp r2"
+ shows "bsimp (bsimp_ASEQ x1 (bsimp r1) (bsimp r2)) = bsimp_ASEQ x1 (bsimp r1) (bsimp r2)"
+ using assms
+ apply(case_tac "bsimp r1 = AZERO")
+ apply(simp)
+ apply(case_tac "bsimp r2 = AZERO")
+ apply(simp)
+ apply (metis bnullable.elims(2) bnullable.elims(3) bsimp.simps(3) bsimp_ASEQ.simps(2) bsimp_ASEQ.simps(3) bsimp_ASEQ.simps(4) bsimp_ASEQ.simps(5) bsimp_ASEQ.simps(6))
+ apply(case_tac "\<exists>bs. bsimp r1 = AONE bs")
+ apply(auto)[1]
+ apply(subst bsimp_ASEQ2)
+ apply(subst bsimp_ASEQ2)
+ apply (metis assms(2) bsimp_fuse)
+ apply(subst bsimp_ASEQ1)
+ apply(auto)
+ done
+
+
+
+lemma k0:
+ shows "flts (r # rs1) = flts [r] @ flts rs1"
+ apply(induct r arbitrary: rs1)
+ apply(auto)
+ done
+
+lemma k00:
+ shows "flts (rs1 @ rs2) = flts rs1 @ flts rs2"
+ apply(induct rs1 arbitrary: rs2)
+ apply(auto)
+ by (metis append.assoc k0)
+
+lemma k0a:
+ shows "flts [AALTs bs rs] = map (fuse bs) rs"
+ apply(simp)
+ done
+
+
+lemma k0b:
+ assumes "nonalt r" "r \<noteq> AZERO"
+ shows "flts [r] = [r]"
+ using assms
+ apply(case_tac r)
+ apply(simp_all)
+ done
+
+lemma nn1:
+ assumes "nonnested (AALTs bs rs)"
+ shows "\<nexists>bs1 rs1. flts rs = [AALTs bs1 rs1]"
+ using assms
+ apply(induct rs rule: flts.induct)
+ apply(auto)
+ done
+
+lemma nn1q:
+ assumes "nonnested (AALTs bs rs)"
+ shows "\<nexists>bs1 rs1. AALTs bs1 rs1 \<in> set (flts rs)"
+ using assms
+ apply(induct rs rule: flts.induct)
+ apply(auto)
+ done
+
+lemma nn1qq:
+ assumes "nonnested (AALTs bs rs)"
+ shows "\<nexists>bs1 rs1. AALTs bs1 rs1 \<in> set rs"
+ using assms
+ apply(induct rs rule: flts.induct)
+ apply(auto)
+ done
+
+lemma nn10:
+ assumes "nonnested (AALTs cs rs)"
+ shows "nonnested (AALTs (bs @ cs) rs)"
+ using assms
+ apply(induct rs arbitrary: cs bs)
+ apply(simp_all)
+ apply(case_tac a)
+ apply(simp_all)
+ done
+
+lemma nn11a:
+ assumes "nonalt r"
+ shows "nonalt (fuse bs r)"
+ using assms
+ apply(induct r)
+ apply(auto)
+ done
+
+
+lemma nn1a:
+ assumes "nonnested r"
+ shows "nonnested (fuse bs r)"
+ using assms
+ apply(induct bs r arbitrary: rule: fuse.induct)
+ apply(simp_all add: nn10)
+ done
+
+lemma n0:
+ shows "nonnested (AALTs bs rs) \<longleftrightarrow> (\<forall>r \<in> set rs. nonalt r)"
+ apply(induct rs arbitrary: bs)
+ apply(auto)
+ apply (metis list.set_intros(1) nn1qq nonalt.elims(3))
+ apply (metis list.set_intros(2) nn1qq nonalt.elims(3))
+ by (metis nonalt.elims(2) nonnested.simps(3) nonnested.simps(4) nonnested.simps(5) nonnested.simps(6) nonnested.simps(7))
+
+
+
+
+lemma nn1c:
+ assumes "\<forall>r \<in> set rs. nonnested r"
+ shows "\<forall>r \<in> set (flts rs). nonalt r"
+ using assms
+ apply(induct rs rule: flts.induct)
+ apply(auto)
+ apply(rule nn11a)
+ by (metis nn1qq nonalt.elims(3))
+
+lemma nn1bb:
+ assumes "\<forall>r \<in> set rs. nonalt r"
+ shows "nonnested (bsimp_AALTs bs rs)"
+ using assms
+ apply(induct bs rs rule: bsimp_AALTs.induct)
+ apply(auto)
+ apply (metis nn11a nonalt.simps(1) nonnested.elims(3))
+ using n0 by auto
+
+lemma nn1b:
+ shows "nonnested (bsimp r)"
+ apply(induct r)
+ apply(simp_all)
+ apply(case_tac "bsimp r1 = AZERO")
+ apply(simp)
+ apply(case_tac "bsimp r2 = AZERO")
+ apply(simp)
+ apply(subst bsimp_ASEQ0)
+ apply(simp)
+ apply(case_tac "\<exists>bs. bsimp r1 = AONE bs")
+ apply(auto)[1]
+ apply(subst bsimp_ASEQ2)
+ apply (simp add: nn1a)
+ apply(subst bsimp_ASEQ1)
+ apply(auto)
+ apply(rule nn1bb)
+ apply(auto)
+ by (metis (mono_tags, hide_lams) imageE nn1c set_map)
+
+lemma nn1d:
+ assumes "bsimp r = AALTs bs rs"
+ shows "\<forall>r1 \<in> set rs. \<forall> bs. r1 \<noteq> AALTs bs rs2"
+ using nn1b assms
+ by (metis nn1qq)
+
+lemma nn_flts:
+ assumes "nonnested (AALTs bs rs)"
+ shows "\<forall>r \<in> set (flts rs). nonalt r"
+ using assms
+ apply(induct rs arbitrary: bs rule: flts.induct)
+ apply(auto)
+ done
+
+
+
+lemma rt:
+ shows "sum_list (map asize (flts (map bsimp rs))) \<le> sum_list (map asize rs)"
+ apply(induct rs)
+ apply(simp)
+ apply(simp)
+ apply(subst k0)
+ apply(simp)
+ by (smt add_le_cancel_right add_mono bsimp_size flts.simps(1) flts_size k0 le_iff_add list.simps(9) map_append sum_list.Cons sum_list.append trans_le_add1)
+
+lemma bsimp_AALTs_qq:
+ assumes "1 < length rs"
+ shows "bsimp_AALTs bs rs = AALTs bs rs"
+ using assms
+ apply(case_tac rs)
+ apply(simp)
+ apply(case_tac list)
+ apply(simp_all)
+ done
+
+
+lemma bsimp_AALTs1:
+ assumes "nonalt r"
+ shows "bsimp_AALTs bs (flts [r]) = fuse bs r"
+ using assms
+ apply(case_tac r)
+ apply(simp_all)
+ done
+
+lemma bbbbs:
+ assumes "good r" "r = AALTs bs1 rs"
+ shows "bsimp_AALTs bs (flts [r]) = AALTs bs (map (fuse bs1) rs)"
+ using assms
+ by (metis (no_types, lifting) Nil_is_map_conv append.left_neutral append_butlast_last_id bsimp_AALTs.elims butlast.simps(2) good.simps(4) good.simps(5) k0a map_butlast)
+
+lemma bbbbs1:
+ shows "nonalt r \<or> (\<exists>bs rs. r = AALTs bs rs)"
+ using nonalt.elims(3) by auto
+
+
+lemma good_fuse:
+ shows "good (fuse bs r) = good r"
+ apply(induct r arbitrary: bs)
+ apply(auto)
+ apply(case_tac r1)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r1)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac x2a)
+ apply(simp_all)
+ apply(case_tac list)
+ apply(simp_all)
+ apply(case_tac x2a)
+ apply(simp_all)
+ apply(case_tac list)
+ apply(simp_all)
+ done
+
+lemma good0:
+ assumes "rs \<noteq> Nil" "\<forall>r \<in> set rs. nonalt r"
+ shows "good (bsimp_AALTs bs rs) \<longleftrightarrow> (\<forall>r \<in> set rs. good r)"
+ using assms
+ apply(induct bs rs rule: bsimp_AALTs.induct)
+ apply(auto simp add: good_fuse)
+ done
+
+lemma good0a:
+ assumes "flts (map bsimp rs) \<noteq> Nil" "\<forall>r \<in> set (flts (map bsimp rs)). nonalt r"
+ shows "good (bsimp (AALTs bs rs)) \<longleftrightarrow> (\<forall>r \<in> set (flts (map bsimp rs)). good r)"
+ using assms
+ apply(simp)
+ apply(auto)
+ apply(subst (asm) good0)
+ apply(simp)
+ apply(auto)
+ apply(subst good0)
+ apply(simp)
+ apply(auto)
+ done
+
+lemma flts0:
+ assumes "r \<noteq> AZERO" "nonalt r"
+ shows "flts [r] \<noteq> []"
+ using assms
+ apply(induct r)
+ apply(simp_all)
+ done
+
+lemma flts1:
+ assumes "good r"
+ shows "flts [r] \<noteq> []"
+ using assms
+ apply(induct r)
+ apply(simp_all)
+ apply(case_tac x2a)
+ apply(simp)
+ apply(simp)
+ done
+
+lemma flts2:
+ assumes "good r"
+ shows "\<forall>r' \<in> set (flts [r]). good r' \<and> nonalt r'"
+ using assms
+ apply(induct r)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 2
+ apply(simp)
+ apply(auto)[1]
+ apply (metis bsimp_AALTs.elims good.simps(4) good.simps(5) good.simps(6) good_fuse)
+ apply (metis bsimp_AALTs.elims good.simps(4) good.simps(5) good.simps(6) nn11a)
+ apply fastforce
+ apply(simp)
+ done
+
+
+lemma flts3:
+ assumes "\<forall>r \<in> set rs. good r \<or> r = AZERO"
+ shows "\<forall>r \<in> set (flts rs). good r"
+ using assms
+ apply(induct rs arbitrary: rule: flts.induct)
+ apply(simp_all)
+ by (metis UnE flts2 k0a set_map)
+
+lemma flts3b:
+ assumes "\<exists>r\<in>set rs. good r"
+ shows "flts rs \<noteq> []"
+ using assms
+ apply(induct rs arbitrary: rule: flts.induct)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(auto)
+ done
+
+lemma flts4:
+ assumes "bsimp_AALTs bs (flts rs) = AZERO"
+ shows "\<forall>r \<in> set rs. \<not> good r"
+ using assms
+ apply(induct rs arbitrary: bs rule: flts.induct)
+ apply(auto)
+ defer
+ apply (metis (no_types, lifting) Nil_is_append_conv append_self_conv2 bsimp_AALTs.elims butlast.simps(2) butlast_append flts3b nonalt.simps(1) nonalt.simps(2))
+ apply (metis arexp.distinct(7) bsimp_AALTs.elims flts2 good.simps(1) good.simps(2) good0 k0b list.distinct(1) list.inject nonalt.simps(3))
+ apply (metis arexp.distinct(3) arexp.distinct(7) bsimp_AALTs.elims fuse.simps(3) list.distinct(1) list.inject)
+ apply (metis arexp.distinct(7) bsimp_AALTs.elims good.simps(1) good_fuse list.distinct(1) list.inject)
+ apply (metis arexp.distinct(7) bsimp_AALTs.elims list.distinct(1) list.inject)
+ apply (metis arexp.distinct(7) bsimp_AALTs.elims flts2 good.simps(1) good.simps(33) good0 k0b list.distinct(1) list.inject nonalt.simps(6))
+ by (metis (no_types, lifting) Nil_is_append_conv append_Nil2 arexp.distinct(7) bsimp_AALTs.elims butlast.simps(2) butlast_append flts1 flts2 good.simps(1) good0 k0a)
+
+
+lemma flts_nil:
+ assumes "\<forall>y. asize y < Suc (sum_list (map asize rs)) \<longrightarrow>
+ good (bsimp y) \<or> bsimp y = AZERO"
+ and "\<forall>r\<in>set rs. \<not> good (bsimp r)"
+ shows "flts (map bsimp rs) = []"
+ using assms
+ apply(induct rs)
+ apply(simp)
+ apply(simp)
+ apply(subst k0)
+ apply(simp)
+ by force
+
+lemma flts_nil2:
+ assumes "\<forall>y. asize y < Suc (sum_list (map asize rs)) \<longrightarrow>
+ good (bsimp y) \<or> bsimp y = AZERO"
+ and "bsimp_AALTs bs (flts (map bsimp rs)) = AZERO"
+ shows "flts (map bsimp rs) = []"
+ using assms
+ apply(induct rs arbitrary: bs)
+ apply(simp)
+ apply(simp)
+ apply(subst k0)
+ apply(simp)
+ apply(subst (asm) k0)
+ apply(auto)
+ apply (metis flts.simps(1) flts.simps(2) flts4 k0 less_add_Suc1 list.set_intros(1))
+ by (metis flts.simps(2) flts4 k0 less_add_Suc1 list.set_intros(1))
+
+
+
+lemma good_SEQ:
+ assumes "r1 \<noteq> AZERO" "r2 \<noteq> AZERO" "\<forall>bs. r1 \<noteq> AONE bs"
+ shows "good (ASEQ bs r1 r2) = (good r1 \<and> good r2)"
+ using assms
+ apply(case_tac r1)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ done
+
+lemma good1:
+ shows "good (bsimp a) \<or> bsimp a = AZERO"
+ apply(induct a taking: asize rule: measure_induct)
+ apply(case_tac x)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 3
+ apply(simp)
+ prefer 2
+ (* AALTs case *)
+ apply(simp only:)
+ apply(case_tac "x52")
+ apply(simp)
+ thm good0a
+ (* AALTs list at least one - case *)
+ apply(simp only: )
+ apply(frule_tac x="a" in spec)
+ apply(drule mp)
+ apply(simp)
+ (* either first element is good, or AZERO *)
+ apply(erule disjE)
+ prefer 2
+ apply(simp)
+ (* in the AZERO case, the size is smaller *)
+ apply(drule_tac x="AALTs x51 list" in spec)
+ apply(drule mp)
+ apply(simp add: asize0)
+ apply(subst (asm) bsimp.simps)
+ apply(subst (asm) bsimp.simps)
+ apply(assumption)
+ (* in the good case *)
+ apply(frule_tac x="AALTs x51 list" in spec)
+ apply(drule mp)
+ apply(simp add: asize0)
+ apply(erule disjE)
+ apply(rule disjI1)
+ apply(simp add: good0)
+ apply(subst good0)
+ apply (metis Nil_is_append_conv flts1 k0)
+ apply (metis ex_map_conv list.simps(9) nn1b nn1c)
+ apply(simp)
+ apply(subst k0)
+ apply(simp)
+ apply(auto)[1]
+ using flts2 apply blast
+ apply(subst (asm) good0)
+ prefer 3
+ apply(auto)[1]
+ apply auto[1]
+ apply (metis ex_map_conv nn1b nn1c)
+ (* in the AZERO case *)
+ apply(simp)
+ apply(frule_tac x="a" in spec)
+ apply(drule mp)
+ apply(simp)
+ apply(erule disjE)
+ apply(rule disjI1)
+ apply(subst good0)
+ apply(subst k0)
+ using flts1 apply blast
+ apply(auto)[1]
+ apply (metis (no_types, hide_lams) ex_map_conv list.simps(9) nn1b nn1c)
+ apply(auto)[1]
+ apply(subst (asm) k0)
+ apply(auto)[1]
+ using flts2 apply blast
+ apply(frule_tac x="AALTs x51 list" in spec)
+ apply(drule mp)
+ apply(simp add: asize0)
+ apply(erule disjE)
+ apply(simp)
+ apply(simp)
+ apply (metis add.left_commute flts_nil2 less_add_Suc1 less_imp_Suc_add list.distinct(1) list.set_cases nat.inject)
+ apply(subst (2) k0)
+ apply(simp)
+ (* SEQ case *)
+ apply(simp)
+ apply(case_tac "bsimp x42 = AZERO")
+ apply(simp)
+ apply(case_tac "bsimp x43 = AZERO")
+ apply(simp)
+ apply(subst (2) bsimp_ASEQ0)
+ apply(simp)
+ apply(case_tac "\<exists>bs. bsimp x42 = AONE bs")
+ apply(auto)[1]
+ apply(subst bsimp_ASEQ2)
+ using good_fuse apply force
+ apply(subst bsimp_ASEQ1)
+ apply(auto)
+ apply(subst good_SEQ)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ using less_add_Suc1 less_add_Suc2 by blast
+
+lemma good1a:
+ assumes "L(erase a) \<noteq> {}"
+ shows "good (bsimp a)"
+ using good1 assms
+ using L_bsimp_erase by force
+
+
+
+lemma flts_append:
+ "flts (xs1 @ xs2) = flts xs1 @ flts xs2"
+ apply(induct xs1 arbitrary: xs2 rule: rev_induct)
+ apply(auto)
+ apply(case_tac xs)
+ apply(auto)
+ apply(case_tac x)
+ apply(auto)
+ apply(case_tac x)
+ apply(auto)
+ done
+
+lemma g1:
+ assumes "good (bsimp_AALTs bs rs)"
+ shows "bsimp_AALTs bs rs = AALTs bs rs \<or> (\<exists>r. rs = [r] \<and> bsimp_AALTs bs [r] = fuse bs r)"
+using assms
+ apply(induct rs arbitrary: bs)
+ apply(simp)
+ apply(case_tac rs)
+ apply(simp only:)
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ by simp
+
+lemma flts_0:
+ assumes "nonnested (AALTs bs rs)"
+ shows "\<forall>r \<in> set (flts rs). r \<noteq> AZERO"
+ using assms
+ apply(induct rs arbitrary: bs rule: flts.induct)
+ apply(simp)
+ apply(simp)
+ defer
+ apply(simp)
+ apply(simp)
+ apply(simp)
+apply(simp)
+ apply(rule ballI)
+ apply(simp)
+ done
+
+lemma flts_0a:
+ assumes "nonnested (AALTs bs rs)"
+ shows "AZERO \<notin> set (flts rs)"
+ using assms
+ using flts_0 by blast
+
+lemma qqq1:
+ shows "AZERO \<notin> set (flts (map bsimp rs))"
+ by (metis ex_map_conv flts3 good.simps(1) good1)
+
+
+fun nonazero :: "arexp \<Rightarrow> bool"
+ where
+ "nonazero AZERO = False"
+| "nonazero r = True"
+
+lemma flts_concat:
+ shows "flts rs = concat (map (\<lambda>r. flts [r]) rs)"
+ apply(induct rs)
+ apply(auto)
+ apply(subst k0)
+ apply(simp)
+ done
+
+lemma flts_single1:
+ assumes "nonalt r" "nonazero r"
+ shows "flts [r] = [r]"
+ using assms
+ apply(induct r)
+ apply(auto)
+ done
+
+lemma flts_qq:
+ assumes "\<forall>y. asize y < Suc (sum_list (map asize rs)) \<longrightarrow> good y \<longrightarrow> bsimp y = y"
+ "\<forall>r'\<in>set rs. good r' \<and> nonalt r'"
+ shows "flts (map bsimp rs) = rs"
+ using assms
+ apply(induct rs)
+ apply(simp)
+ apply(simp)
+ apply(subst k0)
+ apply(subgoal_tac "flts [bsimp a] = [a]")
+ prefer 2
+ apply(drule_tac x="a" in spec)
+ apply(drule mp)
+ apply(simp)
+ apply(auto)[1]
+ using good.simps(1) k0b apply blast
+ apply(auto)[1]
+ done
+
+lemma test:
+ assumes "good r"
+ shows "bsimp r = r"
+ using assms
+ apply(induct r taking: "asize" rule: measure_induct)
+ apply(erule good.elims)
+ apply(simp_all)
+ apply(subst k0)
+ apply(subst (2) k0)
+ apply(subst flts_qq)
+ apply(auto)[1]
+ apply(auto)[1]
+ apply (metis append_Cons append_Nil bsimp_AALTs.simps(3) good.simps(1) k0b)
+ apply force+
+ apply (metis (no_types, lifting) add_Suc add_Suc_right asize.simps(5) bsimp.simps(1) bsimp_ASEQ.simps(19) less_add_Suc1 less_add_Suc2)
+ apply (metis add_Suc add_Suc_right arexp.distinct(5) arexp.distinct(7) asize.simps(4) asize.simps(5) bsimp.simps(1) bsimp.simps(2) bsimp_ASEQ1 good.simps(21) good.simps(8) less_add_Suc1 less_add_Suc2)
+ apply force+
+ apply (metis (no_types, lifting) add_Suc add_Suc_right arexp.distinct(5) arexp.distinct(7) asize.simps(4) asize.simps(5) bsimp.simps(1) bsimp.simps(2) bsimp_ASEQ1 good.simps(25) good.simps(8) less_add_Suc1 less_add_Suc2)
+ apply (metis add_Suc add_Suc_right arexp.distinct(7) asize.simps(4) bsimp.simps(2) bsimp_ASEQ1 good.simps(26) good.simps(8) less_add_Suc1 less_add_Suc2)
+ apply force+
+ done
+
+lemma test2:
+ assumes "good r"
+ shows "bsimp r = r"
+ using assms
+ apply(induct r taking: "asize" rule: measure_induct)
+ apply(case_tac x)
+ apply(simp_all)
+ defer
+ (* AALT case *)
+ apply(subgoal_tac "1 < length x52")
+ prefer 2
+ apply(case_tac x52)
+ apply(simp)
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ apply(simp)
+ apply(subst bsimp_AALTs_qq)
+ prefer 2
+ apply(subst flts_qq)
+ apply(auto)[1]
+ apply(auto)[1]
+ apply(case_tac x52)
+ apply(simp)
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ apply(simp)
+ apply(auto)[1]
+ apply (metis (no_types, lifting) bsimp_AALTs.elims good.simps(6) length_Cons length_pos_if_in_set list.size(3) nat_neq_iff)
+ apply(simp)
+ apply(case_tac x52)
+ apply(simp)
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ apply(simp)
+ apply(subst k0)
+ apply(simp)
+ apply(subst (2) k0)
+ apply(simp)
+ apply (simp add: Suc_lessI flts1 one_is_add)
+ (* SEQ case *)
+ apply(case_tac "bsimp x42 = AZERO")
+ apply simp
+ apply (metis asize.elims good.simps(10) good.simps(11) good.simps(12) good.simps(2) good.simps(7) good.simps(9) good_SEQ less_add_Suc1)
+ apply(case_tac "\<exists>bs'. bsimp x42 = AONE bs'")
+ apply(auto)[1]
+ defer
+ apply(case_tac "bsimp x43 = AZERO")
+ apply(simp)
+ apply (metis bsimp.elims bsimp.simps(3) good.simps(10) good.simps(11) good.simps(12) good.simps(8) good.simps(9) good_SEQ less_add_Suc2)
+ apply(auto)
+ apply (subst bsimp_ASEQ1)
+ apply(auto)[3]
+ apply(auto)[1]
+ apply (metis bsimp.simps(3) good.simps(2) good_SEQ less_add_Suc1)
+ apply (metis bsimp.simps(3) good.simps(2) good_SEQ less_add_Suc1 less_add_Suc2)
+ apply (subst bsimp_ASEQ2)
+ apply(drule_tac x="x42" in spec)
+ apply(drule mp)
+ apply(simp)
+ apply(drule mp)
+ apply (metis bsimp.elims bsimp.simps(3) good.simps(10) good.simps(11) good.simps(2) good_SEQ)
+ apply(simp)
+ done
+
+
+lemma bsimp_idem:
+ shows "bsimp (bsimp r) = bsimp r"
+ using test good1
+ by force
+
+
+
+lemma contains48:
+ assumes "\<And>x2aa bs bs1. \<lbrakk>x2aa \<in> set x2a; fuse bs x2aa >> bs @ bs1\<rbrakk> \<Longrightarrow> x2aa >> bs1"
+ "AALTs (bs @ x1) x2a >> bs @ bs1"
+ shows "AALTs x1 x2a >> bs1"
+ using assms
+ apply(induct x2a arbitrary: bs x1 bs1)
+ apply(auto)
+ apply(erule contains.cases)
+ apply(auto)
+ apply(erule contains.cases)
+ apply(auto)
+ apply (simp add: contains.intros(4))
+ using contains.intros(5) by blast
+
+
+lemma contains49:
+ assumes "fuse bs a >> bs @ bs1"
+ shows "a >> bs1"
+ using assms
+ apply(induct a arbitrary: bs bs1)
+ apply(auto)
+ using contains.simps apply blast
+ apply(erule contains.cases)
+ apply(auto)
+ apply(rule contains.intros)
+ apply(erule contains.cases)
+ apply(auto)
+ apply(rule contains.intros)
+ apply(erule contains.cases)
+ apply(auto)
+ apply(rule contains.intros)
+ apply(auto)[2]
+ prefer 2
+ apply(erule contains.cases)
+ apply(auto)
+ apply (simp add: contains.intros(6))
+ using contains.intros(7) apply blast
+ using contains48 by blast
+
+
+lemma contains50_IFF2:
+ shows "bsimp_AALTs bs [a] >> bs @ bs1 \<longleftrightarrow> fuse bs a >> bs @ bs1"
+ by simp
+
+lemma contains50_IFF3:
+ shows "bsimp_AALTs bs as >> bs @ bs1 \<longleftrightarrow> (\<exists>a \<in> set as. fuse bs a >> bs @ bs1)"
+apply(induct as arbitrary: bs bs1)
+ apply(simp)
+ apply(auto elim: contains.cases simp add: contains0)
+ apply(case_tac as)
+ apply(auto)
+ apply(case_tac list)
+ apply(auto)
+ apply(erule contains.cases)
+ apply(auto)
+ apply (simp add: contains0)
+apply(erule contains.cases)
+ apply(auto)
+ using contains0 apply auto[1]
+ apply(erule contains.cases)
+ apply(auto)
+ apply(erule contains.cases)
+ apply(auto)
+ using contains0 apply blast
+ apply (metis bsimp_AALTs.simps(2) bsimp_AALTs.simps(3) contains.intros(4) contains49 list.exhaust)
+ by (smt bsimp_AALTs.simps(3) contains.intros(4) contains.intros(5) contains49 list.set_cases)
+
+lemma contains50_IFF4:
+ shows "bsimp_AALTs bs as >> bs @ bs1 \<longleftrightarrow> (\<exists>a \<in> set as. a >> bs1)"
+ by (meson contains0 contains49 contains50_IFF3)
+
+
+lemma contains50:
+ assumes "bsimp_AALTs bs rs2 >> bs @ bs1"
+ shows "bsimp_AALTs bs (rs1 @ rs2) >> bs @ bs1"
+ using assms
+ apply(induct rs1 arbitrary: bs rs2 bs1)
+ apply(simp)
+ apply(auto)
+ apply(case_tac rs1)
+ apply(simp)
+ apply(case_tac rs2)
+ apply(simp)
+ using contains.simps apply blast
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ apply(rule contains.intros)
+ back
+ apply(rule contains.intros)
+ using contains49 apply blast
+ apply(simp)
+ using contains.intros(5) apply blast
+ apply(simp)
+ by (metis bsimp_AALTs.elims contains.intros(4) contains.intros(5) contains49 list.distinct(1))
+
+lemma contains51:
+ assumes "bsimp_AALTs bs [r] >> bs @ bs1"
+ shows "bsimp_AALTs bs ([r] @ rs2) >> bs @ bs1"
+ using assms
+ apply(induct rs2 arbitrary: bs r bs1)
+ apply(simp)
+ apply(auto)
+ using contains.intros(4) contains49 by blast
+
+lemma contains51a:
+ assumes "bsimp_AALTs bs rs2 >> bs @ bs1"
+ shows "bsimp_AALTs bs (rs2 @ [r]) >> bs @ bs1"
+ using assms
+ apply(induct rs2 arbitrary: bs r bs1)
+ apply(simp)
+ apply(auto)
+ using contains.simps apply blast
+ apply(case_tac rs2)
+ apply(auto)
+ using contains3b contains49 apply blast
+ apply(case_tac list)
+ apply(auto)
+ apply(erule contains.cases)
+ apply(auto)
+ using contains.intros(4) apply auto[1]
+ apply(erule contains.cases)
+ apply(auto)
+ apply (simp add: contains.intros(4) contains.intros(5))
+ apply (simp add: contains.intros(5))
+ apply(erule contains.cases)
+ apply(auto)
+ apply (simp add: contains.intros(4))
+ apply(erule contains.cases)
+ apply(auto)
+ using contains.intros(4) contains.intros(5) apply blast
+ using contains.intros(5) by blast
+
+lemma contains51b:
+ assumes "bsimp_AALTs bs rs >> bs @ bs1"
+ shows "bsimp_AALTs bs (rs @ rs2) >> bs @ bs1"
+ using assms
+ apply(induct rs2 arbitrary: bs rs bs1)
+ apply(simp)
+ using contains51a by fastforce
+
+lemma contains51c:
+ assumes "AALTs (bs @ bs2) rs >> bs @ bs1"
+ shows "bsimp_AALTs bs (map (fuse bs2) rs) >> bs @ bs1"
+ using assms
+ apply(induct rs arbitrary: bs bs1 bs2)
+ apply(auto)
+ apply(erule contains.cases)
+ apply(auto)
+ apply(erule contains.cases)
+ apply(auto)
+ using contains0 contains51 apply auto[1]
+ by (metis append.left_neutral append_Cons contains50 list.simps(9))
+
+
+lemma contains51d:
+ assumes "fuse bs r >> bs @ bs1"
+ shows "bsimp_AALTs bs (flts [r]) >> bs @ bs1"
+ using assms
+ apply(induct r arbitrary: bs bs1)
+ apply(auto)
+ by (simp add: contains51c)
+
+lemma contains52:
+ assumes "\<exists>r \<in> set rs. (fuse bs r) >> bs @ bs1"
+ shows "bsimp_AALTs bs (flts rs) >> bs @ bs1"
+ using assms
+ apply(induct rs arbitrary: bs bs1)
+ apply(simp)
+ apply(auto)
+ defer
+ apply (metis contains50 k0)
+ apply(subst k0)
+ apply(rule contains51b)
+ using contains51d by blast
+
+lemma contains55:
+ assumes "a >> bs"
+ shows "bsimp a >> bs"
+ using assms
+ apply(induct a bs arbitrary:)
+ apply(auto intro: contains.intros)
+ apply(case_tac "bsimp a1 = AZERO")
+ apply(simp)
+ using contains.simps apply blast
+ apply(case_tac "bsimp a2 = AZERO")
+ apply(simp)
+ using contains.simps apply blast
+ apply(case_tac "\<exists>bs. bsimp a1 = AONE bs")
+ apply(auto)[1]
+ apply(rotate_tac 1)
+ apply(erule contains.cases)
+ apply(auto)
+ apply (simp add: b1 contains0 fuse_append)
+ apply (simp add: bsimp_ASEQ1 contains.intros(3))
+ prefer 2
+ apply(case_tac rs)
+ apply(simp)
+ using contains.simps apply blast
+ apply (metis contains50 k0)
+ (* AALTS case *)
+ apply(rule contains52)
+ apply(rule_tac x="bsimp r" in bexI)
+ apply(auto)
+ using contains0 by blast
+
+lemma test1:
+ shows "AALT [] (ACHAR [Z] c) (ACHAR [S] c) >> [S]"
+ by (metis contains.intros(2) contains.intros(4) contains.intros(5) self_append_conv2)
+
+lemma test1a:
+ shows "bsimp (AALT [] (ACHAR [Z] c) (ACHAR [S] c)) = AALT [] (ACHAR [Z] c) (ACHAR [S] c)"
+ apply(simp)
+ done
+
+lemma q3a:
+ assumes "\<exists>r \<in> set rs. bnullable r"
+ shows "bmkeps (AALTs bs (map (fuse bs1) rs)) = bmkeps (AALTs (bs@bs1) rs)"
+ using assms
+ apply(induct rs arbitrary: bs bs1)
+ apply(simp)
+ apply(simp)
+ apply(auto)
+ apply (metis append_assoc b2 bnullable_correctness erase_fuse r0)
+ apply(case_tac "bnullable a")
+ apply (metis append.assoc b2 bnullable_correctness erase_fuse r0)
+ apply(case_tac rs)
+ apply(simp)
+ apply(simp)
+ apply(auto)[1]
+ apply (metis bnullable_correctness erase_fuse)+
+ done
+
+
+
+lemma qq4a:
+ assumes "\<exists>x\<in>set list. bnullable x"
+ shows "\<exists>x\<in>set (flts list). bnullable x"
+ using assms
+ apply(induct list rule: flts.induct)
+ apply(auto)
+ by (metis UnCI bnullable_correctness erase_fuse imageI)
+
+
+lemma qs3:
+ assumes "\<exists>r \<in> set rs. bnullable r"
+ shows "bmkeps (AALTs bs rs) = bmkeps (AALTs bs (flts rs))"
+ using assms
+ apply(induct rs arbitrary: bs taking: size rule: measure_induct)
+ apply(case_tac x)
+ apply(simp)
+ apply(simp)
+ apply(case_tac a)
+ apply(simp)
+ apply (simp add: r1)
+ apply(simp)
+ apply (simp add: r0)
+ apply(simp)
+ apply(case_tac "flts list")
+ apply(simp)
+ apply (metis L_erase_AALTs L_erase_flts L_flat_Prf1 L_flat_Prf2 Prf_elims(1) bnullable_correctness erase.simps(4) mkeps_nullable r2)
+ apply(simp)
+ apply (simp add: r1)
+ prefer 3
+ apply(simp)
+ apply (simp add: r0)
+ prefer 2
+ apply(simp)
+ apply(case_tac "\<exists>x\<in>set x52. bnullable x")
+ apply(case_tac "list")
+ apply(simp)
+ apply (metis b2 fuse.simps(4) q3a r2)
+ apply(erule disjE)
+ apply(subst qq1)
+ apply(auto)[1]
+ apply (metis bnullable_correctness erase_fuse)
+ apply(simp)
+ apply (metis b2 fuse.simps(4) q3a r2)
+ apply(simp)
+ apply(auto)[1]
+ apply(subst qq1)
+ apply (metis bnullable_correctness erase_fuse image_eqI set_map)
+ apply (metis b2 fuse.simps(4) q3a r2)
+ apply(subst qq1)
+ apply (metis bnullable_correctness erase_fuse image_eqI set_map)
+ apply (metis b2 fuse.simps(4) q3a r2)
+ apply(simp)
+ apply(subst qq2)
+ apply (metis bnullable_correctness erase_fuse imageE set_map)
+ prefer 2
+ apply(case_tac "list")
+ apply(simp)
+ apply(simp)
+ apply (simp add: qq4a)
+ apply(simp)
+ apply(auto)
+ apply(case_tac list)
+ apply(simp)
+ apply(simp)
+ apply (simp add: r0)
+ apply(case_tac "bnullable (ASEQ x41 x42 x43)")
+ apply(case_tac list)
+ apply(simp)
+ apply(simp)
+ apply (simp add: r0)
+ apply(simp)
+ using qq4a r1 r2 by auto
+
+
+
+lemma k1:
+ assumes "\<And>x2aa. \<lbrakk>x2aa \<in> set x2a; bnullable x2aa\<rbrakk> \<Longrightarrow> bmkeps x2aa = bmkeps (bsimp x2aa)"
+ "\<exists>x\<in>set x2a. bnullable x"
+ shows "bmkeps (AALTs x1 (flts x2a)) = bmkeps (AALTs x1 (flts (map bsimp x2a)))"
+ using assms
+ apply(induct x2a)
+ apply fastforce
+ apply(simp)
+ apply(subst k0)
+ apply(subst (2) k0)
+ apply(auto)[1]
+ apply (metis b3 k0 list.set_intros(1) qs3 r0)
+ by (smt b3 imageI insert_iff k0 list.set(2) qq3 qs3 r0 r1 set_map)
+
+
+
+lemma bmkeps_simp:
+ assumes "bnullable r"
+ shows "bmkeps r = bmkeps (bsimp r)"
+ using assms
+ apply(induct r)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 3
+ apply(simp)
+ apply(case_tac "bsimp r1 = AZERO")
+ apply(simp)
+ apply(auto)[1]
+ apply (metis L_bsimp_erase L_flat_Prf1 L_flat_Prf2 Prf_elims(1) bnullable_correctness erase.simps(1) mkeps_nullable)
+ apply(case_tac "bsimp r2 = AZERO")
+ apply(simp)
+ apply(auto)[1]
+ apply (metis L_bsimp_erase L_flat_Prf1 L_flat_Prf2 Prf_elims(1) bnullable_correctness erase.simps(1) mkeps_nullable)
+ apply(case_tac "\<exists>bs. bsimp r1 = AONE bs")
+ apply(auto)[1]
+ apply(subst b1)
+ apply(subst b2)
+ apply(simp add: b3[symmetric])
+ apply(simp)
+ apply(subgoal_tac "bsimp_ASEQ x1 (bsimp r1) (bsimp r2) = ASEQ x1 (bsimp r1) (bsimp r2)")
+ prefer 2
+ apply (smt b3 bnullable.elims(2) bsimp_ASEQ.simps(17) bsimp_ASEQ.simps(19) bsimp_ASEQ.simps(20) bsimp_ASEQ.simps(21) bsimp_ASEQ.simps(22) bsimp_ASEQ.simps(24) bsimp_ASEQ.simps(25) bsimp_ASEQ.simps(26) bsimp_ASEQ.simps(27) bsimp_ASEQ.simps(29) bsimp_ASEQ.simps(30) bsimp_ASEQ.simps(31))
+ apply(simp)
+ apply(simp)
+ thm q3
+ apply(subst q3[symmetric])
+ apply simp
+ using b3 qq4a apply auto[1]
+ apply(subst qs3)
+ apply simp
+ using k1 by blast
+
+thm bmkeps_retrieve bmkeps_simp bder_retrieve
+
+lemma bmkeps_bder_AALTs:
+ assumes "\<exists>r \<in> set rs. bnullable (bder c r)"
+ shows "bmkeps (bder c (bsimp_AALTs bs rs)) = bmkeps (bsimp_AALTs bs (map (bder c) rs))"
+ using assms
+ apply(induct rs)
+ apply(simp)
+ apply(simp)
+ apply(auto)
+ apply(case_tac rs)
+ apply(simp)
+ apply (metis (full_types) Prf_injval bder_retrieve bmkeps_retrieve bnullable_correctness erase_bder erase_fuse mkeps_nullable retrieve_fuse2)
+ apply(simp)
+ apply(case_tac rs)
+ apply(simp_all)
+ done
+
+lemma bbs0:
+ shows "blexer_simp r [] = blexer r []"
+ apply(simp add: blexer_def blexer_simp_def)
+ done
+
+lemma bbs1:
+ shows "blexer_simp r [c] = blexer r [c]"
+ apply(simp add: blexer_def blexer_simp_def)
+ apply(auto)
+ defer
+ using b3 apply auto[1]
+ using b3 apply auto[1]
+ apply(subst bmkeps_simp[symmetric])
+ apply(simp)
+ apply(simp)
+ done
+
+lemma oo:
+ shows "(case (blexer (der c r) s) of None \<Rightarrow> None | Some v \<Rightarrow> Some (injval r c v)) = blexer r (c # s)"
+ apply(simp add: blexer_correctness)
+ done
+
+lemma XXX2_helper:
+ assumes "\<forall>y. asize y < Suc (sum_list (map asize rs)) \<longrightarrow> good y \<longrightarrow> bsimp y = y"
+ "\<forall>r'\<in>set rs. good r' \<and> nonalt r'"
+ shows "flts (map (bsimp \<circ> bder c) (flts (map bsimp rs))) = flts (map (bsimp \<circ> bder c) rs)"
+ using assms
+ apply(induct rs arbitrary: c)
+ apply(simp)
+ apply(simp)
+ apply(subst k0)
+ apply(simp add: flts_append)
+ apply(subst (2) k0)
+ apply(simp add: flts_append)
+ apply(subgoal_tac "flts [a] = [a]")
+ prefer 2
+ using good.simps(1) k0b apply blast
+ apply(simp)
+ done
+
+lemma bmkeps_good:
+ assumes "good a"
+ shows "bmkeps (bsimp a) = bmkeps a"
+ using assms
+ using test2 by auto
+
+
+lemma xxx_bder:
+ assumes "good r"
+ shows "L (erase r) \<noteq> {}"
+ using assms
+ apply(induct r rule: good.induct)
+ apply(auto simp add: Sequ_def)
+ done
+
+lemma xxx_bder2:
+ assumes "L (erase (bsimp r)) = {}"
+ shows "bsimp r = AZERO"
+ using assms xxx_bder test2 good1
+ by blast
+
+lemma XXX2aa:
+ assumes "good a"
+ shows "bsimp (bder c (bsimp a)) = bsimp (bder c a)"
+ using assms
+ by (simp add: test2)
+
+lemma XXX2aa_ders:
+ assumes "good a"
+ shows "bsimp (bders (bsimp a) s) = bsimp (bders a s)"
+ using assms
+ by (simp add: test2)
+
+lemma XXX4a:
+ shows "good (bders_simp (bsimp r) s) \<or> bders_simp (bsimp r) s = AZERO"
+ apply(induct s arbitrary: r rule: rev_induct)
+ apply(simp)
+ apply (simp add: good1)
+ apply(simp add: bders_simp_append)
+ apply (simp add: good1)
+ done
+
+lemma XXX4a_good:
+ assumes "good a"
+ shows "good (bders_simp a s) \<or> bders_simp a s = AZERO"
+ using assms
+ apply(induct s arbitrary: a rule: rev_induct)
+ apply(simp)
+ apply(simp add: bders_simp_append)
+ apply (simp add: good1)
+ done
+
+lemma XXX4a_good_cons:
+ assumes "s \<noteq> []"
+ shows "good (bders_simp a s) \<or> bders_simp a s = AZERO"
+ using assms
+ apply(case_tac s)
+ apply(auto)
+ using XXX4a by blast
+
+lemma XXX4b:
+ assumes "good a" "L (erase (bders_simp a s)) \<noteq> {}"
+ shows "good (bders_simp a s)"
+ using assms
+ apply(induct s arbitrary: a)
+ apply(simp)
+ apply(simp)
+ apply(subgoal_tac "L (erase (bder a aa)) = {} \<or> L (erase (bder a aa)) \<noteq> {}")
+ prefer 2
+ apply(auto)[1]
+ apply(erule disjE)
+ apply(subgoal_tac "bsimp (bder a aa) = AZERO")
+ prefer 2
+ using L_bsimp_erase xxx_bder2 apply auto[1]
+ apply(simp)
+ apply (metis L.simps(1) XXX4a erase.simps(1))
+ apply(drule_tac x="bsimp (bder a aa)" in meta_spec)
+ apply(drule meta_mp)
+ apply simp
+ apply(rule good1a)
+ apply(auto)
+ done
+
+lemma bders_AZERO:
+ shows "bders AZERO s = AZERO"
+ and "bders_simp AZERO s = AZERO"
+ apply (induct s)
+ apply(auto)
+ done
+
+lemma LA:
+ assumes "\<Turnstile> v : ders s (erase r)"
+ shows "retrieve (bders r s) v = retrieve r (flex (erase r) id s v)"
+ using assms
+ apply(induct s arbitrary: r v rule: rev_induct)
+ apply(simp)
+ apply(simp add: bders_append ders_append)
+ apply(subst bder_retrieve)
+ apply(simp)
+ apply(drule Prf_injval)
+ by (simp add: flex_append)
+
+
+lemma LB:
+ assumes "s \<in> (erase r) \<rightarrow> v"
+ shows "retrieve r v = retrieve r (flex (erase r) id s (mkeps (ders s (erase r))))"
+ using assms
+ apply(induct s arbitrary: r v rule: rev_induct)
+ apply(simp)
+ apply(subgoal_tac "v = mkeps (erase r)")
+ prefer 2
+ apply (simp add: Posix1(1) Posix_determ Posix_mkeps nullable_correctness)
+ apply(simp)
+ apply(simp add: flex_append ders_append)
+ by (metis Posix_determ Posix_flex Posix_injval Posix_mkeps ders_snoc lexer_correctness(2) lexer_flex)
+
+lemma LB_sym:
+ assumes "s \<in> (erase r) \<rightarrow> v"
+ shows "retrieve r v = retrieve r (flex (erase r) id s (mkeps (erase (bders r s))))"
+ using assms
+ by (simp add: LB)
+
+
+lemma LC:
+ assumes "s \<in> (erase r) \<rightarrow> v"
+ shows "retrieve r v = retrieve (bders r s) (mkeps (erase (bders r s)))"
+ apply(simp)
+ by (metis LA LB Posix1(1) assms lexer_correct_None lexer_flex mkeps_nullable)
+
+
+lemma L0:
+ assumes "bnullable a"
+ shows "retrieve (bsimp a) (mkeps (erase (bsimp a))) = retrieve a (mkeps (erase a))"
+ using assms b3 bmkeps_retrieve bmkeps_simp bnullable_correctness
+ by (metis b3 bmkeps_retrieve bmkeps_simp bnullable_correctness)
+
+thm bmkeps_retrieve
+
+lemma L0a:
+ assumes "s \<in> L(erase a)"
+ shows "retrieve (bsimp (bders a s)) (mkeps (erase (bsimp (bders a s)))) =
+ retrieve (bders a s) (mkeps (erase (bders a s)))"
+ using assms
+ by (metis L0 bnullable_correctness erase_bders lexer_correct_None lexer_flex)
+
+lemma L0aa:
+ assumes "s \<in> L (erase a)"
+ shows "[] \<in> erase (bsimp (bders a s)) \<rightarrow> mkeps (erase (bsimp (bders a s)))"
+ using assms
+ by (metis Posix_mkeps b3 bnullable_correctness erase_bders lexer_correct_None lexer_flex)
+
+lemma L0aaa:
+ assumes "[c] \<in> L (erase a)"
+ shows "[c] \<in> (erase a) \<rightarrow> flex (erase a) id [c] (mkeps (erase (bder c a)))"
+ using assms
+ by (metis bders.simps(1) bders.simps(2) erase_bders lexer_correct_None lexer_correct_Some lexer_flex option.inject)
+
+lemma L0aaaa:
+ assumes "[c] \<in> L (erase a)"
+ shows "[c] \<in> (erase a) \<rightarrow> flex (erase a) id [c] (mkeps (erase (bders a [c])))"
+ using assms
+ using L0aaa by auto
+
+
+lemma L02:
+ assumes "bnullable (bder c a)"
+ shows "retrieve (bsimp a) (flex (erase (bsimp a)) id [c] (mkeps (erase (bder c (bsimp a))))) =
+ retrieve (bder c (bsimp a)) (mkeps (erase (bder c (bsimp a))))"
+ using assms
+ apply(simp)
+ using bder_retrieve L0 bmkeps_simp bmkeps_retrieve L0 LA LB
+ apply(subst bder_retrieve[symmetric])
+ apply (metis L_bsimp_erase bnullable_correctness der_correctness erase_bder mkeps_nullable nullable_correctness)
+ apply(simp)
+ done
+
+lemma L02_bders:
+ assumes "bnullable (bders a s)"
+ shows "retrieve (bsimp a) (flex (erase (bsimp a)) id s (mkeps (erase (bders (bsimp a) s)))) =
+ retrieve (bders (bsimp a) s) (mkeps (erase (bders (bsimp a) s)))"
+ using assms
+ by (metis LA L_bsimp_erase bnullable_correctness ders_correctness erase_bders mkeps_nullable nullable_correctness)
+
+
+
+
+lemma L03:
+ assumes "bnullable (bder c a)"
+ shows "retrieve (bder c (bsimp a)) (mkeps (erase (bder c (bsimp a)))) =
+ bmkeps (bsimp (bder c (bsimp a)))"
+ using assms
+ by (metis L0 L_bsimp_erase bmkeps_retrieve bnullable_correctness der_correctness erase_bder nullable_correctness)
+
+lemma L04:
+ assumes "bnullable (bder c a)"
+ shows "retrieve (bder c (bsimp a)) (mkeps (erase (bder c (bsimp a)))) =
+ retrieve (bsimp (bder c (bsimp a))) (mkeps (erase (bsimp (bder c (bsimp a)))))"
+ using assms
+ by (metis L0 L_bsimp_erase bnullable_correctness der_correctness erase_bder nullable_correctness)
+
+lemma L05:
+ assumes "bnullable (bder c a)"
+ shows "retrieve (bder c (bsimp a)) (mkeps (erase (bder c (bsimp a)))) =
+ retrieve (bsimp (bder c (bsimp a))) (mkeps (erase (bsimp (bder c (bsimp a)))))"
+ using assms
+ using L04 by auto
+
+lemma L06:
+ assumes "bnullable (bder c a)"
+ shows "bmkeps (bder c (bsimp a)) = bmkeps (bsimp (bder c (bsimp a)))"
+ using assms
+ by (metis L03 L_bsimp_erase bmkeps_retrieve bnullable_correctness der_correctness erase_bder nullable_correctness)
+
+lemma L07:
+ assumes "s \<in> L (erase r)"
+ shows "retrieve r (flex (erase r) id s (mkeps (ders s (erase r))))
+ = retrieve (bders r s) (mkeps (erase (bders r s)))"
+ using assms
+ using LB LC lexer_correct_Some by auto
+
+lemma L06_2:
+ assumes "bnullable (bders a [c,d])"
+ shows "bmkeps (bders (bsimp a) [c,d]) = bmkeps (bsimp (bders (bsimp a) [c,d]))"
+ using assms
+ apply(simp)
+ by (metis L_bsimp_erase bmkeps_simp bnullable_correctness der_correctness erase_bder nullable_correctness)
+
+lemma L06_bders:
+ assumes "bnullable (bders a s)"
+ shows "bmkeps (bders (bsimp a) s) = bmkeps (bsimp (bders (bsimp a) s))"
+ using assms
+ by (metis L_bsimp_erase bmkeps_simp bnullable_correctness ders_correctness erase_bders nullable_correctness)
+
+lemma LLLL:
+ shows "L (erase a) = L (erase (bsimp a))"
+ and "L (erase a) = {flat v | v. \<Turnstile> v: (erase a)}"
+ and "L (erase a) = {flat v | v. \<Turnstile> v: (erase (bsimp a))}"
+ using L_bsimp_erase apply(blast)
+ apply (simp add: L_flat_Prf)
+ using L_bsimp_erase L_flat_Prf apply(auto)[1]
+ done
+
+
+
+lemma L07XX:
+ assumes "s \<in> L (erase a)"
+ shows "s \<in> erase a \<rightarrow> flex (erase a) id s (mkeps (ders s (erase a)))"
+ using assms
+ by (meson lexer_correct_None lexer_correctness(1) lexer_flex)
+
+lemma LX0:
+ assumes "s \<in> L r"
+ shows "decode (bmkeps (bders (intern r) s)) r = Some(flex r id s (mkeps (ders s r)))"
+ by (metis assms blexer_correctness blexer_def lexer_correct_None lexer_flex)
+
+lemma L1:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "decode (bmkeps (bders (intern r) s)) r = Some v"
+ using assms
+ by (metis blexer_correctness blexer_def lexer_correctness(1) option.distinct(1))
+
+lemma L2:
+ assumes "s \<in> (der c r) \<rightarrow> v"
+ shows "decode (bmkeps (bders (intern r) (c # s))) r = Some (injval r c v)"
+ using assms
+ apply(subst bmkeps_retrieve)
+ using Posix1(1) lexer_correct_None lexer_flex apply fastforce
+ using MAIN_decode
+ apply(subst MAIN_decode[symmetric])
+ apply(simp)
+ apply (meson Posix1(1) lexer_correct_None lexer_flex mkeps_nullable)
+ apply(simp)
+ apply(subgoal_tac "v = flex (der c r) id s (mkeps (ders s (der c r)))")
+ prefer 2
+ apply (metis Posix_determ lexer_correctness(1) lexer_flex option.distinct(1))
+ apply(simp)
+ apply(subgoal_tac "injval r c (flex (der c r) id s (mkeps (ders s (der c r)))) =
+ (flex (der c r) ((\<lambda>v. injval r c v) o id) s (mkeps (ders s (der c r))))")
+ apply(simp)
+ using flex_fun_apply by blast
+
+lemma L3:
+ assumes "s2 \<in> (ders s1 r) \<rightarrow> v"
+ shows "decode (bmkeps (bders (intern r) (s1 @ s2))) r = Some (flex r id s1 v)"
+ using assms
+ apply(induct s1 arbitrary: r s2 v rule: rev_induct)
+ apply(simp)
+ using L1 apply blast
+ apply(simp add: ders_append)
+ apply(drule_tac x="r" in meta_spec)
+ apply(drule_tac x="x # s2" in meta_spec)
+ apply(drule_tac x="injval (ders xs r) x v" in meta_spec)
+ apply(drule meta_mp)
+ defer
+ apply(simp)
+ apply(simp add: flex_append)
+ by (simp add: Posix_injval)
+
+
+
+lemma bders_snoc:
+ "bder c (bders a s) = bders a (s @ [c])"
+ apply(simp add: bders_append)
+ done
+
+
+lemma QQ1:
+ shows "bsimp (bders (bsimp a) []) = bders_simp (bsimp a) []"
+ apply(simp)
+ apply(simp add: bsimp_idem)
+ done
+
+lemma QQ2:
+ shows "bsimp (bders (bsimp a) [c]) = bders_simp (bsimp a) [c]"
+ apply(simp)
+ done
+
+lemma XXX2a_long:
+ assumes "good a"
+ shows "bsimp (bder c (bsimp a)) = bsimp (bder c a)"
+ using assms
+ apply(induct a arbitrary: c taking: asize rule: measure_induct)
+ apply(case_tac x)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 3
+ apply(simp)
+ apply(simp)
+ apply(auto)[1]
+apply(case_tac "x42 = AZERO")
+ apply(simp)
+ apply(case_tac "x43 = AZERO")
+ apply(simp)
+ using test2 apply force
+ apply(case_tac "\<exists>bs. x42 = AONE bs")
+ apply(clarify)
+ apply(simp)
+ apply(subst bsimp_ASEQ1)
+ apply(simp)
+ using b3 apply force
+ using bsimp_ASEQ0 test2 apply force
+ thm good_SEQ test2
+ apply (simp add: good_SEQ test2)
+ apply (simp add: good_SEQ test2)
+ apply(case_tac "x42 = AZERO")
+ apply(simp)
+ apply(case_tac "x43 = AZERO")
+ apply(simp)
+ apply (simp add: bsimp_ASEQ0)
+ apply(case_tac "\<exists>bs. x42 = AONE bs")
+ apply(clarify)
+ apply(simp)
+ apply(subst bsimp_ASEQ1)
+ apply(simp)
+ using bsimp_ASEQ0 test2 apply force
+ apply (simp add: good_SEQ test2)
+ apply (simp add: good_SEQ test2)
+ apply (simp add: good_SEQ test2)
+ (* AALTs case *)
+ apply(simp)
+ using test2 by fastforce
+
+
+lemma bder_bsimp_AALTs:
+ shows "bder c (bsimp_AALTs bs rs) = bsimp_AALTs bs (map (bder c) rs)"
+ apply(induct bs rs rule: bsimp_AALTs.induct)
+ apply(simp)
+ apply(simp)
+ apply (simp add: bder_fuse)
+ apply(simp)
+ done
+
+lemma bders_bsimp_AALTs:
+ shows "bders (bsimp_AALTs bs rs) s = bsimp_AALTs bs (map (\<lambda>a. bders a s) rs)"
+ apply(induct s arbitrary: bs rs rule: rev_induct)
+ apply(simp)
+ apply(simp add: bders_append)
+ apply(simp add: bder_bsimp_AALTs)
+ apply(simp add: comp_def)
+ done
+
+lemma flts_nothing:
+ assumes "\<forall>r \<in> set rs. r \<noteq> AZERO" "\<forall>r \<in> set rs. nonalt r"
+ shows "flts rs = rs"
+ using assms
+ apply(induct rs rule: flts.induct)
+ apply(auto)
+ done
+
+lemma flts_flts:
+ assumes "\<forall>r \<in> set rs. good r"
+ shows "flts (flts rs) = flts rs"
+ using assms
+ apply(induct rs taking: "\<lambda>rs. sum_list (map asize rs)" rule: measure_induct)
+ apply(case_tac x)
+ apply(simp)
+ apply(simp)
+ apply(case_tac a)
+ apply(simp_all add: bder_fuse flts_append)
+ apply(subgoal_tac "\<forall>r \<in> set x52. r \<noteq> AZERO")
+ prefer 2
+ apply (metis Nil_is_append_conv bsimp_AALTs.elims good.simps(1) good.simps(5) good0 list.distinct(1) n0 nn1b split_list_last test2)
+ apply(subgoal_tac "\<forall>r \<in> set x52. nonalt r")
+ prefer 2
+ apply (metis n0 nn1b test2)
+ by (metis flts_fuse flts_nothing)
+
+
+lemma iii:
+ assumes "bsimp_AALTs bs rs \<noteq> AZERO"
+ shows "rs \<noteq> []"
+ using assms
+ apply(induct bs rs rule: bsimp_AALTs.induct)
+ apply(auto)
+ done
+
+lemma CT1_SEQ:
+ shows "bsimp (ASEQ bs a1 a2) = bsimp (ASEQ bs (bsimp a1) (bsimp a2))"
+ apply(simp add: bsimp_idem)
+ done
+
+lemma CT1:
+ shows "bsimp (AALTs bs as) = bsimp (AALTs bs (map bsimp as))"
+ apply(induct as arbitrary: bs)
+ apply(simp)
+ apply(simp)
+ by (simp add: bsimp_idem comp_def)
+
+lemma CT1a:
+ shows "bsimp (AALT bs a1 a2) = bsimp(AALT bs (bsimp a1) (bsimp a2))"
+ by (metis CT1 list.simps(8) list.simps(9))
+
+lemma WWW2:
+ shows "bsimp (bsimp_AALTs bs1 (flts (map bsimp as1))) =
+ bsimp_AALTs bs1 (flts (map bsimp as1))"
+ by (metis bsimp.simps(2) bsimp_idem)
+
+lemma CT1b:
+ shows "bsimp (bsimp_AALTs bs as) = bsimp (bsimp_AALTs bs (map bsimp as))"
+ apply(induct bs as rule: bsimp_AALTs.induct)
+ apply(auto simp add: bsimp_idem)
+ apply (simp add: bsimp_fuse bsimp_idem)
+ by (metis bsimp_idem comp_apply)
+
+
+
+
+(* CT *)
+
+lemma CTa:
+ assumes "\<forall>r \<in> set as. nonalt r \<and> r \<noteq> AZERO"
+ shows "flts as = as"
+ using assms
+ apply(induct as)
+ apply(simp)
+ apply(case_tac as)
+ apply(simp)
+ apply (simp add: k0b)
+ using flts_nothing by auto
+
+lemma CT0:
+ assumes "\<forall>r \<in> set as1. nonalt r \<and> r \<noteq> AZERO"
+ shows "flts [bsimp_AALTs bs1 as1] = flts (map (fuse bs1) as1)"
+ using assms CTa
+ apply(induct as1 arbitrary: bs1)
+ apply(simp)
+ apply(simp)
+ apply(case_tac as1)
+ apply(simp)
+ apply(simp)
+proof -
+fix a :: arexp and as1a :: "arexp list" and bs1a :: "bit list" and aa :: arexp and list :: "arexp list"
+ assume a1: "nonalt a \<and> a \<noteq> AZERO \<and> nonalt aa \<and> aa \<noteq> AZERO \<and> (\<forall>r\<in>set list. nonalt r \<and> r \<noteq> AZERO)"
+ assume a2: "\<And>as. \<forall>r\<in>set as. nonalt r \<and> r \<noteq> AZERO \<Longrightarrow> flts as = as"
+ assume a3: "as1a = aa # list"
+ have "flts [a] = [a]"
+using a1 k0b by blast
+then show "fuse bs1a a # fuse bs1a aa # map (fuse bs1a) list = flts (fuse bs1a a # fuse bs1a aa # map (fuse bs1a) list)"
+ using a3 a2 a1 by (metis (no_types) append.left_neutral append_Cons flts_fuse k00 k0b list.simps(9))
+qed
+
+
+lemma CT01:
+ assumes "\<forall>r \<in> set as1. nonalt r \<and> r \<noteq> AZERO" "\<forall>r \<in> set as2. nonalt r \<and> r \<noteq> AZERO"
+ shows "flts [bsimp_AALTs bs1 as1, bsimp_AALTs bs2 as2] = flts ((map (fuse bs1) as1) @ (map (fuse bs2) as2))"
+ using assms CT0
+ by (metis k0 k00)
+
+
+
+lemma CT_exp:
+ assumes "\<forall>a \<in> set as. bsimp (bder c (bsimp a)) = bsimp (bder c a)"
+ shows "map bsimp (map (bder c) as) = map bsimp (map (bder c) (map bsimp as))"
+ using assms
+ apply(induct as)
+ apply(auto)
+ done
+
+lemma asize_set:
+ assumes "a \<in> set as"
+ shows "asize a < Suc (sum_list (map asize as))"
+ using assms
+ apply(induct as arbitrary: a)
+ apply(auto)
+ using le_add2 le_less_trans not_less_eq by blast
+
+lemma L_erase_bder_simp:
+ shows "L (erase (bsimp (bder a r))) = L (der a (erase (bsimp r)))"
+ using L_bsimp_erase der_correctness by auto
+
+lemma PPP0:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "(bders (intern r) s) >> code v"
+ using assms
+ by (smt L07 L1 LX0 Posix1(1) Posix_Prf contains6 erase_bders erase_intern lexer_correct_None lexer_flex mkeps_nullable option.inject retrieve_code)
+
+thm L07 L1 LX0 Posix1(1) Posix_Prf contains6 erase_bders erase_intern lexer_correct_None lexer_flex mkeps_nullable option.inject retrieve_code
+
+
+lemma PPP0_isar:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "(bders (intern r) s) >> code v"
+proof -
+ from assms have a1: "\<Turnstile> v : r" using Posix_Prf by simp
+
+ from assms have "s \<in> L r" using Posix1(1) by auto
+ then have "[] \<in> L (ders s r)" by (simp add: ders_correctness Ders_def)
+ then have a2: "\<Turnstile> mkeps (ders s r) : ders s r"
+ by (simp add: mkeps_nullable nullable_correctness)
+
+ have "retrieve (bders (intern r) s) (mkeps (ders s r)) =
+ retrieve (intern r) (flex r id s (mkeps (ders s r)))" using a2 LA LB bder_retrieve by simp
+ also have "... = retrieve (intern r) v"
+ using LB assms by auto
+ also have "... = code v" using a1 by (simp add: retrieve_code)
+ finally have "retrieve (bders (intern r) s) (mkeps (ders s r)) = code v" by simp
+ moreover
+ have "\<Turnstile> mkeps (ders s r) : erase (bders (intern r) s)" using a2 by simp
+ then have "bders (intern r) s >> retrieve (bders (intern r) s) (mkeps (ders s r))"
+ by (rule contains6)
+ ultimately
+ show "(bders (intern r) s) >> code v" by simp
+qed
+
+lemma PPP0b:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "(intern r) >> code v"
+ using assms
+ using Posix_Prf contains2 by auto
+
+lemma PPP0_eq:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "(intern r >> code v) = (bders (intern r) s >> code v)"
+ using assms
+ using PPP0_isar PPP0b by blast
+
+lemma f_cont1:
+ assumes "fuse bs1 a >> bs"
+ shows "\<exists>bs2. bs = bs1 @ bs2"
+ using assms
+ apply(induct a arbitrary: bs1 bs)
+ apply(auto elim: contains.cases)
+ done
+
+
+lemma f_cont2:
+ assumes "bsimp_AALTs bs1 as >> bs"
+ shows "\<exists>bs2. bs = bs1 @ bs2"
+ using assms
+ apply(induct bs1 as arbitrary: bs rule: bsimp_AALTs.induct)
+ apply(auto elim: contains.cases f_cont1)
+ done
+
+lemma contains_SEQ1:
+ assumes "bsimp_ASEQ bs r1 r2 >> bsX"
+ shows "\<exists>bs1 bs2. r1 >> bs1 \<and> r2 >> bs2 \<and> bsX = bs @ bs1 @ bs2"
+ using assms
+ apply(auto)
+ apply(case_tac "r1 = AZERO")
+ apply(auto)
+ using contains.simps apply blast
+ apply(case_tac "r2 = AZERO")
+ apply(auto)
+ apply(simp add: bsimp_ASEQ0)
+ using contains.simps apply blast
+ apply(case_tac "\<exists>bsX. r1 = AONE bsX")
+ apply(auto)
+ apply(simp add: bsimp_ASEQ2)
+ apply (metis append_assoc contains.intros(1) contains49 f_cont1)
+ apply(simp add: bsimp_ASEQ1)
+ apply(erule contains.cases)
+ apply(auto)
+ done
+
+lemma contains59:
+ assumes "AALTs bs rs >> bs2"
+ shows "\<exists>r \<in> set rs. (fuse bs r) >> bs2"
+ using assms
+ apply(induct rs arbitrary: bs bs2)
+ apply(auto)
+ apply(erule contains.cases)
+ apply(auto)
+ apply(erule contains.cases)
+ apply(auto)
+ using contains0 by blast
+
+lemma contains60:
+ assumes "\<exists>r \<in> set rs. fuse bs r >> bs2"
+ shows "AALTs bs rs >> bs2"
+ using assms
+ apply(induct rs arbitrary: bs bs2)
+ apply(auto)
+ apply (metis contains3b contains49 f_cont1)
+ using contains.intros(5) f_cont1 by blast
+
+
+
+lemma contains61:
+ assumes "bsimp_AALTs bs rs >> bs2"
+ shows "\<exists>r \<in> set rs. (fuse bs r) >> bs2"
+ using assms
+ apply(induct arbitrary: bs2 rule: bsimp_AALTs.induct)
+ apply(auto)
+ using contains.simps apply blast
+ using contains59 by fastforce
+
+lemma contains61b:
+ assumes "bsimp_AALTs bs rs >> bs2"
+ shows "\<exists>r \<in> set (flts rs). (fuse bs r) >> bs2"
+ using assms
+ apply(induct bs rs arbitrary: bs2 rule: bsimp_AALTs.induct)
+ apply(auto)
+ using contains.simps apply blast
+ using contains51d contains61 f_cont1 apply blast
+ by (metis bsimp_AALTs.simps(3) contains52 contains61 f_cont2)
+
+
+
+lemma contains61a:
+ assumes "\<exists>r \<in> set rs. (fuse bs r) >> bs2"
+ shows "bsimp_AALTs bs rs >> bs2"
+ using assms
+ apply(induct rs arbitrary: bs2 bs)
+ apply(auto)
+ apply (metis bsimp_AALTs.elims contains60 list.distinct(1) list.inject list.set_intros(1))
+ by (metis append_Cons append_Nil contains50 f_cont2)
+
+lemma contains62:
+ assumes "bsimp_AALTs bs (rs1 @ rs2) >> bs2"
+ shows "bsimp_AALTs bs rs1 >> bs2 \<or> bsimp_AALTs bs rs2 >> bs2"
+ using assms
+ apply -
+ apply(drule contains61)
+ apply(auto)
+ apply(case_tac rs1)
+ apply(auto)
+ apply(case_tac list)
+ apply(auto)
+ apply (simp add: contains60)
+ apply(case_tac list)
+ apply(auto)
+ apply (simp add: contains60)
+ apply (meson contains60 list.set_intros(2))
+ apply(case_tac rs2)
+ apply(auto)
+ apply(case_tac list)
+ apply(auto)
+ apply (simp add: contains60)
+ apply(case_tac list)
+ apply(auto)
+ apply (simp add: contains60)
+ apply (meson contains60 list.set_intros(2))
+ done
+
+lemma contains63:
+ assumes "AALTs bs (map (fuse bs1) rs) >> bs3"
+ shows "AALTs (bs @ bs1) rs >> bs3"
+ using assms
+ apply(induct rs arbitrary: bs bs1 bs3)
+ apply(auto elim: contains.cases)
+ apply(erule contains.cases)
+ apply(auto)
+ apply (simp add: contains0 contains60 fuse_append)
+ by (metis contains.intros(5) contains59 f_cont1)
+
+lemma contains64:
+ assumes "bsimp_AALTs bs (flts rs1 @ flts rs2) >> bs2" "\<forall>r \<in> set rs2. \<not> fuse bs r >> bs2"
+ shows "bsimp_AALTs bs (flts rs1) >> bs2"
+ using assms
+ apply(induct rs2 arbitrary: rs1 bs bs2)
+ apply(auto)
+ apply(drule_tac x="rs1" in meta_spec)
+ apply(drule_tac x="bs" in meta_spec)
+ apply(drule_tac x="bs2" in meta_spec)
+ apply(drule meta_mp)
+ apply(drule contains61)
+ apply(auto)
+ using contains51b contains61a f_cont1 apply blast
+ apply(subst (asm) k0)
+ apply(auto)
+ prefer 2
+ using contains50 contains61a f_cont1 apply blast
+ apply(case_tac a)
+ apply(auto)
+ by (metis contains60 fuse_append)
+
+
+
+lemma contains65:
+ assumes "bsimp_AALTs bs (flts rs) >> bs2"
+ shows "\<exists>r \<in> set rs. (fuse bs r) >> bs2"
+ using assms
+ apply(induct rs arbitrary: bs bs2 taking: "\<lambda>rs. sum_list (map asize rs)" rule: measure_induct)
+ apply(case_tac x)
+ apply(auto elim: contains.cases)
+ apply(case_tac list)
+ apply(auto elim: contains.cases)
+ apply(case_tac a)
+ apply(auto elim: contains.cases)
+ apply(drule contains61)
+ apply(auto)
+ apply (metis contains60 fuse_append)
+ apply(case_tac lista)
+ apply(auto elim: contains.cases)
+ apply(subst (asm) k0)
+ apply(drule contains62)
+ apply(auto)
+ apply(case_tac a)
+ apply(auto elim: contains.cases)
+ apply(case_tac x52)
+ apply(auto elim: contains.cases)
+ apply(case_tac list)
+ apply(auto elim: contains.cases)
+ apply (simp add: contains60 fuse_append)
+ apply(erule contains.cases)
+ apply(auto)
+ apply (metis append.left_neutral contains0 contains60 fuse.simps(4) in_set_conv_decomp)
+ apply(erule contains.cases)
+ apply(auto)
+ apply (metis contains0 contains60 fuse.simps(4) list.set_intros(1) list.set_intros(2))
+ apply (simp add: contains.intros(5) contains63)
+ apply(case_tac aa)
+ apply(auto)
+ apply (meson contains60 contains61 contains63)
+ apply(subst (asm) k0)
+ apply(drule contains64)
+ apply(auto)[1]
+ by (metis append_Nil2 bsimp_AALTs.simps(2) contains50 contains61a contains64 f_cont2 flts.simps(1))
+
+
+lemma contains55a:
+ assumes "bsimp r >> bs"
+ shows "r >> bs"
+ using assms
+ apply(induct r arbitrary: bs)
+ apply(auto)
+ apply(frule contains_SEQ1)
+ apply(auto)
+ apply (simp add: contains.intros(3))
+ apply(frule f_cont2)
+ apply(auto)
+ apply(drule contains65)
+ apply(auto)
+ using contains0 contains49 contains60 by blast
+
+
+lemma PPP1_eq:
+ shows "bsimp r >> bs \<longleftrightarrow> r >> bs"
+ using contains55 contains55a by blast
+
+
+definition "SET a \<equiv> {bs . a >> bs}"
+
+lemma "SET(bsimp a) \<subseteq> SET(a)"
+ unfolding SET_def
+ apply(auto simp add: PPP1_eq)
+ done
+
+lemma retrieve_code_bder:
+ assumes "\<Turnstile> v : der c r"
+ shows "code (injval r c v) = retrieve (bder c (intern r)) v"
+ using assms
+ by (simp add: Prf_injval bder_retrieve retrieve_code)
+
+lemma Etrans:
+ assumes "a >> s" "s = t"
+ shows "a >> t"
+ using assms by simp
+
+
+
+lemma retrieve_code_bders:
+ assumes "\<Turnstile> v : ders s r"
+ shows "code (flex r id s v) = retrieve (bders (intern r) s) v"
+ using assms
+ apply(induct s arbitrary: v r rule: rev_induct)
+ apply(auto simp add: ders_append flex_append bders_append)
+ apply (simp add: retrieve_code)
+ apply(frule Prf_injval)
+ apply(drule_tac meta_spec)+
+ apply(drule meta_mp)
+ apply(assumption)
+ apply(simp)
+ apply(subst bder_retrieve)
+ apply(simp)
+ apply(simp)
+ done
+
+lemma contains70:
+ assumes "s \<in> L(r)"
+ shows "bders (intern r) s >> code (flex r id s (mkeps (ders s r)))"
+ apply(subst PPP0_eq[symmetric])
+ apply (meson assms lexer_correct_None lexer_correctness(1) lexer_flex)
+ by (metis L07XX PPP0b assms erase_intern)
+
+
+
+lemma PPP:
+ assumes "\<Turnstile> v : r"
+ shows "intern r >> (retrieve (intern r) v)"
+ using assms
+ using contains5 by blast
+
+
+
+
+
+
+
+
+definition FC where
+ "FC a s v = retrieve a (flex (erase a) id s v)"
+
+definition FE where
+ "FE a s = retrieve a (flex (erase a) id s (mkeps (ders s (erase a))))"
+
+definition PV where
+ "PV r s v = flex r id s v"
+
+definition PX where
+ "PX r s = PV r s (mkeps (ders s r))"
+
+
+lemma FE_PX:
+ shows "FE r s = retrieve r (PX (erase r) s)"
+ unfolding FE_def PX_def PV_def by(simp)
+
+lemma FE_PX_code:
+ assumes "s \<in> L r"
+ shows "FE (intern r) s = code (PX r s)"
+ unfolding FE_def PX_def PV_def
+ using assms
+ by (metis L07XX Posix_Prf erase_intern retrieve_code)
+
+
+lemma PV_id[simp]:
+ shows "PV r [] v = v"
+ by (simp add: PV_def)
+
+lemma PX_id[simp]:
+ shows "PX r [] = mkeps r"
+ by (simp add: PX_def)
+
+lemma PV_cons:
+ shows "PV r (c # s) v = injval r c (PV (der c r) s v)"
+ apply(simp add: PV_def flex_fun_apply)
+ done
+
+lemma PX_cons:
+ shows "PX r (c # s) = injval r c (PX (der c r) s)"
+ apply(simp add: PX_def PV_cons)
+ done
+
+lemma PV_append:
+ shows "PV r (s1 @ s2) v = PV r s1 (PV (ders s1 r) s2 v)"
+ apply(simp add: PV_def flex_append)
+ by (simp add: flex_fun_apply2)
+
+lemma PX_append:
+ shows "PX r (s1 @ s2) = PV r s1 (PX (ders s1 r) s2)"
+ by (simp add: PV_append PX_def ders_append)
+
+lemma code_PV0:
+ shows "PV r (c # s) v = injval r c (PV (der c r) s v)"
+ unfolding PX_def PV_def
+ apply(simp)
+ by (simp add: flex_injval)
+
+lemma code_PX0:
+ shows "PX r (c # s) = injval r c (PX (der c r) s)"
+ unfolding PX_def
+ apply(simp add: code_PV0)
+ done
+
+lemma Prf_PV:
+ assumes "\<Turnstile> v : ders s r"
+ shows "\<Turnstile> PV r s v : r"
+ using assms unfolding PX_def PV_def
+ apply(induct s arbitrary: v r)
+ apply(simp)
+ apply(simp)
+ by (simp add: Prf_injval flex_injval)
+
+
+lemma Prf_PX:
+ assumes "s \<in> L r"
+ shows "\<Turnstile> PX r s : r"
+ using assms unfolding PX_def PV_def
+ using L1 LX0 Posix_Prf lexer_correct_Some by fastforce
+
+lemma PV1:
+ assumes "\<Turnstile> v : ders s r"
+ shows "(intern r) >> code (PV r s v)"
+ using assms
+ by (simp add: Prf_PV contains2)
+
+lemma PX1:
+ assumes "s \<in> L r"
+ shows "(intern r) >> code (PX r s)"
+ using assms
+ by (simp add: Prf_PX contains2)
+
+lemma PX2:
+ assumes "s \<in> L (der c r)"
+ shows "bder c (intern r) >> code (injval r c (PX (der c r) s))"
+ using assms
+ by (simp add: Prf_PX contains6 retrieve_code_bder)
+
+lemma PX2a:
+ assumes "c # s \<in> L r"
+ shows "bder c (intern r) >> code (injval r c (PX (der c r) s))"
+ using assms
+ using PX2 lexer_correct_None by force
+
+lemma PX2b:
+ assumes "c # s \<in> L r"
+ shows "bder c (intern r) >> code (PX r (c # s))"
+ using assms unfolding PX_def PV_def
+ by (metis Der_def L07XX PV_def PX2a PX_def Posix_determ Posix_injval der_correctness erase_intern mem_Collect_eq)
+
+lemma PV3:
+ assumes "\<Turnstile> v : ders s r"
+ shows "bders (intern r) s >> code (PV r s v)"
+ using assms
+ using PX_def PV_def contains70
+ by (simp add: contains6 retrieve_code_bders)
+
+lemma PX3:
+ assumes "s \<in> L r"
+ shows "bders (intern r) s >> code (PX r s)"
+ using assms
+ using PX_def PV_def contains70 by auto
+
+
+lemma PV_bders_iff:
+ assumes "\<Turnstile> v : ders s r"
+ shows "bders (intern r) s >> code (PV r s v) \<longleftrightarrow> (intern r) >> code (PV r s v)"
+ by (simp add: PV1 PV3 assms)
+
+lemma PX_bders_iff:
+ assumes "s \<in> L r"
+ shows "bders (intern r) s >> code (PX r s) \<longleftrightarrow> (intern r) >> code (PX r s)"
+ by (simp add: PX1 PX3 assms)
+
+lemma PX4:
+ assumes "(s1 @ s2) \<in> L r"
+ shows "bders (intern r) (s1 @ s2) >> code (PX r (s1 @ s2))"
+ using assms
+ by (simp add: PX3)
+
+lemma PX_bders_iff2:
+ assumes "(s1 @ s2) \<in> L r"
+ shows "bders (intern r) (s1 @ s2) >> code (PX r (s1 @ s2)) \<longleftrightarrow>
+ (intern r) >> code (PX r (s1 @ s2))"
+ by (simp add: PX1 PX3 assms)
+
+lemma PV_bders_iff3:
+ assumes "\<Turnstile> v : ders (s1 @ s2) r"
+ shows "bders (intern r) (s1 @ s2) >> code (PV r (s1 @ s2) v) \<longleftrightarrow>
+ bders (intern r) s1 >> code (PV r (s1 @ s2) v)"
+ by (metis PV3 PV_append Prf_PV assms ders_append)
+
+
+
+lemma PX_bders_iff3:
+ assumes "(s1 @ s2) \<in> L r"
+ shows "bders (intern r) (s1 @ s2) >> code (PX r (s1 @ s2)) \<longleftrightarrow>
+ bders (intern r) s1 >> code (PX r (s1 @ s2))"
+ by (metis Ders_def L07XX PV_append PV_def PX4 PX_def Posix_Prf assms contains6 ders_append ders_correctness erase_bders erase_intern mem_Collect_eq retrieve_code_bders)
+
+lemma PV_bder_iff:
+ assumes "\<Turnstile> v : ders (s1 @ [c]) r"
+ shows "bder c (bders (intern r) s1) >> code (PV r (s1 @ [c]) v) \<longleftrightarrow>
+ bders (intern r) s1 >> code (PV r (s1 @ [c]) v)"
+ by (simp add: PV_bders_iff3 assms bders_snoc)
+
+lemma PV_bder_IFF:
+ assumes "\<Turnstile> v : ders (s1 @ c # s2) r"
+ shows "bder c (bders (intern r) s1) >> code (PV r (s1 @ c # s2) v) \<longleftrightarrow>
+ bders (intern r) s1 >> code (PV r (s1 @ c # s2) v)"
+ by (metis LA PV3 PV_def Prf_PV assms bders_append code_PV0 contains7 ders.simps(2) erase_bders erase_intern retrieve_code_bders)
+
+
+lemma PX_bder_iff:
+ assumes "(s1 @ [c]) \<in> L r"
+ shows "bder c (bders (intern r) s1) >> code (PX r (s1 @ [c])) \<longleftrightarrow>
+ bders (intern r) s1 >> code (PX r (s1 @ [c]))"
+ by (simp add: PX_bders_iff3 assms bders_snoc)
+
+lemma PV_bder_iff2:
+ assumes "\<Turnstile> v : ders (c # s1) r"
+ shows "bders (bder c (intern r)) s1 >> code (PV r (c # s1) v) \<longleftrightarrow>
+ bder c (intern r) >> code (PV r (c # s1) v)"
+ by (metis PV3 Prf_PV assms bders.simps(2) code_PV0 contains7 ders.simps(2) erase_intern retrieve_code)
+
+
+lemma PX_bder_iff2:
+ assumes "(c # s1) \<in> L r"
+ shows "bders (bder c (intern r)) s1 >> code (PX r (c # s1)) \<longleftrightarrow>
+ bder c (intern r) >> code (PX r (c # s1))"
+ using PX2b PX3 assms by force
+
+
+lemma FC_id:
+ shows "FC r [] v = retrieve r v"
+ by (simp add: FC_def)
+
+lemma FC_char:
+ shows "FC r [c] v = retrieve r (injval (erase r) c v)"
+ by (simp add: FC_def)
+
+lemma FC_char2:
+ assumes "\<Turnstile> v : der c (erase r)"
+ shows "FC r [c] v = FC (bder c r) [] v"
+ using assms
+ by (simp add: FC_char FC_id bder_retrieve)
+
+
+lemma FC_bders_iff:
+ assumes "\<Turnstile> v : ders s (erase r)"
+ shows "bders r s >> FC r s v \<longleftrightarrow> r >> FC r s v"
+ unfolding FC_def
+ by (simp add: assms contains8_iff)
+
+
+lemma FC_bder_iff:
+ assumes "\<Turnstile> v : der c (erase r)"
+ shows "bder c r >> FC r [c] v \<longleftrightarrow> r >> FC r [c] v"
+ apply(subst FC_bders_iff[symmetric])
+ apply(simp add: assms)
+ apply(simp)
+ done
+
+lemma FC_bders_iff2:
+ assumes "\<Turnstile> v : ders (c # s) (erase r)"
+ shows "bders r (c # s) >> FC r (c # s) v \<longleftrightarrow> bders (bder c r) s >> FC (bder c r) s v"
+ apply(subst FC_bders_iff)
+ using assms apply simp
+ by (metis FC_def assms contains7b contains8_iff ders.simps(2) erase_bder)
+
+
+lemma FC_bnullable0:
+ assumes "bnullable r"
+ shows "FC r [] (mkeps (erase r)) = FC (bsimp r) [] (mkeps (erase (bsimp r)))"
+ unfolding FC_def
+ by (simp add: L0 assms)
+
+
+lemma FC_nullable2:
+ assumes "bnullable (bders a s)"
+ shows "FC (bsimp a) s (mkeps (erase (bders (bsimp a) s))) =
+ FC (bders (bsimp a) s) [] (mkeps (erase (bders (bsimp a) s)))"
+ unfolding FC_def
+ using L02_bders assms by auto
+
+lemma FC_nullable3:
+ assumes "bnullable (bders a s)"
+ shows "FC a s (mkeps (erase (bders a s))) =
+ FC (bders a s) [] (mkeps (erase (bders a s)))"
+ unfolding FC_def
+ using LA assms bnullable_correctness mkeps_nullable by fastforce
+
+
+lemma FE_contains0:
+ assumes "bnullable r"
+ shows "r >> FE r []"
+ by (simp add: FE_def assms bnullable_correctness contains6 mkeps_nullable)
+
+lemma FE_contains1:
+ assumes "bnullable (bders r s)"
+ shows "r >> FE r s"
+ by (metis FE_def Prf_flex assms bnullable_correctness contains6 erase_bders mkeps_nullable)
+
+lemma FE_bnullable0:
+ assumes "bnullable r"
+ shows "FE r [] = FE (bsimp r) []"
+ unfolding FE_def
+ by (simp add: L0 assms)
+
+
+lemma FE_nullable1:
+ assumes "bnullable (bders r s)"
+ shows "FE r s = FE (bders r s) []"
+ unfolding FE_def
+ using LA assms bnullable_correctness mkeps_nullable by fastforce
+
+lemma FE_contains2:
+ assumes "bnullable (bders r s)"
+ shows "r >> FE (bders r s) []"
+ by (metis FE_contains1 FE_nullable1 assms)
+
+lemma FE_contains3:
+ assumes "bnullable (bder c r)"
+ shows "r >> FE (bsimp (bder c r)) []"
+ by (metis FE_def L0 assms bder_retrieve bders.simps(1) bnullable_correctness contains7a erase_bder erase_bders flex.simps(1) id_apply mkeps_nullable)
+
+lemma FE_contains4:
+ assumes "bnullable (bders r s)"
+ shows "r >> FE (bsimp (bders r s)) []"
+ using FE_bnullable0 FE_contains2 assms by auto
+
+lemma FC4:
+ assumes "\<Turnstile> v : ders s (erase a)"
+ shows "FC a s v = FC (bders a s) [] v"
+ unfolding FC_def by (simp add: LA assms)
+
+lemma FC5:
+ assumes "nullable (erase a)"
+ shows "FC a [] (mkeps (erase a)) = FC (bsimp a) [] (mkeps (erase (bsimp a)))"
+ unfolding FC_def
+ using L0 assms bnullable_correctness by auto
+
+
+lemma in1:
+ assumes "AALTs bsX rsX \<in> set rs"
+ shows "\<forall>r \<in> set rsX. fuse bsX r \<in> set (flts rs)"
+ using assms
+ apply(induct rs arbitrary: bsX rsX)
+ apply(auto)
+ by (metis append_assoc in_set_conv_decomp k0)
+
+lemma in2a:
+ assumes "nonnested (bsimp r)" "\<not>nonalt(bsimp r)"
+ shows "(\<exists>bsX rsX. r = AALTs bsX rsX) \<or> (\<exists>bsX rX1 rX2. r = ASEQ bsX rX1 rX2 \<and> bnullable rX1)"
+ using assms
+ apply(induct r)
+ apply(auto)
+ by (metis arexp.distinct(25) b3 bnullable.simps(2) bsimp_ASEQ.simps(1) bsimp_ASEQ0 bsimp_ASEQ1 nonalt.elims(3) nonalt.simps(2))
+
+
+lemma [simp]:
+ shows "size (fuse bs r) = size r"
+ by (induct r) (auto)
+
+fun AALTs_subs where
+ "AALTs_subs (AZERO) = {}"
+| "AALTs_subs (AONE bs) = {AONE bs}"
+| "AALTs_subs (ACHAR bs c) = {ACHAR bs c}"
+| "AALTs_subs (ASEQ bs r1 r2) = {ASEQ bs r1 r2}"
+| "AALTs_subs (ASTAR bs r) = {ASTAR bs r}"
+| "AALTs_subs (AALTs bs []) = {}"
+| "AALTs_subs (AALTs bs (r#rs)) = AALTs_subs (fuse bs r) \<union> AALTs_subs (AALTs bs rs)"
+
+lemma nonalt_10:
+ assumes "nonalt r" "r \<noteq> AZERO"
+ shows "r \<in> AALTs_subs r"
+ using assms
+ apply(induct r)
+ apply(auto)
+ done
+
+lemma flt_fuse:
+ shows "flts (map (fuse bs) rs) = map (fuse bs) (flts rs)"
+ apply(induct rs arbitrary: bs rule: flts.induct)
+ apply(auto)
+ by (simp add: fuse_append)
+
+lemma AALTs_subs_fuse:
+ shows "AALTs_subs (fuse bs r) = (fuse bs) ` (AALTs_subs r)"
+ apply(induct r arbitrary: bs rule: AALTs_subs.induct)
+ apply(auto)
+ apply (simp add: fuse_append)
+ apply blast
+ by (simp add: fuse_append)
+
+lemma AALTs_subs_fuse2:
+ shows "AALTs_subs (AALTs bs rs) = AALTs_subs (AALTs [] (map (fuse bs) rs))"
+ apply(induct rs arbitrary: bs)
+ apply(auto)
+ apply (auto simp add: fuse_empty)
+ done
+
+lemma fuse_map:
+ shows "map (fuse (bs1 @ bs2)) rs = map (fuse bs1) (map (fuse bs2) rs)"
+ apply(induct rs)
+ apply(auto)
+ using fuse_append by blast
+
+
+
+lemma contains59_2:
+ assumes "AALTs bs rs >> bs2"
+ shows "\<exists>r\<in>AALTs_subs (AALTs bs rs). r >> bs2"
+ using assms
+ apply(induct rs arbitrary: bs bs2 taking: "\<lambda>rs. sum_list (map asize rs)" rule: measure_induct)
+ apply(case_tac x)
+ apply(auto)
+ using contains59 apply force
+ apply(erule contains.cases)
+ apply(auto)
+ apply(case_tac "r = AZERO")
+ apply(simp)
+ apply (metis bsimp_AALTs.simps(1) contains61 empty_iff empty_set)
+ apply(case_tac "nonalt r")
+ apply (metis UnCI bsimp_AALTs.simps(1) contains0 contains61 empty_iff empty_set nn11a nonalt_10)
+ apply(subgoal_tac "\<exists>bsX rsX. r = AALTs bsX rsX")
+ prefer 2
+ using bbbbs1 apply blast
+ apply(auto)
+ apply (metis UnCI contains0 fuse.simps(4) less_add_Suc1)
+ apply(drule_tac x="rs" in spec)
+ apply(drule mp)
+ apply(simp add: asize0)
+ apply(drule_tac x="bsa" in spec)
+ apply(drule_tac x="bsa @ bs1" in spec)
+ apply(auto)
+ done
+
+lemma TEMPLATE_contains61a:
+ assumes "\<exists>r \<in> set rs. (fuse bs r) >> bs2"
+ shows "bsimp_AALTs bs rs >> bs2"
+ using assms
+ apply(induct rs arbitrary: bs2 bs)
+ apply(auto)
+ apply (metis bsimp_AALTs.elims contains60 list.distinct(1) list.inject list.set_intros(1))
+ by (metis append_Cons append_Nil contains50 f_cont2)
+
+
+
+
+lemma H1:
+ assumes "r >> bs2" "r \<in> AALTs_subs a"
+ shows "a >> bs2"
+ using assms
+ apply(induct a arbitrary: r bs2 rule: AALTs_subs.induct)
+ apply(auto)
+ apply (simp add: contains60)
+ by (simp add: contains59 contains60)
+
+lemma H3:
+ assumes "a >> bs"
+ shows "\<exists>r \<in> AALTs_subs a. r >> bs"
+ using assms
+ apply(induct a bs)
+ apply(auto intro: contains.intros)
+ using contains.intros(4) contains59_2 by fastforce
+
+lemma H4:
+ shows "AALTs_subs (AALTs bs rs1) \<subseteq> AALTs_subs (AALTs bs (rs1 @ rs2))"
+ apply(induct rs1)
+ apply(auto)
+ done
+
+lemma H5:
+ shows "AALTs_subs (AALTs bs rs2) \<subseteq> AALTs_subs (AALTs bs (rs1 @ rs2))"
+ apply(induct rs1)
+ apply(auto)
+ done
+
+lemma H7:
+ shows "AALTs_subs (AALTs bs (rs1 @ rs2)) = AALTs_subs (AALTs bs rs1) \<union> AALTs_subs (AALTs bs rs2)"
+ apply(induct rs1)
+ apply(auto)
+ done
+
+lemma H10:
+ shows "AALTs_subs (AALTs bs rs) = (\<Union>r \<in> set rs. AALTs_subs (fuse bs r))"
+ apply(induct rs arbitrary: bs)
+ apply(auto)
+ done
+
+lemma H6:
+ shows "AALTs_subs (AALTs bs (flts rs)) = AALTs_subs (AALTs bs rs)"
+ apply(induct rs arbitrary: bs rule: flts.induct)
+ apply(auto)
+ apply (metis AALTs_subs_fuse2 H7 Un_iff fuse_map)
+ apply (metis AALTs_subs_fuse2 H7 UnCI fuse_map)
+ by (simp add: H7)
+
+
+
+lemma H2:
+ assumes "r >> bs2" "r \<in> AALTs_subs (AALTs bs rs)"
+ shows "r \<in> AALTs_subs (AALTs bs (flts rs))"
+ using assms
+ apply(induct rs arbitrary: r bs bs2 rule: flts.induct)
+ apply(auto)
+ apply (metis AALTs_subs_fuse2 H4 fuse_map in_mono)
+ using H7 by blast
+
+lemma HH1:
+ assumes "r \<in> AALTs_subs (fuse bs a)" "r >> bs2"
+ shows "\<exists>bs3. bs2 = bs @ bs3"
+ using assms
+ using H1 f_cont1 by blast
+
+lemma fuse_inj:
+ assumes "fuse bs a = fuse bs b"
+ shows "a = b"
+ using assms
+ apply(induct a arbitrary: bs b)
+ apply(auto)
+ apply(case_tac b)
+ apply(auto)
+ apply(case_tac b)
+ apply(auto)
+ apply(case_tac b)
+ apply(auto)
+ apply(case_tac b)
+ apply(auto)
+ apply(case_tac b)
+ apply(auto)
+ apply(case_tac b)
+ apply(auto)
+ done
+
+lemma HH11:
+ assumes "r \<in> AALTs_subs (fuse bs1 a)"
+ shows "fuse bs r \<in> AALTs_subs (fuse (bs @ bs1) a)"
+ using assms
+ apply(induct a arbitrary: r bs bs1)
+ apply(auto)
+ apply(subst (asm) H10)
+ apply(auto)
+ apply(drule_tac x="x" in meta_spec)
+ apply(simp)
+ apply(drule_tac x="r" in meta_spec)
+ apply(drule_tac x="bs" in meta_spec)
+ apply(drule_tac x="bs1 @ x1" in meta_spec)
+ apply(simp)
+ apply(subst H10)
+ apply(auto)
+ done
+
+lemma HH12:
+ assumes "r \<in> AALTs_subs a"
+ shows "fuse bs r \<in> AALTs_subs (fuse bs a)"
+ using AALTs_subs_fuse assms by blast
+
+lemma HH13:
+ assumes "r \<in> (\<Union>r \<in> set rs. AALTs_subs r)"
+ shows "fuse bs r \<in> AALTs_subs (AALTs bs rs)"
+ using assms
+ using H10 HH12 by blast
+
+
+lemma contains61a_2:
+ assumes "\<exists>r\<in>AALTs_subs (AALTs bs rs). r >> bs2"
+ shows "bsimp_AALTs bs rs >> bs2"
+ using assms
+ apply(induct rs arbitrary: bs2 bs)
+ apply(auto)
+ apply (simp add: H1 TEMPLATE_contains61a)
+ by (metis append_Cons append_Nil contains50 f_cont2)
+
+lemma contains_equiv_def2:
+ shows " (AALTs bs as >> bs@bs1) \<longleftrightarrow> (\<exists>a\<in>(\<Union> (AALTs_subs ` set as)). a >> bs1)"
+ by (metis H1 H3 UN_E UN_I contains0 contains49 contains59 contains60)
+
+lemma contains_equiv_def:
+ shows "(AALTs bs as >> bs@bs1) \<longleftrightarrow> (\<exists>a\<in>set as. a >> bs1)"
+ by (meson contains0 contains49 contains59 contains60)
+
+lemma map_fuse2:
+ shows "map (bder c) (map (fuse bs) as) = map (fuse bs) (map (bder c) as)"
+ by (simp add: map_bder_fuse)
+
+lemma map_fuse3:
+ shows "map (\<lambda>a. bders a s) (map (fuse bs) as) = map (fuse bs) (map (\<lambda>a. bders a s) as)"
+ apply(induct s arbitrary: bs as rule: rev_induct)
+ apply(auto simp add: bders_append map_fuse2)
+ using bder_fuse by blast
+
+lemma bders_AALTs:
+ shows "bders (AALTs bs2 as) s = AALTs bs2 (map (\<lambda>a. bders a s) as)"
+ apply(induct s arbitrary: bs2 as rule: rev_induct)
+ apply(auto simp add: bders_append)
+ done
+
+lemma bders_AALTs_contains:
+ shows "bders (AALTs bs2 as) s >> bs2 @ bs \<longleftrightarrow>
+ AALTs bs2 (map (\<lambda>a. bders a s) as) >> bs2 @ bs"
+ apply(induct s arbitrary: bs bs2 as)
+ apply(auto)[1]
+ apply(simp)
+ by (smt comp_apply map_eq_conv)
+
+
+lemma derc_alt00_Urb:
+ shows "bder c (bsimp_AALTs bs2 (flts [bsimp a])) >> bs2 @ bs \<longleftrightarrow>
+ fuse bs2 (bder c (bsimp a)) >> bs2 @ bs"
+ apply(case_tac "bsimp a")
+ apply(auto)
+ apply(subst (asm) bder_bsimp_AALTs)
+ apply(subst (asm) map_fuse2)
+ using contains60 contains61 contains63 apply blast
+ by (metis bder_bsimp_AALTs contains51c map_bder_fuse map_map)
+
+lemma ders_alt00_Urb:
+ shows "bders (bsimp_AALTs bs2 (flts [bsimp a])) s >> bs2 @ bs \<longleftrightarrow>
+ fuse bs2 (bders (bsimp a) s) >> bs2 @ bs"
+ apply(case_tac "bsimp a")
+ apply (simp add: bders_AZERO(1))
+ using bders_fuse bsimp_AALTs.simps(2) flts.simps(1) flts.simps(4) apply presburger
+ using bders_fuse bsimp_AALTs.simps(2) flts.simps(1) flts.simps(5) apply presburger
+ using bders_fuse bsimp_AALTs.simps(2) flts.simps(1) flts.simps(6) apply presburger
+ prefer 2
+ using bders_fuse bsimp_AALTs.simps(2) flts.simps(1) flts.simps(7) apply presburger
+ apply(auto simp add: bders_bsimp_AALTs)
+ apply(drule contains61)
+ apply(auto simp add: bders_AALTs)
+ apply(rule contains63)
+ apply(rule contains60)
+ apply(auto)
+ using bders_fuse apply auto[1]
+ by (metis contains51c map_fuse3 map_map)
+
+lemma derc_alt00_Urb2a:
+ shows "bder c (bsimp_AALTs bs2 (flts [bsimp a])) >> bs2 @ bs \<longleftrightarrow>
+ bder c (bsimp a) >> bs"
+ using contains0 contains49 derc_alt00_Urb by blast
+
+
+lemma derc_alt00_Urb2:
+ assumes "fuse bs2 (bder c (bsimp a)) >> bs2 @ bs" "a \<in> set as"
+ shows "bder c (bsimp_AALTs bs2 (flts (map bsimp as))) >> bs2 @ bs"
+ using assms
+ apply(subgoal_tac "\<exists>list1 list2. as = list1 @ [a] @ list2")
+ prefer 2
+ using split_list_last apply fastforce
+ apply(erule exE)+
+ apply(simp add: flts_append del: append.simps)
+ using bder_bsimp_AALTs contains50 contains51b derc_alt00_Urb by auto
+
+lemma ders_alt00_Urb2:
+ assumes "fuse bs2 (bders (bsimp a) s) >> bs2 @ bs" "a \<in> set as"
+ shows "bders (bsimp_AALTs bs2 (flts (map bsimp as))) s >> bs2 @ bs"
+ using assms
+ apply(subgoal_tac "\<exists>list1 list2. as = list1 @ [a] @ list2")
+ prefer 2
+ using split_list_last apply fastforce
+ apply(erule exE)+
+ apply(simp add: flts_append del: append.simps)
+ apply(simp add: bders_bsimp_AALTs)
+ apply(rule contains50)
+ apply(rule contains51b)
+ using bders_bsimp_AALTs ders_alt00_Urb by auto
+
+
+lemma derc_alt2:
+ assumes "bder c (AALTs bs2 as) >> bs2 @ bs"
+ and "\<forall>a \<in> set as. ((bder c a >> bs) \<longrightarrow> (bder c (bsimp a) >> bs))"
+ shows "bder c (bsimp (AALTs bs2 as)) >> bs2 @ bs"
+ using assms
+ apply -
+ apply(simp)
+ apply(subst (asm) contains_equiv_def)
+ apply(simp)
+ apply(erule bexE)
+ using contains0 derc_alt00_Urb2 by blast
+
+
+
+lemma ders_alt2:
+ assumes "bders (AALTs bs2 as) s >> bs2 @ bs"
+ and "\<forall>a \<in> set as. ((bders a s >> bs) \<longrightarrow> (bders (bsimp a) s >> bs))"
+ shows "bders (bsimp (AALTs bs2 as)) s >> bs2 @ bs"
+ using assms
+ apply -
+ apply(simp add: bders_AALTs)
+ thm contains_equiv_def
+ apply(subst (asm) contains_equiv_def)
+ apply(simp)
+ apply(erule bexE)
+ using contains0 ders_alt00_Urb2 by blast
+
+
+
+
+lemma bder_simp_contains:
+ assumes "bder c a >> bs"
+ shows "bder c (bsimp a) >> bs"
+ using assms
+ apply(induct a arbitrary: c bs)
+ apply(auto elim: contains.cases)
+ apply(case_tac "bnullable a1")
+ apply(simp)
+ prefer 2
+ apply(simp)
+ apply(erule contains.cases)
+ apply(auto)
+ apply(case_tac "(bsimp a1) = AZERO")
+ apply(simp)
+ apply (metis append_Nil2 contains0 contains49 fuse.simps(1))
+ apply(case_tac "(bsimp a2a) = AZERO")
+ apply(simp)
+ apply (metis bder.simps(1) bsimp.simps(1) bsimp_ASEQ0 contains.intros(3) contains55)
+ apply(case_tac "\<exists>bsX. (bsimp a1) = AONE bsX")
+ apply(auto)[1]
+ using b3 apply fastforce
+ apply(subst bsimp_ASEQ1)
+ apply(auto)[3]
+ apply(simp)
+ apply(subgoal_tac "\<not> bnullable (bsimp a1)")
+ prefer 2
+ using b3 apply blast
+ apply(simp)
+ apply (simp add: contains.intros(3) contains55)
+ (* SEQ nullable case *)
+ apply(erule contains.cases)
+ apply(auto)
+ apply(erule contains.cases)
+ apply(auto)
+ apply(case_tac "(bsimp a1) = AZERO")
+ apply(simp)
+ apply (metis append_Nil2 contains0 contains49 fuse.simps(1))
+ apply(case_tac "(bsimp a2a) = AZERO")
+ apply(simp)
+ apply (metis bder.simps(1) bsimp.simps(1) bsimp_ASEQ0 contains.intros(3) contains55)
+ apply(case_tac "\<exists>bsX. (bsimp a1) = AONE bsX")
+ apply(auto)[1]
+ using contains.simps apply blast
+ apply(subst bsimp_ASEQ1)
+ apply(auto)[3]
+ apply(simp)
+ apply(subgoal_tac "bnullable (bsimp a1)")
+ prefer 2
+ using b3 apply blast
+ apply(simp)
+ apply (metis contains.intros(3) contains.intros(4) contains55 self_append_conv2)
+ apply(erule contains.cases)
+ apply(auto)
+ apply(case_tac "(bsimp a1) = AZERO")
+ apply(simp)
+ using b3 apply force
+ apply(case_tac "(bsimp a2) = AZERO")
+ apply(simp)
+ apply (metis bder.simps(1) bsimp_ASEQ0 bsimp_ASEQ_fuse contains0 contains49 f_cont1)
+ apply(case_tac "\<exists>bsX. (bsimp a1) = AONE bsX")
+ apply(auto)[1]
+ apply (metis append_assoc bder_fuse bmkeps.simps(1) bmkeps_simp bsimp_ASEQ2 contains0 contains49 f_cont1)
+ apply(subst bsimp_ASEQ1)
+ apply(auto)[3]
+ apply(simp)
+ apply(subgoal_tac "bnullable (bsimp a1)")
+ prefer 2
+ using b3 apply blast
+ apply(simp)
+ apply (metis bmkeps_simp contains.intros(4) contains.intros(5) contains0 contains49 f_cont1)
+ apply(erule contains.cases)
+ apply(auto)
+ (* ALT case *)
+ apply(subgoal_tac "\<exists>bsX. bs = x1 @ bsX")
+ prefer 2
+ using contains59 f_cont1 apply blast
+ apply(auto)
+ apply(rule derc_alt2[simplified])
+ apply(simp)
+ by blast
+
+
+
+lemma bder_simp_containsA:
+ assumes "bder c a >> bs"
+ shows "bsimp (bder c (bsimp a)) >> bs"
+ using assms
+ by (simp add: bder_simp_contains contains55)
+
+lemma bder_simp_containsB:
+ assumes "bsimp (bder c a) >> bs"
+ shows "bder c (bsimp a) >> bs"
+ using assms
+ by (simp add: PPP1_eq bder_simp_contains)
+
+lemma bder_simp_contains_IFF:
+ assumes "good a"
+ shows "bsimp (bder c a) >> bs \<longleftrightarrow> bder c (bsimp a) >> bs"
+ using assms
+ by (simp add: PPP1_eq test2)
+
+
+lemma ders_seq:
+ assumes "bders (ASEQ bs a1 a2) s >> bs @ bs2"
+ and "\<And>s bs. bders a1 s >> bs \<Longrightarrow> bders (bsimp a1) s >> bs"
+ "\<And>s bs. bders a2 s >> bs \<Longrightarrow> bders (bsimp a2) s >> bs"
+ shows "bders (ASEQ bs (bsimp a1) (bsimp a2)) s >> bs @ bs2"
+ using assms(1)
+ apply(induct s arbitrary: a1 a2 bs bs2 rule: rev_induct)
+ apply(auto)[1]
+ thm CT1_SEQ PPP1_eq
+ apply (metis CT1_SEQ PPP1_eq)
+ apply(auto simp add: bders_append)
+ apply(drule bder_simp_contains)
+ oops
+
+
+lemma bders_simp_contains:
+ assumes "bders a s >> bs"
+ shows "bders (bsimp a) s >> bs"
+ using assms
+ apply(induct a arbitrary: s bs)
+ apply(auto elim: contains.cases)[4]
+ prefer 2
+ apply(subgoal_tac "\<exists>bsX. bs = x1 @ bsX")
+ prefer 2
+ apply (metis bders_AALTs contains59 f_cont1)
+ apply(clarify)
+ apply(rule ders_alt2)
+ apply(assumption)
+ apply(auto)[1]
+ prefer 2
+ apply simp
+ (* SEQ case *)
+ apply(case_tac "bsimp a1 = AZERO")
+ apply(simp)
+ apply (metis LLLL(1) bders_AZERO(1) bsimp.simps(1) bsimp.simps(3) bsimp_ASEQ.simps(1) contains55 ders_correctness erase_bders good.simps(1) good1a xxx_bder2)
+ apply(case_tac "bsimp a2 = AZERO")
+ apply(simp)
+ apply (metis LLLL(1) bders_AZERO(1) bsimp.simps(1) bsimp.simps(3) bsimp_ASEQ0 contains55 ders_correctness erase_bders good.simps(1) good1a xxx_bder2)
+ apply(case_tac "\<exists>bsX. bsimp a1 = AONE bsX")
+ apply(auto)
+ apply(subst bsimp_ASEQ2)
+ apply(case_tac s)
+ apply(simp)
+ apply (metis b1 bsimp.simps(1) contains55)
+ apply(simp)
+ apply(subgoal_tac "bnullable a1")
+ prefer 2
+ using b3 apply fastforce
+ apply(auto)
+ apply(subst (asm) bders_AALTs)
+ apply(erule contains.cases)
+ apply(auto)
+ prefer 2
+ apply(erule contains.cases)
+ apply(auto)
+ apply(simp add: fuse_append)
+ apply(simp add: bder_fuse bders_fuse)
+apply (metis bders.simps(2) bmkeps.simps(1) bmkeps_simp contains0 contains49 f_cont1)
+ using contains_equiv_def apply auto[1]
+ apply(simp add: bder_fuse bders_fuse fuse_append)
+ apply(rule contains0)
+ oops
+
+
+lemma T0:
+ assumes "s = []"
+ shows "bders (bsimp r) s >> bs \<longleftrightarrow> bders r s >> bs"
+ using assms
+ by (simp add: PPP1_eq test2)
+
+lemma T1:
+ assumes "s = [a]" "bders r s >> bs"
+ shows "bders (bsimp r) s >> bs"
+ using assms
+ apply(simp)
+ by (simp add: bder_simp_contains)
+
+lemma TX:
+ assumes "\<Turnstile> v : ders s (erase r)" "\<Turnstile> v : ders s (erase (bsimp r))"
+ shows "bders r s >> FC r s v \<longleftrightarrow> bders (bsimp r) s >> FC (bsimp r) s v"
+ using FC_def contains7b
+ using assms by metis
+
+lemma mkeps1:
+ assumes "s \<in> L (erase r)"
+ shows "\<Turnstile> mkeps (ders s (erase r)) : ders s (erase r)"
+ using assms
+ by (meson lexer_correct_None lexer_flex mkeps_nullable)
+
+lemma mkeps2:
+ assumes "s \<in> L (erase r)"
+ shows "\<Turnstile> mkeps (ders s (erase (bsimp r))) : ders s (erase (bsimp r))"
+ using assms
+ by (metis LLLL(1) lexer_correct_None lexer_flex mkeps_nullable)
+
+thm FC_def FE_def PX_def PV_def
+
+
+lemma TX2:
+ assumes "s \<in> L (erase r)"
+ shows "bders r s >> FE r s \<longleftrightarrow> bders (bsimp r) s >> FE (bsimp r) s"
+ using assms
+ by (simp add: FE_def contains7b mkeps1 mkeps2)
+
+lemma TX3:
+ assumes "s \<in> L (erase r)"
+ shows "bders r s >> FE r s \<longleftrightarrow> bders (bsimp r) s >> FE (bders (bsimp r) s) []"
+ using assms
+ by (metis FE_PX FE_def L07 LLLL(1) PX_id TX2)
+
+find_theorems "FE _ _ = _"
+find_theorems "FC _ _ _ = _"
+find_theorems "(bder _ _ >> _ _ _ _) = _"
+
+
+(* HERE *)
+
+lemma PX:
+ assumes "s \<in> L r" "bders (intern r) s >> code (PX r s)"
+ shows "bders (bsimp (intern r)) s >> code (PX r s)"
+ using assms
+ apply(induct s arbitrary: r rule: rev_induct)
+ apply(simp)
+ apply (simp add: PPP1_eq)
+ apply (simp add: bders_append bders_simp_append)
+ thm PX_bder_iff PX_bders_iff
+ apply(subst (asm) PX_bder_iff)
+ apply(assumption)
+ apply(subst (asm) (2) PX_bders_iff)
+ find_theorems "_ >> code (PX _ _)"
+ find_theorems "PX _ _ = _"
+ find_theorems "(intern _) >> _"
+ apply (simp add: contains55)
+ apply (simp add: bders_append bders_simp_append)
+ apply (simp add: PPP1_eq)
+ find_theorems "(bder _ _ >> _) = _"
+ apply(rule contains50)
+
+ apply(case_tac "bders a xs = AZERO")
+ apply(simp)
+ apply(subgoal_tac "bders_simp a xs = AZERO")
+ prefer 2
+ apply (metis L_bders_simp XXX4a_good_cons bders.simps(1) bders_simp.simps(1) bsimp.simps(3) good.simps(1) good1a test2 xxx_bder2)
+ apply(simp)
+ apply(case_tac xs)
+ apply(simp)
+ apply (simp add: PPP1_eq)
+ apply(simp)
+ apply(subgoal_tac "good (bders_simp a (aa # list)) \<or> (bders_simp a (aa # list) = AZERO)")
+ apply(auto)
+ apply(subst (asm) bder_simp_contains_IFF)
+ apply(simp)
+
+(* TOBE PROVED *)
+lemma
+ assumes "s \<in> L (erase r)"
+ shows "bders_simp r s >> bs \<longleftrightarrow> bders r s >> bs"
+ using assms
+ apply(induct s arbitrary: r bs)
+ apply(simp)
+ apply(simp add: bders_append bders_simp_append)
+ apply(rule iffI)
+ apply(drule_tac x="bsimp (bder a r)" in meta_spec)
+ apply(drule_tac x="bs" in meta_spec)
+ apply(drule meta_mp)
+ using L_bsimp_erase lexer_correct_None apply fastforce
+ apply(simp)
+
+
+ prefer 2
+
+
+ oops
+
+
+lemma
+ assumes "s \<in> L r"
+ shows "(bders_simp (intern r) s >> code (PX r s)) \<longleftrightarrow> ((intern r) >> code (PX r s))"
+ using assms
+ apply(induct s arbitrary: r rule: rev_induct)
+ apply(simp)
+ apply(simp add: bders_simp_append)
+ apply(simp add: PPP1_eq)
+
+
+find_theorems "retrieve (bders _ _) _"
+find_theorems "_ >> retrieve _ _"
+find_theorems "bsimp _ >> _"
+ oops
+
+
+lemma PX4a:
+ assumes "(s1 @ s2) \<in> L r"
+ shows "bders (intern r) (s1 @ s2) >> code (PV r s1 (PX (ders s1 r) s2))"
+ using PX4[OF assms]
+ apply(simp add: PX_append)
+ done
+
+lemma PV5:
+ assumes "s2 \<in> (ders s1 r) \<rightarrow> v"
+ shows "bders (intern r) (s1 @ s2) >> code (PV r s1 v)"
+ by (simp add: PPP0_isar PV_def Posix_flex assms)
+
+lemma PV6:
+ assumes "s2 \<in> (ders s1 r) \<rightarrow> v"
+ shows "bders (bders (intern r) s1) s2 >> code (PV r s1 v)"
+ using PV5 assms bders_append by auto
+
+find_theorems "retrieve (bders _ _) _"
+find_theorems "_ >> retrieve _ _"
+find_theorems "bder _ _ >> _"
+
+
+lemma OO0_PX:
+ assumes "s \<in> L r"
+ shows "bders (intern r) s >> code (PX r s)"
+ using assms
+ by (simp add: PX3)
+
+
+lemma OO1:
+ assumes "[c] \<in> r \<rightarrow> v"
+ shows "bder c (intern r) >> code v"
+ using assms
+ using PPP0_isar by force
+
+lemma OO1a:
+ assumes "[c] \<in> L r"
+ shows "bder c (intern r) >> code (PX r [c])"
+ using assms unfolding PX_def PV_def
+ using contains70 by fastforce
+
+lemma OO12:
+ assumes "[c1, c2] \<in> L r"
+ shows "bders (intern r) [c1, c2] >> code (PX r [c1, c2])"
+ using assms
+ using PX_def PV_def contains70 by presburger
+
+lemma OO2:
+ assumes "[c] \<in> L r"
+ shows "bders_simp (intern r) [c] >> code (PX r [c])"
+ using assms
+ using OO1a Posix1(1) contains55 by auto
+
+
+thm L07XX PPP0b erase_intern
+
+find_theorems "retrieve (bders _ _) _"
+find_theorems "_ >> retrieve _ _"
+find_theorems "bder _ _ >> _"
+
+
+lemma PPP3:
+ assumes "\<Turnstile> v : ders s (erase a)"
+ shows "bders a s >> retrieve a (flex (erase a) id s v)"
+ using LA[OF assms] contains6 erase_bders assms by metis
+
+
+find_theorems "bder _ _ >> _"
+
+
+lemma
+ fixes n :: nat
+ shows "(\<Sum>i \<in> {0..n}. i) = n * (n + 1) div 2"
+ apply(induct n)
+ apply(simp)
+ apply(simp)
+ done
+
+lemma COUNTEREXAMPLE:
+ assumes "r = AALTs [S] [ASEQ [S] (AALTs [S] [AONE [S], ACHAR [S] c]) (ACHAR [S] c)]"
+ shows "bsimp (bder c (bsimp r)) = bsimp (bder c r)"
+ apply(simp_all add: assms)
+ oops
+
+lemma COUNTEREXAMPLE:
+ assumes "r = AALTs [S] [ASEQ [S] (AALTs [S] [AONE [S], ACHAR [S] c]) (ACHAR [S] c)]"
+ shows "bsimp r = r"
+ apply(simp_all add: assms)
+ oops
+
+lemma COUNTEREXAMPLE:
+ assumes "r = AALTs [S] [ASEQ [S] (AALTs [S] [AONE [S], ACHAR [S] c]) (ACHAR [S] c)]"
+ shows "bsimp r = XXX"
+ and "bder c r = XXX"
+ and "bder c (bsimp r) = XXX"
+ and "bsimp (bder c (bsimp r)) = XXX"
+ and "bsimp (bder c r) = XXX"
+ apply(simp_all add: assms)
+ oops
+
+lemma COUNTEREXAMPLE_contains1:
+ assumes "r = AALTs [S] [ASEQ [S] (AALTs [S] [AONE [S], ACHAR [S] c]) (ACHAR [S] c)]"
+ and "bsimp (bder c r) >> bs"
+ shows "bsimp (bder c (bsimp r)) >> bs"
+ using assms
+ apply(auto elim!: contains.cases)
+ apply(rule Etrans)
+ apply(rule contains.intros)
+ apply(rule contains.intros)
+ apply(simp)
+ apply(rule Etrans)
+ apply(rule contains.intros)
+ apply(rule contains.intros)
+ apply(simp)
+ done
+
+lemma COUNTEREXAMPLE_contains2:
+ assumes "r = AALTs [S] [ASEQ [S] (AALTs [S] [AONE [S], ACHAR [S] c]) (ACHAR [S] c)]"
+ and "bsimp (bder c (bsimp r)) >> bs"
+ shows "bsimp (bder c r) >> bs"
+ using assms
+ apply(auto elim!: contains.cases)
+ apply(rule Etrans)
+ apply(rule contains.intros)
+ apply(rule contains.intros)
+ apply(simp)
+ apply(rule Etrans)
+ apply(rule contains.intros)
+ apply(rule contains.intros)
+ apply(simp)
+ done
+
+
+end
\ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys2/BitCoded2CT.thy Sun Oct 10 18:35:21 2021 +0100
@@ -0,0 +1,3921 @@
+
+theory BitCoded2CT
+ imports "Lexer"
+begin
+
+section \<open>Bit-Encodings\<close>
+
+datatype bit = Z | S
+
+fun
+ code :: "val \<Rightarrow> bit list"
+where
+ "code Void = []"
+| "code (Char c) = []"
+| "code (Left v) = Z # (code v)"
+| "code (Right v) = S # (code v)"
+| "code (Seq v1 v2) = (code v1) @ (code v2)"
+| "code (Stars []) = [S]"
+| "code (Stars (v # vs)) = (Z # code v) @ code (Stars vs)"
+
+
+fun
+ Stars_add :: "val \<Rightarrow> val \<Rightarrow> val"
+where
+ "Stars_add v (Stars vs) = Stars (v # vs)"
+| "Stars_add v _ = Stars [v]"
+
+function
+ decode' :: "bit list \<Rightarrow> rexp \<Rightarrow> (val * bit list)"
+where
+ "decode' ds ZERO = (Void, [])"
+| "decode' ds ONE = (Void, ds)"
+| "decode' ds (CHAR d) = (Char d, ds)"
+| "decode' [] (ALT r1 r2) = (Void, [])"
+| "decode' (Z # ds) (ALT r1 r2) = (let (v, ds') = decode' ds r1 in (Left v, ds'))"
+| "decode' (S # ds) (ALT r1 r2) = (let (v, ds') = decode' ds r2 in (Right v, ds'))"
+| "decode' ds (SEQ r1 r2) = (let (v1, ds') = decode' ds r1 in
+ let (v2, ds'') = decode' ds' r2 in (Seq v1 v2, ds''))"
+| "decode' [] (STAR r) = (Void, [])"
+| "decode' (S # ds) (STAR r) = (Stars [], ds)"
+| "decode' (Z # ds) (STAR r) = (let (v, ds') = decode' ds r in
+ let (vs, ds'') = decode' ds' (STAR r)
+ in (Stars_add v vs, ds''))"
+by pat_completeness auto
+
+lemma decode'_smaller:
+ assumes "decode'_dom (ds, r)"
+ shows "length (snd (decode' ds r)) \<le> length ds"
+using assms
+apply(induct ds r)
+apply(auto simp add: decode'.psimps split: prod.split)
+using dual_order.trans apply blast
+by (meson dual_order.trans le_SucI)
+
+termination "decode'"
+apply(relation "inv_image (measure(%cs. size cs) <*lex*> measure(%s. size s)) (%(ds,r). (r,ds))")
+apply(auto dest!: decode'_smaller)
+by (metis less_Suc_eq_le snd_conv)
+
+definition
+ decode :: "bit list \<Rightarrow> rexp \<Rightarrow> val option"
+where
+ "decode ds r \<equiv> (let (v, ds') = decode' ds r
+ in (if ds' = [] then Some v else None))"
+
+lemma decode'_code_Stars:
+ assumes "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> (\<forall>x. decode' (code v @ x) r = (v, x)) \<and> flat v \<noteq> []"
+ shows "decode' (code (Stars vs) @ ds) (STAR r) = (Stars vs, ds)"
+ using assms
+ apply(induct vs)
+ apply(auto)
+ done
+
+lemma decode'_code:
+ assumes "\<Turnstile> v : r"
+ shows "decode' ((code v) @ ds) r = (v, ds)"
+using assms
+ apply(induct v r arbitrary: ds)
+ apply(auto)
+ using decode'_code_Stars by blast
+
+lemma decode_code:
+ assumes "\<Turnstile> v : r"
+ shows "decode (code v) r = Some v"
+ using assms unfolding decode_def
+ by (smt append_Nil2 decode'_code old.prod.case)
+
+
+section {* Annotated Regular Expressions *}
+
+datatype arexp =
+ AZERO
+| AONE "bit list"
+| ACHAR "bit list" char
+| ASEQ "bit list" arexp arexp
+| AALTs "bit list" "arexp list"
+| ASTAR "bit list" arexp
+
+abbreviation
+ "AALT bs r1 r2 \<equiv> AALTs bs [r1, r2]"
+
+fun asize :: "arexp \<Rightarrow> nat" where
+ "asize AZERO = 1"
+| "asize (AONE cs) = 1"
+| "asize (ACHAR cs c) = 1"
+| "asize (AALTs cs rs) = Suc (sum_list (map asize rs))"
+| "asize (ASEQ cs r1 r2) = Suc (asize r1 + asize r2)"
+| "asize (ASTAR cs r) = Suc (asize r)"
+
+fun
+ erase :: "arexp \<Rightarrow> rexp"
+where
+ "erase AZERO = ZERO"
+| "erase (AONE _) = ONE"
+| "erase (ACHAR _ c) = CHAR c"
+| "erase (AALTs _ []) = ZERO"
+| "erase (AALTs _ [r]) = (erase r)"
+| "erase (AALTs bs (r#rs)) = ALT (erase r) (erase (AALTs bs rs))"
+| "erase (ASEQ _ r1 r2) = SEQ (erase r1) (erase r2)"
+| "erase (ASTAR _ r) = STAR (erase r)"
+
+lemma decode_code_erase:
+ assumes "\<Turnstile> v : (erase a)"
+ shows "decode (code v) (erase a) = Some v"
+ using assms
+ by (simp add: decode_code)
+
+
+fun nonalt :: "arexp \<Rightarrow> bool"
+ where
+ "nonalt (AALTs bs2 rs) = False"
+| "nonalt r = True"
+
+
+fun good :: "arexp \<Rightarrow> bool" where
+ "good AZERO = False"
+| "good (AONE cs) = True"
+| "good (ACHAR cs c) = True"
+| "good (AALTs cs []) = False"
+| "good (AALTs cs [r]) = False"
+| "good (AALTs cs (r1#r2#rs)) = (\<forall>r' \<in> set (r1#r2#rs). good r' \<and> nonalt r')"
+| "good (ASEQ _ AZERO _) = False"
+| "good (ASEQ _ (AONE _) _) = False"
+| "good (ASEQ _ _ AZERO) = False"
+| "good (ASEQ cs r1 r2) = (good r1 \<and> good r2)"
+| "good (ASTAR cs r) = True"
+
+
+
+
+fun fuse :: "bit list \<Rightarrow> arexp \<Rightarrow> arexp" where
+ "fuse bs AZERO = AZERO"
+| "fuse bs (AONE cs) = AONE (bs @ cs)"
+| "fuse bs (ACHAR cs c) = ACHAR (bs @ cs) c"
+| "fuse bs (AALTs cs rs) = AALTs (bs @ cs) rs"
+| "fuse bs (ASEQ cs r1 r2) = ASEQ (bs @ cs) r1 r2"
+| "fuse bs (ASTAR cs r) = ASTAR (bs @ cs) r"
+
+lemma fuse_append:
+ shows "fuse (bs1 @ bs2) r = fuse bs1 (fuse bs2 r)"
+ apply(induct r)
+ apply(auto)
+ done
+
+
+fun intern :: "rexp \<Rightarrow> arexp" where
+ "intern ZERO = AZERO"
+| "intern ONE = AONE []"
+| "intern (CHAR c) = ACHAR [] c"
+| "intern (ALT r1 r2) = AALT [] (fuse [Z] (intern r1))
+ (fuse [S] (intern r2))"
+| "intern (SEQ r1 r2) = ASEQ [] (intern r1) (intern r2)"
+| "intern (STAR r) = ASTAR [] (intern r)"
+
+
+fun retrieve :: "arexp \<Rightarrow> val \<Rightarrow> bit list" where
+ "retrieve (AONE bs) Void = bs"
+| "retrieve (ACHAR bs c) (Char d) = bs"
+| "retrieve (AALTs bs [r]) v = bs @ retrieve r v"
+| "retrieve (AALTs bs (r#rs)) (Left v) = bs @ retrieve r v"
+| "retrieve (AALTs bs (r#rs)) (Right v) = bs @ retrieve (AALTs [] rs) v"
+| "retrieve (ASEQ bs r1 r2) (Seq v1 v2) = bs @ retrieve r1 v1 @ retrieve r2 v2"
+| "retrieve (ASTAR bs r) (Stars []) = bs @ [S]"
+| "retrieve (ASTAR bs r) (Stars (v#vs)) =
+ bs @ [Z] @ retrieve r v @ retrieve (ASTAR [] r) (Stars vs)"
+
+
+
+fun
+ bnullable :: "arexp \<Rightarrow> bool"
+where
+ "bnullable (AZERO) = False"
+| "bnullable (AONE bs) = True"
+| "bnullable (ACHAR bs c) = False"
+| "bnullable (AALTs bs rs) = (\<exists>r \<in> set rs. bnullable r)"
+| "bnullable (ASEQ bs r1 r2) = (bnullable r1 \<and> bnullable r2)"
+| "bnullable (ASTAR bs r) = True"
+
+fun
+ bmkeps :: "arexp \<Rightarrow> bit list"
+where
+ "bmkeps(AONE bs) = bs"
+| "bmkeps(ASEQ bs r1 r2) = bs @ (bmkeps r1) @ (bmkeps r2)"
+| "bmkeps(AALTs bs [r]) = bs @ (bmkeps r)"
+| "bmkeps(AALTs bs (r#rs)) = (if bnullable(r) then bs @ (bmkeps r) else (bmkeps (AALTs bs rs)))"
+| "bmkeps(ASTAR bs r) = bs @ [S]"
+
+
+fun
+ bder :: "char \<Rightarrow> arexp \<Rightarrow> arexp"
+where
+ "bder c (AZERO) = AZERO"
+| "bder c (AONE bs) = AZERO"
+| "bder c (ACHAR bs d) = (if c = d then AONE bs else AZERO)"
+| "bder c (AALTs bs rs) = AALTs bs (map (bder c) rs)"
+| "bder c (ASEQ bs r1 r2) =
+ (if bnullable r1
+ then AALT bs (ASEQ [] (bder c r1) r2) (fuse (bmkeps r1) (bder c r2))
+ else ASEQ bs (bder c r1) r2)"
+| "bder c (ASTAR bs r) = ASEQ bs (fuse [Z] (bder c r)) (ASTAR [] r)"
+
+
+fun
+ bders :: "arexp \<Rightarrow> string \<Rightarrow> arexp"
+where
+ "bders r [] = r"
+| "bders r (c#s) = bders (bder c r) s"
+
+lemma bders_append:
+ "bders r (s1 @ s2) = bders (bders r s1) s2"
+ apply(induct s1 arbitrary: r s2)
+ apply(simp_all)
+ done
+
+lemma bnullable_correctness:
+ shows "nullable (erase r) = bnullable r"
+ apply(induct r rule: erase.induct)
+ apply(simp_all)
+ done
+
+lemma erase_fuse:
+ shows "erase (fuse bs r) = erase r"
+ apply(induct r rule: erase.induct)
+ apply(simp_all)
+ done
+
+lemma erase_intern [simp]:
+ shows "erase (intern r) = r"
+ apply(induct r)
+ apply(simp_all add: erase_fuse)
+ done
+
+lemma erase_bder [simp]:
+ shows "erase (bder a r) = der a (erase r)"
+ apply(induct r rule: erase.induct)
+ apply(simp_all add: erase_fuse bnullable_correctness)
+ done
+
+lemma erase_bders [simp]:
+ shows "erase (bders r s) = ders s (erase r)"
+ apply(induct s arbitrary: r )
+ apply(simp_all)
+ done
+
+lemma retrieve_encode_STARS:
+ assumes "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> code v = retrieve (intern r) v"
+ shows "code (Stars vs) = retrieve (ASTAR [] (intern r)) (Stars vs)"
+ using assms
+ apply(induct vs)
+ apply(simp_all)
+ done
+
+lemma retrieve_fuse2:
+ assumes "\<Turnstile> v : (erase r)"
+ shows "retrieve (fuse bs r) v = bs @ retrieve r v"
+ using assms
+ apply(induct r arbitrary: v bs)
+ apply(auto elim: Prf_elims)[4]
+ defer
+ using retrieve_encode_STARS
+ apply(auto elim!: Prf_elims)[1]
+ apply(case_tac vs)
+ apply(simp)
+ apply(simp)
+ (* AALTs case *)
+ apply(simp)
+ apply(case_tac x2a)
+ apply(simp)
+ apply(auto elim!: Prf_elims)[1]
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ apply(auto)
+ apply(auto elim!: Prf_elims)[1]
+ done
+
+lemma retrieve_fuse:
+ assumes "\<Turnstile> v : r"
+ shows "retrieve (fuse bs (intern r)) v = bs @ retrieve (intern r) v"
+ using assms
+ by (simp_all add: retrieve_fuse2)
+
+
+lemma retrieve_code:
+ assumes "\<Turnstile> v : r"
+ shows "code v = retrieve (intern r) v"
+ using assms
+ apply(induct v r )
+ apply(simp_all add: retrieve_fuse retrieve_encode_STARS)
+ done
+
+lemma r:
+ assumes "bnullable (AALTs bs (a # rs))"
+ shows "bnullable a \<or> (\<not> bnullable a \<and> bnullable (AALTs bs rs))"
+ using assms
+ apply(induct rs)
+ apply(auto)
+ done
+
+lemma r0:
+ assumes "bnullable a"
+ shows "bmkeps (AALTs bs (a # rs)) = bs @ (bmkeps a)"
+ using assms
+ by (metis bmkeps.simps(3) bmkeps.simps(4) list.exhaust)
+
+lemma r1:
+ assumes "\<not> bnullable a" "bnullable (AALTs bs rs)"
+ shows "bmkeps (AALTs bs (a # rs)) = bmkeps (AALTs bs rs)"
+ using assms
+ apply(induct rs)
+ apply(auto)
+ done
+
+lemma r2:
+ assumes "x \<in> set rs" "bnullable x"
+ shows "bnullable (AALTs bs rs)"
+ using assms
+ apply(induct rs)
+ apply(auto)
+ done
+
+lemma r3:
+ assumes "\<not> bnullable r"
+ " \<exists> x \<in> set rs. bnullable x"
+ shows "retrieve (AALTs bs rs) (mkeps (erase (AALTs bs rs))) =
+ retrieve (AALTs bs (r # rs)) (mkeps (erase (AALTs bs (r # rs))))"
+ using assms
+ apply(induct rs arbitrary: r bs)
+ apply(auto)[1]
+ apply(auto)
+ using bnullable_correctness apply blast
+ apply(auto simp add: bnullable_correctness mkeps_nullable retrieve_fuse2)
+ apply(subst retrieve_fuse2[symmetric])
+ apply (smt bnullable.simps(4) bnullable_correctness erase.simps(5) erase.simps(6) insert_iff list.exhaust list.set(2) mkeps.simps(3) mkeps_nullable)
+ apply(simp)
+ apply(case_tac "bnullable a")
+ apply (smt append_Nil2 bnullable.simps(4) bnullable_correctness erase.simps(5) erase.simps(6) fuse.simps(4) insert_iff list.exhaust list.set(2) mkeps.simps(3) mkeps_nullable retrieve_fuse2)
+ apply(drule_tac x="a" in meta_spec)
+ apply(drule_tac x="bs" in meta_spec)
+ apply(drule meta_mp)
+ apply(simp)
+ apply(drule meta_mp)
+ apply(auto)
+ apply(subst retrieve_fuse2[symmetric])
+ apply(case_tac rs)
+ apply(simp)
+ apply(auto)[1]
+ apply (simp add: bnullable_correctness)
+ apply (metis append_Nil2 bnullable_correctness erase_fuse fuse.simps(4) list.set_intros(1) mkeps.simps(3) mkeps_nullable nullable.simps(4) r2)
+ apply (simp add: bnullable_correctness)
+ apply (metis append_Nil2 bnullable_correctness erase.simps(6) erase_fuse fuse.simps(4) list.set_intros(2) mkeps.simps(3) mkeps_nullable r2)
+ apply(simp)
+ done
+
+
+lemma t:
+ assumes "\<forall>r \<in> set rs. nullable (erase r) \<longrightarrow> bmkeps r = retrieve r (mkeps (erase r))"
+ "nullable (erase (AALTs bs rs))"
+ shows " bmkeps (AALTs bs rs) = retrieve (AALTs bs rs) (mkeps (erase (AALTs bs rs)))"
+ using assms
+ apply(induct rs arbitrary: bs)
+ apply(simp)
+ apply(auto simp add: bnullable_correctness)
+ apply(case_tac rs)
+ apply(auto simp add: bnullable_correctness)[2]
+ apply(subst r1)
+ apply(simp)
+ apply(rule r2)
+ apply(assumption)
+ apply(simp)
+ apply(drule_tac x="bs" in meta_spec)
+ apply(drule meta_mp)
+ apply(auto)[1]
+ prefer 2
+ apply(case_tac "bnullable a")
+ apply(subst r0)
+ apply blast
+ apply(subgoal_tac "nullable (erase a)")
+ prefer 2
+ using bnullable_correctness apply blast
+ apply (metis (no_types, lifting) erase.simps(5) erase.simps(6) list.exhaust mkeps.simps(3) retrieve.simps(3) retrieve.simps(4))
+ apply(subst r1)
+ apply(simp)
+ using r2 apply blast
+ apply(drule_tac x="bs" in meta_spec)
+ apply(drule meta_mp)
+ apply(auto)[1]
+ apply(simp)
+ using r3 apply blast
+ apply(auto)
+ using r3 by blast
+
+lemma bmkeps_retrieve:
+ assumes "nullable (erase r)"
+ shows "bmkeps r = retrieve r (mkeps (erase r))"
+ using assms
+ apply(induct r)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ defer
+ apply(simp)
+ apply(rule t)
+ apply(auto)
+ done
+
+lemma bder_retrieve:
+ assumes "\<Turnstile> v : der c (erase r)"
+ shows "retrieve (bder c r) v = retrieve r (injval (erase r) c v)"
+ using assms
+ apply(induct r arbitrary: v rule: erase.induct)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(case_tac "c = ca")
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(simp)
+ apply(rename_tac "r\<^sub>1" "r\<^sub>2" rs v)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(simp)
+ apply(case_tac rs)
+ apply(simp)
+ apply(simp)
+ apply (smt Prf_elims(3) injval.simps(2) injval.simps(3) retrieve.simps(4) retrieve.simps(5) same_append_eq)
+ apply(simp)
+ apply(case_tac "nullable (erase r1)")
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(subgoal_tac "bnullable r1")
+ prefer 2
+ using bnullable_correctness apply blast
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(subgoal_tac "bnullable r1")
+ prefer 2
+ using bnullable_correctness apply blast
+ apply(simp)
+ apply(simp add: retrieve_fuse2)
+ apply(simp add: bmkeps_retrieve)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ using bnullable_correctness apply blast
+ apply(rename_tac bs r v)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(clarify)
+ apply(erule Prf_elims)
+ apply(clarify)
+ apply(subst injval.simps)
+ apply(simp del: retrieve.simps)
+ apply(subst retrieve.simps)
+ apply(subst retrieve.simps)
+ apply(simp)
+ apply(simp add: retrieve_fuse2)
+ done
+
+
+
+lemma MAIN_decode:
+ assumes "\<Turnstile> v : ders s r"
+ shows "Some (flex r id s v) = decode (retrieve (bders (intern r) s) v) r"
+ using assms
+proof (induct s arbitrary: v rule: rev_induct)
+ case Nil
+ have "\<Turnstile> v : ders [] r" by fact
+ then have "\<Turnstile> v : r" by simp
+ then have "Some v = decode (retrieve (intern r) v) r"
+ using decode_code retrieve_code by auto
+ then show "Some (flex r id [] v) = decode (retrieve (bders (intern r) []) v) r"
+ by simp
+next
+ case (snoc c s v)
+ have IH: "\<And>v. \<Turnstile> v : ders s r \<Longrightarrow>
+ Some (flex r id s v) = decode (retrieve (bders (intern r) s) v) r" by fact
+ have asm: "\<Turnstile> v : ders (s @ [c]) r" by fact
+ then have asm2: "\<Turnstile> injval (ders s r) c v : ders s r"
+ by (simp add: Prf_injval ders_append)
+ have "Some (flex r id (s @ [c]) v) = Some (flex r id s (injval (ders s r) c v))"
+ by (simp add: flex_append)
+ also have "... = decode (retrieve (bders (intern r) s) (injval (ders s r) c v)) r"
+ using asm2 IH by simp
+ also have "... = decode (retrieve (bder c (bders (intern r) s)) v) r"
+ using asm by (simp_all add: bder_retrieve ders_append)
+ finally show "Some (flex r id (s @ [c]) v) =
+ decode (retrieve (bders (intern r) (s @ [c])) v) r" by (simp add: bders_append)
+qed
+
+
+definition blex where
+ "blex a s \<equiv> if bnullable (bders a s) then Some (bmkeps (bders a s)) else None"
+
+
+
+definition blexer where
+ "blexer r s \<equiv> if bnullable (bders (intern r) s) then
+ decode (bmkeps (bders (intern r) s)) r else None"
+
+lemma blexer_correctness:
+ shows "blexer r s = lexer r s"
+proof -
+ { define bds where "bds \<equiv> bders (intern r) s"
+ define ds where "ds \<equiv> ders s r"
+ assume asm: "nullable ds"
+ have era: "erase bds = ds"
+ unfolding ds_def bds_def by simp
+ have mke: "\<Turnstile> mkeps ds : ds"
+ using asm by (simp add: mkeps_nullable)
+ have "decode (bmkeps bds) r = decode (retrieve bds (mkeps ds)) r"
+ using bmkeps_retrieve
+ using asm era by (simp add: bmkeps_retrieve)
+ also have "... = Some (flex r id s (mkeps ds))"
+ using mke by (simp_all add: MAIN_decode ds_def bds_def)
+ finally have "decode (bmkeps bds) r = Some (flex r id s (mkeps ds))"
+ unfolding bds_def ds_def .
+ }
+ then show "blexer r s = lexer r s"
+ unfolding blexer_def lexer_flex
+ apply(subst bnullable_correctness[symmetric])
+ apply(simp)
+ done
+qed
+
+lemma asize0:
+ shows "0 < asize r"
+ apply(induct r)
+ apply(auto)
+ done
+
+lemma asize_fuse:
+ shows "asize (fuse bs r) = asize r"
+ apply(induct r)
+ apply(auto)
+ done
+
+lemma bder_fuse:
+ shows "bder c (fuse bs a) = fuse bs (bder c a)"
+ apply(induct a arbitrary: bs c)
+ apply(simp_all)
+ done
+
+lemma map_bder_fuse:
+ shows "map (bder c \<circ> fuse bs1) as1 = map (fuse bs1) (map (bder c) as1)"
+ apply(induct as1)
+ apply(auto simp add: bder_fuse)
+ done
+
+
+fun nonnested :: "arexp \<Rightarrow> bool"
+ where
+ "nonnested (AALTs bs2 []) = True"
+| "nonnested (AALTs bs2 ((AALTs bs1 rs1) # rs2)) = False"
+| "nonnested (AALTs bs2 (r # rs2)) = nonnested (AALTs bs2 rs2)"
+| "nonnested r = True"
+
+
+
+fun distinctBy :: "'a list \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'b set \<Rightarrow> 'a list"
+ where
+ "distinctBy [] f acc = []"
+| "distinctBy (x#xs) f acc =
+ (if (f x) \<in> acc then distinctBy xs f acc
+ else x # (distinctBy xs f ({f x} \<union> acc)))"
+
+fun flts :: "arexp list \<Rightarrow> arexp list"
+ where
+ "flts [] = []"
+| "flts (AZERO # rs) = flts rs"
+| "flts ((AALTs bs rs1) # rs) = (map (fuse bs) rs1) @ flts rs"
+| "flts (r1 # rs) = r1 # flts rs"
+
+
+fun spill :: "arexp list \<Rightarrow> arexp list"
+ where
+ "spill [] = []"
+| "spill ((AALTs bs rs1) # rs) = (map (fuse bs) rs1) @ spill rs"
+| "spill (r1 # rs) = r1 # spill rs"
+
+lemma spill_Cons:
+ shows "spill (r # rs1) = spill [r] @ spill rs1"
+ apply(induct r arbitrary: rs1)
+ apply(auto)
+ done
+
+lemma spill_append:
+ shows "spill (rs1 @ rs2) = spill rs1 @ spill rs2"
+ apply(induct rs1 arbitrary: rs2)
+ apply(auto)
+ by (metis append.assoc spill_Cons)
+
+fun bsimp_ASEQ :: "bit list \<Rightarrow> arexp \<Rightarrow> arexp \<Rightarrow> arexp"
+ where
+ "bsimp_ASEQ _ AZERO _ = AZERO"
+| "bsimp_ASEQ _ _ AZERO = AZERO"
+| "bsimp_ASEQ bs1 (AONE bs2) r2 = fuse (bs1 @ bs2) r2"
+| "bsimp_ASEQ bs1 r1 r2 = ASEQ bs1 r1 r2"
+
+
+fun bsimp_AALTs :: "bit list \<Rightarrow> arexp list \<Rightarrow> arexp"
+ where
+ "bsimp_AALTs _ [] = AZERO"
+| "bsimp_AALTs bs1 [r] = fuse bs1 r"
+| "bsimp_AALTs bs1 rs = AALTs bs1 rs"
+
+
+fun bsimp :: "arexp \<Rightarrow> arexp"
+ where
+ "bsimp (ASEQ bs1 r1 r2) = bsimp_ASEQ bs1 (bsimp r1) (bsimp r2)"
+| "bsimp (AALTs bs1 rs) = bsimp_AALTs bs1 (flts (map bsimp rs))"
+| "bsimp r = r"
+
+
+inductive contains2 :: "arexp \<Rightarrow> bit list \<Rightarrow> bool" ("_ >>2 _" [51, 50] 50)
+ where
+ "AONE bs >>2 bs"
+| "ACHAR bs c >>2 bs"
+| "\<lbrakk>a1 >>2 bs1; a2 >>2 bs2\<rbrakk> \<Longrightarrow> ASEQ bs a1 a2 >>2 bs @ bs1 @ bs2"
+| "r >>2 bs1 \<Longrightarrow> AALTs bs (r#rs) >>2 bs @ bs1"
+| "AALTs bs rs >>2 bs @ bs1 \<Longrightarrow> AALTs bs (r#rs) >>2 bs @ bs1"
+| "ASTAR bs r >>2 bs @ [S]"
+| "\<lbrakk>r >>2 bs1; ASTAR [] r >>2 bs2\<rbrakk> \<Longrightarrow> ASTAR bs r >>2 bs @ Z # bs1 @ bs2"
+| "r >>2 bs \<Longrightarrow> (bsimp r) >>2 bs"
+
+
+inductive contains :: "arexp \<Rightarrow> bit list \<Rightarrow> bool" ("_ >> _" [51, 50] 50)
+ where
+ "AONE bs >> bs"
+| "ACHAR bs c >> bs"
+| "\<lbrakk>a1 >> bs1; a2 >> bs2\<rbrakk> \<Longrightarrow> ASEQ bs a1 a2 >> bs @ bs1 @ bs2"
+| "r >> bs1 \<Longrightarrow> AALTs bs (r#rs) >> bs @ bs1"
+| "AALTs bs rs >> bs @ bs1 \<Longrightarrow> AALTs bs (r#rs) >> bs @ bs1"
+| "ASTAR bs r >> bs @ [S]"
+| "\<lbrakk>r >> bs1; ASTAR [] r >> bs2\<rbrakk> \<Longrightarrow> ASTAR bs r >> bs @ Z # bs1 @ bs2"
+
+lemma contains0:
+ assumes "a >> bs"
+ shows "(fuse bs1 a) >> bs1 @ bs"
+ using assms
+ apply(induct arbitrary: bs1)
+ apply(auto intro: contains.intros)
+ apply (metis append.assoc contains.intros(3))
+ apply (metis append.assoc contains.intros(4))
+ apply (metis append.assoc contains.intros(5))
+ apply (metis append.assoc contains.intros(6))
+ apply (metis append_assoc contains.intros(7))
+ done
+
+lemma contains1:
+ assumes "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> intern r >> code v"
+ shows "ASTAR [] (intern r) >> code (Stars vs)"
+ using assms
+ apply(induct vs)
+ apply(simp)
+ using contains.simps apply blast
+ apply(simp)
+ apply(subst (2) append_Nil[symmetric])
+ apply(rule contains.intros)
+ apply(auto)
+ done
+
+
+
+
+
+lemma contains2:
+ assumes "\<Turnstile> v : r"
+ shows "(intern r) >> code v"
+ using assms
+ apply(induct)
+ prefer 4
+ apply(simp)
+ apply(rule contains.intros)
+ prefer 4
+ apply(simp)
+ apply(rule contains.intros)
+ apply(simp)
+ apply(subst (3) append_Nil[symmetric])
+ apply(rule contains.intros)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(subst (9) append_Nil[symmetric])
+ apply(rule contains.intros)
+ apply (metis append_Cons append_self_conv2 contains0)
+ apply(simp)
+ apply(subst (9) append_Nil[symmetric])
+ apply(rule contains.intros)
+ back
+ apply(rule contains.intros)
+ apply(drule_tac ?bs1.0="[S]" in contains0)
+ apply(simp)
+ apply(simp)
+ apply(case_tac vs)
+ apply(simp)
+ apply (metis append_Nil contains.intros(6))
+ using contains1 by blast
+
+lemma qq1:
+ assumes "\<exists>r \<in> set rs. bnullable r"
+ shows "bmkeps (AALTs bs (rs @ rs1)) = bmkeps (AALTs bs rs)"
+ using assms
+ apply(induct rs arbitrary: rs1 bs)
+ apply(simp)
+ apply(simp)
+ by (metis Nil_is_append_conv bmkeps.simps(4) neq_Nil_conv r0 split_list_last)
+
+lemma qq2:
+ assumes "\<forall>r \<in> set rs. \<not> bnullable r" "\<exists>r \<in> set rs1. bnullable r"
+ shows "bmkeps (AALTs bs (rs @ rs1)) = bmkeps (AALTs bs rs1)"
+ using assms
+ apply(induct rs arbitrary: rs1 bs)
+ apply(simp)
+ apply(simp)
+ by (metis append_assoc in_set_conv_decomp r1 r2)
+
+lemma qq2a:
+ assumes "\<not> bnullable r" "\<exists>r \<in> set rs1. bnullable r"
+ shows "bmkeps (AALTs bs (r # rs1)) = bmkeps (AALTs bs rs1)"
+ using assms
+ by (simp add: r1)
+
+lemma qq3:
+ shows "bnullable (AALTs bs rs) = (\<exists>r \<in> set rs. bnullable r)"
+ apply(induct rs arbitrary: bs)
+ apply(simp)
+ apply(simp)
+ done
+
+lemma qq4:
+ assumes "bnullable (AALTs bs rs)"
+ shows "bmkeps (AALTs bs rs) = bs @ bmkeps (AALTs [] rs)"
+ by (metis append_Nil2 assms bmkeps_retrieve bnullable_correctness erase_fuse fuse.simps(4) mkeps_nullable retrieve_fuse2)
+
+
+lemma contains3a:
+ assumes "AALTs bs lst >> bs @ bs1"
+ shows "AALTs bs (a # lst) >> bs @ bs1"
+ using assms
+ apply -
+ by (simp add: contains.intros(5))
+
+
+lemma contains3b:
+ assumes "a >> bs1"
+ shows "AALTs bs (a # lst) >> bs @ bs1"
+ using assms
+ apply -
+ apply(rule contains.intros)
+ apply(simp)
+ done
+
+
+lemma contains3:
+ assumes "\<And>x. \<lbrakk>x \<in> set rs; bnullable x\<rbrakk> \<Longrightarrow> x >> bmkeps x" "x \<in> set rs" "bnullable x"
+ shows "AALTs bs rs >> bmkeps (AALTs bs rs)"
+ using assms
+ apply(induct rs arbitrary: bs x)
+ apply simp
+ by (metis contains.intros(4) contains.intros(5) list.set_intros(1) list.set_intros(2) qq3 qq4 r r0 r1)
+
+lemma cont1:
+ assumes "\<And>v. \<Turnstile> v : erase r \<Longrightarrow> r >> retrieve r v"
+ "\<forall>v\<in>set vs. \<Turnstile> v : erase r \<and> flat v \<noteq> []"
+ shows "ASTAR bs r >> retrieve (ASTAR bs r) (Stars vs)"
+ using assms
+ apply(induct vs arbitrary: bs r)
+ apply(simp)
+ using contains.intros(6) apply auto[1]
+ by (simp add: contains.intros(7))
+
+lemma contains4:
+ assumes "bnullable a"
+ shows "a >> bmkeps a"
+ using assms
+ apply(induct a rule: bnullable.induct)
+ apply(auto intro: contains.intros)
+ using contains3 by blast
+
+lemma contains5:
+ assumes "\<Turnstile> v : r"
+ shows "(intern r) >> retrieve (intern r) v"
+ using contains2[OF assms] retrieve_code[OF assms]
+ by (simp)
+
+
+lemma contains6:
+ assumes "\<Turnstile> v : (erase r)"
+ shows "r >> retrieve r v"
+ using assms
+ apply(induct r arbitrary: v rule: erase.induct)
+ apply(auto)[1]
+ using Prf_elims(1) apply blast
+ using Prf_elims(4) contains.intros(1) apply force
+ using Prf_elims(5) contains.intros(2) apply force
+ apply(auto)[1]
+ using Prf_elims(1) apply blast
+ apply(auto)[1]
+ using contains3b contains3a apply blast
+ prefer 2
+ apply(auto)[1]
+ apply (metis Prf_elims(2) contains.intros(3) retrieve.simps(6))
+ prefer 2
+ apply(auto)[1]
+ apply (metis Prf_elims(6) cont1)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(auto)
+ apply (simp add: contains3b)
+ using retrieve_fuse2 contains3b contains3a
+ apply(subst retrieve_fuse2[symmetric])
+ apply (metis append_Nil2 erase_fuse fuse.simps(4))
+ apply(simp)
+ by (metis append_Nil2 erase_fuse fuse.simps(4))
+
+lemma contains7:
+ assumes "\<Turnstile> v : der c (erase r)"
+ shows "(bder c r) >> retrieve r (injval (erase r) c v)"
+ using bder_retrieve[OF assms(1)] retrieve_code[OF assms(1)]
+ by (metis assms contains6 erase_bder)
+
+
+lemma contains7a:
+ assumes "\<Turnstile> v : der c (erase r)"
+ shows "r >> retrieve r (injval (erase r) c v)"
+ using assms
+ apply -
+ apply(drule Prf_injval)
+ apply(drule contains6)
+ apply(simp)
+ done
+
+lemma contains7b:
+ assumes "\<Turnstile> v : ders s (erase r)"
+ shows "(bders r s) >> retrieve r (flex (erase r) id s v)"
+ using assms
+ apply(induct s arbitrary: r v)
+ apply(simp)
+ apply (simp add: contains6)
+ apply(simp add: bders_append flex_append ders_append)
+ apply(drule_tac x="bder a r" in meta_spec)
+ apply(drule meta_spec)
+ apply(drule meta_mp)
+ apply(simp)
+ apply(simp)
+ apply(subst (asm) bder_retrieve)
+ defer
+ apply (simp add: flex_injval)
+ by (simp add: Prf_flex)
+
+lemma contains7_iff:
+ assumes "\<Turnstile> v : der c (erase r)"
+ shows "(bder c r) >> retrieve r (injval (erase r) c v) \<longleftrightarrow>
+ r >> retrieve r (injval (erase r) c v)"
+ by (simp add: assms contains7 contains7a)
+
+lemma contains8_iff:
+ assumes "\<Turnstile> v : ders s (erase r)"
+ shows "(bders r s) >> retrieve r (flex (erase r) id s v) \<longleftrightarrow>
+ r >> retrieve r (flex (erase r) id s v)"
+ using Prf_flex assms contains6 contains7b by blast
+
+
+fun
+ bders_simp :: "arexp \<Rightarrow> string \<Rightarrow> arexp"
+where
+ "bders_simp r [] = r"
+| "bders_simp r (c # s) = bders_simp (bsimp (bder c r)) s"
+
+definition blexer_simp where
+ "blexer_simp r s \<equiv> if bnullable (bders_simp (intern r) s) then
+ decode (bmkeps (bders_simp (intern r) s)) r else None"
+
+
+
+
+
+lemma bders_simp_append:
+ shows "bders_simp r (s1 @ s2) = bders_simp (bders_simp r s1) s2"
+ apply(induct s1 arbitrary: r s2)
+ apply(simp)
+ apply(simp)
+ done
+
+lemma bsimp_ASEQ_size:
+ shows "asize (bsimp_ASEQ bs r1 r2) \<le> Suc (asize r1 + asize r2)"
+ apply(induct bs r1 r2 rule: bsimp_ASEQ.induct)
+ apply(auto)
+ done
+
+
+
+lemma flts_size:
+ shows "sum_list (map asize (flts rs)) \<le> sum_list (map asize rs)"
+ apply(induct rs rule: flts.induct)
+ apply(simp_all)
+ by (simp add: asize_fuse comp_def)
+
+
+lemma bsimp_AALTs_size:
+ shows "asize (bsimp_AALTs bs rs) \<le> Suc (sum_list (map asize rs))"
+ apply(induct rs rule: bsimp_AALTs.induct)
+ apply(auto simp add: asize_fuse)
+ done
+
+
+lemma bsimp_size:
+ shows "asize (bsimp r) \<le> asize r"
+ apply(induct r)
+ apply(simp_all)
+ apply (meson Suc_le_mono add_mono_thms_linordered_semiring(1) bsimp_ASEQ_size le_trans)
+ apply(rule le_trans)
+ apply(rule bsimp_AALTs_size)
+ apply(simp)
+ apply(rule le_trans)
+ apply(rule flts_size)
+ by (simp add: sum_list_mono)
+
+lemma bsimp_asize0:
+ shows "(\<Sum>x\<leftarrow>rs. asize (bsimp x)) \<le> sum_list (map asize rs)"
+ apply(induct rs)
+ apply(auto)
+ by (simp add: add_mono bsimp_size)
+
+lemma bsimp_AALTs_size2:
+ assumes "\<forall>r \<in> set rs. nonalt r"
+ shows "asize (bsimp_AALTs bs rs) \<ge> sum_list (map asize rs)"
+ using assms
+ apply(induct rs rule: bsimp_AALTs.induct)
+ apply(simp_all add: asize_fuse)
+ done
+
+
+lemma qq:
+ shows "map (asize \<circ> fuse bs) rs = map asize rs"
+ apply(induct rs)
+ apply(auto simp add: asize_fuse)
+ done
+
+lemma flts_size2:
+ assumes "\<exists>bs rs'. AALTs bs rs' \<in> set rs"
+ shows "sum_list (map asize (flts rs)) < sum_list (map asize rs)"
+ using assms
+ apply(induct rs)
+ apply(auto simp add: qq)
+ apply (simp add: flts_size less_Suc_eq_le)
+ apply(case_tac a)
+ apply(auto simp add: qq)
+ prefer 2
+ apply (simp add: flts_size le_imp_less_Suc)
+ using less_Suc_eq by auto
+
+lemma bsimp_AALTs_size3:
+ assumes "\<exists>r \<in> set (map bsimp rs). \<not>nonalt r"
+ shows "asize (bsimp (AALTs bs rs)) < asize (AALTs bs rs)"
+ using assms flts_size2
+ apply -
+ apply(clarify)
+ apply(simp)
+ apply(drule_tac x="map bsimp rs" in meta_spec)
+ apply(drule meta_mp)
+ apply (metis list.set_map nonalt.elims(3))
+ apply(simp)
+ apply(rule order_class.order.strict_trans1)
+ apply(rule bsimp_AALTs_size)
+ apply(simp)
+ by (smt Suc_leI bsimp_asize0 comp_def le_imp_less_Suc le_trans map_eq_conv not_less_eq)
+
+
+
+
+lemma L_bsimp_ASEQ:
+ "L (SEQ (erase r1) (erase r2)) = L (erase (bsimp_ASEQ bs r1 r2))"
+ apply(induct bs r1 r2 rule: bsimp_ASEQ.induct)
+ apply(simp_all)
+ by (metis erase_fuse fuse.simps(4))
+
+lemma L_bsimp_AALTs:
+ "L (erase (AALTs bs rs)) = L (erase (bsimp_AALTs bs rs))"
+ apply(induct bs rs rule: bsimp_AALTs.induct)
+ apply(simp_all add: erase_fuse)
+ done
+
+lemma L_erase_AALTs:
+ shows "L (erase (AALTs bs rs)) = \<Union> (L ` erase ` (set rs))"
+ apply(induct rs)
+ apply(simp)
+ apply(simp)
+ apply(case_tac rs)
+ apply(simp)
+ apply(simp)
+ done
+
+lemma L_erase_flts:
+ shows "\<Union> (L ` erase ` (set (flts rs))) = \<Union> (L ` erase ` (set rs))"
+ apply(induct rs rule: flts.induct)
+ apply(simp_all)
+ apply(auto)
+ using L_erase_AALTs erase_fuse apply auto[1]
+ by (simp add: L_erase_AALTs erase_fuse)
+
+
+lemma L_bsimp_erase:
+ shows "L (erase r) = L (erase (bsimp r))"
+ apply(induct r)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(auto simp add: Sequ_def)[1]
+ apply(subst L_bsimp_ASEQ[symmetric])
+ apply(auto simp add: Sequ_def)[1]
+ apply(subst (asm) L_bsimp_ASEQ[symmetric])
+ apply(auto simp add: Sequ_def)[1]
+ apply(simp)
+ apply(subst L_bsimp_AALTs[symmetric])
+ defer
+ apply(simp)
+ apply(subst (2)L_erase_AALTs)
+ apply(subst L_erase_flts)
+ apply(auto)
+ apply (simp add: L_erase_AALTs)
+ using L_erase_AALTs by blast
+
+lemma bsimp_ASEQ0:
+ shows "bsimp_ASEQ bs r1 AZERO = AZERO"
+ apply(induct r1)
+ apply(auto)
+ done
+
+
+
+lemma bsimp_ASEQ1:
+ assumes "r1 \<noteq> AZERO" "r2 \<noteq> AZERO" "\<forall>bs. r1 \<noteq> AONE bs"
+ shows "bsimp_ASEQ bs r1 r2 = ASEQ bs r1 r2"
+ using assms
+ apply(induct bs r1 r2 rule: bsimp_ASEQ.induct)
+ apply(auto)
+ done
+
+lemma bsimp_ASEQ2:
+ shows "bsimp_ASEQ bs (AONE bs1) r2 = fuse (bs @ bs1) r2"
+ apply(induct r2)
+ apply(auto)
+ done
+
+
+lemma L_bders_simp:
+ shows "L (erase (bders_simp r s)) = L (erase (bders r s))"
+ apply(induct s arbitrary: r rule: rev_induct)
+ apply(simp)
+ apply(simp)
+ apply(simp add: ders_append)
+ apply(simp add: bders_simp_append)
+ apply(simp add: L_bsimp_erase[symmetric])
+ by (simp add: der_correctness)
+
+lemma b1:
+ "bsimp_ASEQ bs1 (AONE bs) r = fuse (bs1 @ bs) r"
+ apply(induct r)
+ apply(auto)
+ done
+
+lemma b2:
+ assumes "bnullable r"
+ shows "bmkeps (fuse bs r) = bs @ bmkeps r"
+ by (simp add: assms bmkeps_retrieve bnullable_correctness erase_fuse mkeps_nullable retrieve_fuse2)
+
+lemma b3:
+ shows "bnullable r = bnullable (bsimp r)"
+ using L_bsimp_erase bnullable_correctness nullable_correctness by auto
+
+
+lemma b4:
+ shows "bnullable (bders_simp r s) = bnullable (bders r s)"
+ by (metis L_bders_simp bnullable_correctness lexer.simps(1) lexer_correct_None option.distinct(1))
+
+lemma q1:
+ assumes "\<forall>r \<in> set rs. bmkeps(bsimp r) = bmkeps r"
+ shows "map (\<lambda>r. bmkeps(bsimp r)) rs = map bmkeps rs"
+ using assms
+ apply(induct rs)
+ apply(simp)
+ apply(simp)
+ done
+
+lemma q3:
+ assumes "\<exists>r \<in> set rs. bnullable r"
+ shows "bmkeps (AALTs bs rs) = bmkeps (bsimp_AALTs bs rs)"
+ using assms
+ apply(induct bs rs rule: bsimp_AALTs.induct)
+ apply(simp)
+ apply(simp)
+ apply (simp add: b2)
+ apply(simp)
+ done
+
+
+lemma fuse_empty:
+ shows "fuse [] r = r"
+ apply(induct r)
+ apply(auto)
+ done
+
+lemma flts_fuse:
+ shows "map (fuse bs) (flts rs) = flts (map (fuse bs) rs)"
+ apply(induct rs arbitrary: bs rule: flts.induct)
+ apply(auto simp add: fuse_append)
+ done
+
+lemma bsimp_ASEQ_fuse:
+ shows "fuse bs1 (bsimp_ASEQ bs2 r1 r2) = bsimp_ASEQ (bs1 @ bs2) r1 r2"
+ apply(induct r1 r2 arbitrary: bs1 bs2 rule: bsimp_ASEQ.induct)
+ apply(auto)
+ done
+
+lemma bsimp_AALTs_fuse:
+ assumes "\<forall>r \<in> set rs. fuse bs1 (fuse bs2 r) = fuse (bs1 @ bs2) r"
+ shows "fuse bs1 (bsimp_AALTs bs2 rs) = bsimp_AALTs (bs1 @ bs2) rs"
+ using assms
+ apply(induct bs2 rs arbitrary: bs1 rule: bsimp_AALTs.induct)
+ apply(auto)
+ done
+
+
+
+lemma bsimp_fuse:
+ shows "fuse bs (bsimp r) = bsimp (fuse bs r)"
+apply(induct r arbitrary: bs)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 3
+ apply(simp)
+ apply(simp)
+ apply (simp add: bsimp_ASEQ_fuse)
+ apply(simp)
+ by (simp add: bsimp_AALTs_fuse fuse_append)
+
+lemma bsimp_fuse_AALTs:
+ shows "fuse bs (bsimp (AALTs [] rs)) = bsimp (AALTs bs rs)"
+ apply(subst bsimp_fuse)
+ apply(simp)
+ done
+
+lemma bsimp_fuse_AALTs2:
+ shows "fuse bs (bsimp_AALTs [] rs) = bsimp_AALTs bs rs"
+ using bsimp_AALTs_fuse fuse_append by auto
+
+
+lemma bsimp_ASEQ_idem:
+ assumes "bsimp (bsimp r1) = bsimp r1" "bsimp (bsimp r2) = bsimp r2"
+ shows "bsimp (bsimp_ASEQ x1 (bsimp r1) (bsimp r2)) = bsimp_ASEQ x1 (bsimp r1) (bsimp r2)"
+ using assms
+ apply(case_tac "bsimp r1 = AZERO")
+ apply(simp)
+ apply(case_tac "bsimp r2 = AZERO")
+ apply(simp)
+ apply (metis bnullable.elims(2) bnullable.elims(3) bsimp.simps(3) bsimp_ASEQ.simps(2) bsimp_ASEQ.simps(3) bsimp_ASEQ.simps(4) bsimp_ASEQ.simps(5) bsimp_ASEQ.simps(6))
+ apply(case_tac "\<exists>bs. bsimp r1 = AONE bs")
+ apply(auto)[1]
+ apply(subst bsimp_ASEQ2)
+ apply(subst bsimp_ASEQ2)
+ apply (metis assms(2) bsimp_fuse)
+ apply(subst bsimp_ASEQ1)
+ apply(auto)
+ done
+
+
+
+lemma k0:
+ shows "flts (r # rs1) = flts [r] @ flts rs1"
+ apply(induct r arbitrary: rs1)
+ apply(auto)
+ done
+
+lemma k00:
+ shows "flts (rs1 @ rs2) = flts rs1 @ flts rs2"
+ apply(induct rs1 arbitrary: rs2)
+ apply(auto)
+ by (metis append.assoc k0)
+
+lemma k0a:
+ shows "flts [AALTs bs rs] = map (fuse bs) rs"
+ apply(simp)
+ done
+
+
+lemma k0b:
+ assumes "nonalt r" "r \<noteq> AZERO"
+ shows "flts [r] = [r]"
+ using assms
+ apply(case_tac r)
+ apply(simp_all)
+ done
+
+lemma nn1:
+ assumes "nonnested (AALTs bs rs)"
+ shows "\<nexists>bs1 rs1. flts rs = [AALTs bs1 rs1]"
+ using assms
+ apply(induct rs rule: flts.induct)
+ apply(auto)
+ done
+
+lemma nn1q:
+ assumes "nonnested (AALTs bs rs)"
+ shows "\<nexists>bs1 rs1. AALTs bs1 rs1 \<in> set (flts rs)"
+ using assms
+ apply(induct rs rule: flts.induct)
+ apply(auto)
+ done
+
+lemma nn1qq:
+ assumes "nonnested (AALTs bs rs)"
+ shows "\<nexists>bs1 rs1. AALTs bs1 rs1 \<in> set rs"
+ using assms
+ apply(induct rs rule: flts.induct)
+ apply(auto)
+ done
+
+lemma nn10:
+ assumes "nonnested (AALTs cs rs)"
+ shows "nonnested (AALTs (bs @ cs) rs)"
+ using assms
+ apply(induct rs arbitrary: cs bs)
+ apply(simp_all)
+ apply(case_tac a)
+ apply(simp_all)
+ done
+
+lemma nn11a:
+ assumes "nonalt r"
+ shows "nonalt (fuse bs r)"
+ using assms
+ apply(induct r)
+ apply(auto)
+ done
+
+
+lemma nn1a:
+ assumes "nonnested r"
+ shows "nonnested (fuse bs r)"
+ using assms
+ apply(induct bs r arbitrary: rule: fuse.induct)
+ apply(simp_all add: nn10)
+ done
+
+lemma n0:
+ shows "nonnested (AALTs bs rs) \<longleftrightarrow> (\<forall>r \<in> set rs. nonalt r)"
+ apply(induct rs arbitrary: bs)
+ apply(auto)
+ apply (metis list.set_intros(1) nn1qq nonalt.elims(3))
+ apply (metis list.set_intros(2) nn1qq nonalt.elims(3))
+ by (metis nonalt.elims(2) nonnested.simps(3) nonnested.simps(4) nonnested.simps(5) nonnested.simps(6) nonnested.simps(7))
+
+
+
+
+lemma nn1c:
+ assumes "\<forall>r \<in> set rs. nonnested r"
+ shows "\<forall>r \<in> set (flts rs). nonalt r"
+ using assms
+ apply(induct rs rule: flts.induct)
+ apply(auto)
+ apply(rule nn11a)
+ by (metis nn1qq nonalt.elims(3))
+
+lemma nn1bb:
+ assumes "\<forall>r \<in> set rs. nonalt r"
+ shows "nonnested (bsimp_AALTs bs rs)"
+ using assms
+ apply(induct bs rs rule: bsimp_AALTs.induct)
+ apply(auto)
+ apply (metis nn11a nonalt.simps(1) nonnested.elims(3))
+ using n0 by auto
+
+lemma nn1b:
+ shows "nonnested (bsimp r)"
+ apply(induct r)
+ apply(simp_all)
+ apply(case_tac "bsimp r1 = AZERO")
+ apply(simp)
+ apply(case_tac "bsimp r2 = AZERO")
+ apply(simp)
+ apply(subst bsimp_ASEQ0)
+ apply(simp)
+ apply(case_tac "\<exists>bs. bsimp r1 = AONE bs")
+ apply(auto)[1]
+ apply(subst bsimp_ASEQ2)
+ apply (simp add: nn1a)
+ apply(subst bsimp_ASEQ1)
+ apply(auto)
+ apply(rule nn1bb)
+ apply(auto)
+ by (metis (mono_tags, hide_lams) imageE nn1c set_map)
+
+lemma nn1d:
+ assumes "bsimp r = AALTs bs rs"
+ shows "\<forall>r1 \<in> set rs. \<forall> bs. r1 \<noteq> AALTs bs rs2"
+ using nn1b assms
+ by (metis nn1qq)
+
+lemma nn_flts:
+ assumes "nonnested (AALTs bs rs)"
+ shows "\<forall>r \<in> set (flts rs). nonalt r"
+ using assms
+ apply(induct rs arbitrary: bs rule: flts.induct)
+ apply(auto)
+ done
+
+
+
+lemma rt:
+ shows "sum_list (map asize (flts (map bsimp rs))) \<le> sum_list (map asize rs)"
+ apply(induct rs)
+ apply(simp)
+ apply(simp)
+ apply(subst k0)
+ apply(simp)
+ by (smt add_le_cancel_right add_mono bsimp_size flts.simps(1) flts_size k0 le_iff_add list.simps(9) map_append sum_list.Cons sum_list.append trans_le_add1)
+
+lemma bsimp_AALTs_qq:
+ assumes "1 < length rs"
+ shows "bsimp_AALTs bs rs = AALTs bs rs"
+ using assms
+ apply(case_tac rs)
+ apply(simp)
+ apply(case_tac list)
+ apply(simp_all)
+ done
+
+
+lemma bsimp_AALTs1:
+ assumes "nonalt r"
+ shows "bsimp_AALTs bs (flts [r]) = fuse bs r"
+ using assms
+ apply(case_tac r)
+ apply(simp_all)
+ done
+
+lemma bbbbs:
+ assumes "good r" "r = AALTs bs1 rs"
+ shows "bsimp_AALTs bs (flts [r]) = AALTs bs (map (fuse bs1) rs)"
+ using assms
+ by (metis (no_types, lifting) Nil_is_map_conv append.left_neutral append_butlast_last_id bsimp_AALTs.elims butlast.simps(2) good.simps(4) good.simps(5) k0a map_butlast)
+
+lemma bbbbs1:
+ shows "nonalt r \<or> (\<exists>bs rs. r = AALTs bs rs)"
+ using nonalt.elims(3) by auto
+
+
+lemma good_fuse:
+ shows "good (fuse bs r) = good r"
+ apply(induct r arbitrary: bs)
+ apply(auto)
+ apply(case_tac r1)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r1)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac x2a)
+ apply(simp_all)
+ apply(case_tac list)
+ apply(simp_all)
+ apply(case_tac x2a)
+ apply(simp_all)
+ apply(case_tac list)
+ apply(simp_all)
+ done
+
+lemma good0:
+ assumes "rs \<noteq> Nil" "\<forall>r \<in> set rs. nonalt r"
+ shows "good (bsimp_AALTs bs rs) \<longleftrightarrow> (\<forall>r \<in> set rs. good r)"
+ using assms
+ apply(induct bs rs rule: bsimp_AALTs.induct)
+ apply(auto simp add: good_fuse)
+ done
+
+lemma good0a:
+ assumes "flts (map bsimp rs) \<noteq> Nil" "\<forall>r \<in> set (flts (map bsimp rs)). nonalt r"
+ shows "good (bsimp (AALTs bs rs)) \<longleftrightarrow> (\<forall>r \<in> set (flts (map bsimp rs)). good r)"
+ using assms
+ apply(simp)
+ apply(auto)
+ apply(subst (asm) good0)
+ apply(simp)
+ apply(auto)
+ apply(subst good0)
+ apply(simp)
+ apply(auto)
+ done
+
+lemma flts0:
+ assumes "r \<noteq> AZERO" "nonalt r"
+ shows "flts [r] \<noteq> []"
+ using assms
+ apply(induct r)
+ apply(simp_all)
+ done
+
+lemma flts1:
+ assumes "good r"
+ shows "flts [r] \<noteq> []"
+ using assms
+ apply(induct r)
+ apply(simp_all)
+ apply(case_tac x2a)
+ apply(simp)
+ apply(simp)
+ done
+
+lemma flts2:
+ assumes "good r"
+ shows "\<forall>r' \<in> set (flts [r]). good r' \<and> nonalt r'"
+ using assms
+ apply(induct r)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 2
+ apply(simp)
+ apply(auto)[1]
+ apply (metis bsimp_AALTs.elims good.simps(4) good.simps(5) good.simps(6) good_fuse)
+ apply (metis bsimp_AALTs.elims good.simps(4) good.simps(5) good.simps(6) nn11a)
+ apply fastforce
+ apply(simp)
+ done
+
+
+lemma flts3:
+ assumes "\<forall>r \<in> set rs. good r \<or> r = AZERO"
+ shows "\<forall>r \<in> set (flts rs). good r"
+ using assms
+ apply(induct rs arbitrary: rule: flts.induct)
+ apply(simp_all)
+ by (metis UnE flts2 k0a set_map)
+
+lemma flts3b:
+ assumes "\<exists>r\<in>set rs. good r"
+ shows "flts rs \<noteq> []"
+ using assms
+ apply(induct rs arbitrary: rule: flts.induct)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(auto)
+ done
+
+lemma flts4:
+ assumes "bsimp_AALTs bs (flts rs) = AZERO"
+ shows "\<forall>r \<in> set rs. \<not> good r"
+ using assms
+ apply(induct rs arbitrary: bs rule: flts.induct)
+ apply(auto)
+ defer
+ apply (metis (no_types, lifting) Nil_is_append_conv append_self_conv2 bsimp_AALTs.elims butlast.simps(2) butlast_append flts3b nonalt.simps(1) nonalt.simps(2))
+ apply (metis arexp.distinct(7) bsimp_AALTs.elims flts2 good.simps(1) good.simps(2) good0 k0b list.distinct(1) list.inject nonalt.simps(3))
+ apply (metis arexp.distinct(3) arexp.distinct(7) bsimp_AALTs.elims fuse.simps(3) list.distinct(1) list.inject)
+ apply (metis arexp.distinct(7) bsimp_AALTs.elims good.simps(1) good_fuse list.distinct(1) list.inject)
+ apply (metis arexp.distinct(7) bsimp_AALTs.elims list.distinct(1) list.inject)
+ apply (metis arexp.distinct(7) bsimp_AALTs.elims flts2 good.simps(1) good.simps(33) good0 k0b list.distinct(1) list.inject nonalt.simps(6))
+ by (metis (no_types, lifting) Nil_is_append_conv append_Nil2 arexp.distinct(7) bsimp_AALTs.elims butlast.simps(2) butlast_append flts1 flts2 good.simps(1) good0 k0a)
+
+
+lemma flts_nil:
+ assumes "\<forall>y. asize y < Suc (sum_list (map asize rs)) \<longrightarrow>
+ good (bsimp y) \<or> bsimp y = AZERO"
+ and "\<forall>r\<in>set rs. \<not> good (bsimp r)"
+ shows "flts (map bsimp rs) = []"
+ using assms
+ apply(induct rs)
+ apply(simp)
+ apply(simp)
+ apply(subst k0)
+ apply(simp)
+ by force
+
+lemma flts_nil2:
+ assumes "\<forall>y. asize y < Suc (sum_list (map asize rs)) \<longrightarrow>
+ good (bsimp y) \<or> bsimp y = AZERO"
+ and "bsimp_AALTs bs (flts (map bsimp rs)) = AZERO"
+ shows "flts (map bsimp rs) = []"
+ using assms
+ apply(induct rs arbitrary: bs)
+ apply(simp)
+ apply(simp)
+ apply(subst k0)
+ apply(simp)
+ apply(subst (asm) k0)
+ apply(auto)
+ apply (metis flts.simps(1) flts.simps(2) flts4 k0 less_add_Suc1 list.set_intros(1))
+ by (metis flts.simps(2) flts4 k0 less_add_Suc1 list.set_intros(1))
+
+
+
+lemma good_SEQ:
+ assumes "r1 \<noteq> AZERO" "r2 \<noteq> AZERO" "\<forall>bs. r1 \<noteq> AONE bs"
+ shows "good (ASEQ bs r1 r2) = (good r1 \<and> good r2)"
+ using assms
+ apply(case_tac r1)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ done
+
+lemma good1:
+ shows "good (bsimp a) \<or> bsimp a = AZERO"
+ apply(induct a taking: asize rule: measure_induct)
+ apply(case_tac x)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 3
+ apply(simp)
+ prefer 2
+ (* AALTs case *)
+ apply(simp only:)
+ apply(case_tac "x52")
+ apply(simp)
+ thm good0a
+ (* AALTs list at least one - case *)
+ apply(simp only: )
+ apply(frule_tac x="a" in spec)
+ apply(drule mp)
+ apply(simp)
+ (* either first element is good, or AZERO *)
+ apply(erule disjE)
+ prefer 2
+ apply(simp)
+ (* in the AZERO case, the size is smaller *)
+ apply(drule_tac x="AALTs x51 list" in spec)
+ apply(drule mp)
+ apply(simp add: asize0)
+ apply(subst (asm) bsimp.simps)
+ apply(subst (asm) bsimp.simps)
+ apply(assumption)
+ (* in the good case *)
+ apply(frule_tac x="AALTs x51 list" in spec)
+ apply(drule mp)
+ apply(simp add: asize0)
+ apply(erule disjE)
+ apply(rule disjI1)
+ apply(simp add: good0)
+ apply(subst good0)
+ apply (metis Nil_is_append_conv flts1 k0)
+ apply (metis ex_map_conv list.simps(9) nn1b nn1c)
+ apply(simp)
+ apply(subst k0)
+ apply(simp)
+ apply(auto)[1]
+ using flts2 apply blast
+ apply(subst (asm) good0)
+ prefer 3
+ apply(auto)[1]
+ apply auto[1]
+ apply (metis ex_map_conv nn1b nn1c)
+ (* in the AZERO case *)
+ apply(simp)
+ apply(frule_tac x="a" in spec)
+ apply(drule mp)
+ apply(simp)
+ apply(erule disjE)
+ apply(rule disjI1)
+ apply(subst good0)
+ apply(subst k0)
+ using flts1 apply blast
+ apply(auto)[1]
+ apply (metis (no_types, hide_lams) ex_map_conv list.simps(9) nn1b nn1c)
+ apply(auto)[1]
+ apply(subst (asm) k0)
+ apply(auto)[1]
+ using flts2 apply blast
+ apply(frule_tac x="AALTs x51 list" in spec)
+ apply(drule mp)
+ apply(simp add: asize0)
+ apply(erule disjE)
+ apply(simp)
+ apply(simp)
+ apply (metis add.left_commute flts_nil2 less_add_Suc1 less_imp_Suc_add list.distinct(1) list.set_cases nat.inject)
+ apply(subst (2) k0)
+ apply(simp)
+ (* SEQ case *)
+ apply(simp)
+ apply(case_tac "bsimp x42 = AZERO")
+ apply(simp)
+ apply(case_tac "bsimp x43 = AZERO")
+ apply(simp)
+ apply(subst (2) bsimp_ASEQ0)
+ apply(simp)
+ apply(case_tac "\<exists>bs. bsimp x42 = AONE bs")
+ apply(auto)[1]
+ apply(subst bsimp_ASEQ2)
+ using good_fuse apply force
+ apply(subst bsimp_ASEQ1)
+ apply(auto)
+ apply(subst good_SEQ)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ using less_add_Suc1 less_add_Suc2 by blast
+
+lemma good1a:
+ assumes "L(erase a) \<noteq> {}"
+ shows "good (bsimp a)"
+ using good1 assms
+ using L_bsimp_erase by force
+
+
+
+lemma flts_append:
+ "flts (xs1 @ xs2) = flts xs1 @ flts xs2"
+ apply(induct xs1 arbitrary: xs2 rule: rev_induct)
+ apply(auto)
+ apply(case_tac xs)
+ apply(auto)
+ apply(case_tac x)
+ apply(auto)
+ apply(case_tac x)
+ apply(auto)
+ done
+
+lemma g1:
+ assumes "good (bsimp_AALTs bs rs)"
+ shows "bsimp_AALTs bs rs = AALTs bs rs \<or> (\<exists>r. rs = [r] \<and> bsimp_AALTs bs [r] = fuse bs r)"
+using assms
+ apply(induct rs arbitrary: bs)
+ apply(simp)
+ apply(case_tac rs)
+ apply(simp only:)
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ by simp
+
+lemma flts_0:
+ assumes "nonnested (AALTs bs rs)"
+ shows "\<forall>r \<in> set (flts rs). r \<noteq> AZERO"
+ using assms
+ apply(induct rs arbitrary: bs rule: flts.induct)
+ apply(simp)
+ apply(simp)
+ defer
+ apply(simp)
+ apply(simp)
+ apply(simp)
+apply(simp)
+ apply(rule ballI)
+ apply(simp)
+ done
+
+lemma flts_0a:
+ assumes "nonnested (AALTs bs rs)"
+ shows "AZERO \<notin> set (flts rs)"
+ using assms
+ using flts_0 by blast
+
+lemma qqq1:
+ shows "AZERO \<notin> set (flts (map bsimp rs))"
+ by (metis ex_map_conv flts3 good.simps(1) good1)
+
+
+fun nonazero :: "arexp \<Rightarrow> bool"
+ where
+ "nonazero AZERO = False"
+| "nonazero r = True"
+
+lemma flts_concat:
+ shows "flts rs = concat (map (\<lambda>r. flts [r]) rs)"
+ apply(induct rs)
+ apply(auto)
+ apply(subst k0)
+ apply(simp)
+ done
+
+lemma flts_single1:
+ assumes "nonalt r" "nonazero r"
+ shows "flts [r] = [r]"
+ using assms
+ apply(induct r)
+ apply(auto)
+ done
+
+lemma flts_qq:
+ assumes "\<forall>y. asize y < Suc (sum_list (map asize rs)) \<longrightarrow> good y \<longrightarrow> bsimp y = y"
+ "\<forall>r'\<in>set rs. good r' \<and> nonalt r'"
+ shows "flts (map bsimp rs) = rs"
+ using assms
+ apply(induct rs)
+ apply(simp)
+ apply(simp)
+ apply(subst k0)
+ apply(subgoal_tac "flts [bsimp a] = [a]")
+ prefer 2
+ apply(drule_tac x="a" in spec)
+ apply(drule mp)
+ apply(simp)
+ apply(auto)[1]
+ using good.simps(1) k0b apply blast
+ apply(auto)[1]
+ done
+
+lemma test:
+ assumes "good r"
+ shows "bsimp r = r"
+ using assms
+ apply(induct r taking: "asize" rule: measure_induct)
+ apply(erule good.elims)
+ apply(simp_all)
+ apply(subst k0)
+ apply(subst (2) k0)
+ apply(subst flts_qq)
+ apply(auto)[1]
+ apply(auto)[1]
+ apply (metis append_Cons append_Nil bsimp_AALTs.simps(3) good.simps(1) k0b)
+ apply force+
+ apply (metis (no_types, lifting) add_Suc add_Suc_right asize.simps(5) bsimp.simps(1) bsimp_ASEQ.simps(19) less_add_Suc1 less_add_Suc2)
+ apply (metis add_Suc add_Suc_right arexp.distinct(5) arexp.distinct(7) asize.simps(4) asize.simps(5) bsimp.simps(1) bsimp.simps(2) bsimp_ASEQ1 good.simps(21) good.simps(8) less_add_Suc1 less_add_Suc2)
+ apply force+
+ apply (metis (no_types, lifting) add_Suc add_Suc_right arexp.distinct(5) arexp.distinct(7) asize.simps(4) asize.simps(5) bsimp.simps(1) bsimp.simps(2) bsimp_ASEQ1 good.simps(25) good.simps(8) less_add_Suc1 less_add_Suc2)
+ apply (metis add_Suc add_Suc_right arexp.distinct(7) asize.simps(4) bsimp.simps(2) bsimp_ASEQ1 good.simps(26) good.simps(8) less_add_Suc1 less_add_Suc2)
+ apply force+
+ done
+
+lemma test2:
+ assumes "good r"
+ shows "bsimp r = r"
+ using assms
+ apply(induct r taking: "asize" rule: measure_induct)
+ apply(case_tac x)
+ apply(simp_all)
+ defer
+ (* AALT case *)
+ apply(subgoal_tac "1 < length x52")
+ prefer 2
+ apply(case_tac x52)
+ apply(simp)
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ apply(simp)
+ apply(subst bsimp_AALTs_qq)
+ prefer 2
+ apply(subst flts_qq)
+ apply(auto)[1]
+ apply(auto)[1]
+ apply(case_tac x52)
+ apply(simp)
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ apply(simp)
+ apply(auto)[1]
+ apply (metis (no_types, lifting) bsimp_AALTs.elims good.simps(6) length_Cons length_pos_if_in_set list.size(3) nat_neq_iff)
+ apply(simp)
+ apply(case_tac x52)
+ apply(simp)
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ apply(simp)
+ apply(subst k0)
+ apply(simp)
+ apply(subst (2) k0)
+ apply(simp)
+ apply (simp add: Suc_lessI flts1 one_is_add)
+ (* SEQ case *)
+ apply(case_tac "bsimp x42 = AZERO")
+ apply simp
+ apply (metis asize.elims good.simps(10) good.simps(11) good.simps(12) good.simps(2) good.simps(7) good.simps(9) good_SEQ less_add_Suc1)
+ apply(case_tac "\<exists>bs'. bsimp x42 = AONE bs'")
+ apply(auto)[1]
+ defer
+ apply(case_tac "bsimp x43 = AZERO")
+ apply(simp)
+ apply (metis bsimp.elims bsimp.simps(3) good.simps(10) good.simps(11) good.simps(12) good.simps(8) good.simps(9) good_SEQ less_add_Suc2)
+ apply(auto)
+ apply (subst bsimp_ASEQ1)
+ apply(auto)[3]
+ apply(auto)[1]
+ apply (metis bsimp.simps(3) good.simps(2) good_SEQ less_add_Suc1)
+ apply (metis bsimp.simps(3) good.simps(2) good_SEQ less_add_Suc1 less_add_Suc2)
+ apply (subst bsimp_ASEQ2)
+ apply(drule_tac x="x42" in spec)
+ apply(drule mp)
+ apply(simp)
+ apply(drule mp)
+ apply (metis bsimp.elims bsimp.simps(3) good.simps(10) good.simps(11) good.simps(2) good_SEQ)
+ apply(simp)
+ done
+
+
+lemma bsimp_idem:
+ shows "bsimp (bsimp r) = bsimp r"
+ using test good1
+ by force
+
+
+lemma contains_ex1:
+ assumes "a = AALTs bs1 [AZERO, AONE bs2]" "a >> bs"
+ shows "bsimp a >> bs"
+ using assms
+ apply(simp)
+ apply(erule contains.cases)
+ apply(auto)
+ using contains.simps apply blast
+ apply(erule contains.cases)
+ apply(auto)
+ using contains0 apply fastforce
+ using contains.simps by blast
+
+lemma contains_ex2:
+ assumes "a = AALTs bs1 [AZERO, AONE bs2, AALTs bs5 [AONE bs3, AZERO, AONE bs4]]" "a >> bs"
+ shows "bsimp a >> bs"
+ using assms
+ apply(simp)
+ apply(erule contains.cases)
+ apply(auto)
+ using contains.simps apply blast
+ apply(erule contains.cases)
+ apply(auto)
+ using contains3b apply blast
+ apply(erule contains.cases)
+ apply(auto)
+ apply(erule contains.cases)
+ apply(auto)
+ apply (metis contains.intros(4) contains.intros(5) contains0 fuse.simps(2))
+ apply(erule contains.cases)
+ apply(auto)
+ using contains.simps apply blast
+ apply(erule contains.cases)
+ apply(auto)
+ apply (metis contains.intros(4) contains.intros(5) contains0 fuse.simps(2))
+ apply(erule contains.cases)
+ apply(auto)
+apply(erule contains.cases)
+ apply(auto)
+ done
+
+lemma contains48:
+ assumes "\<And>x2aa bs bs1. \<lbrakk>x2aa \<in> set x2a; fuse bs x2aa >> bs @ bs1\<rbrakk> \<Longrightarrow> x2aa >> bs1"
+ "AALTs (bs @ x1) x2a >> bs @ bs1"
+ shows "AALTs x1 x2a >> bs1"
+ using assms
+ apply(induct x2a arbitrary: bs x1 bs1)
+ apply(auto)
+ apply(erule contains.cases)
+ apply(auto)
+ apply(erule contains.cases)
+ apply(auto)
+ apply (simp add: contains.intros(4))
+ using contains.intros(5) by blast
+
+
+lemma contains49:
+ assumes "fuse bs a >> bs @ bs1"
+ shows "a >> bs1"
+ using assms
+ apply(induct a arbitrary: bs bs1)
+ apply(auto)
+ using contains.simps apply blast
+ apply(erule contains.cases)
+ apply(auto)
+ apply(rule contains.intros)
+ apply(erule contains.cases)
+ apply(auto)
+ apply(rule contains.intros)
+ apply(erule contains.cases)
+ apply(auto)
+ apply(rule contains.intros)
+ apply(auto)[2]
+ prefer 2
+ apply(erule contains.cases)
+ apply(auto)
+ apply (simp add: contains.intros(6))
+ using contains.intros(7) apply blast
+ using contains48 by blast
+
+lemma contains50:
+ assumes "bsimp_AALTs bs rs2 >> bs @ bs1"
+ shows "bsimp_AALTs bs (rs1 @ rs2) >> bs @ bs1"
+ using assms
+ apply(induct rs1 arbitrary: bs rs2 bs1)
+ apply(simp)
+ apply(auto)
+ apply(case_tac rs1)
+ apply(simp)
+ apply(case_tac rs2)
+ apply(simp)
+ using contains.simps apply blast
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ apply(rule contains.intros)
+ back
+ apply(rule contains.intros)
+ using contains49 apply blast
+ apply(simp)
+ using contains.intros(5) apply blast
+ apply(simp)
+ by (metis bsimp_AALTs.elims contains.intros(4) contains.intros(5) contains49 list.distinct(1))
+
+lemma contains51:
+ assumes "bsimp_AALTs bs [r] >> bs @ bs1"
+ shows "bsimp_AALTs bs ([r] @ rs2) >> bs @ bs1"
+ using assms
+ apply(induct rs2 arbitrary: bs r bs1)
+ apply(simp)
+ apply(auto)
+ using contains.intros(4) contains49 by blast
+
+lemma contains51a:
+ assumes "bsimp_AALTs bs rs2 >> bs @ bs1"
+ shows "bsimp_AALTs bs (rs2 @ [r]) >> bs @ bs1"
+ using assms
+ apply(induct rs2 arbitrary: bs r bs1)
+ apply(simp)
+ apply(auto)
+ using contains.simps apply blast
+ apply(case_tac rs2)
+ apply(auto)
+ using contains3b contains49 apply blast
+ apply(case_tac list)
+ apply(auto)
+ apply(erule contains.cases)
+ apply(auto)
+ using contains.intros(4) apply auto[1]
+ apply(erule contains.cases)
+ apply(auto)
+ apply (simp add: contains.intros(4) contains.intros(5))
+ apply (simp add: contains.intros(5))
+ apply(erule contains.cases)
+ apply(auto)
+ apply (simp add: contains.intros(4))
+ apply(erule contains.cases)
+ apply(auto)
+ using contains.intros(4) contains.intros(5) apply blast
+ using contains.intros(5) by blast
+
+lemma contains51b:
+ assumes "bsimp_AALTs bs rs >> bs @ bs1"
+ shows "bsimp_AALTs bs (rs @ rs2) >> bs @ bs1"
+ using assms
+ apply(induct rs2 arbitrary: bs rs bs1)
+ apply(simp)
+ using contains51a by fastforce
+
+
+lemma contains51c:
+ assumes "AALTs (bs @ bs2) rs >> bs @ bs1"
+ shows "bsimp_AALTs bs (map (fuse bs2) rs) >> bs @ bs1"
+ using assms
+ apply(induct rs arbitrary: bs bs1 bs2)
+ apply(auto)
+ apply(erule contains.cases)
+ apply(auto)
+ apply(erule contains.cases)
+ apply(auto)
+ using contains0 contains51 apply auto[1]
+ by (metis append.left_neutral append_Cons contains50 list.simps(9))
+
+
+lemma contains51d:
+ assumes "fuse bs r >> bs @ bs1"
+ shows "bsimp_AALTs bs (flts [r]) >> bs @ bs1"
+ using assms
+ apply(induct r arbitrary: bs bs1)
+ apply(auto)
+ by (simp add: contains51c)
+
+lemma contains52:
+ assumes "\<exists>r \<in> set rs. (fuse bs r) >> bs @ bs1"
+ shows "bsimp_AALTs bs (flts rs) >> bs @ bs1"
+ using assms
+ apply(induct rs arbitrary: bs bs1)
+ apply(simp)
+ apply(auto)
+ defer
+ apply (metis contains50 k0)
+ apply(subst k0)
+ apply(rule contains51b)
+ using contains51d by blast
+
+lemma contains55:
+ assumes "a >> bs"
+ shows "bsimp a >> bs"
+ using assms
+ apply(induct a bs arbitrary:)
+ apply(auto intro: contains.intros)
+ apply(case_tac "bsimp a1 = AZERO")
+ apply(simp)
+ using contains.simps apply blast
+ apply(case_tac "bsimp a2 = AZERO")
+ apply(simp)
+ using contains.simps apply blast
+ apply(case_tac "\<exists>bs. bsimp a1 = AONE bs")
+ apply(auto)[1]
+ apply(rotate_tac 1)
+ apply(erule contains.cases)
+ apply(auto)
+ apply (simp add: b1 contains0 fuse_append)
+ apply (simp add: bsimp_ASEQ1 contains.intros(3))
+ prefer 2
+ apply(case_tac rs)
+ apply(simp)
+ using contains.simps apply blast
+ apply (metis contains50 k0)
+ (* AALTS case *)
+ apply(rule contains52)
+ apply(rule_tac x="bsimp r" in bexI)
+ apply(auto)
+ using contains0 by blast
+
+
+lemma q3a:
+ assumes "\<exists>r \<in> set rs. bnullable r"
+ shows "bmkeps (AALTs bs (map (fuse bs1) rs)) = bmkeps (AALTs (bs@bs1) rs)"
+ using assms
+ apply(induct rs arbitrary: bs bs1)
+ apply(simp)
+ apply(simp)
+ apply(auto)
+ apply (metis append_assoc b2 bnullable_correctness erase_fuse r0)
+ apply(case_tac "bnullable a")
+ apply (metis append.assoc b2 bnullable_correctness erase_fuse r0)
+ apply(case_tac rs)
+ apply(simp)
+ apply(simp)
+ apply(auto)[1]
+ apply (metis bnullable_correctness erase_fuse)+
+ done
+
+
+
+lemma qq4a:
+ assumes "\<exists>x\<in>set list. bnullable x"
+ shows "\<exists>x\<in>set (flts list). bnullable x"
+ using assms
+ apply(induct list rule: flts.induct)
+ apply(auto)
+ by (metis UnCI bnullable_correctness erase_fuse imageI)
+
+
+lemma qs3:
+ assumes "\<exists>r \<in> set rs. bnullable r"
+ shows "bmkeps (AALTs bs rs) = bmkeps (AALTs bs (flts rs))"
+ using assms
+ apply(induct rs arbitrary: bs taking: size rule: measure_induct)
+ apply(case_tac x)
+ apply(simp)
+ apply(simp)
+ apply(case_tac a)
+ apply(simp)
+ apply (simp add: r1)
+ apply(simp)
+ apply (simp add: r0)
+ apply(simp)
+ apply(case_tac "flts list")
+ apply(simp)
+ apply (metis L_erase_AALTs L_erase_flts L_flat_Prf1 L_flat_Prf2 Prf_elims(1) bnullable_correctness erase.simps(4) mkeps_nullable r2)
+ apply(simp)
+ apply (simp add: r1)
+ prefer 3
+ apply(simp)
+ apply (simp add: r0)
+ prefer 2
+ apply(simp)
+ apply(case_tac "\<exists>x\<in>set x52. bnullable x")
+ apply(case_tac "list")
+ apply(simp)
+ apply (metis b2 fuse.simps(4) q3a r2)
+ apply(erule disjE)
+ apply(subst qq1)
+ apply(auto)[1]
+ apply (metis bnullable_correctness erase_fuse)
+ apply(simp)
+ apply (metis b2 fuse.simps(4) q3a r2)
+ apply(simp)
+ apply(auto)[1]
+ apply(subst qq1)
+ apply (metis bnullable_correctness erase_fuse image_eqI set_map)
+ apply (metis b2 fuse.simps(4) q3a r2)
+ apply(subst qq1)
+ apply (metis bnullable_correctness erase_fuse image_eqI set_map)
+ apply (metis b2 fuse.simps(4) q3a r2)
+ apply(simp)
+ apply(subst qq2)
+ apply (metis bnullable_correctness erase_fuse imageE set_map)
+ prefer 2
+ apply(case_tac "list")
+ apply(simp)
+ apply(simp)
+ apply (simp add: qq4a)
+ apply(simp)
+ apply(auto)
+ apply(case_tac list)
+ apply(simp)
+ apply(simp)
+ apply (simp add: r0)
+ apply(case_tac "bnullable (ASEQ x41 x42 x43)")
+ apply(case_tac list)
+ apply(simp)
+ apply(simp)
+ apply (simp add: r0)
+ apply(simp)
+ using qq4a r1 r2 by auto
+
+
+
+lemma k1:
+ assumes "\<And>x2aa. \<lbrakk>x2aa \<in> set x2a; bnullable x2aa\<rbrakk> \<Longrightarrow> bmkeps x2aa = bmkeps (bsimp x2aa)"
+ "\<exists>x\<in>set x2a. bnullable x"
+ shows "bmkeps (AALTs x1 (flts x2a)) = bmkeps (AALTs x1 (flts (map bsimp x2a)))"
+ using assms
+ apply(induct x2a)
+ apply fastforce
+ apply(simp)
+ apply(subst k0)
+ apply(subst (2) k0)
+ apply(auto)[1]
+ apply (metis b3 k0 list.set_intros(1) qs3 r0)
+ by (smt b3 imageI insert_iff k0 list.set(2) qq3 qs3 r0 r1 set_map)
+
+
+
+lemma bmkeps_simp:
+ assumes "bnullable r"
+ shows "bmkeps r = bmkeps (bsimp r)"
+ using assms
+ apply(induct r)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 3
+ apply(simp)
+ apply(case_tac "bsimp r1 = AZERO")
+ apply(simp)
+ apply(auto)[1]
+ apply (metis L_bsimp_erase L_flat_Prf1 L_flat_Prf2 Prf_elims(1) bnullable_correctness erase.simps(1) mkeps_nullable)
+ apply(case_tac "bsimp r2 = AZERO")
+ apply(simp)
+ apply(auto)[1]
+ apply (metis L_bsimp_erase L_flat_Prf1 L_flat_Prf2 Prf_elims(1) bnullable_correctness erase.simps(1) mkeps_nullable)
+ apply(case_tac "\<exists>bs. bsimp r1 = AONE bs")
+ apply(auto)[1]
+ apply(subst b1)
+ apply(subst b2)
+ apply(simp add: b3[symmetric])
+ apply(simp)
+ apply(subgoal_tac "bsimp_ASEQ x1 (bsimp r1) (bsimp r2) = ASEQ x1 (bsimp r1) (bsimp r2)")
+ prefer 2
+ apply (smt b3 bnullable.elims(2) bsimp_ASEQ.simps(17) bsimp_ASEQ.simps(19) bsimp_ASEQ.simps(20) bsimp_ASEQ.simps(21) bsimp_ASEQ.simps(22) bsimp_ASEQ.simps(24) bsimp_ASEQ.simps(25) bsimp_ASEQ.simps(26) bsimp_ASEQ.simps(27) bsimp_ASEQ.simps(29) bsimp_ASEQ.simps(30) bsimp_ASEQ.simps(31))
+ apply(simp)
+ apply(simp)
+ thm q3
+ apply(subst q3[symmetric])
+ apply simp
+ using b3 qq4a apply auto[1]
+ apply(subst qs3)
+ apply simp
+ using k1 by blast
+
+thm bmkeps_retrieve bmkeps_simp bder_retrieve
+
+lemma bmkeps_bder_AALTs:
+ assumes "\<exists>r \<in> set rs. bnullable (bder c r)"
+ shows "bmkeps (bder c (bsimp_AALTs bs rs)) = bmkeps (bsimp_AALTs bs (map (bder c) rs))"
+ using assms
+ apply(induct rs)
+ apply(simp)
+ apply(simp)
+ apply(auto)
+ apply(case_tac rs)
+ apply(simp)
+ apply (metis (full_types) Prf_injval bder_retrieve bmkeps_retrieve bnullable_correctness erase_bder erase_fuse mkeps_nullable retrieve_fuse2)
+ apply(simp)
+ apply(case_tac rs)
+ apply(simp_all)
+ done
+
+lemma bbs0:
+ shows "blexer_simp r [] = blexer r []"
+ apply(simp add: blexer_def blexer_simp_def)
+ done
+
+lemma bbs1:
+ shows "blexer_simp r [c] = blexer r [c]"
+ apply(simp add: blexer_def blexer_simp_def)
+ apply(auto)
+ defer
+ using b3 apply auto[1]
+ using b3 apply auto[1]
+ apply(subst bmkeps_simp[symmetric])
+ apply(simp)
+ apply(simp)
+ done
+
+lemma oo:
+ shows "(case (blexer (der c r) s) of None \<Rightarrow> None | Some v \<Rightarrow> Some (injval r c v)) = blexer r (c # s)"
+ apply(simp add: blexer_correctness)
+ done
+
+lemma XXX2_helper:
+ assumes "\<forall>y. asize y < Suc (sum_list (map asize rs)) \<longrightarrow> good y \<longrightarrow> bsimp y = y"
+ "\<forall>r'\<in>set rs. good r' \<and> nonalt r'"
+ shows "flts (map (bsimp \<circ> bder c) (flts (map bsimp rs))) = flts (map (bsimp \<circ> bder c) rs)"
+ using assms
+ apply(induct rs arbitrary: c)
+ apply(simp)
+ apply(simp)
+ apply(subst k0)
+ apply(simp add: flts_append)
+ apply(subst (2) k0)
+ apply(simp add: flts_append)
+ apply(subgoal_tac "flts [a] = [a]")
+ prefer 2
+ using good.simps(1) k0b apply blast
+ apply(simp)
+ done
+
+lemma bmkeps_good:
+ assumes "good a"
+ shows "bmkeps (bsimp a) = bmkeps a"
+ using assms
+ using test2 by auto
+
+
+lemma xxx_bder:
+ assumes "good r"
+ shows "L (erase r) \<noteq> {}"
+ using assms
+ apply(induct r rule: good.induct)
+ apply(auto simp add: Sequ_def)
+ done
+
+lemma xxx_bder2:
+ assumes "L (erase (bsimp r)) = {}"
+ shows "bsimp r = AZERO"
+ using assms xxx_bder test2 good1
+ by blast
+
+lemma XXX2aa:
+ assumes "good a"
+ shows "bsimp (bder c (bsimp a)) = bsimp (bder c a)"
+ using assms
+ by (simp add: test2)
+
+lemma XXX2aa_ders:
+ assumes "good a"
+ shows "bsimp (bders (bsimp a) s) = bsimp (bders a s)"
+ using assms
+ by (simp add: test2)
+
+lemma XXX4a:
+ shows "good (bders_simp (bsimp r) s) \<or> bders_simp (bsimp r) s = AZERO"
+ apply(induct s arbitrary: r rule: rev_induct)
+ apply(simp)
+ apply (simp add: good1)
+ apply(simp add: bders_simp_append)
+ apply (simp add: good1)
+ done
+
+lemma XXX4a_good:
+ assumes "good a"
+ shows "good (bders_simp a s) \<or> bders_simp a s = AZERO"
+ using assms
+ apply(induct s arbitrary: a rule: rev_induct)
+ apply(simp)
+ apply(simp add: bders_simp_append)
+ apply (simp add: good1)
+ done
+
+lemma XXX4a_good_cons:
+ assumes "s \<noteq> []"
+ shows "good (bders_simp a s) \<or> bders_simp a s = AZERO"
+ using assms
+ apply(case_tac s)
+ apply(auto)
+ using XXX4a by blast
+
+lemma XXX4b:
+ assumes "good a" "L (erase (bders_simp a s)) \<noteq> {}"
+ shows "good (bders_simp a s)"
+ using assms
+ apply(induct s arbitrary: a)
+ apply(simp)
+ apply(simp)
+ apply(subgoal_tac "L (erase (bder a aa)) = {} \<or> L (erase (bder a aa)) \<noteq> {}")
+ prefer 2
+ apply(auto)[1]
+ apply(erule disjE)
+ apply(subgoal_tac "bsimp (bder a aa) = AZERO")
+ prefer 2
+ using L_bsimp_erase xxx_bder2 apply auto[1]
+ apply(simp)
+ apply (metis L.simps(1) XXX4a erase.simps(1))
+ apply(drule_tac x="bsimp (bder a aa)" in meta_spec)
+ apply(drule meta_mp)
+ apply simp
+ apply(rule good1a)
+ apply(auto)
+ done
+
+lemma bders_AZERO:
+ shows "bders AZERO s = AZERO"
+ and "bders_simp AZERO s = AZERO"
+ apply (induct s)
+ apply(auto)
+ done
+
+lemma LA:
+ assumes "\<Turnstile> v : ders s (erase r)"
+ shows "retrieve (bders r s) v = retrieve r (flex (erase r) id s v)"
+ using assms
+ apply(induct s arbitrary: r v rule: rev_induct)
+ apply(simp)
+ apply(simp add: bders_append ders_append)
+ apply(subst bder_retrieve)
+ apply(simp)
+ apply(drule Prf_injval)
+ by (simp add: flex_append)
+
+
+lemma LB:
+ assumes "s \<in> (erase r) \<rightarrow> v"
+ shows "retrieve r v = retrieve r (flex (erase r) id s (mkeps (ders s (erase r))))"
+ using assms
+ apply(induct s arbitrary: r v rule: rev_induct)
+ apply(simp)
+ apply(subgoal_tac "v = mkeps (erase r)")
+ prefer 2
+ apply (simp add: Posix1(1) Posix_determ Posix_mkeps nullable_correctness)
+ apply(simp)
+ apply(simp add: flex_append ders_append)
+ by (metis Posix_determ Posix_flex Posix_injval Posix_mkeps ders_snoc lexer_correctness(2) lexer_flex)
+
+lemma LB_sym:
+ assumes "s \<in> (erase r) \<rightarrow> v"
+ shows "retrieve r v = retrieve r (flex (erase r) id s (mkeps (erase (bders r s))))"
+ using assms
+ by (simp add: LB)
+
+
+lemma LC:
+ assumes "s \<in> (erase r) \<rightarrow> v"
+ shows "retrieve r v = retrieve (bders r s) (mkeps (erase (bders r s)))"
+ apply(simp)
+ by (metis LA LB Posix1(1) assms lexer_correct_None lexer_flex mkeps_nullable)
+
+
+lemma L0:
+ assumes "bnullable a"
+ shows "retrieve (bsimp a) (mkeps (erase (bsimp a))) = retrieve a (mkeps (erase a))"
+ using assms b3 bmkeps_retrieve bmkeps_simp bnullable_correctness
+ by (metis b3 bmkeps_retrieve bmkeps_simp bnullable_correctness)
+
+thm bmkeps_retrieve
+
+lemma L0a:
+ assumes "s \<in> L(erase a)"
+ shows "retrieve (bsimp (bders a s)) (mkeps (erase (bsimp (bders a s)))) =
+ retrieve (bders a s) (mkeps (erase (bders a s)))"
+ using assms
+ by (metis L0 bnullable_correctness erase_bders lexer_correct_None lexer_flex)
+
+lemma L0aa:
+ assumes "s \<in> L (erase a)"
+ shows "[] \<in> erase (bsimp (bders a s)) \<rightarrow> mkeps (erase (bsimp (bders a s)))"
+ using assms
+ by (metis Posix_mkeps b3 bnullable_correctness erase_bders lexer_correct_None lexer_flex)
+
+lemma L0aaa:
+ assumes "[c] \<in> L (erase a)"
+ shows "[c] \<in> (erase a) \<rightarrow> flex (erase a) id [c] (mkeps (erase (bder c a)))"
+ using assms
+ by (metis bders.simps(1) bders.simps(2) erase_bders lexer_correct_None lexer_correct_Some lexer_flex option.inject)
+
+lemma L0aaaa:
+ assumes "[c] \<in> L (erase a)"
+ shows "[c] \<in> (erase a) \<rightarrow> flex (erase a) id [c] (mkeps (erase (bders a [c])))"
+ using assms
+ using L0aaa by auto
+
+
+lemma L02:
+ assumes "bnullable (bder c a)"
+ shows "retrieve (bsimp a) (flex (erase (bsimp a)) id [c] (mkeps (erase (bder c (bsimp a))))) =
+ retrieve (bder c (bsimp a)) (mkeps (erase (bder c (bsimp a))))"
+ using assms
+ apply(simp)
+ using bder_retrieve L0 bmkeps_simp bmkeps_retrieve L0 LA LB
+ apply(subst bder_retrieve[symmetric])
+ apply (metis L_bsimp_erase bnullable_correctness der_correctness erase_bder mkeps_nullable nullable_correctness)
+ apply(simp)
+ done
+
+lemma L02_bders:
+ assumes "bnullable (bders a s)"
+ shows "retrieve (bsimp a) (flex (erase (bsimp a)) id s (mkeps (erase (bders (bsimp a) s)))) =
+ retrieve (bders (bsimp a) s) (mkeps (erase (bders (bsimp a) s)))"
+ using assms
+ by (metis LA L_bsimp_erase bnullable_correctness ders_correctness erase_bders mkeps_nullable nullable_correctness)
+
+
+
+
+lemma L03:
+ assumes "bnullable (bder c a)"
+ shows "retrieve (bder c (bsimp a)) (mkeps (erase (bder c (bsimp a)))) =
+ bmkeps (bsimp (bder c (bsimp a)))"
+ using assms
+ by (metis L0 L_bsimp_erase bmkeps_retrieve bnullable_correctness der_correctness erase_bder nullable_correctness)
+
+lemma L04:
+ assumes "bnullable (bder c a)"
+ shows "retrieve (bder c (bsimp a)) (mkeps (erase (bder c (bsimp a)))) =
+ retrieve (bsimp (bder c (bsimp a))) (mkeps (erase (bsimp (bder c (bsimp a)))))"
+ using assms
+ by (metis L0 L_bsimp_erase bnullable_correctness der_correctness erase_bder nullable_correctness)
+
+lemma L05:
+ assumes "bnullable (bder c a)"
+ shows "retrieve (bder c (bsimp a)) (mkeps (erase (bder c (bsimp a)))) =
+ retrieve (bsimp (bder c (bsimp a))) (mkeps (erase (bsimp (bder c (bsimp a)))))"
+ using assms
+ using L04 by auto
+
+lemma L06:
+ assumes "bnullable (bder c a)"
+ shows "bmkeps (bder c (bsimp a)) = bmkeps (bsimp (bder c (bsimp a)))"
+ using assms
+ by (metis L03 L_bsimp_erase bmkeps_retrieve bnullable_correctness der_correctness erase_bder nullable_correctness)
+
+lemma L07:
+ assumes "s \<in> L (erase r)"
+ shows "retrieve r (flex (erase r) id s (mkeps (ders s (erase r))))
+ = retrieve (bders r s) (mkeps (erase (bders r s)))"
+ using assms
+ using LB LC lexer_correct_Some by auto
+
+lemma L06_2:
+ assumes "bnullable (bders a [c,d])"
+ shows "bmkeps (bders (bsimp a) [c,d]) = bmkeps (bsimp (bders (bsimp a) [c,d]))"
+ using assms
+ apply(simp)
+ by (metis L_bsimp_erase bmkeps_simp bnullable_correctness der_correctness erase_bder nullable_correctness)
+
+lemma L06_bders:
+ assumes "bnullable (bders a s)"
+ shows "bmkeps (bders (bsimp a) s) = bmkeps (bsimp (bders (bsimp a) s))"
+ using assms
+ by (metis L_bsimp_erase bmkeps_simp bnullable_correctness ders_correctness erase_bders nullable_correctness)
+
+lemma LLLL:
+ shows "L (erase a) = L (erase (bsimp a))"
+ and "L (erase a) = {flat v | v. \<Turnstile> v: (erase a)}"
+ and "L (erase a) = {flat v | v. \<Turnstile> v: (erase (bsimp a))}"
+ using L_bsimp_erase apply(blast)
+ apply (simp add: L_flat_Prf)
+ using L_bsimp_erase L_flat_Prf apply(auto)[1]
+ done
+
+
+
+lemma L07XX:
+ assumes "s \<in> L (erase a)"
+ shows "s \<in> erase a \<rightarrow> flex (erase a) id s (mkeps (ders s (erase a)))"
+ using assms
+ by (meson lexer_correct_None lexer_correctness(1) lexer_flex)
+
+lemma LX0:
+ assumes "s \<in> L r"
+ shows "decode (bmkeps (bders (intern r) s)) r = Some(flex r id s (mkeps (ders s r)))"
+ by (metis assms blexer_correctness blexer_def lexer_correct_None lexer_flex)
+
+lemma L1:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "decode (bmkeps (bders (intern r) s)) r = Some v"
+ using assms
+ by (metis blexer_correctness blexer_def lexer_correctness(1) option.distinct(1))
+
+lemma L2:
+ assumes "s \<in> (der c r) \<rightarrow> v"
+ shows "decode (bmkeps (bders (intern r) (c # s))) r = Some (injval r c v)"
+ using assms
+ apply(subst bmkeps_retrieve)
+ using Posix1(1) lexer_correct_None lexer_flex apply fastforce
+ using MAIN_decode
+ apply(subst MAIN_decode[symmetric])
+ apply(simp)
+ apply (meson Posix1(1) lexer_correct_None lexer_flex mkeps_nullable)
+ apply(simp)
+ apply(subgoal_tac "v = flex (der c r) id s (mkeps (ders s (der c r)))")
+ prefer 2
+ apply (metis Posix_determ lexer_correctness(1) lexer_flex option.distinct(1))
+ apply(simp)
+ apply(subgoal_tac "injval r c (flex (der c r) id s (mkeps (ders s (der c r)))) =
+ (flex (der c r) ((\<lambda>v. injval r c v) o id) s (mkeps (ders s (der c r))))")
+ apply(simp)
+ using flex_fun_apply by blast
+
+lemma L3:
+ assumes "s2 \<in> (ders s1 r) \<rightarrow> v"
+ shows "decode (bmkeps (bders (intern r) (s1 @ s2))) r = Some (flex r id s1 v)"
+ using assms
+ apply(induct s1 arbitrary: r s2 v rule: rev_induct)
+ apply(simp)
+ using L1 apply blast
+ apply(simp add: ders_append)
+ apply(drule_tac x="r" in meta_spec)
+ apply(drule_tac x="x # s2" in meta_spec)
+ apply(drule_tac x="injval (ders xs r) x v" in meta_spec)
+ apply(drule meta_mp)
+ defer
+ apply(simp)
+ apply(simp add: flex_append)
+ by (simp add: Posix_injval)
+
+
+
+lemma bders_snoc:
+ "bder c (bders a s) = bders a (s @ [c])"
+ apply(simp add: bders_append)
+ done
+
+
+lemma QQ1:
+ shows "bsimp (bders (bsimp a) []) = bders_simp (bsimp a) []"
+ apply(simp)
+ apply(simp add: bsimp_idem)
+ done
+
+lemma QQ2:
+ shows "bsimp (bders (bsimp a) [c]) = bders_simp (bsimp a) [c]"
+ apply(simp)
+ done
+
+lemma XXX2a_long:
+ assumes "good a"
+ shows "bsimp (bder c (bsimp a)) = bsimp (bder c a)"
+ using assms
+ apply(induct a arbitrary: c taking: asize rule: measure_induct)
+ apply(case_tac x)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 3
+ apply(simp)
+ apply(simp)
+ apply(auto)[1]
+apply(case_tac "x42 = AZERO")
+ apply(simp)
+ apply(case_tac "x43 = AZERO")
+ apply(simp)
+ using test2 apply force
+ apply(case_tac "\<exists>bs. x42 = AONE bs")
+ apply(clarify)
+ apply(simp)
+ apply(subst bsimp_ASEQ1)
+ apply(simp)
+ using b3 apply force
+ using bsimp_ASEQ0 test2 apply force
+ thm good_SEQ test2
+ apply (simp add: good_SEQ test2)
+ apply (simp add: good_SEQ test2)
+ apply(case_tac "x42 = AZERO")
+ apply(simp)
+ apply(case_tac "x43 = AZERO")
+ apply(simp)
+ apply (simp add: bsimp_ASEQ0)
+ apply(case_tac "\<exists>bs. x42 = AONE bs")
+ apply(clarify)
+ apply(simp)
+ apply(subst bsimp_ASEQ1)
+ apply(simp)
+ using bsimp_ASEQ0 test2 apply force
+ apply (simp add: good_SEQ test2)
+ apply (simp add: good_SEQ test2)
+ apply (simp add: good_SEQ test2)
+ (* AALTs case *)
+ apply(simp)
+ using test2 by fastforce
+
+
+lemma bder_bsimp_AALTs:
+ shows "bder c (bsimp_AALTs bs rs) = bsimp_AALTs bs (map (bder c) rs)"
+ apply(induct bs rs rule: bsimp_AALTs.induct)
+ apply(simp)
+ apply(simp)
+ apply (simp add: bder_fuse)
+ apply(simp)
+ done
+
+lemma flts_nothing:
+ assumes "\<forall>r \<in> set rs. r \<noteq> AZERO" "\<forall>r \<in> set rs. nonalt r"
+ shows "flts rs = rs"
+ using assms
+ apply(induct rs rule: flts.induct)
+ apply(auto)
+ done
+
+lemma flts_flts:
+ assumes "\<forall>r \<in> set rs. good r"
+ shows "flts (flts rs) = flts rs"
+ using assms
+ apply(induct rs taking: "\<lambda>rs. sum_list (map asize rs)" rule: measure_induct)
+ apply(case_tac x)
+ apply(simp)
+ apply(simp)
+ apply(case_tac a)
+ apply(simp_all add: bder_fuse flts_append)
+ apply(subgoal_tac "\<forall>r \<in> set x52. r \<noteq> AZERO")
+ prefer 2
+ apply (metis Nil_is_append_conv bsimp_AALTs.elims good.simps(1) good.simps(5) good0 list.distinct(1) n0 nn1b split_list_last test2)
+ apply(subgoal_tac "\<forall>r \<in> set x52. nonalt r")
+ prefer 2
+ apply (metis n0 nn1b test2)
+ by (metis flts_fuse flts_nothing)
+
+
+lemma iii:
+ assumes "bsimp_AALTs bs rs \<noteq> AZERO"
+ shows "rs \<noteq> []"
+ using assms
+ apply(induct bs rs rule: bsimp_AALTs.induct)
+ apply(auto)
+ done
+
+lemma CT1_SEQ:
+ shows "bsimp (ASEQ bs a1 a2) = bsimp (ASEQ bs (bsimp a1) (bsimp a2))"
+ apply(simp add: bsimp_idem)
+ done
+
+lemma CT1:
+ shows "bsimp (AALTs bs as) = bsimp (AALTs bs (map bsimp as))"
+ apply(induct as arbitrary: bs)
+ apply(simp)
+ apply(simp)
+ by (simp add: bsimp_idem comp_def)
+
+lemma CT1a:
+ shows "bsimp (AALT bs a1 a2) = bsimp(AALT bs (bsimp a1) (bsimp a2))"
+ by (metis CT1 list.simps(8) list.simps(9))
+
+lemma WWW2:
+ shows "bsimp (bsimp_AALTs bs1 (flts (map bsimp as1))) =
+ bsimp_AALTs bs1 (flts (map bsimp as1))"
+ by (metis bsimp.simps(2) bsimp_idem)
+
+lemma CT1b:
+ shows "bsimp (bsimp_AALTs bs as) = bsimp (bsimp_AALTs bs (map bsimp as))"
+ apply(induct bs as rule: bsimp_AALTs.induct)
+ apply(auto simp add: bsimp_idem)
+ apply (simp add: bsimp_fuse bsimp_idem)
+ by (metis bsimp_idem comp_apply)
+
+
+
+
+(* CT *)
+
+lemma CTa:
+ assumes "\<forall>r \<in> set as. nonalt r \<and> r \<noteq> AZERO"
+ shows "flts as = as"
+ using assms
+ apply(induct as)
+ apply(simp)
+ apply(case_tac as)
+ apply(simp)
+ apply (simp add: k0b)
+ using flts_nothing by auto
+
+lemma CT0:
+ assumes "\<forall>r \<in> set as1. nonalt r \<and> r \<noteq> AZERO"
+ shows "flts [bsimp_AALTs bs1 as1] = flts (map (fuse bs1) as1)"
+ using assms CTa
+ apply(induct as1 arbitrary: bs1)
+ apply(simp)
+ apply(simp)
+ apply(case_tac as1)
+ apply(simp)
+ apply(simp)
+proof -
+fix a :: arexp and as1a :: "arexp list" and bs1a :: "bit list" and aa :: arexp and list :: "arexp list"
+ assume a1: "nonalt a \<and> a \<noteq> AZERO \<and> nonalt aa \<and> aa \<noteq> AZERO \<and> (\<forall>r\<in>set list. nonalt r \<and> r \<noteq> AZERO)"
+ assume a2: "\<And>as. \<forall>r\<in>set as. nonalt r \<and> r \<noteq> AZERO \<Longrightarrow> flts as = as"
+ assume a3: "as1a = aa # list"
+ have "flts [a] = [a]"
+using a1 k0b by blast
+then show "fuse bs1a a # fuse bs1a aa # map (fuse bs1a) list = flts (fuse bs1a a # fuse bs1a aa # map (fuse bs1a) list)"
+ using a3 a2 a1 by (metis (no_types) append.left_neutral append_Cons flts_fuse k00 k0b list.simps(9))
+qed
+
+
+lemma CT01:
+ assumes "\<forall>r \<in> set as1. nonalt r \<and> r \<noteq> AZERO" "\<forall>r \<in> set as2. nonalt r \<and> r \<noteq> AZERO"
+ shows "flts [bsimp_AALTs bs1 as1, bsimp_AALTs bs2 as2] = flts ((map (fuse bs1) as1) @ (map (fuse bs2) as2))"
+ using assms CT0
+ by (metis k0 k00)
+
+
+
+lemma CT_exp:
+ assumes "\<forall>a \<in> set as. bsimp (bder c (bsimp a)) = bsimp (bder c a)"
+ shows "map bsimp (map (bder c) as) = map bsimp (map (bder c) (map bsimp as))"
+ using assms
+ apply(induct as)
+ apply(auto)
+ done
+
+lemma asize_set:
+ assumes "a \<in> set as"
+ shows "asize a < Suc (sum_list (map asize as))"
+ using assms
+ apply(induct as arbitrary: a)
+ apply(auto)
+ using le_add2 le_less_trans not_less_eq by blast
+
+lemma L_erase_bder_simp:
+ shows "L (erase (bsimp (bder a r))) = L (der a (erase (bsimp r)))"
+ using L_bsimp_erase der_correctness by auto
+
+lemma PPP0:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "(bders (intern r) s) >> code v"
+ using assms
+ by (smt L07 L1 LX0 Posix1(1) Posix_Prf contains6 erase_bders erase_intern lexer_correct_None lexer_flex mkeps_nullable option.inject retrieve_code)
+
+thm L07 L1 LX0 Posix1(1) Posix_Prf contains6 erase_bders erase_intern lexer_correct_None lexer_flex mkeps_nullable option.inject retrieve_code
+
+
+lemma PPP0_isar:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "(bders (intern r) s) >> code v"
+proof -
+ from assms have a1: "\<Turnstile> v : r" using Posix_Prf by simp
+
+ from assms have "s \<in> L r" using Posix1(1) by auto
+ then have "[] \<in> L (ders s r)" by (simp add: ders_correctness Ders_def)
+ then have a2: "\<Turnstile> mkeps (ders s r) : ders s r"
+ by (simp add: mkeps_nullable nullable_correctness)
+
+ have "retrieve (bders (intern r) s) (mkeps (ders s r)) =
+ retrieve (intern r) (flex r id s (mkeps (ders s r)))" using a2 LA LB bder_retrieve by simp
+ also have "... = retrieve (intern r) v"
+ using LB assms by auto
+ also have "... = code v" using a1 by (simp add: retrieve_code)
+ finally have "retrieve (bders (intern r) s) (mkeps (ders s r)) = code v" by simp
+ moreover
+ have "\<Turnstile> mkeps (ders s r) : erase (bders (intern r) s)" using a2 by simp
+ then have "bders (intern r) s >> retrieve (bders (intern r) s) (mkeps (ders s r))"
+ by (rule contains6)
+ ultimately
+ show "(bders (intern r) s) >> code v" by simp
+qed
+
+lemma PPP0b:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "(intern r) >> code v"
+ using assms
+ using Posix_Prf contains2 by auto
+
+lemma PPP0_eq:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "(intern r >> code v) = (bders (intern r) s >> code v)"
+ using assms
+ using PPP0_isar PPP0b by blast
+
+lemma f_cont1:
+ assumes "fuse bs1 a >> bs"
+ shows "\<exists>bs2. bs = bs1 @ bs2"
+ using assms
+ apply(induct a arbitrary: bs1 bs)
+ apply(auto elim: contains.cases)
+ done
+
+
+lemma f_cont2:
+ assumes "bsimp_AALTs bs1 as >> bs"
+ shows "\<exists>bs2. bs = bs1 @ bs2"
+ using assms
+ apply(induct bs1 as arbitrary: bs rule: bsimp_AALTs.induct)
+ apply(auto elim: contains.cases f_cont1)
+ done
+
+lemma contains_SEQ1:
+ assumes "bsimp_ASEQ bs r1 r2 >> bsX"
+ shows "\<exists>bs1 bs2. r1 >> bs1 \<and> r2 >> bs2 \<and> bsX = bs @ bs1 @ bs2"
+ using assms
+ apply(auto)
+ apply(case_tac "r1 = AZERO")
+ apply(auto)
+ using contains.simps apply blast
+ apply(case_tac "r2 = AZERO")
+ apply(auto)
+ apply(simp add: bsimp_ASEQ0)
+ using contains.simps apply blast
+ apply(case_tac "\<exists>bsX. r1 = AONE bsX")
+ apply(auto)
+ apply(simp add: bsimp_ASEQ2)
+ apply (metis append_assoc contains.intros(1) contains49 f_cont1)
+ apply(simp add: bsimp_ASEQ1)
+ apply(erule contains.cases)
+ apply(auto)
+ done
+
+lemma contains59:
+ assumes "AALTs bs rs >> bs2"
+ shows "\<exists>r \<in> set rs. (fuse bs r) >> bs2"
+ using assms
+ apply(induct rs arbitrary: bs bs2)
+ apply(auto)
+ apply(erule contains.cases)
+ apply(auto)
+ apply(erule contains.cases)
+ apply(auto)
+ using contains0 by blast
+
+lemma contains60:
+ assumes "\<exists>r \<in> set rs. fuse bs r >> bs2"
+ shows "AALTs bs rs >> bs2"
+ using assms
+ apply(induct rs arbitrary: bs bs2)
+ apply(auto)
+ apply (metis contains3b contains49 f_cont1)
+ using contains.intros(5) f_cont1 by blast
+
+
+
+lemma contains61:
+ assumes "bsimp_AALTs bs rs >> bs2"
+ shows "\<exists>r \<in> set rs. (fuse bs r) >> bs2"
+ using assms
+ apply(induct arbitrary: bs2 rule: bsimp_AALTs.induct)
+ apply(auto)
+ using contains.simps apply blast
+ using contains59 by fastforce
+
+lemma contains61b:
+ assumes "bsimp_AALTs bs rs >> bs2"
+ shows "\<exists>r \<in> set (flts rs). (fuse bs r) >> bs2"
+ using assms
+ apply(induct bs rs arbitrary: bs2 rule: bsimp_AALTs.induct)
+ apply(auto)
+ using contains.simps apply blast
+ using contains51d contains61 f_cont1 apply blast
+ by (metis bsimp_AALTs.simps(3) contains52 contains61 f_cont2)
+
+
+
+lemma contains61a:
+ assumes "\<exists>r \<in> set rs. (fuse bs r) >> bs2"
+ shows "bsimp_AALTs bs rs >> bs2"
+ using assms
+ apply(induct rs arbitrary: bs2 bs)
+ apply(auto)
+ apply (metis bsimp_AALTs.elims contains60 list.distinct(1) list.inject list.set_intros(1))
+ by (metis append_Cons append_Nil contains50 f_cont2)
+
+lemma contains62:
+ assumes "bsimp_AALTs bs (rs1 @ rs2) >> bs2"
+ shows "bsimp_AALTs bs rs1 >> bs2 \<or> bsimp_AALTs bs rs2 >> bs2"
+ using assms
+ apply -
+ apply(drule contains61)
+ apply(auto)
+ apply(case_tac rs1)
+ apply(auto)
+ apply(case_tac list)
+ apply(auto)
+ apply (simp add: contains60)
+ apply(case_tac list)
+ apply(auto)
+ apply (simp add: contains60)
+ apply (meson contains60 list.set_intros(2))
+ apply(case_tac rs2)
+ apply(auto)
+ apply(case_tac list)
+ apply(auto)
+ apply (simp add: contains60)
+ apply(case_tac list)
+ apply(auto)
+ apply (simp add: contains60)
+ apply (meson contains60 list.set_intros(2))
+ done
+
+lemma contains63:
+ assumes "AALTs bs (map (fuse bs1) rs) >> bs3"
+ shows "AALTs (bs @ bs1) rs >> bs3"
+ using assms
+ apply(induct rs arbitrary: bs bs1 bs3)
+ apply(auto elim: contains.cases)
+ apply(erule contains.cases)
+ apply(auto)
+ apply (simp add: contains0 contains60 fuse_append)
+ by (metis contains.intros(5) contains59 f_cont1)
+
+lemma contains64:
+ assumes "bsimp_AALTs bs (flts rs1 @ flts rs2) >> bs2" "\<forall>r \<in> set rs2. \<not> fuse bs r >> bs2"
+ shows "bsimp_AALTs bs (flts rs1) >> bs2"
+ using assms
+ apply(induct rs2 arbitrary: rs1 bs bs2)
+ apply(auto)
+ apply(drule_tac x="rs1" in meta_spec)
+ apply(drule_tac x="bs" in meta_spec)
+ apply(drule_tac x="bs2" in meta_spec)
+ apply(drule meta_mp)
+ apply(drule contains61)
+ apply(auto)
+ using contains51b contains61a f_cont1 apply blast
+ apply(subst (asm) k0)
+ apply(auto)
+ prefer 2
+ using contains50 contains61a f_cont1 apply blast
+ apply(case_tac a)
+ apply(auto)
+ by (metis contains60 fuse_append)
+
+
+
+lemma contains65:
+ assumes "bsimp_AALTs bs (flts rs) >> bs2"
+ shows "\<exists>r \<in> set rs. (fuse bs r) >> bs2"
+ using assms
+ apply(induct rs arbitrary: bs bs2 taking: "\<lambda>rs. sum_list (map asize rs)" rule: measure_induct)
+ apply(case_tac x)
+ apply(auto elim: contains.cases)
+ apply(case_tac list)
+ apply(auto elim: contains.cases)
+ apply(case_tac a)
+ apply(auto elim: contains.cases)
+ apply(drule contains61)
+ apply(auto)
+ apply (metis contains60 fuse_append)
+ apply(case_tac lista)
+ apply(auto elim: contains.cases)
+ apply(subst (asm) k0)
+ apply(drule contains62)
+ apply(auto)
+ apply(case_tac a)
+ apply(auto elim: contains.cases)
+ apply(case_tac x52)
+ apply(auto elim: contains.cases)
+ apply(case_tac list)
+ apply(auto elim: contains.cases)
+ apply (simp add: contains60 fuse_append)
+ apply(erule contains.cases)
+ apply(auto)
+ apply (metis append.left_neutral contains0 contains60 fuse.simps(4) in_set_conv_decomp)
+ apply(erule contains.cases)
+ apply(auto)
+ apply (metis contains0 contains60 fuse.simps(4) list.set_intros(1) list.set_intros(2))
+ apply (simp add: contains.intros(5) contains63)
+ apply(case_tac aa)
+ apply(auto)
+ apply (meson contains60 contains61 contains63)
+ apply(subst (asm) k0)
+ apply(drule contains64)
+ apply(auto)[1]
+ by (metis append_Nil2 bsimp_AALTs.simps(2) contains50 contains61a contains64 f_cont2 flts.simps(1))
+
+
+lemma contains55a:
+ assumes "bsimp r >> bs"
+ shows "r >> bs"
+ using assms
+ apply(induct r arbitrary: bs)
+ apply(auto)
+ apply(frule contains_SEQ1)
+ apply(auto)
+ apply (simp add: contains.intros(3))
+ apply(frule f_cont2)
+ apply(auto)
+ apply(drule contains65)
+ apply(auto)
+ using contains0 contains49 contains60 by blast
+
+
+lemma PPP1_eq:
+ shows "bsimp r >> bs \<longleftrightarrow> r >> bs"
+ using contains55 contains55a by blast
+
+lemma retrieve_code_bder:
+ assumes "\<Turnstile> v : der c r"
+ shows "code (injval r c v) = retrieve (bder c (intern r)) v"
+ using assms
+ by (simp add: Prf_injval bder_retrieve retrieve_code)
+
+lemma Etrans:
+ assumes "a >> s" "s = t"
+ shows "a >> t"
+ using assms by simp
+
+
+
+lemma retrieve_code_bders:
+ assumes "\<Turnstile> v : ders s r"
+ shows "code (flex r id s v) = retrieve (bders (intern r) s) v"
+ using assms
+ apply(induct s arbitrary: v r rule: rev_induct)
+ apply(auto simp add: ders_append flex_append bders_append)
+ apply (simp add: retrieve_code)
+ apply(frule Prf_injval)
+ apply(drule_tac meta_spec)+
+ apply(drule meta_mp)
+ apply(assumption)
+ apply(simp)
+ apply(subst bder_retrieve)
+ apply(simp)
+ apply(simp)
+ done
+
+lemma contains70:
+ assumes "s \<in> L(r)"
+ shows "bders (intern r) s >> code (flex r id s (mkeps (ders s r)))"
+ apply(subst PPP0_eq[symmetric])
+ apply (meson assms lexer_correct_None lexer_correctness(1) lexer_flex)
+ by (metis L07XX PPP0b assms erase_intern)
+
+
+lemma contains_equiv_def:
+ shows " (AALTs bs as >> bs@bs1) \<longleftrightarrow> (\<exists>a\<in>set as. a >> bs1)"
+ by (meson contains0 contains49 contains59 contains60)
+
+lemma i_know_it_must_be_a_theorem_but_dunno_its_name:
+ assumes "a \<and> (a=b) "
+ shows"b"
+ using assms
+ apply -
+ by auto
+
+lemma concat_def:
+ shows"[]@lst=lst"
+ apply auto
+ done
+
+lemma derc_alt00:
+ assumes " bder c a >> bs" and "bder c (bsimp a) >> bs"
+ shows "bder c (bsimp_AALTs [] (flts [bsimp a])) >> bs"
+ using assms
+ apply -
+ apply(case_tac "bsimp a")
+ prefer 6
+ apply(simp)+
+ apply(subst bder_bsimp_AALTs)
+ by (metis append_Nil contains51c map_bder_fuse map_map)
+lemma derc_alt01:
+ shows "\<And>a list1 list2.
+ \<lbrakk> bder c (bsimp a) >> bs ;
+ bder c a >> bs; as = [a] @ list2; flts (map bsimp list1) = [];
+ flts (map bsimp list2) \<noteq> []\<rbrakk>
+ \<Longrightarrow> bder c (bsimp_AALTs [] (flts [bsimp a] @ flts (map bsimp list2))) >> bs"
+ using bder_bsimp_AALTs contains51b derc_alt00 f_cont2 by fastforce
+
+lemma derc_alt10:
+ shows "\<And>a list1 list2.
+ \<lbrakk> a \<in> set as; bder c (bsimp a) >> bs;
+ bder c a >> bs; as = list1 @ [a] @ list2; flts (map bsimp list1) \<noteq> [];
+flts(map bsimp list2) = []\<rbrakk>
+ \<Longrightarrow> bder c (bsimp_AALTs []
+ (flts (map bsimp list1) @
+ flts (map bsimp [a]) @ flts (map bsimp list2))) >> bs"
+ apply(subst bder_bsimp_AALTs)
+ apply simp
+ using bder_bsimp_AALTs contains50 derc_alt00 f_cont2 by fastforce
+
+
+(*QUESTION*)
+lemma derc_alt:
+ assumes "bder c (AALTs [] as) >> bs"
+ and "\<forall>a \<in> set as. ((bder c a >> bs) \<longrightarrow> (bder c (bsimp a) >> bs))"
+ shows "bder c (bsimp(AALTs [] as)) >> bs"
+ using assms
+ apply -
+ using contains_equiv_def
+ apply -
+ apply(simp add: bder.simps)
+ apply(drule_tac x="[]" in meta_spec)
+ apply(drule_tac x="map (bder c) as" in meta_spec)
+ apply(drule_tac x="bs" in meta_spec)
+
+ apply(simp add:List.append.simps(1))
+ apply(erule bexE)
+ apply(subgoal_tac "\<exists>list1 list2. as = list1 @ [a] @ list2")
+ prefer 2
+ using split_list_last apply fastforce
+ apply(erule exE)+
+ apply(rule_tac t="as" and s="list1@[a]@list2" in subst)
+ apply simp
+ (*find_theorems "map _ _ = _"*)
+ apply(subst map_append)+
+ apply(subst k00)+
+ apply(case_tac "flts (map bsimp list1) = Nil")
+ apply(case_tac "flts (map bsimp list2) = Nil")
+ apply simp
+ using derc_alt00 apply blast
+ apply simp
+ using derc_alt01 apply blast
+ apply(case_tac "flts (map bsimp list2) = Nil")
+ using derc_alt10 apply blast
+ by (smt bder_bsimp_AALTs contains50 contains51b derc_alt00 f_cont2 list.simps(8) list.simps(9) map_append)
+
+ (*find_theorems "flts _ = _ "*)
+(* (*HERE*)
+ apply(drule i_know_it_must_be_a_theorem_but_dunno_its_name)
+*)
+
+lemma transfer:
+ assumes " (a \<Rightarrow> c) \<and> (c \<Rightarrow> b)"
+ shows "a \<Rightarrow> b"
+
+(*if we have proved that a can prove c, to prove a can prove b, we
+then have the option to just show that c can prove b *)
+(*how to express the above using drule+mp and a lemma*)
+
+definition FC where
+ "FC a s v = retrieve a (flex (erase a) id s v)"
+
+definition FE where
+ "FE a s = retrieve a (flex (erase a) id s (mkeps (ders s (erase a))))"
+
+definition PV where
+ "PV r s v = flex r id s v"
+
+definition PX where
+ "PX r s = PV r s (mkeps (ders s r))"
+
+lemma FE_PX:
+ shows "FE r s = retrieve r (PX (erase r) s)"
+ unfolding FE_def PX_def PV_def by(simp)
+
+lemma FE_PX_code:
+ assumes "s \<in> L r"
+ shows "FE (intern r) s = code (PX r s)"
+ unfolding FE_def PX_def PV_def
+ using assms
+ by (metis L07XX Posix_Prf erase_intern retrieve_code)
+
+
+lemma PV_id[simp]:
+ shows "PV r [] v = v"
+ by (simp add: PV_def)
+
+lemma PX_id[simp]:
+ shows "PX r [] = mkeps r"
+ by (simp add: PX_def)
+
+lemma PV_cons:
+ shows "PV r (c # s) v = injval r c (PV (der c r) s v)"
+ apply(simp add: PV_def flex_fun_apply)
+ done
+
+lemma PX_cons:
+ shows "PX r (c # s) = injval r c (PX (der c r) s)"
+ apply(simp add: PX_def PV_cons)
+ done
+
+lemma PV_append:
+ shows "PV r (s1 @ s2) v = PV r s1 (PV (ders s1 r) s2 v)"
+ apply(simp add: PV_def flex_append)
+ by (simp add: flex_fun_apply2)
+
+lemma PX_append:
+ shows "PX r (s1 @ s2) = PV r s1 (PX (ders s1 r) s2)"
+ by (simp add: PV_append PX_def ders_append)
+
+lemma code_PV0:
+ shows "PV r (c # s) v = injval r c (PV (der c r) s v)"
+ unfolding PX_def PV_def
+ apply(simp)
+ by (simp add: flex_injval)
+
+lemma code_PX0:
+ shows "PX r (c # s) = injval r c (PX (der c r) s)"
+ unfolding PX_def
+ apply(simp add: code_PV0)
+ done
+
+lemma Prf_PV:
+ assumes "\<Turnstile> v : ders s r"
+ shows "\<Turnstile> PV r s v : r"
+ using assms unfolding PX_def PV_def
+ apply(induct s arbitrary: v r)
+ apply(simp)
+ apply(simp)
+ by (simp add: Prf_injval flex_injval)
+
+
+lemma Prf_PX:
+ assumes "s \<in> L r"
+ shows "\<Turnstile> PX r s : r"
+ using assms unfolding PX_def PV_def
+ using L1 LX0 Posix_Prf lexer_correct_Some by fastforce
+
+lemma PV1:
+ assumes "\<Turnstile> v : ders s r"
+ shows "(intern r) >> code (PV r s v)"
+ using assms
+ by (simp add: Prf_PV contains2)
+
+lemma PX1:
+ assumes "s \<in> L r"
+ shows "(intern r) >> code (PX r s)"
+ using assms
+ by (simp add: Prf_PX contains2)
+
+lemma PX2:
+ assumes "s \<in> L (der c r)"
+ shows "bder c (intern r) >> code (injval r c (PX (der c r) s))"
+ using assms
+ by (simp add: Prf_PX contains6 retrieve_code_bder)
+
+lemma PX2a:
+ assumes "c # s \<in> L r"
+ shows "bder c (intern r) >> code (injval r c (PX (der c r) s))"
+ using assms
+ using PX2 lexer_correct_None by force
+
+lemma PX2b:
+ assumes "c # s \<in> L r"
+ shows "bder c (intern r) >> code (PX r (c # s))"
+ using assms unfolding PX_def PV_def
+ by (metis Der_def L07XX PV_def PX2a PX_def Posix_determ Posix_injval der_correctness erase_intern mem_Collect_eq)
+
+lemma PV3:
+ assumes "\<Turnstile> v : ders s r"
+ shows "bders (intern r) s >> code (PV r s v)"
+ using assms
+ using PX_def PV_def contains70
+ by (simp add: contains6 retrieve_code_bders)
+
+lemma PX3:
+ assumes "s \<in> L r"
+ shows "bders (intern r) s >> code (PX r s)"
+ using assms
+ using PX_def PV_def contains70 by auto
+
+
+lemma PV_bders_iff:
+ assumes "\<Turnstile> v : ders s r"
+ shows "bders (intern r) s >> code (PV r s v) \<longleftrightarrow> (intern r) >> code (PV r s v)"
+ by (simp add: PV1 PV3 assms)
+
+lemma PX_bders_iff:
+ assumes "s \<in> L r"
+ shows "bders (intern r) s >> code (PX r s) \<longleftrightarrow> (intern r) >> code (PX r s)"
+ by (simp add: PX1 PX3 assms)
+
+lemma PX4:
+ assumes "(s1 @ s2) \<in> L r"
+ shows "bders (intern r) (s1 @ s2) >> code (PX r (s1 @ s2))"
+ using assms
+ by (simp add: PX3)
+
+lemma PX_bders_iff2:
+ assumes "(s1 @ s2) \<in> L r"
+ shows "bders (intern r) (s1 @ s2) >> code (PX r (s1 @ s2)) \<longleftrightarrow>
+ (intern r) >> code (PX r (s1 @ s2))"
+ by (simp add: PX1 PX3 assms)
+
+lemma PV_bders_iff3:
+ assumes "\<Turnstile> v : ders (s1 @ s2) r"
+ shows "bders (intern r) (s1 @ s2) >> code (PV r (s1 @ s2) v) \<longleftrightarrow>
+ bders (intern r) s1 >> code (PV r (s1 @ s2) v)"
+ by (metis PV3 PV_append Prf_PV assms ders_append)
+
+
+
+lemma PX_bders_iff3:
+ assumes "(s1 @ s2) \<in> L r"
+ shows "bders (intern r) (s1 @ s2) >> code (PX r (s1 @ s2)) \<longleftrightarrow>
+ bders (intern r) s1 >> code (PX r (s1 @ s2))"
+ by (metis Ders_def L07XX PV_append PV_def PX4 PX_def Posix_Prf assms contains6 ders_append ders_correctness erase_bders erase_intern mem_Collect_eq retrieve_code_bders)
+
+lemma PV_bder_iff:
+ assumes "\<Turnstile> v : ders (s1 @ [c]) r"
+ shows "bder c (bders (intern r) s1) >> code (PV r (s1 @ [c]) v) \<longleftrightarrow>
+ bders (intern r) s1 >> code (PV r (s1 @ [c]) v)"
+ by (simp add: PV_bders_iff3 assms bders_snoc)
+
+lemma PV_bder_IFF:
+ assumes "\<Turnstile> v : ders (s1 @ c # s2) r"
+ shows "bder c (bders (intern r) s1) >> code (PV r (s1 @ c # s2) v) \<longleftrightarrow>
+ bders (intern r) s1 >> code (PV r (s1 @ c # s2) v)"
+ by (metis LA PV3 PV_def Prf_PV assms bders_append code_PV0 contains7 ders.simps(2) erase_bders erase_intern retrieve_code_bders)
+
+
+lemma PX_bder_iff:
+ assumes "(s1 @ [c]) \<in> L r"
+ shows "bder c (bders (intern r) s1) >> code (PX r (s1 @ [c])) \<longleftrightarrow>
+ bders (intern r) s1 >> code (PX r (s1 @ [c]))"
+ by (simp add: PX_bders_iff3 assms bders_snoc)
+
+lemma PV_bder_iff2:
+ assumes "\<Turnstile> v : ders (c # s1) r"
+ shows "bders (bder c (intern r)) s1 >> code (PV r (c # s1) v) \<longleftrightarrow>
+ bder c (intern r) >> code (PV r (c # s1) v)"
+ by (metis PV3 Prf_PV assms bders.simps(2) code_PV0 contains7 ders.simps(2) erase_intern retrieve_code)
+
+
+lemma PX_bder_iff2:
+ assumes "(c # s1) \<in> L r"
+ shows "bders (bder c (intern r)) s1 >> code (PX r (c # s1)) \<longleftrightarrow>
+ bder c (intern r) >> code (PX r (c # s1))"
+ using PX2b PX3 assms by force
+
+
+lemma FC_id:
+ shows "FC r [] v = retrieve r v"
+ by (simp add: FC_def)
+
+lemma FC_char:
+ shows "FC r [c] v = retrieve r (injval (erase r) c v)"
+ by (simp add: FC_def)
+
+lemma FC_char2:
+ assumes "\<Turnstile> v : der c (erase r)"
+ shows "FC r [c] v = FC (bder c r) [] v"
+ using assms
+ by (simp add: FC_char FC_id bder_retrieve)
+
+
+lemma FC_bders_iff:
+ assumes "\<Turnstile> v : ders s (erase r)"
+ shows "bders r s >> FC r s v \<longleftrightarrow> r >> FC r s v"
+ unfolding FC_def
+ by (simp add: assms contains8_iff)
+
+
+lemma FC_bder_iff:
+ assumes "\<Turnstile> v : der c (erase r)"
+ shows "bder c r >> FC r [c] v \<longleftrightarrow> r >> FC r [c] v"
+ apply(subst FC_bders_iff[symmetric])
+ apply(simp add: assms)
+ apply(simp)
+ done
+
+lemma FC_bnullable0:
+ assumes "bnullable r"
+ shows "FC r [] (mkeps (erase r)) = FC (bsimp r) [] (mkeps (erase (bsimp r)))"
+ unfolding FC_def
+ by (simp add: L0 assms)
+
+
+lemma FC_nullable2:
+ assumes "bnullable (bders a s)"
+ shows "FC (bsimp a) s (mkeps (erase (bders (bsimp a) s))) =
+ FC (bders (bsimp a) s) [] (mkeps (erase (bders (bsimp a) s)))"
+ unfolding FC_def
+ using L02_bders assms by auto
+
+lemma FC_nullable3:
+ assumes "bnullable (bders a s)"
+ shows "FC a s (mkeps (erase (bders a s))) =
+ FC (bders a s) [] (mkeps (erase (bders a s)))"
+ unfolding FC_def
+ using LA assms bnullable_correctness mkeps_nullable by fastforce
+
+
+lemma FE_contains0:
+ assumes "bnullable r"
+ shows "r >> FE r []"
+ by (simp add: FE_def assms bnullable_correctness contains6 mkeps_nullable)
+
+lemma FE_contains1:
+ assumes "bnullable (bders r s)"
+ shows "r >> FE r s"
+ by (metis FE_def Prf_flex assms bnullable_correctness contains6 erase_bders mkeps_nullable)
+
+lemma FE_bnullable0:
+ assumes "bnullable r"
+ shows "FE r [] = FE (bsimp r) []"
+ unfolding FE_def
+ by (simp add: L0 assms)
+
+
+lemma FE_nullable1:
+ assumes "bnullable (bders r s)"
+ shows "FE r s = FE (bders r s) []"
+ unfolding FE_def
+ using LA assms bnullable_correctness mkeps_nullable by fastforce
+
+lemma FE_contains2:
+ assumes "bnullable (bders r s)"
+ shows "r >> FE (bders r s) []"
+ by (metis FE_contains1 FE_nullable1 assms)
+
+lemma FE_contains3:
+ assumes "bnullable (bder c r)"
+ shows "r >> FE (bsimp (bder c r)) []"
+ by (metis FE_def L0 assms bder_retrieve bders.simps(1) bnullable_correctness contains7a erase_bder erase_bders flex.simps(1) id_apply mkeps_nullable)
+
+lemma FE_contains4:
+ assumes "bnullable (bders r s)"
+ shows "r >> FE (bsimp (bders r s)) []"
+ using FE_bnullable0 FE_contains2 assms by auto
+
+
+(*
+lemma FE_bnullable2:
+ assumes "bnullable (bder c r)"
+ shows "FE r [c] = FE (bsimp r) [c]"
+ unfolding FE_def
+ apply(simp)
+ using L0
+
+ apply(subst FE_nullable1)
+ using assms apply(simp)
+ apply(subst FE_bnullable0)
+ using assms apply(simp)
+ unfolding FE_def
+ apply(simp)
+ apply(subst L0)
+ using assms apply(simp)
+ apply(subst bder_retrieve[symmetric])
+ using LLLL(1) L_erase_bder_simp assms bnullable_correctness mkeps_nullable nullable_correctness apply b last
+ apply(simp)
+ find_theorems "retrieve _ (injval _ _ _)"
+ find_theorems "retrieve (bsimp _) _"
+
+ lemma FE_nullable3:
+ assumes "bnullable (bders a s)"
+ shows "FE (bsimp a) s = FE a s"
+
+ unfolding FE_def
+ using LA assms bnullable_correctness mkeps_nullable by fas tforce
+*)
+
+
+lemma FC4:
+ assumes "\<Turnstile> v : ders s (erase a)"
+ shows "FC a s v = FC (bders a s) [] v"
+ unfolding FC_def by (simp add: LA assms)
+
+lemma FC5:
+ assumes "nullable (erase a)"
+ shows "FC a [] (mkeps (erase a)) = FC (bsimp a) [] (mkeps (erase (bsimp a)))"
+ unfolding FC_def
+ using L0 assms bnullable_correctness by auto
+
+
+lemma FC6:
+ assumes "nullable (erase (bders a s))"
+ shows "FC (bsimp a) s (mkeps (erase (bders (bsimp a) s))) = FC a s (mkeps (erase (bders a s)))"
+ apply(subst (2) FC4)
+ using assms mkeps_nullable apply auto[1]
+ apply(subst FC_nullable2)
+ using assms bnullable_correctness apply blast
+ oops
+(*
+lemma FC_bnullable:
+ assumes "bnullable (bders r s)"
+ shows "FC r s (mkeps (erase r)) = FC (bsimp r) s (mkeps (erase (bsimp r)))"
+ using assms
+ unfolding FC_def
+ using L0 L0a bder_retrieve L02_bders L04
+
+ apply(induct s arbitrary: r)
+ apply(simp add: FC_id)
+ apply (simp add: L0 assms)
+ apply(simp add: bders_append)
+ apply(drule_tac x="bder a r" in meta_spec)
+ apply(drule meta_mp)
+ apply(simp)
+
+ apply(subst bder_retrieve[symmetric])
+ apply(simp)
+*)
+
+
+lemma FC_bnullable:
+ assumes "bnullable (bders r s)"
+ shows "FC r s (mkeps (ders s (erase r))) = FC (bsimp r) s (mkeps (ders s (erase (bsimp r))))"
+ unfolding FC_def
+ oops
+
+lemma AA0:
+ assumes "bnullable (bders r s)"
+ assumes "bders r s >> FC r s (mkeps (erase (bders r s)))"
+ shows "bders (bsimp r) s >> FC (bsimp r) s (mkeps (erase (bders (bsimp r) s)))"
+ using assms
+ apply(subst (asm) FC_bders_iff)
+ apply(simp)
+ using bnullable_correctness mkeps_nullable apply fastforce
+ apply(subst FC_bders_iff)
+ apply(simp)
+ apply (metis LLLL(1) bnullable_correctness ders_correctness erase_bders mkeps_nullable nullable_correctness)
+ apply(simp add: PPP1_eq)
+ unfolding FC_def
+ find_theorems "retrieve (bsimp _) _"
+ using contains7b
+ oops
+
+
+lemma AA1:
+
+ assumes "\<Turnstile> v : der c (erase r)" "\<Turnstile> v : der c (erase (bsimp r))"
+ assumes "bder c r >> FC r [c] v"
+ shows "bder c (bsimp r) >> FC (bsimp r) [c] v"
+ using assms
+ apply(subst (asm) FC_bder_iff)
+ apply(rule assms)
+ apply(subst FC_bder_iff)
+ apply(rule assms)
+ apply(simp add: PPP1_eq)
+ unfolding FC_def
+ find_theorems "retrieve (bsimp _) _"
+ using contains7b
+ oops
+
+
+lemma PX_bder_simp_iff:
+ assumes "\<Turnstile> v: ders (s1 @ s2) r"
+ shows "bders (bsimp (bders (intern r) s1)) s2 >> code (PV r (s1 @ s2) v) \<longleftrightarrow>
+ bders (intern r) s1 >> code (PV r (s1 @ s2) v)"
+ using assms
+ apply(induct s2 arbitrary: r s1 v)
+ apply(simp)
+ apply (simp add: PV3 contains55)
+ apply(drule_tac x="r" in meta_spec)
+ apply(drule_tac x="s1 @ [a]" in meta_spec)
+ apply(drule_tac x="v" in meta_spec)
+ apply(simp)
+ apply(simp add: bders_append)
+ apply(subst (asm) PV_bder_IFF)
+ oops
+
+lemma in1:
+ assumes "AALTs bsX rsX \<in> set rs"
+ shows "\<forall>r \<in> set rsX. fuse bsX r \<in> set (flts rs)"
+ using assms
+ apply(induct rs arbitrary: bsX rsX)
+ apply(auto)
+ by (metis append_assoc in_set_conv_decomp k0)
+
+lemma in2a:
+ assumes "nonnested (bsimp r)" "\<not>nonalt(bsimp r)"
+ shows "(\<exists>bsX rsX. r = AALTs bsX rsX) \<or> (\<exists>bsX rX1 rX2. r = ASEQ bsX rX1 rX2 \<and> bnullable rX1)"
+ using assms
+ apply(induct r)
+ apply(auto)
+ by (metis arexp.distinct(25) b3 bnullable.simps(2) bsimp_ASEQ.simps(1) bsimp_ASEQ0 bsimp_ASEQ1 nonalt.elims(3) nonalt.simps(2))
+
+
+lemma in2:
+ assumes "bder c r >> bs2" and
+ "AALTs bsX rsX = bsimp r" and
+ "XX \<in> set rsX" "nonnested (bsimp r)"
+ shows "bder c (fuse bsX XX) >> bs2"
+
+ sorry
+
+
+lemma
+ assumes "bder c a >> bs"
+ shows "bder c (bsimp a) >> bs"
+ using assms
+ apply(induct a arbitrary: c bs)
+ apply(auto elim: contains.cases)
+ apply(case_tac "bnullable a1")
+ apply(simp)
+ prefer 2
+ apply(simp)
+ apply(erule contains.cases)
+ apply(auto)
+ apply(case_tac "(bsimp a1) = AZERO")
+ apply(simp)
+ apply (metis append_Nil2 contains0 contains49 fuse.simps(1))
+ apply(case_tac "(bsimp a2a) = AZERO")
+ apply(simp)
+ apply (metis bder.simps(1) bsimp.simps(1) bsimp_ASEQ0 contains.intros(3) contains55)
+ apply(case_tac "\<exists>bsX. (bsimp a1) = AONE bsX")
+ apply(auto)[1]
+ using b3 apply fastforce
+ apply(subst bsimp_ASEQ1)
+ apply(auto)[3]
+ apply(simp)
+ apply(subgoal_tac "\<not> bnullable (bsimp a1)")
+ prefer 2
+ using b3 apply blast
+ apply(simp)
+ apply (simp add: contains.intros(3) contains55)
+ (* SEQ nullable case *)
+ apply(erule contains.cases)
+ apply(auto)
+ apply(erule contains.cases)
+ apply(auto)
+ apply(case_tac "(bsimp a1) = AZERO")
+ apply(simp)
+ apply (metis append_Nil2 contains0 contains49 fuse.simps(1))
+ apply(case_tac "(bsimp a2a) = AZERO")
+ apply(simp)
+ apply (metis bder.simps(1) bsimp.simps(1) bsimp_ASEQ0 contains.intros(3) contains55)
+ apply(case_tac "\<exists>bsX. (bsimp a1) = AONE bsX")
+ apply(auto)[1]
+ using contains.simps apply blast
+ apply(subst bsimp_ASEQ1)
+ apply(auto)[3]
+ apply(simp)
+ apply(subgoal_tac "bnullable (bsimp a1)")
+ prefer 2
+ using b3 apply blast
+ apply(simp)
+ apply (metis contains.intros(3) contains.intros(4) contains55 self_append_conv2)
+ apply(erule contains.cases)
+ apply(auto)
+ apply(case_tac "(bsimp a1) = AZERO")
+ apply(simp)
+ using b3 apply force
+ apply(case_tac "(bsimp a2) = AZERO")
+ apply(simp)
+ apply (metis bder.simps(1) bsimp_ASEQ0 bsimp_ASEQ_fuse contains0 contains49 f_cont1)
+ apply(case_tac "\<exists>bsX. (bsimp a1) = AONE bsX")
+ apply(auto)[1]
+ apply (metis append_assoc bder_fuse bmkeps.simps(1) bmkeps_simp bsimp_ASEQ2 contains0 contains49 f_cont1)
+ apply(subst bsimp_ASEQ1)
+ apply(auto)[3]
+ apply(simp)
+ apply(subgoal_tac "bnullable (bsimp a1)")
+ prefer 2
+ using b3 apply blast
+ apply(simp)
+ apply (metis bmkeps_simp contains.intros(4) contains.intros(5) contains0 contains49 f_cont1)
+ apply(erule contains.cases)
+ apply(auto)
+ (* ALT case *)
+ apply(drule contains59)
+ apply(auto)
+ apply(subst bder_bsimp_AALTs)
+ apply(rule contains61a)
+ apply(auto)
+ apply(subgoal_tac "bsimp r \<in> set (map bsimp x2a)")
+ prefer 2
+ apply simp
+ apply(case_tac "bsimp r = AZERO")
+ apply (metis Nil_is_append_conv bder.simps(1) bsimp_AALTs.elims bsimp_AALTs.simps(2) contains49 contains61 f_cont2 list.distinct(1) split_list_last)
+ apply(subgoal_tac "nonnested (bsimp r)")
+ prefer 2
+ using nn1b apply blast
+ apply(case_tac "nonalt (bsimp r)")
+ apply(rule_tac x="bsimp r" in bexI)
+ apply (metis contains0 contains49 f_cont1)
+ apply (metis append_Cons flts_append in_set_conv_decomp k0 k0b)
+ (* AALTS case *)
+ apply(subgoal_tac "\<exists>rsX bsX. (bsimp r) = AALTs bsX rsX \<and> (\<forall>r \<in> set rsX. nonalt r)")
+ prefer 2
+ apply (metis n0 nonalt.elims(3))
+ apply(auto)
+ apply(subgoal_tac "bsimp r \<in> set (map bsimp x2a)")
+ prefer 2
+ apply (metis imageI list.set_map)
+ apply(simp)
+ apply(simp add: image_def)
+ apply(erule bexE)
+ apply(subgoal_tac "AALTs bsX rsX \<in> set (map bsimp x2a)")
+ prefer 2
+ apply simp
+ apply(drule in1)
+ apply(subgoal_tac "rsX \<noteq> []")
+ prefer 2
+ apply (metis arexp.distinct(7) good.simps(4) good1)
+
+ by (metis contains0 contains49 f_cont1 in2 list.exhaust list.set_intros(1))
+
+lemma CONTAINS1:
+ assumes "a >> bs"
+ shows "a >>2 bs"
+ using assms
+ apply(induct a bs)
+ apply(auto intro: contains2.intros)
+ done
+
+lemma CONTAINS2:
+ assumes "a >>2 bs"
+ shows "a >> bs"
+ using assms
+ apply(induct a bs)
+ apply(auto intro: contains.intros)
+ using contains55 by auto
+
+lemma CONTAINS2_IFF:
+ shows "a >> bs \<longleftrightarrow> a >>2 bs"
+ using CONTAINS1 CONTAINS2 by blast
+
+lemma
+ assumes "bders (intern r) s >>2 bs"
+ shows "bders_simp (intern r) s >>2 bs"
+ using assms
+ apply(induct s arbitrary: r bs)
+ apply(simp)
+ apply(simp)
+ oops
+
+
+lemma
+ assumes "s \<in> L r"
+ shows "(bders_simp (intern r) s >> code (PX r s)) \<longleftrightarrow> ((intern r) >> code (PX r s))"
+ using assms
+ apply(induct s arbitrary: r rule: rev_induct)
+ apply(simp)
+ apply(simp add: bders_simp_append)
+ apply(simp add: PPP1_eq)
+
+
+find_theorems "retrieve (bders _ _) _"
+find_theorems "_ >> retrieve _ _"
+find_theorems "bsimp _ >> _"
+ oops
+
+
+lemma PX4a:
+ assumes "(s1 @ s2) \<in> L r"
+ shows "bders (intern r) (s1 @ s2) >> code (PV r s1 (PX (ders s1 r) s2))"
+ using PX4[OF assms]
+ apply(simp add: PX_append)
+ done
+
+lemma PV5:
+ assumes "s2 \<in> (ders s1 r) \<rightarrow> v"
+ shows "bders (intern r) (s1 @ s2) >> code (PV r s1 v)"
+ by (simp add: PPP0_isar PV_def Posix_flex assms)
+
+lemma PV6:
+ assumes "s2 \<in> (ders s1 r) \<rightarrow> v"
+ shows "bders (bders (intern r) s1) s2 >> code (PV r s1 v)"
+ using PV5 assms bders_append by auto
+
+find_theorems "retrieve (bders _ _) _"
+find_theorems "_ >> retrieve _ _"
+find_theorems "bder _ _ >> _"
+
+
+lemma OO0_PX:
+ assumes "s \<in> L r"
+ shows "bders (intern r) s >> code (PX r s)"
+ using assms
+ by (simp add: PX3)
+
+
+lemma OO1:
+ assumes "[c] \<in> r \<rightarrow> v"
+ shows "bder c (intern r) >> code v"
+ using assms
+ using PPP0_isar by force
+
+lemma OO1a:
+ assumes "[c] \<in> L r"
+ shows "bder c (intern r) >> code (PX r [c])"
+ using assms unfolding PX_def PV_def
+ using contains70 by fastforce
+
+lemma OO12:
+ assumes "[c1, c2] \<in> L r"
+ shows "bders (intern r) [c1, c2] >> code (PX r [c1, c2])"
+ using assms
+ using PX_def PV_def contains70 by presburger
+
+lemma OO2:
+ assumes "[c] \<in> L r"
+ shows "bders_simp (intern r) [c] >> code (PX r [c])"
+ using assms
+ using OO1a Posix1(1) contains55 by auto
+
+
+lemma OO22:
+ assumes "[c1, c2] \<in> L r"
+ shows "bders_simp (intern r) [c1, c2] >> code (PX r [c1, c2])"
+ using assms
+ apply(simp)
+ apply(rule contains55)
+ apply(rule Etrans)
+ thm contains7
+ apply(rule contains7)
+ oops
+
+
+lemma contains70:
+ assumes "s \<in> L(r)"
+ shows "bders_simp (intern r) s >> code (flex r id s (mkeps (ders s r)))"
+ using assms
+ apply(induct s arbitrary: r rule: rev_induct)
+ apply(simp)
+ apply (simp add: contains2 mkeps_nullable nullable_correctness)
+ apply(simp add: bders_simp_append flex_append)
+ apply(simp add: PPP1_eq)
+ apply(rule Etrans)
+ apply(rule_tac v="flex r id xs (mkeps (ders (xs @ [x]) r))" in contains7)
+ oops
+
+
+thm L07XX PPP0b erase_intern
+
+find_theorems "retrieve (bders _ _) _"
+find_theorems "_ >> retrieve _ _"
+find_theorems "bder _ _ >> _"
+
+
+lemma PPP3:
+ assumes "\<Turnstile> v : ders s (erase a)"
+ shows "bders a s >> retrieve a (flex (erase a) id s v)"
+ using LA[OF assms] contains6 erase_bders assms by metis
+
+
+find_theorems "bder _ _ >> _"
+
+
+lemma
+ fixes n :: nat
+ shows "(\<Sum>i \<in> {0..n}. i) = n * (n + 1) div 2"
+ apply(induct n)
+ apply(simp)
+ apply(simp)
+ done
+
+lemma COUNTEREXAMPLE:
+ assumes "r = AALTs [S] [ASEQ [S] (AALTs [S] [AONE [S], ACHAR [S] c]) (ACHAR [S] c)]"
+ shows "bsimp (bder c (bsimp r)) = bsimp (bder c r)"
+ apply(simp_all add: assms)
+ oops
+
+lemma COUNTEREXAMPLE:
+ assumes "r = AALTs [S] [ASEQ [S] (AALTs [S] [AONE [S], ACHAR [S] c]) (ACHAR [S] c)]"
+ shows "bsimp r = r"
+ apply(simp_all add: assms)
+ oops
+
+lemma COUNTEREXAMPLE:
+ assumes "r = AALTs [S] [ASEQ [S] (AALTs [S] [AONE [S], ACHAR [S] c]) (ACHAR [S] c)]"
+ shows "bsimp r = XXX"
+ and "bder c r = XXX"
+ and "bder c (bsimp r) = XXX"
+ and "bsimp (bder c (bsimp r)) = XXX"
+ and "bsimp (bder c r) = XXX"
+ apply(simp_all add: assms)
+ oops
+
+lemma COUNTEREXAMPLE_contains1:
+ assumes "r = AALTs [S] [ASEQ [S] (AALTs [S] [AONE [S], ACHAR [S] c]) (ACHAR [S] c)]"
+ and "bsimp (bder c r) >> bs"
+ shows "bsimp (bder c (bsimp r)) >> bs"
+ using assms
+ apply(auto elim!: contains.cases)
+ apply(rule Etrans)
+ apply(rule contains.intros)
+ apply(rule contains.intros)
+ apply(simp)
+ apply(rule Etrans)
+ apply(rule contains.intros)
+ apply(rule contains.intros)
+ apply(simp)
+ done
+
+lemma COUNTEREXAMPLE_contains2:
+ assumes "r = AALTs [S] [ASEQ [S] (AALTs [S] [AONE [S], ACHAR [S] c]) (ACHAR [S] c)]"
+ and "bsimp (bder c (bsimp r)) >> bs"
+ shows "bsimp (bder c r) >> bs"
+ using assms
+ apply(auto elim!: contains.cases)
+ apply(rule Etrans)
+ apply(rule contains.intros)
+ apply(rule contains.intros)
+ apply(simp)
+ apply(rule Etrans)
+ apply(rule contains.intros)
+ apply(rule contains.intros)
+ apply(simp)
+ done
+
+
+end
\ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys2/BitCodedCT.thy Sun Oct 10 18:35:21 2021 +0100
@@ -0,0 +1,3438 @@
+
+theory BitCodedCT
+ imports "Lexer"
+begin
+
+section \<open>Bit-Encodings\<close>
+
+datatype bit = Z | S
+
+fun
+ code :: "val \<Rightarrow> bit list"
+where
+ "code Void = []"
+| "code (Char c) = []"
+| "code (Left v) = Z # (code v)"
+| "code (Right v) = S # (code v)"
+| "code (Seq v1 v2) = (code v1) @ (code v2)"
+| "code (Stars []) = [S]"
+| "code (Stars (v # vs)) = (Z # code v) @ code (Stars vs)"
+
+
+fun
+ Stars_add :: "val \<Rightarrow> val \<Rightarrow> val"
+where
+ "Stars_add v (Stars vs) = Stars (v # vs)"
+
+function
+ decode' :: "bit list \<Rightarrow> rexp \<Rightarrow> (val * bit list)"
+where
+ "decode' ds ZERO = (Void, [])"
+| "decode' ds ONE = (Void, ds)"
+| "decode' ds (CHAR d) = (Char d, ds)"
+| "decode' [] (ALT r1 r2) = (Void, [])"
+| "decode' (Z # ds) (ALT r1 r2) = (let (v, ds') = decode' ds r1 in (Left v, ds'))"
+| "decode' (S # ds) (ALT r1 r2) = (let (v, ds') = decode' ds r2 in (Right v, ds'))"
+| "decode' ds (SEQ r1 r2) = (let (v1, ds') = decode' ds r1 in
+ let (v2, ds'') = decode' ds' r2 in (Seq v1 v2, ds''))"
+| "decode' [] (STAR r) = (Void, [])"
+| "decode' (S # ds) (STAR r) = (Stars [], ds)"
+| "decode' (Z # ds) (STAR r) = (let (v, ds') = decode' ds r in
+ let (vs, ds'') = decode' ds' (STAR r)
+ in (Stars_add v vs, ds''))"
+by pat_completeness auto
+
+lemma decode'_smaller:
+ assumes "decode'_dom (ds, r)"
+ shows "length (snd (decode' ds r)) \<le> length ds"
+using assms
+apply(induct ds r)
+apply(auto simp add: decode'.psimps split: prod.split)
+using dual_order.trans apply blast
+by (meson dual_order.trans le_SucI)
+
+termination "decode'"
+apply(relation "inv_image (measure(%cs. size cs) <*lex*> measure(%s. size s)) (%(ds,r). (r,ds))")
+apply(auto dest!: decode'_smaller)
+by (metis less_Suc_eq_le snd_conv)
+
+definition
+ decode :: "bit list \<Rightarrow> rexp \<Rightarrow> val option"
+where
+ "decode ds r \<equiv> (let (v, ds') = decode' ds r
+ in (if ds' = [] then Some v else None))"
+
+lemma decode'_code_Stars:
+ assumes "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> (\<forall>x. decode' (code v @ x) r = (v, x)) \<and> flat v \<noteq> []"
+ shows "decode' (code (Stars vs) @ ds) (STAR r) = (Stars vs, ds)"
+ using assms
+ apply(induct vs)
+ apply(auto)
+ done
+
+lemma decode'_code:
+ assumes "\<Turnstile> v : r"
+ shows "decode' ((code v) @ ds) r = (v, ds)"
+using assms
+ apply(induct v r arbitrary: ds)
+ apply(auto)
+ using decode'_code_Stars by blast
+
+lemma decode_code:
+ assumes "\<Turnstile> v : r"
+ shows "decode (code v) r = Some v"
+ using assms unfolding decode_def
+ by (smt append_Nil2 decode'_code old.prod.case)
+
+
+section {* Annotated Regular Expressions *}
+
+datatype arexp =
+ AZERO
+| AONE "bit list"
+| ACHAR "bit list" char
+| ASEQ "bit list" arexp arexp
+| AALTs "bit list" "arexp list"
+| ASTAR "bit list" arexp
+
+abbreviation
+ "AALT bs r1 r2 \<equiv> AALTs bs [r1, r2]"
+
+fun asize :: "arexp \<Rightarrow> nat" where
+ "asize AZERO = 1"
+| "asize (AONE cs) = 1"
+| "asize (ACHAR cs c) = 1"
+| "asize (AALTs cs rs) = Suc (sum_list (map asize rs))"
+| "asize (ASEQ cs r1 r2) = Suc (asize r1 + asize r2)"
+| "asize (ASTAR cs r) = Suc (asize r)"
+
+fun
+ erase :: "arexp \<Rightarrow> rexp"
+where
+ "erase AZERO = ZERO"
+| "erase (AONE _) = ONE"
+| "erase (ACHAR _ c) = CHAR c"
+| "erase (AALTs _ []) = ZERO"
+| "erase (AALTs _ [r]) = (erase r)"
+| "erase (AALTs bs (r#rs)) = ALT (erase r) (erase (AALTs bs rs))"
+| "erase (ASEQ _ r1 r2) = SEQ (erase r1) (erase r2)"
+| "erase (ASTAR _ r) = STAR (erase r)"
+
+lemma decode_code_erase:
+ assumes "\<Turnstile> v : (erase a)"
+ shows "decode (code v) (erase a) = Some v"
+ using assms
+ by (simp add: decode_code)
+
+
+fun nonalt :: "arexp \<Rightarrow> bool"
+ where
+ "nonalt (AALTs bs2 rs) = False"
+| "nonalt r = True"
+
+
+fun good :: "arexp \<Rightarrow> bool" where
+ "good AZERO = False"
+| "good (AONE cs) = True"
+| "good (ACHAR cs c) = True"
+| "good (AALTs cs []) = False"
+| "good (AALTs cs [r]) = False"
+| "good (AALTs cs (r1#r2#rs)) = (\<forall>r' \<in> set (r1#r2#rs). good r' \<and> nonalt r')"
+| "good (ASEQ _ AZERO _) = False"
+| "good (ASEQ _ (AONE _) _) = False"
+| "good (ASEQ _ _ AZERO) = False"
+| "good (ASEQ cs r1 r2) = (good r1 \<and> good r2)"
+| "good (ASTAR cs r) = True"
+
+
+
+
+fun fuse :: "bit list \<Rightarrow> arexp \<Rightarrow> arexp" where
+ "fuse bs AZERO = AZERO"
+| "fuse bs (AONE cs) = AONE (bs @ cs)"
+| "fuse bs (ACHAR cs c) = ACHAR (bs @ cs) c"
+| "fuse bs (AALTs cs rs) = AALTs (bs @ cs) rs"
+| "fuse bs (ASEQ cs r1 r2) = ASEQ (bs @ cs) r1 r2"
+| "fuse bs (ASTAR cs r) = ASTAR (bs @ cs) r"
+
+lemma fuse_append:
+ shows "fuse (bs1 @ bs2) r = fuse bs1 (fuse bs2 r)"
+ apply(induct r)
+ apply(auto)
+ done
+
+
+fun intern :: "rexp \<Rightarrow> arexp" where
+ "intern ZERO = AZERO"
+| "intern ONE = AONE []"
+| "intern (CHAR c) = ACHAR [] c"
+| "intern (ALT r1 r2) = AALT [] (fuse [Z] (intern r1))
+ (fuse [S] (intern r2))"
+| "intern (SEQ r1 r2) = ASEQ [] (intern r1) (intern r2)"
+| "intern (STAR r) = ASTAR [] (intern r)"
+
+
+fun retrieve :: "arexp \<Rightarrow> val \<Rightarrow> bit list" where
+ "retrieve (AONE bs) Void = bs"
+| "retrieve (ACHAR bs c) (Char d) = bs"
+| "retrieve (AALTs bs [r]) v = bs @ retrieve r v"
+| "retrieve (AALTs bs (r#rs)) (Left v) = bs @ retrieve r v"
+| "retrieve (AALTs bs (r#rs)) (Right v) = bs @ retrieve (AALTs [] rs) v"
+| "retrieve (ASEQ bs r1 r2) (Seq v1 v2) = bs @ retrieve r1 v1 @ retrieve r2 v2"
+| "retrieve (ASTAR bs r) (Stars []) = bs @ [S]"
+| "retrieve (ASTAR bs r) (Stars (v#vs)) =
+ bs @ [Z] @ retrieve r v @ retrieve (ASTAR [] r) (Stars vs)"
+
+
+
+fun
+ bnullable :: "arexp \<Rightarrow> bool"
+where
+ "bnullable (AZERO) = False"
+| "bnullable (AONE bs) = True"
+| "bnullable (ACHAR bs c) = False"
+| "bnullable (AALTs bs rs) = (\<exists>r \<in> set rs. bnullable r)"
+| "bnullable (ASEQ bs r1 r2) = (bnullable r1 \<and> bnullable r2)"
+| "bnullable (ASTAR bs r) = True"
+
+fun
+ bmkeps :: "arexp \<Rightarrow> bit list"
+where
+ "bmkeps(AONE bs) = bs"
+| "bmkeps(ASEQ bs r1 r2) = bs @ (bmkeps r1) @ (bmkeps r2)"
+| "bmkeps(AALTs bs [r]) = bs @ (bmkeps r)"
+| "bmkeps(AALTs bs (r#rs)) = (if bnullable(r) then bs @ (bmkeps r) else (bmkeps (AALTs bs rs)))"
+| "bmkeps(ASTAR bs r) = bs @ [S]"
+
+
+fun
+ bder :: "char \<Rightarrow> arexp \<Rightarrow> arexp"
+where
+ "bder c (AZERO) = AZERO"
+| "bder c (AONE bs) = AZERO"
+| "bder c (ACHAR bs d) = (if c = d then AONE bs else AZERO)"
+| "bder c (AALTs bs rs) = AALTs bs (map (bder c) rs)"
+| "bder c (ASEQ bs r1 r2) =
+ (if bnullable r1
+ then AALT bs (ASEQ [] (bder c r1) r2) (fuse (bmkeps r1) (bder c r2))
+ else ASEQ bs (bder c r1) r2)"
+| "bder c (ASTAR bs r) = ASEQ bs (fuse [Z] (bder c r)) (ASTAR [] r)"
+
+
+fun
+ bders :: "arexp \<Rightarrow> string \<Rightarrow> arexp"
+where
+ "bders r [] = r"
+| "bders r (c#s) = bders (bder c r) s"
+
+lemma bders_append:
+ "bders r (s1 @ s2) = bders (bders r s1) s2"
+ apply(induct s1 arbitrary: r s2)
+ apply(simp_all)
+ done
+
+lemma bnullable_correctness:
+ shows "nullable (erase r) = bnullable r"
+ apply(induct r rule: erase.induct)
+ apply(simp_all)
+ done
+
+lemma erase_fuse:
+ shows "erase (fuse bs r) = erase r"
+ apply(induct r rule: erase.induct)
+ apply(simp_all)
+ done
+
+lemma erase_intern [simp]:
+ shows "erase (intern r) = r"
+ apply(induct r)
+ apply(simp_all add: erase_fuse)
+ done
+
+lemma erase_bder [simp]:
+ shows "erase (bder a r) = der a (erase r)"
+ apply(induct r rule: erase.induct)
+ apply(simp_all add: erase_fuse bnullable_correctness)
+ done
+
+lemma erase_bders [simp]:
+ shows "erase (bders r s) = ders s (erase r)"
+ apply(induct s arbitrary: r )
+ apply(simp_all)
+ done
+
+lemma retrieve_encode_STARS:
+ assumes "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> code v = retrieve (intern r) v"
+ shows "code (Stars vs) = retrieve (ASTAR [] (intern r)) (Stars vs)"
+ using assms
+ apply(induct vs)
+ apply(simp_all)
+ done
+
+lemma retrieve_fuse2:
+ assumes "\<Turnstile> v : (erase r)"
+ shows "retrieve (fuse bs r) v = bs @ retrieve r v"
+ using assms
+ apply(induct r arbitrary: v bs)
+ apply(auto elim: Prf_elims)[4]
+ defer
+ using retrieve_encode_STARS
+ apply(auto elim!: Prf_elims)[1]
+ apply(case_tac vs)
+ apply(simp)
+ apply(simp)
+ (* AALTs case *)
+ apply(simp)
+ apply(case_tac x2a)
+ apply(simp)
+ apply(auto elim!: Prf_elims)[1]
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ apply(auto)
+ apply(auto elim!: Prf_elims)[1]
+ done
+
+lemma retrieve_fuse:
+ assumes "\<Turnstile> v : r"
+ shows "retrieve (fuse bs (intern r)) v = bs @ retrieve (intern r) v"
+ using assms
+ by (simp_all add: retrieve_fuse2)
+
+
+lemma retrieve_code:
+ assumes "\<Turnstile> v : r"
+ shows "code v = retrieve (intern r) v"
+ using assms
+ apply(induct v r )
+ apply(simp_all add: retrieve_fuse retrieve_encode_STARS)
+ done
+
+lemma r:
+ assumes "bnullable (AALTs bs (a # rs))"
+ shows "bnullable a \<or> (\<not> bnullable a \<and> bnullable (AALTs bs rs))"
+ using assms
+ apply(induct rs)
+ apply(auto)
+ done
+
+lemma r0:
+ assumes "bnullable a"
+ shows "bmkeps (AALTs bs (a # rs)) = bs @ (bmkeps a)"
+ using assms
+ by (metis bmkeps.simps(3) bmkeps.simps(4) list.exhaust)
+
+lemma r1:
+ assumes "\<not> bnullable a" "bnullable (AALTs bs rs)"
+ shows "bmkeps (AALTs bs (a # rs)) = bmkeps (AALTs bs rs)"
+ using assms
+ apply(induct rs)
+ apply(auto)
+ done
+
+lemma r2:
+ assumes "x \<in> set rs" "bnullable x"
+ shows "bnullable (AALTs bs rs)"
+ using assms
+ apply(induct rs)
+ apply(auto)
+ done
+
+lemma r3:
+ assumes "\<not> bnullable r"
+ " \<exists> x \<in> set rs. bnullable x"
+ shows "retrieve (AALTs bs rs) (mkeps (erase (AALTs bs rs))) =
+ retrieve (AALTs bs (r # rs)) (mkeps (erase (AALTs bs (r # rs))))"
+ using assms
+ apply(induct rs arbitrary: r bs)
+ apply(auto)[1]
+ apply(auto)
+ using bnullable_correctness apply blast
+ apply(auto simp add: bnullable_correctness mkeps_nullable retrieve_fuse2)
+ apply(subst retrieve_fuse2[symmetric])
+ apply (smt bnullable.simps(4) bnullable_correctness erase.simps(5) erase.simps(6) insert_iff list.exhaust list.set(2) mkeps.simps(3) mkeps_nullable)
+ apply(simp)
+ apply(case_tac "bnullable a")
+ apply (smt append_Nil2 bnullable.simps(4) bnullable_correctness erase.simps(5) erase.simps(6) fuse.simps(4) insert_iff list.exhaust list.set(2) mkeps.simps(3) mkeps_nullable retrieve_fuse2)
+ apply(drule_tac x="a" in meta_spec)
+ apply(drule_tac x="bs" in meta_spec)
+ apply(drule meta_mp)
+ apply(simp)
+ apply(drule meta_mp)
+ apply(auto)
+ apply(subst retrieve_fuse2[symmetric])
+ apply(case_tac rs)
+ apply(simp)
+ apply(auto)[1]
+ apply (simp add: bnullable_correctness)
+ apply (metis append_Nil2 bnullable_correctness erase_fuse fuse.simps(4) list.set_intros(1) mkeps.simps(3) mkeps_nullable nullable.simps(4) r2)
+ apply (simp add: bnullable_correctness)
+ apply (metis append_Nil2 bnullable_correctness erase.simps(6) erase_fuse fuse.simps(4) list.set_intros(2) mkeps.simps(3) mkeps_nullable r2)
+ apply(simp)
+ done
+
+
+lemma t:
+ assumes "\<forall>r \<in> set rs. nullable (erase r) \<longrightarrow> bmkeps r = retrieve r (mkeps (erase r))"
+ "nullable (erase (AALTs bs rs))"
+ shows " bmkeps (AALTs bs rs) = retrieve (AALTs bs rs) (mkeps (erase (AALTs bs rs)))"
+ using assms
+ apply(induct rs arbitrary: bs)
+ apply(simp)
+ apply(auto simp add: bnullable_correctness)
+ apply(case_tac rs)
+ apply(auto simp add: bnullable_correctness)[2]
+ apply(subst r1)
+ apply(simp)
+ apply(rule r2)
+ apply(assumption)
+ apply(simp)
+ apply(drule_tac x="bs" in meta_spec)
+ apply(drule meta_mp)
+ apply(auto)[1]
+ prefer 2
+ apply(case_tac "bnullable a")
+ apply(subst r0)
+ apply blast
+ apply(subgoal_tac "nullable (erase a)")
+ prefer 2
+ using bnullable_correctness apply blast
+ apply (metis (no_types, lifting) erase.simps(5) erase.simps(6) list.exhaust mkeps.simps(3) retrieve.simps(3) retrieve.simps(4))
+ apply(subst r1)
+ apply(simp)
+ using r2 apply blast
+ apply(drule_tac x="bs" in meta_spec)
+ apply(drule meta_mp)
+ apply(auto)[1]
+ apply(simp)
+ using r3 apply blast
+ apply(auto)
+ using r3 by blast
+
+lemma bmkeps_retrieve:
+ assumes "nullable (erase r)"
+ shows "bmkeps r = retrieve r (mkeps (erase r))"
+ using assms
+ apply(induct r)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ defer
+ apply(simp)
+ apply(rule t)
+ apply(auto)
+ done
+
+lemma bder_retrieve:
+ assumes "\<Turnstile> v : der c (erase r)"
+ shows "retrieve (bder c r) v = retrieve r (injval (erase r) c v)"
+ using assms
+ apply(induct r arbitrary: v rule: erase.induct)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(case_tac "c = ca")
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(simp)
+ apply(rename_tac "r\<^sub>1" "r\<^sub>2" rs v)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(simp)
+ apply(case_tac rs)
+ apply(simp)
+ apply(simp)
+ apply (smt Prf_elims(3) injval.simps(2) injval.simps(3) retrieve.simps(4) retrieve.simps(5) same_append_eq)
+ apply(simp)
+ apply(case_tac "nullable (erase r1)")
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(subgoal_tac "bnullable r1")
+ prefer 2
+ using bnullable_correctness apply blast
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(subgoal_tac "bnullable r1")
+ prefer 2
+ using bnullable_correctness apply blast
+ apply(simp)
+ apply(simp add: retrieve_fuse2)
+ apply(simp add: bmkeps_retrieve)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ using bnullable_correctness apply blast
+ apply(rename_tac bs r v)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(clarify)
+ apply(erule Prf_elims)
+ apply(clarify)
+ apply(subst injval.simps)
+ apply(simp del: retrieve.simps)
+ apply(subst retrieve.simps)
+ apply(subst retrieve.simps)
+ apply(simp)
+ apply(simp add: retrieve_fuse2)
+ done
+
+
+
+lemma MAIN_decode:
+ assumes "\<Turnstile> v : ders s r"
+ shows "Some (flex r id s v) = decode (retrieve (bders (intern r) s) v) r"
+ using assms
+proof (induct s arbitrary: v rule: rev_induct)
+ case Nil
+ have "\<Turnstile> v : ders [] r" by fact
+ then have "\<Turnstile> v : r" by simp
+ then have "Some v = decode (retrieve (intern r) v) r"
+ using decode_code retrieve_code by auto
+ then show "Some (flex r id [] v) = decode (retrieve (bders (intern r) []) v) r"
+ by simp
+next
+ case (snoc c s v)
+ have IH: "\<And>v. \<Turnstile> v : ders s r \<Longrightarrow>
+ Some (flex r id s v) = decode (retrieve (bders (intern r) s) v) r" by fact
+ have asm: "\<Turnstile> v : ders (s @ [c]) r" by fact
+ then have asm2: "\<Turnstile> injval (ders s r) c v : ders s r"
+ by (simp add: Prf_injval ders_append)
+ have "Some (flex r id (s @ [c]) v) = Some (flex r id s (injval (ders s r) c v))"
+ by (simp add: flex_append)
+ also have "... = decode (retrieve (bders (intern r) s) (injval (ders s r) c v)) r"
+ using asm2 IH by simp
+ also have "... = decode (retrieve (bder c (bders (intern r) s)) v) r"
+ using asm by (simp_all add: bder_retrieve ders_append)
+ finally show "Some (flex r id (s @ [c]) v) =
+ decode (retrieve (bders (intern r) (s @ [c])) v) r" by (simp add: bders_append)
+qed
+
+
+definition blex where
+ "blex a s \<equiv> if bnullable (bders a s) then Some (bmkeps (bders a s)) else None"
+
+
+
+definition blexer where
+ "blexer r s \<equiv> if bnullable (bders (intern r) s) then
+ decode (bmkeps (bders (intern r) s)) r else None"
+
+lemma blexer_correctness:
+ shows "blexer r s = lexer r s"
+proof -
+ { define bds where "bds \<equiv> bders (intern r) s"
+ define ds where "ds \<equiv> ders s r"
+ assume asm: "nullable ds"
+ have era: "erase bds = ds"
+ unfolding ds_def bds_def by simp
+ have mke: "\<Turnstile> mkeps ds : ds"
+ using asm by (simp add: mkeps_nullable)
+ have "decode (bmkeps bds) r = decode (retrieve bds (mkeps ds)) r"
+ using bmkeps_retrieve
+ using asm era by (simp add: bmkeps_retrieve)
+ also have "... = Some (flex r id s (mkeps ds))"
+ using mke by (simp_all add: MAIN_decode ds_def bds_def)
+ finally have "decode (bmkeps bds) r = Some (flex r id s (mkeps ds))"
+ unfolding bds_def ds_def .
+ }
+ then show "blexer r s = lexer r s"
+ unfolding blexer_def lexer_flex
+ apply(subst bnullable_correctness[symmetric])
+ apply(simp)
+ done
+qed
+
+
+fun distinctBy :: "'a list \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'b set \<Rightarrow> 'a list"
+ where
+ "distinctBy [] f acc = []"
+| "distinctBy (x#xs) f acc =
+ (if (f x) \<in> acc then distinctBy xs f acc
+ else x # (distinctBy xs f ({f x} \<union> acc)))"
+
+fun flts :: "arexp list \<Rightarrow> arexp list"
+ where
+ "flts [] = []"
+| "flts (AZERO # rs) = flts rs"
+| "flts ((AALTs bs rs1) # rs) = (map (fuse bs) rs1) @ flts rs"
+| "flts (r1 # rs) = r1 # flts rs"
+
+fun li :: "bit list \<Rightarrow> arexp list \<Rightarrow> arexp"
+ where
+ "li _ [] = AZERO"
+| "li bs [a] = fuse bs a"
+| "li bs as = AALTs bs as"
+
+
+fun bsimp_ASEQ :: "bit list \<Rightarrow> arexp \<Rightarrow> arexp \<Rightarrow> arexp"
+ where
+ "bsimp_ASEQ _ AZERO _ = AZERO"
+| "bsimp_ASEQ _ _ AZERO = AZERO"
+| "bsimp_ASEQ bs1 (AONE bs2) r2 = fuse (bs1 @ bs2) r2"
+| "bsimp_ASEQ bs1 r1 r2 = ASEQ bs1 r1 r2"
+
+
+fun bsimp_AALTs :: "bit list \<Rightarrow> arexp list \<Rightarrow> arexp"
+ where
+ "bsimp_AALTs _ [] = AZERO"
+| "bsimp_AALTs bs1 [r] = fuse bs1 r"
+| "bsimp_AALTs bs1 rs = AALTs bs1 rs"
+
+
+fun bsimp :: "arexp \<Rightarrow> arexp"
+ where
+ "bsimp (ASEQ bs1 r1 r2) = bsimp_ASEQ bs1 (bsimp r1) (bsimp r2)"
+| "bsimp (AALTs bs1 rs) = bsimp_AALTs bs1 (flts (map bsimp rs))"
+| "bsimp r = r"
+
+
+
+
+fun
+ bders_simp :: "arexp \<Rightarrow> string \<Rightarrow> arexp"
+where
+ "bders_simp r [] = r"
+| "bders_simp r (c # s) = bders_simp (bsimp (bder c r)) s"
+
+definition blexer_simp where
+ "blexer_simp r s \<equiv> if bnullable (bders_simp (intern r) s) then
+ decode (bmkeps (bders_simp (intern r) s)) r else None"
+
+
+lemma asize0:
+ shows "0 < asize r"
+ apply(induct r)
+ apply(auto)
+ done
+
+
+lemma bders_simp_append:
+ shows "bders_simp r (s1 @ s2) = bders_simp (bders_simp r s1) s2"
+ apply(induct s1 arbitrary: r s2)
+ apply(simp)
+ apply(simp)
+ done
+
+lemma bsimp_ASEQ_size:
+ shows "asize (bsimp_ASEQ bs r1 r2) \<le> Suc (asize r1 + asize r2)"
+ apply(induct bs r1 r2 rule: bsimp_ASEQ.induct)
+ apply(auto)
+ done
+
+lemma fuse_size:
+ shows "asize (fuse bs r) = asize r"
+ apply(induct r)
+ apply(auto)
+ done
+
+lemma flts_size:
+ shows "sum_list (map asize (flts rs)) \<le> sum_list (map asize rs)"
+ apply(induct rs rule: flts.induct)
+ apply(simp_all)
+ by (metis (mono_tags, lifting) add_mono comp_apply eq_imp_le fuse_size le_SucI map_eq_conv)
+
+
+lemma bsimp_AALTs_size:
+ shows "asize (bsimp_AALTs bs rs) \<le> Suc (sum_list (map asize rs))"
+ apply(induct rs rule: bsimp_AALTs.induct)
+ apply(auto simp add: fuse_size)
+ done
+
+
+lemma bsimp_size:
+ shows "asize (bsimp r) \<le> asize r"
+ apply(induct r)
+ apply(simp_all)
+ apply (meson Suc_le_mono add_mono_thms_linordered_semiring(1) bsimp_ASEQ_size le_trans)
+ apply(rule le_trans)
+ apply(rule bsimp_AALTs_size)
+ apply(simp)
+ apply(rule le_trans)
+ apply(rule flts_size)
+ by (simp add: sum_list_mono)
+
+lemma bsimp_asize0:
+ shows "(\<Sum>x\<leftarrow>rs. asize (bsimp x)) \<le> sum_list (map asize rs)"
+ apply(induct rs)
+ apply(auto)
+ by (simp add: add_mono bsimp_size)
+
+lemma bsimp_AALTs_size2:
+ assumes "\<forall>r \<in> set rs. nonalt r"
+ shows "asize (bsimp_AALTs bs rs) \<ge> sum_list (map asize rs)"
+ using assms
+ apply(induct rs rule: bsimp_AALTs.induct)
+ apply(simp_all add: fuse_size)
+ done
+
+
+lemma qq:
+ shows "map (asize \<circ> fuse bs) rs = map asize rs"
+ apply(induct rs)
+ apply(auto simp add: fuse_size)
+ done
+
+lemma flts_size2:
+ assumes "\<exists>bs rs'. AALTs bs rs' \<in> set rs"
+ shows "sum_list (map asize (flts rs)) < sum_list (map asize rs)"
+ using assms
+ apply(induct rs)
+ apply(auto simp add: qq)
+ apply (simp add: flts_size less_Suc_eq_le)
+ apply(case_tac a)
+ apply(auto simp add: qq)
+ prefer 2
+ apply (simp add: flts_size le_imp_less_Suc)
+ using less_Suc_eq by auto
+
+lemma bsimp_AALTs_size3:
+ assumes "\<exists>r \<in> set (map bsimp rs). \<not>nonalt r"
+ shows "asize (bsimp (AALTs bs rs)) < asize (AALTs bs rs)"
+ using assms flts_size2
+ apply -
+ apply(clarify)
+ apply(simp)
+ apply(drule_tac x="map bsimp rs" in meta_spec)
+ apply(drule meta_mp)
+ apply (metis list.set_map nonalt.elims(3))
+ apply(simp)
+ apply(rule order_class.order.strict_trans1)
+ apply(rule bsimp_AALTs_size)
+ apply(simp)
+ by (smt Suc_leI bsimp_asize0 comp_def le_imp_less_Suc le_trans map_eq_conv not_less_eq)
+
+
+
+
+lemma L_bsimp_ASEQ:
+ "L (SEQ (erase r1) (erase r2)) = L (erase (bsimp_ASEQ bs r1 r2))"
+ apply(induct bs r1 r2 rule: bsimp_ASEQ.induct)
+ apply(simp_all)
+ by (metis erase_fuse fuse.simps(4))
+
+lemma L_bsimp_AALTs:
+ "L (erase (AALTs bs rs)) = L (erase (bsimp_AALTs bs rs))"
+ apply(induct bs rs rule: bsimp_AALTs.induct)
+ apply(simp_all add: erase_fuse)
+ done
+
+lemma L_erase_AALTs:
+ shows "L (erase (AALTs bs rs)) = \<Union> (L ` erase ` (set rs))"
+ apply(induct rs)
+ apply(simp)
+ apply(simp)
+ apply(case_tac rs)
+ apply(simp)
+ apply(simp)
+ done
+
+lemma L_erase_flts:
+ shows "\<Union> (L ` erase ` (set (flts rs))) = \<Union> (L ` erase ` (set rs))"
+ apply(induct rs rule: flts.induct)
+ apply(simp_all)
+ apply(auto)
+ using L_erase_AALTs erase_fuse apply auto[1]
+ by (simp add: L_erase_AALTs erase_fuse)
+
+
+lemma L_bsimp_erase:
+ shows "L (erase r) = L (erase (bsimp r))"
+ apply(induct r)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(auto simp add: Sequ_def)[1]
+ apply(subst L_bsimp_ASEQ[symmetric])
+ apply(auto simp add: Sequ_def)[1]
+ apply(subst (asm) L_bsimp_ASEQ[symmetric])
+ apply(auto simp add: Sequ_def)[1]
+ apply(simp)
+ apply(subst L_bsimp_AALTs[symmetric])
+ defer
+ apply(simp)
+ apply(subst (2)L_erase_AALTs)
+ apply(subst L_erase_flts)
+ apply(auto)
+ apply (simp add: L_erase_AALTs)
+ using L_erase_AALTs by blast
+
+lemma bsimp_ASEQ0:
+ shows "bsimp_ASEQ bs r1 AZERO = AZERO"
+ apply(induct r1)
+ apply(auto)
+ done
+
+
+
+lemma bsimp_ASEQ1:
+ assumes "r1 \<noteq> AZERO" "r2 \<noteq> AZERO" "\<forall>bs. r1 \<noteq> AONE bs"
+ shows "bsimp_ASEQ bs r1 r2 = ASEQ bs r1 r2"
+ using assms
+ apply(induct bs r1 r2 rule: bsimp_ASEQ.induct)
+ apply(auto)
+ done
+
+lemma bsimp_ASEQ2:
+ shows "bsimp_ASEQ bs (AONE bs1) r2 = fuse (bs @ bs1) r2"
+ apply(induct r2)
+ apply(auto)
+ done
+
+
+lemma L_bders_simp:
+ shows "L (erase (bders_simp r s)) = L (erase (bders r s))"
+ apply(induct s arbitrary: r rule: rev_induct)
+ apply(simp)
+ apply(simp)
+ apply(simp add: ders_append)
+ apply(simp add: bders_simp_append)
+ apply(simp add: L_bsimp_erase[symmetric])
+ by (simp add: der_correctness)
+
+lemma b1:
+ "bsimp_ASEQ bs1 (AONE bs) r = fuse (bs1 @ bs) r"
+ apply(induct r)
+ apply(auto)
+ done
+
+lemma b2:
+ assumes "bnullable r"
+ shows "bmkeps (fuse bs r) = bs @ bmkeps r"
+ by (simp add: assms bmkeps_retrieve bnullable_correctness erase_fuse mkeps_nullable retrieve_fuse2)
+
+lemma b3:
+ shows "bnullable r = bnullable (bsimp r)"
+ using L_bsimp_erase bnullable_correctness nullable_correctness by auto
+
+
+lemma b4:
+ shows "bnullable (bders_simp r s) = bnullable (bders r s)"
+ by (metis L_bders_simp bnullable_correctness lexer.simps(1) lexer_correct_None option.distinct(1))
+
+lemma q1:
+ assumes "\<forall>r \<in> set rs. bmkeps(bsimp r) = bmkeps r"
+ shows "map (\<lambda>r. bmkeps(bsimp r)) rs = map bmkeps rs"
+ using assms
+ apply(induct rs)
+ apply(simp)
+ apply(simp)
+ done
+
+lemma q3:
+ assumes "\<exists>r \<in> set rs. bnullable r"
+ shows "bmkeps (AALTs bs rs) = bmkeps (bsimp_AALTs bs rs)"
+ using assms
+ apply(induct bs rs rule: bsimp_AALTs.induct)
+ apply(simp)
+ apply(simp)
+ apply (simp add: b2)
+ apply(simp)
+ done
+
+lemma qq1:
+ assumes "\<exists>r \<in> set rs. bnullable r"
+ shows "bmkeps (AALTs bs (rs @ rs1)) = bmkeps (AALTs bs rs)"
+ using assms
+ apply(induct rs arbitrary: rs1 bs)
+ apply(simp)
+ apply(simp)
+ by (metis Nil_is_append_conv bmkeps.simps(4) neq_Nil_conv r0 split_list_last)
+
+lemma qq2:
+ assumes "\<forall>r \<in> set rs. \<not> bnullable r" "\<exists>r \<in> set rs1. bnullable r"
+ shows "bmkeps (AALTs bs (rs @ rs1)) = bmkeps (AALTs bs rs1)"
+ using assms
+ apply(induct rs arbitrary: rs1 bs)
+ apply(simp)
+ apply(simp)
+ by (metis append_assoc in_set_conv_decomp r1 r2)
+
+lemma qq3:
+ shows "bnullable (AALTs bs rs) = (\<exists>r \<in> set rs. bnullable r)"
+ apply(induct rs arbitrary: bs)
+ apply(simp)
+ apply(simp)
+ done
+
+lemma fuse_empty:
+ shows "fuse [] r = r"
+ apply(induct r)
+ apply(auto)
+ done
+
+lemma flts_fuse:
+ shows "map (fuse bs) (flts rs) = flts (map (fuse bs) rs)"
+ apply(induct rs arbitrary: bs rule: flts.induct)
+ apply(auto simp add: fuse_append)
+ done
+
+lemma bsimp_ASEQ_fuse:
+ shows "fuse bs1 (bsimp_ASEQ bs2 r1 r2) = bsimp_ASEQ (bs1 @ bs2) r1 r2"
+ apply(induct r1 r2 arbitrary: bs1 bs2 rule: bsimp_ASEQ.induct)
+ apply(auto)
+ done
+
+lemma bsimp_AALTs_fuse:
+ assumes "\<forall>r \<in> set rs. fuse bs1 (fuse bs2 r) = fuse (bs1 @ bs2) r"
+ shows "fuse bs1 (bsimp_AALTs bs2 rs) = bsimp_AALTs (bs1 @ bs2) rs"
+ using assms
+ apply(induct bs2 rs arbitrary: bs1 rule: bsimp_AALTs.induct)
+ apply(auto)
+ done
+
+
+
+lemma bsimp_fuse:
+ shows "fuse bs (bsimp r) = bsimp (fuse bs r)"
+apply(induct r arbitrary: bs)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 3
+ apply(simp)
+ apply(simp)
+ apply (simp add: bsimp_ASEQ_fuse)
+ apply(simp)
+ by (simp add: bsimp_AALTs_fuse fuse_append)
+
+lemma bsimp_fuse_AALTs:
+ shows "fuse bs (bsimp (AALTs [] rs)) = bsimp (AALTs bs rs)"
+ apply(subst bsimp_fuse)
+ apply(simp)
+ done
+
+lemma bsimp_fuse_AALTs2:
+ shows "fuse bs (bsimp_AALTs [] rs) = bsimp_AALTs bs rs"
+ using bsimp_AALTs_fuse fuse_append by auto
+
+
+lemma bsimp_ASEQ_idem:
+ assumes "bsimp (bsimp r1) = bsimp r1" "bsimp (bsimp r2) = bsimp r2"
+ shows "bsimp (bsimp_ASEQ x1 (bsimp r1) (bsimp r2)) = bsimp_ASEQ x1 (bsimp r1) (bsimp r2)"
+ using assms
+ apply(case_tac "bsimp r1 = AZERO")
+ apply(simp)
+ apply(case_tac "bsimp r2 = AZERO")
+ apply(simp)
+ apply (metis bnullable.elims(2) bnullable.elims(3) bsimp.simps(3) bsimp_ASEQ.simps(2) bsimp_ASEQ.simps(3) bsimp_ASEQ.simps(4) bsimp_ASEQ.simps(5) bsimp_ASEQ.simps(6))
+ apply(case_tac "\<exists>bs. bsimp r1 = AONE bs")
+ apply(auto)[1]
+ apply(subst bsimp_ASEQ2)
+ apply(subst bsimp_ASEQ2)
+ apply (metis assms(2) bsimp_fuse)
+ apply(subst bsimp_ASEQ1)
+ apply(auto)
+ done
+
+
+fun nonnested :: "arexp \<Rightarrow> bool"
+ where
+ "nonnested (AALTs bs2 []) = True"
+| "nonnested (AALTs bs2 ((AALTs bs1 rs1) # rs2)) = False"
+| "nonnested (AALTs bs2 (r # rs2)) = nonnested (AALTs bs2 rs2)"
+| "nonnested r = True"
+
+
+lemma k0:
+ shows "flts (r # rs1) = flts [r] @ flts rs1"
+ apply(induct r arbitrary: rs1)
+ apply(auto)
+ done
+
+lemma k00:
+ shows "flts (rs1 @ rs2) = flts rs1 @ flts rs2"
+ apply(induct rs1 arbitrary: rs2)
+ apply(auto)
+ by (metis append.assoc k0)
+
+lemma k0a:
+ shows "flts [AALTs bs rs] = map (fuse bs) rs"
+ apply(simp)
+ done
+
+
+lemma k0b:
+ assumes "nonalt r" "r \<noteq> AZERO"
+ shows "flts [r] = [r]"
+ using assms
+ apply(case_tac r)
+ apply(simp_all)
+ done
+
+lemma nn1:
+ assumes "nonnested (AALTs bs rs)"
+ shows "\<nexists>bs1 rs1. flts rs = [AALTs bs1 rs1]"
+ using assms
+ apply(induct rs rule: flts.induct)
+ apply(auto)
+ done
+
+lemma nn1q:
+ assumes "nonnested (AALTs bs rs)"
+ shows "\<nexists>bs1 rs1. AALTs bs1 rs1 \<in> set (flts rs)"
+ using assms
+ apply(induct rs rule: flts.induct)
+ apply(auto)
+ done
+
+lemma nn1qq:
+ assumes "nonnested (AALTs bs rs)"
+ shows "\<nexists>bs1 rs1. AALTs bs1 rs1 \<in> set rs"
+ using assms
+ apply(induct rs rule: flts.induct)
+ apply(auto)
+ done
+
+lemma nn10:
+ assumes "nonnested (AALTs cs rs)"
+ shows "nonnested (AALTs (bs @ cs) rs)"
+ using assms
+ apply(induct rs arbitrary: cs bs)
+ apply(simp_all)
+ apply(case_tac a)
+ apply(simp_all)
+ done
+
+lemma nn11a:
+ assumes "nonalt r"
+ shows "nonalt (fuse bs r)"
+ using assms
+ apply(induct r)
+ apply(auto)
+ done
+
+
+lemma nn1a:
+ assumes "nonnested r"
+ shows "nonnested (fuse bs r)"
+ using assms
+ apply(induct bs r arbitrary: rule: fuse.induct)
+ apply(simp_all add: nn10)
+ done
+
+lemma n0:
+ shows "nonnested (AALTs bs rs) \<longleftrightarrow> (\<forall>r \<in> set rs. nonalt r)"
+ apply(induct rs arbitrary: bs)
+ apply(auto)
+ apply (metis list.set_intros(1) nn1qq nonalt.elims(3))
+ apply (metis list.set_intros(2) nn1qq nonalt.elims(3))
+ by (metis nonalt.elims(2) nonnested.simps(3) nonnested.simps(4) nonnested.simps(5) nonnested.simps(6) nonnested.simps(7))
+
+
+
+
+lemma nn1c:
+ assumes "\<forall>r \<in> set rs. nonnested r"
+ shows "\<forall>r \<in> set (flts rs). nonalt r"
+ using assms
+ apply(induct rs rule: flts.induct)
+ apply(auto)
+ apply(rule nn11a)
+ by (metis nn1qq nonalt.elims(3))
+
+lemma nn1bb:
+ assumes "\<forall>r \<in> set rs. nonalt r"
+ shows "nonnested (bsimp_AALTs bs rs)"
+ using assms
+ apply(induct bs rs rule: bsimp_AALTs.induct)
+ apply(auto)
+ apply (metis nn11a nonalt.simps(1) nonnested.elims(3))
+ using n0 by auto
+
+lemma nn1b:
+ shows "nonnested (bsimp r)"
+ apply(induct r)
+ apply(simp_all)
+ apply(case_tac "bsimp r1 = AZERO")
+ apply(simp)
+ apply(case_tac "bsimp r2 = AZERO")
+ apply(simp)
+ apply(subst bsimp_ASEQ0)
+ apply(simp)
+ apply(case_tac "\<exists>bs. bsimp r1 = AONE bs")
+ apply(auto)[1]
+ apply(subst bsimp_ASEQ2)
+ apply (simp add: nn1a)
+ apply(subst bsimp_ASEQ1)
+ apply(auto)
+ apply(rule nn1bb)
+ apply(auto)
+ by (metis (mono_tags, hide_lams) imageE nn1c set_map)
+
+lemma nn1d:
+ assumes "bsimp r = AALTs bs rs"
+ shows "\<forall>r1 \<in> set rs. \<forall> bs. r1 \<noteq> AALTs bs rs2"
+ using nn1b assms
+ by (metis nn1qq)
+
+lemma nn_flts:
+ assumes "nonnested (AALTs bs rs)"
+ shows "\<forall>r \<in> set (flts rs). nonalt r"
+ using assms
+ apply(induct rs arbitrary: bs rule: flts.induct)
+ apply(auto)
+ done
+
+lemma rt:
+ shows "sum_list (map asize (flts (map bsimp rs))) \<le> sum_list (map asize rs)"
+ apply(induct rs)
+ apply(simp)
+ apply(simp)
+ apply(subst k0)
+ apply(simp)
+ by (smt add_le_cancel_right add_mono bsimp_size flts.simps(1) flts_size k0 le_iff_add list.simps(9) map_append sum_list.Cons sum_list.append trans_le_add1)
+
+lemma bsimp_AALTs_qq:
+ assumes "1 < length rs"
+ shows "bsimp_AALTs bs rs = AALTs bs rs"
+ using assms
+ apply(case_tac rs)
+ apply(simp)
+ apply(case_tac list)
+ apply(simp_all)
+ done
+
+
+lemma bsimp_AALTs1:
+ assumes "nonalt r"
+ shows "bsimp_AALTs bs (flts [r]) = fuse bs r"
+ using assms
+ apply(case_tac r)
+ apply(simp_all)
+ done
+
+lemma bbbbs:
+ assumes "good r" "r = AALTs bs1 rs"
+ shows "bsimp_AALTs bs (flts [r]) = AALTs bs (map (fuse bs1) rs)"
+ using assms
+ by (metis (no_types, lifting) Nil_is_map_conv append.left_neutral append_butlast_last_id bsimp_AALTs.elims butlast.simps(2) good.simps(4) good.simps(5) k0a map_butlast)
+
+lemma bbbbs1:
+ shows "nonalt r \<or> (\<exists>bs rs. r = AALTs bs rs)"
+ using nonalt.elims(3) by auto
+
+
+lemma good_fuse:
+ shows "good (fuse bs r) = good r"
+ apply(induct r arbitrary: bs)
+ apply(auto)
+ apply(case_tac r1)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r1)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac x2a)
+ apply(simp_all)
+ apply(case_tac list)
+ apply(simp_all)
+ apply(case_tac x2a)
+ apply(simp_all)
+ apply(case_tac list)
+ apply(simp_all)
+ done
+
+lemma good0:
+ assumes "rs \<noteq> Nil" "\<forall>r \<in> set rs. nonalt r"
+ shows "good (bsimp_AALTs bs rs) \<longleftrightarrow> (\<forall>r \<in> set rs. good r)"
+ using assms
+ apply(induct bs rs rule: bsimp_AALTs.induct)
+ apply(auto simp add: good_fuse)
+ done
+
+lemma good0a:
+ assumes "flts (map bsimp rs) \<noteq> Nil" "\<forall>r \<in> set (flts (map bsimp rs)). nonalt r"
+ shows "good (bsimp (AALTs bs rs)) \<longleftrightarrow> (\<forall>r \<in> set (flts (map bsimp rs)). good r)"
+ using assms
+ apply(simp)
+ apply(auto)
+ apply(subst (asm) good0)
+ apply(simp)
+ apply(auto)
+ apply(subst good0)
+ apply(simp)
+ apply(auto)
+ done
+
+lemma flts0:
+ assumes "r \<noteq> AZERO" "nonalt r"
+ shows "flts [r] \<noteq> []"
+ using assms
+ apply(induct r)
+ apply(simp_all)
+ done
+
+lemma flts1:
+ assumes "good r"
+ shows "flts [r] \<noteq> []"
+ using assms
+ apply(induct r)
+ apply(simp_all)
+ apply(case_tac x2a)
+ apply(simp)
+ apply(simp)
+ done
+
+lemma flts2:
+ assumes "good r"
+ shows "\<forall>r' \<in> set (flts [r]). good r' \<and> nonalt r'"
+ using assms
+ apply(induct r)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 2
+ apply(simp)
+ apply(auto)[1]
+ apply (metis bsimp_AALTs.elims good.simps(4) good.simps(5) good.simps(6) good_fuse)
+ apply (metis bsimp_AALTs.elims good.simps(4) good.simps(5) good.simps(6) nn11a)
+ apply fastforce
+ apply(simp)
+ done
+
+
+lemma flts3:
+ assumes "\<forall>r \<in> set rs. good r \<or> r = AZERO"
+ shows "\<forall>r \<in> set (flts rs). good r"
+ using assms
+ apply(induct rs arbitrary: rule: flts.induct)
+ apply(simp_all)
+ by (metis UnE flts2 k0a set_map)
+
+lemma flts3b:
+ assumes "\<exists>r\<in>set rs. good r"
+ shows "flts rs \<noteq> []"
+ using assms
+ apply(induct rs arbitrary: rule: flts.induct)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(auto)
+ done
+
+lemma flts4:
+ assumes "bsimp_AALTs bs (flts rs) = AZERO"
+ shows "\<forall>r \<in> set rs. \<not> good r"
+ using assms
+ apply(induct rs arbitrary: bs rule: flts.induct)
+ apply(auto)
+ defer
+ apply (metis (no_types, lifting) Nil_is_append_conv append_self_conv2 bsimp_AALTs.elims butlast.simps(2) butlast_append flts3b nonalt.simps(1) nonalt.simps(2))
+ apply (metis arexp.distinct(7) bsimp_AALTs.elims flts2 good.simps(1) good.simps(2) good0 k0b list.distinct(1) list.inject nonalt.simps(3))
+ apply (metis arexp.distinct(3) arexp.distinct(7) bsimp_AALTs.elims fuse.simps(3) list.distinct(1) list.inject)
+ apply (metis arexp.distinct(7) bsimp_AALTs.elims good.simps(1) good_fuse list.distinct(1) list.inject)
+ apply (metis arexp.distinct(7) bsimp_AALTs.elims list.distinct(1) list.inject)
+ apply (metis arexp.distinct(7) bsimp_AALTs.elims flts2 good.simps(1) good.simps(33) good0 k0b list.distinct(1) list.inject nonalt.simps(6))
+ by (metis (no_types, lifting) Nil_is_append_conv append_Nil2 arexp.distinct(7) bsimp_AALTs.elims butlast.simps(2) butlast_append flts1 flts2 good.simps(1) good0 k0a)
+
+
+lemma flts_nil:
+ assumes "\<forall>y. asize y < Suc (sum_list (map asize rs)) \<longrightarrow>
+ good (bsimp y) \<or> bsimp y = AZERO"
+ and "\<forall>r\<in>set rs. \<not> good (bsimp r)"
+ shows "flts (map bsimp rs) = []"
+ using assms
+ apply(induct rs)
+ apply(simp)
+ apply(simp)
+ apply(subst k0)
+ apply(simp)
+ by force
+
+lemma flts_nil2:
+ assumes "\<forall>y. asize y < Suc (sum_list (map asize rs)) \<longrightarrow>
+ good (bsimp y) \<or> bsimp y = AZERO"
+ and "bsimp_AALTs bs (flts (map bsimp rs)) = AZERO"
+ shows "flts (map bsimp rs) = []"
+ using assms
+ apply(induct rs arbitrary: bs)
+ apply(simp)
+ apply(simp)
+ apply(subst k0)
+ apply(simp)
+ apply(subst (asm) k0)
+ apply(auto)
+ apply (metis flts.simps(1) flts.simps(2) flts4 k0 less_add_Suc1 list.set_intros(1))
+ by (metis flts.simps(2) flts4 k0 less_add_Suc1 list.set_intros(1))
+
+
+
+lemma good_SEQ:
+ assumes "r1 \<noteq> AZERO" "r2 \<noteq> AZERO" "\<forall>bs. r1 \<noteq> AONE bs"
+ shows "good (ASEQ bs r1 r2) = (good r1 \<and> good r2)"
+ using assms
+ apply(case_tac r1)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ apply(case_tac r2)
+ apply(simp_all)
+ done
+
+lemma good1:
+ shows "good (bsimp a) \<or> bsimp a = AZERO"
+ apply(induct a taking: asize rule: measure_induct)
+ apply(case_tac x)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 3
+ apply(simp)
+ prefer 2
+ (* AALTs case *)
+ apply(simp only:)
+ apply(case_tac "x52")
+ apply(simp)
+ thm good0a
+ (* AALTs list at least one - case *)
+ apply(simp only: )
+ apply(frule_tac x="a" in spec)
+ apply(drule mp)
+ apply(simp)
+ (* either first element is good, or AZERO *)
+ apply(erule disjE)
+ prefer 2
+ apply(simp)
+ (* in the AZERO case, the size is smaller *)
+ apply(drule_tac x="AALTs x51 list" in spec)
+ apply(drule mp)
+ apply(simp add: asize0)
+ apply(subst (asm) bsimp.simps)
+ apply(subst (asm) bsimp.simps)
+ apply(assumption)
+ (* in the good case *)
+ apply(frule_tac x="AALTs x51 list" in spec)
+ apply(drule mp)
+ apply(simp add: asize0)
+ apply(erule disjE)
+ apply(rule disjI1)
+ apply(simp add: good0)
+ apply(subst good0)
+ apply (metis Nil_is_append_conv flts1 k0)
+ apply (metis ex_map_conv list.simps(9) nn1b nn1c)
+ apply(simp)
+ apply(subst k0)
+ apply(simp)
+ apply(auto)[1]
+ using flts2 apply blast
+ apply(subst (asm) good0)
+ prefer 3
+ apply(auto)[1]
+ apply auto[1]
+ apply (metis ex_map_conv nn1b nn1c)
+ (* in the AZERO case *)
+ apply(simp)
+ apply(frule_tac x="a" in spec)
+ apply(drule mp)
+ apply(simp)
+ apply(erule disjE)
+ apply(rule disjI1)
+ apply(subst good0)
+ apply(subst k0)
+ using flts1 apply blast
+ apply(auto)[1]
+ apply (metis (no_types, hide_lams) ex_map_conv list.simps(9) nn1b nn1c)
+ apply(auto)[1]
+ apply(subst (asm) k0)
+ apply(auto)[1]
+ using flts2 apply blast
+ apply(frule_tac x="AALTs x51 list" in spec)
+ apply(drule mp)
+ apply(simp add: asize0)
+ apply(erule disjE)
+ apply(simp)
+ apply(simp)
+ apply (metis add.left_commute flts_nil2 less_add_Suc1 less_imp_Suc_add list.distinct(1) list.set_cases nat.inject)
+ apply(subst (2) k0)
+ apply(simp)
+ (* SEQ case *)
+ apply(simp)
+ apply(case_tac "bsimp x42 = AZERO")
+ apply(simp)
+ apply(case_tac "bsimp x43 = AZERO")
+ apply(simp)
+ apply(subst (2) bsimp_ASEQ0)
+ apply(simp)
+ apply(case_tac "\<exists>bs. bsimp x42 = AONE bs")
+ apply(auto)[1]
+ apply(subst bsimp_ASEQ2)
+ using good_fuse apply force
+ apply(subst bsimp_ASEQ1)
+ apply(auto)
+ apply(subst good_SEQ)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ using less_add_Suc1 less_add_Suc2 by blast
+
+lemma good1a:
+ assumes "L(erase a) \<noteq> {}"
+ shows "good (bsimp a)"
+ using good1 assms
+ using L_bsimp_erase by force
+
+
+
+lemma flts_append:
+ "flts (xs1 @ xs2) = flts xs1 @ flts xs2"
+ apply(induct xs1 arbitrary: xs2 rule: rev_induct)
+ apply(auto)
+ apply(case_tac xs)
+ apply(auto)
+ apply(case_tac x)
+ apply(auto)
+ apply(case_tac x)
+ apply(auto)
+ done
+
+lemma g1:
+ assumes "good (bsimp_AALTs bs rs)"
+ shows "bsimp_AALTs bs rs = AALTs bs rs \<or> (\<exists>r. rs = [r] \<and> bsimp_AALTs bs [r] = fuse bs r)"
+using assms
+ apply(induct rs arbitrary: bs)
+ apply(simp)
+ apply(case_tac rs)
+ apply(simp only:)
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ by simp
+
+lemma flts_0:
+ assumes "nonnested (AALTs bs rs)"
+ shows "\<forall>r \<in> set (flts rs). r \<noteq> AZERO"
+ using assms
+ apply(induct rs arbitrary: bs rule: flts.induct)
+ apply(simp)
+ apply(simp)
+ defer
+ apply(simp)
+ apply(simp)
+ apply(simp)
+apply(simp)
+ apply(rule ballI)
+ apply(simp)
+ done
+
+lemma flts_0a:
+ assumes "nonnested (AALTs bs rs)"
+ shows "AZERO \<notin> set (flts rs)"
+ using assms
+ using flts_0 by blast
+
+lemma qqq1:
+ shows "AZERO \<notin> set (flts (map bsimp rs))"
+ by (metis ex_map_conv flts3 good.simps(1) good1)
+
+
+fun nonazero :: "arexp \<Rightarrow> bool"
+ where
+ "nonazero AZERO = False"
+| "nonazero r = True"
+
+lemma flts_concat:
+ shows "flts rs = concat (map (\<lambda>r. flts [r]) rs)"
+ apply(induct rs)
+ apply(auto)
+ apply(subst k0)
+ apply(simp)
+ done
+
+lemma flts_single1:
+ assumes "nonalt r" "nonazero r"
+ shows "flts [r] = [r]"
+ using assms
+ apply(induct r)
+ apply(auto)
+ done
+
+lemma flts_qq:
+ assumes "\<forall>y. asize y < Suc (sum_list (map asize rs)) \<longrightarrow> good y \<longrightarrow> bsimp y = y"
+ "\<forall>r'\<in>set rs. good r' \<and> nonalt r'"
+ shows "flts (map bsimp rs) = rs"
+ using assms
+ apply(induct rs)
+ apply(simp)
+ apply(simp)
+ apply(subst k0)
+ apply(subgoal_tac "flts [bsimp a] = [a]")
+ prefer 2
+ apply(drule_tac x="a" in spec)
+ apply(drule mp)
+ apply(simp)
+ apply(auto)[1]
+ using good.simps(1) k0b apply blast
+ apply(auto)[1]
+ done
+
+lemma test:
+ assumes "good r"
+ shows "bsimp r = r"
+ using assms
+ apply(induct r taking: "asize" rule: measure_induct)
+ apply(erule good.elims)
+ apply(simp_all)
+ apply(subst k0)
+ apply(subst (2) k0)
+ apply(subst flts_qq)
+ apply(auto)[1]
+ apply(auto)[1]
+ apply (metis append_Cons append_Nil bsimp_AALTs.simps(3) good.simps(1) k0b)
+ apply force+
+ apply (metis (no_types, lifting) add_Suc add_Suc_right asize.simps(5) bsimp.simps(1) bsimp_ASEQ.simps(19) less_add_Suc1 less_add_Suc2)
+ apply (metis add_Suc add_Suc_right arexp.distinct(5) arexp.distinct(7) asize.simps(4) asize.simps(5) bsimp.simps(1) bsimp.simps(2) bsimp_ASEQ1 good.simps(21) good.simps(8) less_add_Suc1 less_add_Suc2)
+ apply force+
+ apply (metis (no_types, lifting) add_Suc add_Suc_right arexp.distinct(5) arexp.distinct(7) asize.simps(4) asize.simps(5) bsimp.simps(1) bsimp.simps(2) bsimp_ASEQ1 good.simps(25) good.simps(8) less_add_Suc1 less_add_Suc2)
+ apply (metis add_Suc add_Suc_right arexp.distinct(7) asize.simps(4) bsimp.simps(2) bsimp_ASEQ1 good.simps(26) good.simps(8) less_add_Suc1 less_add_Suc2)
+ apply force+
+ done
+
+lemma test2:
+ assumes "good r"
+ shows "bsimp r = r"
+ using assms
+ apply(induct r taking: "asize" rule: measure_induct)
+ apply(case_tac x)
+ apply(simp_all)
+ defer
+ (* AALT case *)
+ apply(subgoal_tac "1 < length x52")
+ prefer 2
+ apply(case_tac x52)
+ apply(simp)
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ apply(simp)
+ apply(subst bsimp_AALTs_qq)
+ prefer 2
+ apply(subst flts_qq)
+ apply(auto)[1]
+ apply(auto)[1]
+ apply(case_tac x52)
+ apply(simp)
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ apply(simp)
+ apply(auto)[1]
+ apply (metis (no_types, lifting) bsimp_AALTs.elims good.simps(6) length_Cons length_pos_if_in_set list.size(3) nat_neq_iff)
+ apply(simp)
+ apply(case_tac x52)
+ apply(simp)
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ apply(simp)
+ apply(subst k0)
+ apply(simp)
+ apply(subst (2) k0)
+ apply(simp)
+ apply (simp add: Suc_lessI flts1 one_is_add)
+ (* SEQ case *)
+ apply(case_tac "bsimp x42 = AZERO")
+ apply simp
+ apply (metis asize.elims good.simps(10) good.simps(11) good.simps(12) good.simps(2) good.simps(7) good.simps(9) good_SEQ less_add_Suc1)
+ apply(case_tac "\<exists>bs'. bsimp x42 = AONE bs'")
+ apply(auto)[1]
+ defer
+ apply(case_tac "bsimp x43 = AZERO")
+ apply(simp)
+ apply (metis bsimp.elims bsimp.simps(3) good.simps(10) good.simps(11) good.simps(12) good.simps(8) good.simps(9) good_SEQ less_add_Suc2)
+ apply(auto)
+ apply (subst bsimp_ASEQ1)
+ apply(auto)[3]
+ apply(auto)[1]
+ apply (metis bsimp.simps(3) good.simps(2) good_SEQ less_add_Suc1)
+ apply (metis bsimp.simps(3) good.simps(2) good_SEQ less_add_Suc1 less_add_Suc2)
+ apply (subst bsimp_ASEQ2)
+ apply(drule_tac x="x42" in spec)
+ apply(drule mp)
+ apply(simp)
+ apply(drule mp)
+ apply (metis bsimp.elims bsimp.simps(3) good.simps(10) good.simps(11) good.simps(2) good_SEQ)
+ apply(simp)
+ done
+
+
+lemma bsimp_idem:
+ shows "bsimp (bsimp r) = bsimp r"
+ using test good1
+ by force
+
+
+lemma q3a:
+ assumes "\<exists>r \<in> set rs. bnullable r"
+ shows "bmkeps (AALTs bs (map (fuse bs1) rs)) = bmkeps (AALTs (bs@bs1) rs)"
+ using assms
+ apply(induct rs arbitrary: bs bs1)
+ apply(simp)
+ apply(simp)
+ apply(auto)
+ apply (metis append_assoc b2 bnullable_correctness erase_fuse r0)
+ apply(case_tac "bnullable a")
+ apply (metis append.assoc b2 bnullable_correctness erase_fuse r0)
+ apply(case_tac rs)
+ apply(simp)
+ apply(simp)
+ apply(auto)[1]
+ apply (metis bnullable_correctness erase_fuse)+
+ done
+
+lemma qq4:
+ assumes "\<exists>x\<in>set list. bnullable x"
+ shows "\<exists>x\<in>set (flts list). bnullable x"
+ using assms
+ apply(induct list rule: flts.induct)
+ apply(auto)
+ by (metis UnCI bnullable_correctness erase_fuse imageI)
+
+
+lemma qs3:
+ assumes "\<exists>r \<in> set rs. bnullable r"
+ shows "bmkeps (AALTs bs rs) = bmkeps (AALTs bs (flts rs))"
+ using assms
+ apply(induct rs arbitrary: bs taking: size rule: measure_induct)
+ apply(case_tac x)
+ apply(simp)
+ apply(simp)
+ apply(case_tac a)
+ apply(simp)
+ apply (simp add: r1)
+ apply(simp)
+ apply (simp add: r0)
+ apply(simp)
+ apply(case_tac "flts list")
+ apply(simp)
+ apply (metis L_erase_AALTs L_erase_flts L_flat_Prf1 L_flat_Prf2 Prf_elims(1) bnullable_correctness erase.simps(4) mkeps_nullable r2)
+ apply(simp)
+ apply (simp add: r1)
+ prefer 3
+ apply(simp)
+ apply (simp add: r0)
+ prefer 2
+ apply(simp)
+ apply(case_tac "\<exists>x\<in>set x52. bnullable x")
+ apply(case_tac "list")
+ apply(simp)
+ apply (metis b2 fuse.simps(4) q3a r2)
+ apply(erule disjE)
+ apply(subst qq1)
+ apply(auto)[1]
+ apply (metis bnullable_correctness erase_fuse)
+ apply(simp)
+ apply (metis b2 fuse.simps(4) q3a r2)
+ apply(simp)
+ apply(auto)[1]
+ apply(subst qq1)
+ apply (metis bnullable_correctness erase_fuse image_eqI set_map)
+ apply (metis b2 fuse.simps(4) q3a r2)
+ apply(subst qq1)
+ apply (metis bnullable_correctness erase_fuse image_eqI set_map)
+ apply (metis b2 fuse.simps(4) q3a r2)
+ apply(simp)
+ apply(subst qq2)
+ apply (metis bnullable_correctness erase_fuse imageE set_map)
+ prefer 2
+ apply(case_tac "list")
+ apply(simp)
+ apply(simp)
+ apply (simp add: qq4)
+ apply(simp)
+ apply(auto)
+ apply(case_tac list)
+ apply(simp)
+ apply(simp)
+ apply (simp add: r0)
+ apply(case_tac "bnullable (ASEQ x41 x42 x43)")
+ apply(case_tac list)
+ apply(simp)
+ apply(simp)
+ apply (simp add: r0)
+ apply(simp)
+ using qq4 r1 r2 by auto
+
+
+
+lemma k1:
+ assumes "\<And>x2aa. \<lbrakk>x2aa \<in> set x2a; bnullable x2aa\<rbrakk> \<Longrightarrow> bmkeps x2aa = bmkeps (bsimp x2aa)"
+ "\<exists>x\<in>set x2a. bnullable x"
+ shows "bmkeps (AALTs x1 (flts x2a)) = bmkeps (AALTs x1 (flts (map bsimp x2a)))"
+ using assms
+ apply(induct x2a)
+ apply fastforce
+ apply(simp)
+ apply(subst k0)
+ apply(subst (2) k0)
+ apply(auto)[1]
+ apply (metis b3 k0 list.set_intros(1) qs3 r0)
+ by (smt b3 imageI insert_iff k0 list.set(2) qq3 qs3 r0 r1 set_map)
+
+
+
+lemma bmkeps_simp:
+ assumes "bnullable r"
+ shows "bmkeps r = bmkeps (bsimp r)"
+ using assms
+ apply(induct r)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 3
+ apply(simp)
+ apply(case_tac "bsimp r1 = AZERO")
+ apply(simp)
+ apply(auto)[1]
+ apply (metis L_bsimp_erase L_flat_Prf1 L_flat_Prf2 Prf_elims(1) bnullable_correctness erase.simps(1) mkeps_nullable)
+ apply(case_tac "bsimp r2 = AZERO")
+ apply(simp)
+ apply(auto)[1]
+ apply (metis L_bsimp_erase L_flat_Prf1 L_flat_Prf2 Prf_elims(1) bnullable_correctness erase.simps(1) mkeps_nullable)
+ apply(case_tac "\<exists>bs. bsimp r1 = AONE bs")
+ apply(auto)[1]
+ apply(subst b1)
+ apply(subst b2)
+ apply(simp add: b3[symmetric])
+ apply(simp)
+ apply(subgoal_tac "bsimp_ASEQ x1 (bsimp r1) (bsimp r2) = ASEQ x1 (bsimp r1) (bsimp r2)")
+ prefer 2
+ apply (smt b3 bnullable.elims(2) bsimp_ASEQ.simps(17) bsimp_ASEQ.simps(19) bsimp_ASEQ.simps(20) bsimp_ASEQ.simps(21) bsimp_ASEQ.simps(22) bsimp_ASEQ.simps(24) bsimp_ASEQ.simps(25) bsimp_ASEQ.simps(26) bsimp_ASEQ.simps(27) bsimp_ASEQ.simps(29) bsimp_ASEQ.simps(30) bsimp_ASEQ.simps(31))
+ apply(simp)
+ apply(simp)
+ thm q3
+ apply(subst q3[symmetric])
+ apply simp
+ using b3 qq4 apply auto[1]
+ apply(subst qs3)
+ apply simp
+ using k1 by blast
+
+thm bmkeps_retrieve bmkeps_simp bder_retrieve
+
+lemma bmkeps_bder_AALTs:
+ assumes "\<exists>r \<in> set rs. bnullable (bder c r)"
+ shows "bmkeps (bder c (bsimp_AALTs bs rs)) = bmkeps (bsimp_AALTs bs (map (bder c) rs))"
+ using assms
+ apply(induct rs)
+ apply(simp)
+ apply(simp)
+ apply(auto)
+ apply(case_tac rs)
+ apply(simp)
+ apply (metis (full_types) Prf_injval bder_retrieve bmkeps_retrieve bnullable_correctness erase_bder erase_fuse mkeps_nullable retrieve_fuse2)
+ apply(simp)
+ apply(case_tac rs)
+ apply(simp_all)
+ done
+
+lemma bbs0:
+ shows "blexer_simp r [] = blexer r []"
+ apply(simp add: blexer_def blexer_simp_def)
+ done
+
+lemma bbs1:
+ shows "blexer_simp r [c] = blexer r [c]"
+ apply(simp add: blexer_def blexer_simp_def)
+ apply(auto)
+ defer
+ using b3 apply auto[1]
+ using b3 apply auto[1]
+ apply(subst bmkeps_simp[symmetric])
+ apply(simp)
+ apply(simp)
+ done
+
+lemma oo:
+ shows "(case (blexer (der c r) s) of None \<Rightarrow> None | Some v \<Rightarrow> Some (injval r c v)) = blexer r (c # s)"
+ apply(simp add: blexer_correctness)
+ done
+
+
+lemma bder_fuse:
+ shows "bder c (fuse bs a) = fuse bs (bder c a)"
+ apply(induct a arbitrary: bs c)
+ apply(simp_all)
+ done
+
+lemma XXX2_helper:
+ assumes "\<forall>y. asize y < Suc (sum_list (map asize rs)) \<longrightarrow> good y \<longrightarrow> bsimp y = y"
+ "\<forall>r'\<in>set rs. good r' \<and> nonalt r'"
+ shows "flts (map (bsimp \<circ> bder c) (flts (map bsimp rs))) = flts (map (bsimp \<circ> bder c) rs)"
+ using assms
+ apply(induct rs arbitrary: c)
+ apply(simp)
+ apply(simp)
+ apply(subst k0)
+ apply(simp add: flts_append)
+ apply(subst (2) k0)
+ apply(simp add: flts_append)
+ apply(subgoal_tac "flts [a] = [a]")
+ prefer 2
+ using good.simps(1) k0b apply blast
+ apply(simp)
+ done
+
+lemma bmkeps_good:
+ assumes "good a"
+ shows "bmkeps (bsimp a) = bmkeps a"
+ using assms
+ using test2 by auto
+
+
+lemma xxx_bder:
+ assumes "good r"
+ shows "L (erase r) \<noteq> {}"
+ using assms
+ apply(induct r rule: good.induct)
+ apply(auto simp add: Sequ_def)
+ done
+
+lemma xxx_bder2:
+ assumes "L (erase (bsimp r)) = {}"
+ shows "bsimp r = AZERO"
+ using assms xxx_bder test2 good1
+ by blast
+
+lemma XXX2aa:
+ assumes "good a"
+ shows "bsimp (bder c (bsimp a)) = bsimp (bder c a)"
+ using assms
+ by (simp add: test2)
+
+lemma XXX2aa_ders:
+ assumes "good a"
+ shows "bsimp (bders (bsimp a) s) = bsimp (bders a s)"
+ using assms
+ by (simp add: test2)
+
+lemma XXX4a:
+ shows "good (bders_simp (bsimp r) s) \<or> bders_simp (bsimp r) s = AZERO"
+ apply(induct s arbitrary: r rule: rev_induct)
+ apply(simp)
+ apply (simp add: good1)
+ apply(simp add: bders_simp_append)
+ apply (simp add: good1)
+ done
+
+lemma XXX4a_good:
+ assumes "good a"
+ shows "good (bders_simp a s) \<or> bders_simp a s = AZERO"
+ using assms
+ apply(induct s arbitrary: a rule: rev_induct)
+ apply(simp)
+ apply(simp add: bders_simp_append)
+ apply (simp add: good1)
+ done
+
+lemma XXX4a_good_cons:
+ assumes "s \<noteq> []"
+ shows "good (bders_simp a s) \<or> bders_simp a s = AZERO"
+ using assms
+ apply(case_tac s)
+ apply(auto)
+ using XXX4a by blast
+
+lemma XXX4b:
+ assumes "good a" "L (erase (bders_simp a s)) \<noteq> {}"
+ shows "good (bders_simp a s)"
+ using assms
+ apply(induct s arbitrary: a)
+ apply(simp)
+ apply(simp)
+ apply(subgoal_tac "L (erase (bder a aa)) = {} \<or> L (erase (bder a aa)) \<noteq> {}")
+ prefer 2
+ apply(auto)[1]
+ apply(erule disjE)
+ apply(subgoal_tac "bsimp (bder a aa) = AZERO")
+ prefer 2
+ using L_bsimp_erase xxx_bder2 apply auto[1]
+ apply(simp)
+ apply (metis L.simps(1) XXX4a erase.simps(1))
+ apply(drule_tac x="bsimp (bder a aa)" in meta_spec)
+ apply(drule meta_mp)
+ apply simp
+ apply(rule good1a)
+ apply(auto)
+ done
+
+lemma bders_AZERO:
+ shows "bders AZERO s = AZERO"
+ and "bders_simp AZERO s = AZERO"
+ apply (induct s)
+ apply(auto)
+ done
+
+lemma LA:
+ assumes "\<Turnstile> v : ders s (erase r)"
+ shows "retrieve (bders r s) v = retrieve r (flex (erase r) id s v)"
+ using assms
+ apply(induct s arbitrary: r v rule: rev_induct)
+ apply(simp)
+ apply(simp add: bders_append ders_append)
+ apply(subst bder_retrieve)
+ apply(simp)
+ apply(drule Prf_injval)
+ by (simp add: flex_append)
+
+
+lemma LB:
+ assumes "s \<in> (erase r) \<rightarrow> v"
+ shows "retrieve r v = retrieve r (flex (erase r) id s (mkeps (ders s (erase r))))"
+ using assms
+ apply(induct s arbitrary: r v rule: rev_induct)
+ apply(simp)
+ apply(subgoal_tac "v = mkeps (erase r)")
+ prefer 2
+ apply (simp add: Posix1(1) Posix_determ Posix_mkeps nullable_correctness)
+ apply(simp)
+ apply(simp add: flex_append ders_append)
+ by (metis Posix_determ Posix_flex Posix_injval Posix_mkeps ders_snoc lexer_correctness(2) lexer_flex)
+
+lemma LB_sym:
+ assumes "s \<in> (erase r) \<rightarrow> v"
+ shows "retrieve r v = retrieve r (flex (erase r) id s (mkeps (erase (bders r s))))"
+ using assms
+ by (simp add: LB)
+
+
+lemma LC:
+ assumes "s \<in> (erase r) \<rightarrow> v"
+ shows "retrieve r v = retrieve (bders r s) (mkeps (erase (bders r s)))"
+ apply(simp)
+ by (metis LA LB Posix1(1) assms lexer_correct_None lexer_flex mkeps_nullable)
+
+
+lemma L0:
+ assumes "bnullable a"
+ shows "retrieve (bsimp a) (mkeps (erase (bsimp a))) = retrieve a (mkeps (erase a))"
+ using assms
+ by (metis b3 bmkeps_retrieve bmkeps_simp bnullable_correctness)
+
+thm bmkeps_retrieve
+
+lemma L0a:
+ assumes "s \<in> L(erase a)"
+ shows "retrieve (bsimp (bders a s)) (mkeps (erase (bsimp (bders a s)))) =
+ retrieve (bders a s) (mkeps (erase (bders a s)))"
+ using assms
+ by (metis L0 bnullable_correctness erase_bders lexer_correct_None lexer_flex)
+
+lemma L0aa:
+ assumes "s \<in> L (erase a)"
+ shows "[] \<in> erase (bsimp (bders a s)) \<rightarrow> mkeps (erase (bsimp (bders a s)))"
+ using assms
+ by (metis Posix_mkeps b3 bnullable_correctness erase_bders lexer_correct_None lexer_flex)
+
+lemma L0aaa:
+ assumes "[c] \<in> L (erase a)"
+ shows "[c] \<in> (erase a) \<rightarrow> flex (erase a) id [c] (mkeps (erase (bder c a)))"
+ using assms
+ by (metis bders.simps(1) bders.simps(2) erase_bders lexer_correct_None lexer_correct_Some lexer_flex option.inject)
+
+lemma L0aaaa:
+ assumes "[c] \<in> L (erase a)"
+ shows "[c] \<in> (erase a) \<rightarrow> flex (erase a) id [c] (mkeps (erase (bders a [c])))"
+ using assms
+ using L0aaa by auto
+
+
+lemma L02:
+ assumes "bnullable (bder c a)"
+ shows "retrieve (bsimp a) (flex (erase (bsimp a)) id [c] (mkeps (erase (bder c (bsimp a))))) =
+ retrieve (bder c (bsimp a)) (mkeps (erase (bder c (bsimp a))))"
+ using assms
+ apply(simp)
+ using bder_retrieve L0 bmkeps_simp bmkeps_retrieve L0 LA LB
+ apply(subst bder_retrieve[symmetric])
+ apply (metis L_bsimp_erase bnullable_correctness der_correctness erase_bder mkeps_nullable nullable_correctness)
+ apply(simp)
+ done
+
+lemma L02_bders:
+ assumes "bnullable (bders a s)"
+ shows "retrieve (bsimp a) (flex (erase (bsimp a)) id s (mkeps (erase (bders (bsimp a) s)))) =
+ retrieve (bders (bsimp a) s) (mkeps (erase (bders (bsimp a) s)))"
+ using assms
+ by (metis LA L_bsimp_erase bnullable_correctness ders_correctness erase_bders mkeps_nullable nullable_correctness)
+
+
+
+
+lemma L03:
+ assumes "bnullable (bder c a)"
+ shows "retrieve (bder c (bsimp a)) (mkeps (erase (bder c (bsimp a)))) =
+ bmkeps (bsimp (bder c (bsimp a)))"
+ using assms
+ by (metis L0 L_bsimp_erase bmkeps_retrieve bnullable_correctness der_correctness erase_bder nullable_correctness)
+
+lemma L04:
+ assumes "bnullable (bder c a)"
+ shows "retrieve (bder c (bsimp a)) (mkeps (erase (bder c (bsimp a)))) =
+ retrieve (bsimp (bder c (bsimp a))) (mkeps (erase (bsimp (bder c (bsimp a)))))"
+ using assms
+ by (metis L0 L_bsimp_erase bnullable_correctness der_correctness erase_bder nullable_correctness)
+
+lemma L05:
+ assumes "bnullable (bder c a)"
+ shows "retrieve (bder c (bsimp a)) (mkeps (erase (bder c (bsimp a)))) =
+ retrieve (bsimp (bder c (bsimp a))) (mkeps (erase (bsimp (bder c (bsimp a)))))"
+ using assms
+ using L04 by auto
+
+lemma L06:
+ assumes "bnullable (bder c a)"
+ shows "bmkeps (bder c (bsimp a)) = bmkeps (bsimp (bder c (bsimp a)))"
+ using assms
+ by (metis L03 L_bsimp_erase bmkeps_retrieve bnullable_correctness der_correctness erase_bder nullable_correctness)
+
+lemma L07:
+ assumes "s \<in> L (erase r)"
+ shows "retrieve r (flex (erase r) id s (mkeps (ders s (erase r))))
+ = retrieve (bders r s) (mkeps (erase (bders r s)))"
+ using assms
+ using LB LC lexer_correct_Some by auto
+
+lemma LXXX:
+ assumes "s \<in> (erase r) \<rightarrow> v" "s \<in> (erase (bsimp r)) \<rightarrow> v'"
+ shows "retrieve r v = retrieve (bsimp r) v'"
+ using assms
+ apply -
+ thm LC
+ apply(subst LC)
+ apply(assumption)
+ apply(subst L0[symmetric])
+ using bnullable_correctness lexer_correctness(2) lexer_flex apply fastforce
+ apply(subst (2) LC)
+ apply(assumption)
+ apply(subst (2) L0[symmetric])
+ using bnullable_correctness lexer_correctness(2) lexer_flex apply fastforce
+
+ oops
+
+
+lemma L07a:
+ assumes "s \<in> L (erase r)"
+ shows "retrieve (bsimp r) (flex (erase (bsimp r)) id s (mkeps (ders s (erase (bsimp r)))))
+ = retrieve r (flex (erase r) id s (mkeps (ders s (erase r))))"
+ using assms
+ apply(induct s arbitrary: r)
+ apply(simp)
+ using L0a apply force
+ apply(drule_tac x="(bder a r)" in meta_spec)
+ apply(drule meta_mp)
+ apply (metis L_bsimp_erase erase_bder lexer.simps(2) lexer_correct_None option.case(1))
+ apply(drule sym)
+ apply(simp)
+ apply(subst (asm) bder_retrieve)
+ apply (metis Posix_Prf Posix_flex Posix_mkeps ders.simps(2) lexer_correct_None lexer_flex)
+ apply(simp only: flex_fun_apply)
+ apply(simp)
+ using L0[no_vars] bder_retrieve[no_vars] LA[no_vars] LC[no_vars] L07[no_vars]
+ oops
+
+lemma L08:
+ assumes "s \<in> L (erase r)"
+ shows "retrieve (bders (bsimp r) s) (mkeps (erase (bders (bsimp r) s)))
+ = retrieve (bders r s) (mkeps (erase (bders r s)))"
+ using assms
+ apply(induct s arbitrary: r)
+ apply(simp)
+ using L0 bnullable_correctness nullable_correctness apply blast
+ apply(simp add: bders_append)
+ apply(drule_tac x="(bder a (bsimp r))" in meta_spec)
+ apply(drule meta_mp)
+ apply (metis L_bsimp_erase erase_bder lexer.simps(2) lexer_correct_None option.case(1))
+ apply(drule sym)
+ apply(simp)
+ apply(subst LA)
+ apply (metis L0aa L_bsimp_erase Posix1(1) ders.simps(2) ders_correctness erase_bder erase_bders mkeps_nullable nullable_correctness)
+ apply(subst LA)
+ using lexer_correct_None lexer_flex mkeps_nullable apply force
+
+ using L0[no_vars] bder_retrieve[no_vars] LA[no_vars] LC[no_vars] L07[no_vars]
+
+thm L0[no_vars] bder_retrieve[no_vars] LA[no_vars] LC[no_vars] L07[no_vars]
+ oops
+
+lemma test:
+ assumes "s = [c]"
+ shows "retrieve (bders r s) v = XXX" and "YYY = retrieve r (flex (erase r) id s v)"
+ using assms
+ apply(simp only: bders.simps)
+ defer
+ using assms
+ apply(simp only: flex.simps id_simps)
+ using L0[no_vars] bder_retrieve[no_vars] LA[no_vars] LC[no_vars]
+ find_theorems "retrieve (bders _ _) _"
+ find_theorems "retrieve _ (mkeps _)"
+ oops
+
+lemma L06X:
+ assumes "bnullable (bder c a)"
+ shows "bmkeps (bder c (bsimp a)) = bmkeps (bder c a)"
+ using assms
+ apply(induct a arbitrary: c)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 3
+ apply(simp)
+ prefer 2
+ apply(simp)
+
+ defer
+ oops
+
+lemma L06_2:
+ assumes "bnullable (bders a [c,d])"
+ shows "bmkeps (bders (bsimp a) [c,d]) = bmkeps (bsimp (bders (bsimp a) [c,d]))"
+ using assms
+ apply(simp)
+ by (metis L_bsimp_erase bmkeps_simp bnullable_correctness der_correctness erase_bder nullable_correctness)
+
+lemma L06_bders:
+ assumes "bnullable (bders a s)"
+ shows "bmkeps (bders (bsimp a) s) = bmkeps (bsimp (bders (bsimp a) s))"
+ using assms
+ by (metis L_bsimp_erase bmkeps_simp bnullable_correctness ders_correctness erase_bders nullable_correctness)
+
+lemma LLLL:
+ shows "L (erase a) = L (erase (bsimp a))"
+ and "L (erase a) = {flat v | v. \<Turnstile> v: (erase a)}"
+ and "L (erase a) = {flat v | v. \<Turnstile> v: (erase (bsimp a))}"
+ using L_bsimp_erase apply(blast)
+ apply (simp add: L_flat_Prf)
+ using L_bsimp_erase L_flat_Prf apply(auto)[1]
+ done
+
+
+
+lemma L07XX:
+ assumes "s \<in> L (erase a)"
+ shows "s \<in> erase a \<rightarrow> flex (erase a) id s (mkeps (ders s (erase a)))"
+ using assms
+ by (meson lexer_correct_None lexer_correctness(1) lexer_flex)
+
+lemma LX0:
+ assumes "s \<in> L r"
+ shows "decode (bmkeps (bders (intern r) s)) r = Some(flex r id s (mkeps (ders s r)))"
+ by (metis assms blexer_correctness blexer_def lexer_correct_None lexer_flex)
+
+
+lemma L02_bders2:
+ assumes "bnullable (bders a s)" "s = [c]"
+ shows "retrieve (bders (bsimp a) s) (mkeps (erase (bders (bsimp a) s))) =
+ retrieve (bders a s) (mkeps (erase (bders a s)))"
+ using assms
+ apply(simp)
+
+ apply(induct s arbitrary: a)
+ apply(simp)
+ using L0 apply auto[1]
+ oops
+
+thm bmkeps_retrieve bmkeps_simp Posix_mkeps
+
+lemma WQ1:
+ assumes "s \<in> L (der c r)"
+ shows "s \<in> der c r \<rightarrow> mkeps (ders s (der c r))"
+ using assms
+ oops
+
+lemma L02_bsimp:
+ assumes "bnullable (bders a s)"
+ shows "retrieve (bsimp a) (flex (erase (bsimp a)) id s (mkeps (erase (bders (bsimp a) s)))) =
+ retrieve a (flex (erase a) id s (mkeps (erase (bders a s))))"
+ using assms
+ apply(induct s arbitrary: a)
+ apply(simp)
+ apply (simp add: L0)
+ apply(simp)
+ apply(drule_tac x="bder a aa" in meta_spec)
+ apply(simp)
+ apply(subst (asm) bder_retrieve)
+ using Posix_Prf Posix_flex Posix_mkeps bnullable_correctness apply fastforce
+ apply(simp add: flex_fun_apply)
+ apply(drule sym)
+ apply(simp)
+ apply(subst flex_injval)
+ apply(subst bder_retrieve[symmetric])
+ apply (metis L_bsimp_erase Posix_Prf Posix_flex Posix_mkeps bders.simps(2) bnullable_correctness ders.simps(2) erase_bders lexer_correct_None lexer_flex option.distinct(1))
+ apply(simp only: erase_bder[symmetric] erase_bders[symmetric])
+ apply(subst LB_sym[symmetric])
+ apply(simp)
+ oops
+
+lemma L1:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "decode (bmkeps (bders (intern r) s)) r = Some v"
+ using assms
+ by (metis blexer_correctness blexer_def lexer_correctness(1) option.distinct(1))
+
+lemma L2:
+ assumes "s \<in> (der c r) \<rightarrow> v"
+ shows "decode (bmkeps (bders (intern r) (c # s))) r = Some (injval r c v)"
+ using assms
+ apply(subst bmkeps_retrieve)
+ using Posix1(1) lexer_correct_None lexer_flex apply fastforce
+ using MAIN_decode
+ apply(subst MAIN_decode[symmetric])
+ apply(simp)
+ apply (meson Posix1(1) lexer_correct_None lexer_flex mkeps_nullable)
+ apply(simp)
+ apply(subgoal_tac "v = flex (der c r) id s (mkeps (ders s (der c r)))")
+ prefer 2
+ apply (metis Posix_determ lexer_correctness(1) lexer_flex option.distinct(1))
+ apply(simp)
+ apply(subgoal_tac "injval r c (flex (der c r) id s (mkeps (ders s (der c r)))) =
+ (flex (der c r) ((\<lambda>v. injval r c v) o id) s (mkeps (ders s (der c r))))")
+ apply(simp)
+ using flex_fun_apply by blast
+
+lemma L3:
+ assumes "s2 \<in> (ders s1 r) \<rightarrow> v"
+ shows "decode (bmkeps (bders (intern r) (s1 @ s2))) r = Some (flex r id s1 v)"
+ using assms
+ apply(induct s1 arbitrary: r s2 v rule: rev_induct)
+ apply(simp)
+ using L1 apply blast
+ apply(simp add: ders_append)
+ apply(drule_tac x="r" in meta_spec)
+ apply(drule_tac x="x # s2" in meta_spec)
+ apply(drule_tac x="injval (ders xs r) x v" in meta_spec)
+ apply(drule meta_mp)
+ defer
+ apply(simp)
+ apply(simp add: flex_append)
+ by (simp add: Posix_injval)
+
+
+
+lemma bders_snoc:
+ "bder c (bders a s) = bders a (s @ [c])"
+ apply(simp add: bders_append)
+ done
+
+
+lemma QQ1:
+ shows "bsimp (bders (bsimp a) []) = bders_simp (bsimp a) []"
+ apply(simp)
+ apply(simp add: bsimp_idem)
+ done
+
+lemma QQ2:
+ shows "bsimp (bders (bsimp a) [c]) = bders_simp (bsimp a) [c]"
+ apply(simp)
+ done
+
+lemma XXX2a_long:
+ assumes "good a"
+ shows "bsimp (bder c (bsimp a)) = bsimp (bder c a)"
+ using assms
+ apply(induct a arbitrary: c taking: asize rule: measure_induct)
+ apply(case_tac x)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 3
+ apply(simp)
+ apply(simp)
+ apply(auto)[1]
+apply(case_tac "x42 = AZERO")
+ apply(simp)
+ apply(case_tac "x43 = AZERO")
+ apply(simp)
+ using test2 apply force
+ apply(case_tac "\<exists>bs. x42 = AONE bs")
+ apply(clarify)
+ apply(simp)
+ apply(subst bsimp_ASEQ1)
+ apply(simp)
+ using b3 apply force
+ using bsimp_ASEQ0 test2 apply force
+ thm good_SEQ test2
+ apply (simp add: good_SEQ test2)
+ apply (simp add: good_SEQ test2)
+ apply(case_tac "x42 = AZERO")
+ apply(simp)
+ apply(case_tac "x43 = AZERO")
+ apply(simp)
+ apply (simp add: bsimp_ASEQ0)
+ apply(case_tac "\<exists>bs. x42 = AONE bs")
+ apply(clarify)
+ apply(simp)
+ apply(subst bsimp_ASEQ1)
+ apply(simp)
+ using bsimp_ASEQ0 test2 apply force
+ apply (simp add: good_SEQ test2)
+ apply (simp add: good_SEQ test2)
+ apply (simp add: good_SEQ test2)
+ (* AALTs case *)
+ apply(simp)
+ using test2 by fastforce
+
+lemma XXX2a_long_without_good:
+ assumes "a = AALTs bs0 [AALTs bs1 [AALTs bs2 [ASTAR [] (AONE bs7), AONE bs6, ASEQ bs3 (ACHAR bs4 d) (AONE bs5)]]]"
+ shows "bsimp (bder c (bsimp a)) = bsimp (bder c a)"
+ "bsimp (bder c (bsimp a)) = XXX"
+ "bsimp (bder c a) = YYY"
+ using assms
+ apply(simp)
+ using assms
+ apply(simp)
+ prefer 2
+ using assms
+ apply(simp)
+ oops
+
+lemma bder_bsimp_AALTs:
+ shows "bder c (bsimp_AALTs bs rs) = bsimp_AALTs bs (map (bder c) rs)"
+ apply(induct bs rs rule: bsimp_AALTs.induct)
+ apply(simp)
+ apply(simp)
+ apply (simp add: bder_fuse)
+ apply(simp)
+ done
+
+lemma flts_nothing:
+ assumes "\<forall>r \<in> set rs. r \<noteq> AZERO" "\<forall>r \<in> set rs. nonalt r"
+ shows "flts rs = rs"
+ using assms
+ apply(induct rs rule: flts.induct)
+ apply(auto)
+ done
+
+lemma flts_flts:
+ assumes "\<forall>r \<in> set rs. good r"
+ shows "flts (flts rs) = flts rs"
+ using assms
+ apply(induct rs taking: "\<lambda>rs. sum_list (map asize rs)" rule: measure_induct)
+ apply(case_tac x)
+ apply(simp)
+ apply(simp)
+ apply(case_tac a)
+ apply(simp_all add: bder_fuse flts_append)
+ apply(subgoal_tac "\<forall>r \<in> set x52. r \<noteq> AZERO")
+ prefer 2
+ apply (metis Nil_is_append_conv bsimp_AALTs.elims good.simps(1) good.simps(5) good0 list.distinct(1) n0 nn1b split_list_last test2)
+ apply(subgoal_tac "\<forall>r \<in> set x52. nonalt r")
+ prefer 2
+ apply (metis n0 nn1b test2)
+ by (metis flts_fuse flts_nothing)
+
+
+lemma PP:
+ assumes "bnullable (bders r s)"
+ shows "bmkeps (bders (bsimp r) s) = bmkeps (bders r s)"
+ using assms
+ apply(induct s arbitrary: r)
+ apply(simp)
+ using bmkeps_simp apply auto[1]
+ apply(simp add: bders_append bders_simp_append)
+ oops
+
+lemma PP:
+ assumes "bnullable (bders r s)"
+ shows "bmkeps (bders_simp (bsimp r) s) = bmkeps (bders r s)"
+ using assms
+ apply(induct s arbitrary: r rule: rev_induct)
+ apply(simp)
+ using bmkeps_simp apply auto[1]
+ apply(simp add: bders_append bders_simp_append)
+ apply(drule_tac x="bder a (bsimp r)" in meta_spec)
+ apply(drule_tac meta_mp)
+ defer
+ oops
+
+
+lemma
+ assumes "asize (bsimp a) = asize a" "a = AALTs bs [AALTs bs2 [], AZERO, AONE bs3]"
+ shows "bsimp a = a"
+ using assms
+ apply(simp)
+ oops
+
+
+lemma iii:
+ assumes "bsimp_AALTs bs rs \<noteq> AZERO"
+ shows "rs \<noteq> []"
+ using assms
+ apply(induct bs rs rule: bsimp_AALTs.induct)
+ apply(auto)
+ done
+
+lemma
+ assumes "\<forall>y. asize y < Suc (sum_list (map asize x52)) \<longrightarrow> asize (bsimp y) = asize y \<longrightarrow> bsimp y \<noteq> AZERO \<longrightarrow> bsimp y = y"
+ "asize (bsimp_AALTs x51 (flts (map bsimp x52))) = Suc (sum_list (map asize x52))"
+ "bsimp_AALTs x51 (flts (map bsimp x52)) \<noteq> AZERO"
+ shows "bsimp_AALTs x51 (flts (map bsimp x52)) = AALTs x51 x52"
+ using assms
+ apply(induct x52 arbitrary: x51)
+ apply(simp)
+ oops
+
+
+lemma
+ assumes "asize (bsimp a) = asize a" "bsimp a \<noteq> AZERO"
+ shows "bsimp a = a"
+ using assms
+ apply(induct a taking: asize rule: measure_induct)
+ apply(case_tac x)
+ apply(simp_all)
+ apply(case_tac "(bsimp x42) = AZERO")
+ apply(simp add: asize0)
+ apply(case_tac "(bsimp x43) = AZERO")
+ apply(simp add: asize0)
+ apply (metis bsimp_ASEQ0)
+ apply(case_tac "\<exists>bs. (bsimp x42) = AONE bs")
+ apply(auto)[1]
+ apply (metis b1 bsimp_size fuse_size less_add_Suc2 not_less)
+ apply (metis Suc_inject add.commute asize.simps(5) bsimp_ASEQ1 bsimp_size leD le_neq_implies_less less_add_Suc2 less_add_eq_less)
+ (* ALT case *)
+ apply(frule iii)
+ apply(case_tac x52)
+ apply(simp)
+ apply(simp)
+ apply(subst k0)
+ apply(subst (asm) k0)
+ apply(subst (asm) (2) k0)
+ apply(subst (asm) (3) k0)
+ apply(case_tac "(bsimp a) = AZERO")
+ apply(simp)
+ apply (metis (no_types, lifting) Suc_le_lessD asize0 bsimp_AALTs_size le_less_trans less_add_same_cancel2 not_less_eq rt)
+ apply(simp)
+ apply(case_tac "nonalt (bsimp a)")
+ prefer 2
+ apply(drule_tac x="AALTs x51 (bsimp a # list)" in spec)
+ apply(drule mp)
+ apply (metis asize.simps(4) bsimp.simps(2) bsimp_AALTs_size3 k0 less_not_refl list.set_intros(1) list.simps(9) sum_list.Cons)
+ apply(drule mp)
+ apply(simp)
+ apply (metis asize.simps(4) bsimp.simps(2) bsimp_AALTs_size3 k0 lessI list.set_intros(1) list.simps(9) not_less_eq sum_list.Cons)
+ apply(drule mp)
+ apply(simp)
+ using bsimp_idem apply auto[1]
+ apply(simp add: bsimp_idem)
+ apply (metis append.left_neutral append_Cons asize.simps(4) bsimp.simps(2) bsimp_AALTs_size3 k00 less_not_refl list.set_intros(1) list.simps(9) sum_list.Cons)
+ apply (metis bsimp.simps(2) bsimp_idem k0 list.simps(9) nn1b nonalt.elims(3) nonnested.simps(2))
+ apply(subgoal_tac "flts [bsimp a] = [bsimp a]")
+ prefer 2
+ using k0b apply blast
+ apply(clarify)
+ apply(simp only:)
+ apply(simp)
+ apply(case_tac "flts (map bsimp list) = Nil")
+ apply (metis bsimp_AALTs1 bsimp_size fuse_size less_add_Suc1 not_less)
+ apply (subgoal_tac "bsimp_AALTs x51 (bsimp a # flts (map bsimp list)) = AALTs x51 (bsimp a # flts (map bsimp list))")
+ prefer 2
+ apply (metis bsimp_AALTs.simps(3) neq_Nil_conv)
+ apply(auto)
+ apply (metis add.commute bsimp_size leD le_neq_implies_less less_add_Suc1 less_add_eq_less rt)
+ oops
+
+
+
+
+lemma OOO:
+ shows "bsimp (bsimp_AALTs bs rs) = bsimp_AALTs bs (flts (map bsimp rs))"
+ apply(induct rs arbitrary: bs taking: "\<lambda>rs. sum_list (map asize rs)" rule: measure_induct)
+ apply(case_tac x)
+ apply(simp)
+ apply(simp)
+ apply(case_tac "a = AZERO")
+ apply(simp)
+ apply(case_tac "list")
+ apply(simp)
+ apply(simp)
+ apply(case_tac "bsimp a = AZERO")
+ apply(simp)
+ apply(case_tac "list")
+ apply(simp)
+ apply(simp add: bsimp_fuse[symmetric])
+ apply(simp)
+ apply(case_tac "nonalt (bsimp a)")
+ apply(case_tac list)
+ apply(simp)
+ apply(subst k0b)
+ apply(simp)
+ apply(simp)
+ apply(simp add: bsimp_fuse)
+ apply(simp)
+ apply(subgoal_tac "asize (bsimp a) < asize a \<or> asize (bsimp a) = asize a")
+ prefer 2
+ using bsimp_size le_neq_implies_less apply blast
+ apply(erule disjE)
+ apply(drule_tac x="(bsimp a) # list" in spec)
+ apply(drule mp)
+ apply(simp)
+ apply(simp)
+ apply (metis bsimp.simps(2) bsimp_AALTs.elims bsimp_AALTs.simps(2) bsimp_fuse bsimp_idem list.distinct(1) list.inject list.simps(9))
+ apply(subgoal_tac "\<exists>bs rs. bsimp a = AALTs bs rs \<and> rs \<noteq> Nil \<and> length rs > 1")
+ prefer 2
+ apply (metis bbbbs1 bsimp.simps(2) bsimp_AALTs.simps(1) bsimp_idem flts.simps(1) good.simps(5) good1 length_0_conv length_Suc_conv less_one list.simps(8) nat_neq_iff not_less_eq)
+ apply(auto)
+ oops
+
+
+lemma
+ assumes "rs = [AALTs bsa [AONE bsb, AONE bsb]]"
+ shows "bsimp (bsimp_AALTs bs rs) = bsimp_AALTs bs (flts (map bsimp rs))"
+ using assms
+ apply(simp)
+ oops
+
+
+
+lemma CT1:
+ shows "bsimp (AALTs bs as) = bsimp(AALTs bs (map bsimp as))"
+ apply(induct as arbitrary: bs)
+ apply(simp)
+ apply(simp)
+ by (simp add: bsimp_idem comp_def)
+
+lemma CT1a:
+ shows "bsimp (AALT bs a1 a2) = bsimp(AALT bs (bsimp a1) (bsimp a2))"
+ by (metis CT1 list.simps(8) list.simps(9))
+
+(* CT *)
+
+lemma CTU:
+ shows "bsimp_AALTs bs as = li bs as"
+ apply(induct bs as rule: li.induct)
+ apply(auto)
+ done
+
+
+
+lemma CTa:
+ assumes "\<forall>r \<in> set as. nonalt r \<and> r \<noteq> AZERO"
+ shows "flts as = as"
+ using assms
+ apply(induct as)
+ apply(simp)
+ apply(case_tac as)
+ apply(simp)
+ apply (simp add: k0b)
+ using flts_nothing by auto
+
+lemma CT0:
+ assumes "\<forall>r \<in> set as1. nonalt r \<and> r \<noteq> AZERO"
+ shows "flts [bsimp_AALTs bs1 as1] = flts (map (fuse bs1) as1)"
+ using assms CTa
+ apply(induct as1 arbitrary: bs1)
+ apply(simp)
+ apply(simp)
+ apply(case_tac as1)
+ apply(simp)
+ apply(simp)
+proof -
+fix a :: arexp and as1a :: "arexp list" and bs1a :: "bit list" and aa :: arexp and list :: "arexp list"
+ assume a1: "nonalt a \<and> a \<noteq> AZERO \<and> nonalt aa \<and> aa \<noteq> AZERO \<and> (\<forall>r\<in>set list. nonalt r \<and> r \<noteq> AZERO)"
+ assume a2: "\<And>as. \<forall>r\<in>set as. nonalt r \<and> r \<noteq> AZERO \<Longrightarrow> flts as = as"
+ assume a3: "as1a = aa # list"
+ have "flts [a] = [a]"
+using a1 k0b by blast
+then show "fuse bs1a a # fuse bs1a aa # map (fuse bs1a) list = flts (fuse bs1a a # fuse bs1a aa # map (fuse bs1a) list)"
+ using a3 a2 a1 by (metis (no_types) append.left_neutral append_Cons flts_fuse k00 k0b list.simps(9))
+qed
+
+
+lemma CT01:
+ assumes "\<forall>r \<in> set as1. nonalt r \<and> r \<noteq> AZERO" "\<forall>r \<in> set as2. nonalt r \<and> r \<noteq> AZERO"
+ shows "flts [bsimp_AALTs bs1 as1, bsimp_AALTs bs2 as2] = flts ((map (fuse bs1) as1) @ (map (fuse bs2) as2))"
+ using assms CT0
+ by (metis k0 k00)
+
+
+
+
+lemma
+ shows "bsimp (AALT bs (AALTs bs1 (map (bder c) as1)) (AALTs bs2 (map (bder c) as2)))
+ = bsimp (AALTs bs ((map (fuse bs1) (map (bder c) as1)) @
+ (map (fuse bs2) (map (bder c) as2))))"
+ apply(subst bsimp_idem[symmetric])
+ apply(simp)
+ oops
+
+lemma CT_exp:
+ assumes "\<forall>a \<in> set as. bsimp (bder c (bsimp a)) = bsimp (bder c a)"
+ shows "map bsimp (map (bder c) as) = map bsimp (map (bder c) (map bsimp as))"
+ using assms
+ apply(induct as)
+ apply(auto)
+ done
+
+lemma asize_set:
+ assumes "a \<in> set as"
+ shows "asize a < Suc (sum_list (map asize as))"
+ using assms
+ apply(induct as arbitrary: a)
+ apply(auto)
+ using le_add2 le_less_trans not_less_eq by blast
+
+
+lemma XXX2a_long_without_good:
+ shows "bsimp (bder c (bsimp a)) = bsimp (bder c a)"
+ apply(induct a arbitrary: c taking: "\<lambda>a. asize a" rule: measure_induct)
+ apply(case_tac x)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 3
+ apply(simp)
+ (* AALT case *)
+ prefer 2
+ apply(simp del: bsimp.simps)
+ apply(subst (2) CT1)
+ apply(subst CT_exp)
+ apply(auto)[1]
+ using asize_set apply blast
+ apply(subst CT1[symmetric])
+ apply(simp)
+ oops
+
+lemma YY:
+ assumes "flts (map bsimp as1) = xs"
+ shows "flts (map bsimp (map (fuse bs1) as1)) = map (fuse bs1) xs"
+ using assms
+ apply(induct as1 arbitrary: bs1 xs)
+ apply(simp)
+ apply(auto)
+ by (metis bsimp_fuse flts_fuse k0 list.simps(9))
+
+
+lemma flts_nonalt:
+ assumes "flts (map bsimp xs) = ys"
+ shows "\<forall>y \<in> set ys. nonalt y"
+ using assms
+ apply(induct xs arbitrary: ys)
+ apply(auto)
+ apply(case_tac xs)
+ apply(auto)
+ using flts2 good1 apply fastforce
+ by (smt ex_map_conv list.simps(9) nn1b nn1c)
+
+lemma WWW2:
+ shows "bsimp (bsimp_AALTs bs1 (flts (map bsimp as1))) =
+ bsimp_AALTs bs1 (flts (map bsimp as1))"
+ by (metis bsimp.simps(2) bsimp_idem)
+
+lemma WWW3:
+ shows "flts [bsimp_AALTs bs1 (flts (map bsimp as1))] =
+ flts (map bsimp (map (fuse bs1) as1))"
+ by (metis CT0 YY flts_nonalt flts_nothing qqq1)
+
+lemma WWW4:
+ shows "map (bder c \<circ> fuse bs1) as1 = map (fuse bs1) (map (bder c) as1)"
+ apply(induct as1)
+ apply(auto)
+ using bder_fuse by blast
+
+lemma WWW5:
+ shows "map (bsimp \<circ> bder c) as1 = map bsimp (map (bder c) as1)"
+ apply(induct as1)
+ apply(auto)
+ done
+
+lemma WWW6:
+ shows "bsimp (bder c (bsimp_AALTs x51 (flts [bsimp a1, bsimp a2]) ) ) =
+ bsimp(bsimp_AALTs x51 (map (bder c) (flts [bsimp a1, bsimp a2]))) "
+ using bder_bsimp_AALTs by auto
+
+lemma WWW7:
+ shows "bsimp (bsimp_AALTs x51 (map (bder c) (flts [bsimp a1, bsimp a2]))) =
+ bsimp(bsimp_AALTs x51 (flts (map (bder c) [bsimp a1, bsimp a2])))"
+ sorry
+
+
+lemma stupid:
+ assumes "a = b"
+ shows "bsimp(a) = bsimp(b)"
+ using assms
+ apply(auto)
+ done
+(*
+proving idea:
+bsimp_AALTs x51 (map (bder c) (flts [a1, a2])) = bsimp_AALTs x51 (map (bder c) (flts [a1]++[a2]))
+= bsimp_AALTs x51 (map (bder c) ((flts [a1])++(flts [a2]))) =
+bsimp_AALTs x51 (map (bder c) (flts [a1]))++(map (bder c) (flts [a2])) = A
+and then want to prove that
+map (bder c) (flts [a]) = flts [bder c a] under the condition
+that a is either a seq with the first elem being not nullable, or a character equal to c,
+or an AALTs, or a star
+Then, A = bsimp_AALTs x51 (flts [bder c a]) ++ (map (bder c) (flts [a2])) = A1
+Using the same condition for a2, we get
+A1 = bsimp_AALTs x51 (flts [bder c a1]) ++ (flts [bder c a2])
+=bsimp_AALTs x51 flts ([bder c a1] ++ [bder c a2])
+=bsimp_AALTs x51 flts ([bder c a1, bder c a2])
+ *)
+lemma manipulate_flts:
+ shows "bsimp_AALTs x51 (map (bder c) (flts [a1, a2])) =
+bsimp_AALTs x51 ((map (bder c) (flts [a1])) @ (map (bder c) (flts [a2])))"
+ by (metis k0 map_append)
+
+lemma go_inside_flts:
+ assumes " (bder c a1 \<noteq> AZERO) "
+ "\<not>(\<exists> a01 a02 x02. ( (a1 = ASEQ x02 a01 a02) \<and> bnullable(a01) ) )"
+shows "map (bder c) (flts [a1]) = flts [bder c a1]"
+ using assms
+ apply -
+ apply(case_tac a1)
+ apply(simp)
+ apply(simp)
+ apply(case_tac "x32 = c")
+ prefer 2
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply (simp add: WWW4)
+ apply(simp add: bder_fuse)
+ done
+
+lemma medium010:
+ assumes " (bder c a1 = AZERO) "
+ shows "map (bder c) (flts [a1]) = [AZERO] \<or> map (bder c) (flts [a1]) = []"
+ using assms
+ apply -
+ apply(case_tac a1)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ done
+
+lemma medium011:
+ assumes " (bder c a1 = AZERO) "
+ shows "flts (map (bder c) [a1, a2]) = flts [bder c a2]"
+ using assms
+ apply -
+ apply(simp)
+ done
+
+lemma medium01central:
+ shows "bsimp(bsimp_AALTs x51 (map (bder c) (flts [a2])) ) = bsimp(bsimp_AALTs x51 (flts [bder c a2]))"
+ sorry
+
+
+lemma plus_bsimp:
+ assumes "bsimp( bsimp a) = bsimp (bsimp b)"
+ shows "bsimp a = bsimp b"
+ using assms
+ apply -
+ by (simp add: bsimp_idem)
+lemma patience_good5:
+ assumes "bsimp r = AALTs x y"
+ shows " \<exists> a aa list. y = a#aa#list"
+ by (metis Nil_is_map_conv arexp.simps(13) assms bsimp_AALTs.elims flts1 good.simps(5) good1 k0a)
+
+(*SAD*)
+(*this does not hold actually
+lemma bsimp_equiv0:
+ shows "bsimp(bsimp r) = bsimp(bsimp (AALTs [] [r]))"
+ apply(simp)
+ apply(case_tac "bsimp r")
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ thm good1
+ using good1
+ apply -
+ apply(drule_tac x="r" in meta_spec)
+ apply(erule disjE)
+
+ apply(simp only: bsimp_AALTs.simps)
+ apply(simp only:flts.simps)
+ apply(drule patience_good5)
+ apply(clarify)
+ apply(subst bsimp_AALTs_qq)
+ apply simp
+ prefer 2
+ sorry*)
+
+(*exercise: try multiple ways of proving this*)
+(*this lemma does not hold.........
+lemma bsimp_equiv1:
+ shows "bsimp r = bsimp (AALTs [] [r])"
+ using plus_bsimp
+ apply -
+ using bsimp_equiv0 by blast
+ (*apply(simp)
+ apply(case_tac "bsimp r")
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+(*use lemma good1*)
+ thm good1
+ using good1
+ apply -
+ apply(drule_tac x="r" in meta_spec)
+ apply(erule disjE)
+
+ apply(subst flts_single1)
+ apply(simp only: bsimp_AALTs.simps)
+ prefer 2
+
+ thm flts_single1
+
+ find_theorems "flts _ = _"*)
+*)
+lemma bsimp_equiv2:
+ shows "bsimp (AALTs x51 [r]) = bsimp (AALT x51 AZERO r)"
+ sorry
+
+lemma medium_stupid_isabelle:
+ assumes "rs = a # list"
+ shows "bsimp_AALTs x51 (AZERO # rs) = AALTs x51 (AZERO#rs)"
+ using assms
+ apply -
+ apply(simp)
+ done
+(*
+lemma mediumlittle:
+ shows "bsimp(bsimp_AALTs x51 rs) = bsimp(bsimp_AALTs x51 (AZERO # rs))"
+ apply(case_tac rs)
+ apply(simp)
+ apply(case_tac list)
+ apply(subst medium_stupid_isabelle)
+ apply(simp)
+ prefer 2
+ apply simp
+ apply(rule_tac s="a#list" and t="rs" in subst)
+ apply(simp)
+ apply(rule_tac t="list" and s= "[]" in subst)
+ apply(simp)
+ (*dunno what is the rule for x#nil = x*)
+ apply(case_tac a)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 3
+ apply simp
+ apply(simp only:bsimp_AALTs.simps)
+
+ apply simp
+ apply(case_tac "bsimp x42")
+ apply(simp)
+ apply simp
+ apply(case_tac "bsimp x43")
+ apply simp
+ apply simp
+ apply simp
+ apply simp
+ apply(simp only:bsimp_ASEQ.simps)
+ using good1
+ apply -
+ apply(drule_tac x="x43" in meta_spec)
+ apply(erule disjE)
+ apply(subst bsimp_AALTs_qq)
+ using patience_good5 apply force
+ apply(simp only:bsimp_AALTs.simps)
+ apply(simp only:fuse.simps)
+ apply(simp only:flts.simps)
+(*OK from here you actually realize this lemma doesnt hold*)
+ apply(simp)
+ apply(simp)
+ apply(rule_tac t="rs" and s="a#list" in subst)
+ apply(simp)
+ apply(rule_tac t="list" and s="[]" in subst)
+ apply(simp)
+ (*apply(simp only:bsimp_AALTs.simps)*)
+ (*apply(simp only:fuse.simps)*)
+ sorry
+*)
+lemma singleton_list_map:
+ shows"map f [a] = [f a]"
+ apply simp
+ done
+lemma map_application2:
+ shows"map f [a,b] = [f a, f b]"
+ apply simp
+ done
+(*SAD*)
+(* bsimp (bder c (bsimp_AALTs x51 (flts [bsimp a1, bsimp a2]))) =
+ bsimp (AALT x51 (bder c (bsimp a1)) (bder c (bsimp a2)))*)
+(*This equality does not hold*)
+lemma medium01:
+ assumes " (bder c a1 = AZERO) "
+ shows "bsimp(bsimp_AALTs x51 (map (bder c) (flts [ a1, a2]))) =
+ bsimp(bsimp_AALTs x51 (flts (map (bder c) [ a1, a2])))"
+ apply(subst manipulate_flts)
+ using assms
+ apply -
+ apply(subst medium011)
+ apply(simp)
+ apply(case_tac "map (bder c) (flts [a1]) = []")
+ apply(simp)
+ using medium01central apply blast
+apply(frule medium010)
+ apply(erule disjE)
+ prefer 2
+ apply(simp)
+ apply(simp)
+ apply(case_tac a2)
+ apply simp
+ apply simp
+ apply simp
+ apply(simp only:flts.simps)
+(*HOW do i say here to replace ASEQ ..... back into a2*)
+(*how do i say here to use the definition of map function
+without lemma, of course*)
+(*how do i say here that AZERO#map (bder c) [ASEQ x41 x42 x43]'s list.len >1
+without a lemma, of course*)
+ apply(subst singleton_list_map)
+ apply(simp only: bsimp_AALTs.simps)
+ apply(case_tac "bder c (ASEQ x41 x42 x43)")
+ apply simp
+ apply simp
+ apply simp
+ prefer 3
+ apply simp
+ apply(rule_tac t="bder c (ASEQ x41 x42 x43)"
+and s="ASEQ x41a x42a x43a" in subst)
+ apply simp
+ apply(simp only: flts.simps)
+ apply(simp only: bsimp_AALTs.simps)
+ apply(simp only: fuse.simps)
+ apply(subst (2) bsimp_idem[symmetric])
+ apply(subst (1) bsimp_idem[symmetric])
+ apply(simp only:bsimp.simps)
+ apply(subst map_application2)
+ apply(simp only: bsimp.simps)
+ apply(simp only:flts.simps)
+(*want to happily change between a2 and ASEQ x41 42 43, and eliminate now
+redundant conditions such as map (bder c) (flts [a1]) = [AZERO] *)
+ apply(case_tac "bsimp x42a")
+ apply(simp)
+ apply(case_tac "bsimp x43a")
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 2
+ apply(simp)
+ apply(rule_tac t="bsimp x43a"
+and s="AALTs x51a x52" in subst)
+ apply simp
+ apply(simp only:bsimp_ASEQ.simps)
+ apply(simp only:fuse.simps)
+ apply(simp only:flts.simps)
+
+ using medium01central mediumlittle by auto
+
+
+
+lemma medium1:
+ assumes " (bder c a1 \<noteq> AZERO) "
+ "\<not>(\<exists> a01 a02 x02. ( (a1 = ASEQ x02 a01 a02) \<and> bnullable(a01) ) )"
+" (bder c a2 \<noteq> AZERO)"
+ "\<not>(\<exists> a11 a12 x12. ( (a2 = ASEQ x12 a11 a12) \<and> bnullable(a11) ) )"
+ shows "bsimp_AALTs x51 (map (bder c) (flts [ a1, a2])) =
+ bsimp_AALTs x51 (flts (map (bder c) [ a1, a2]))"
+ using assms
+ apply -
+ apply(subst manipulate_flts)
+ apply(case_tac "a1")
+ apply(simp)
+ apply(simp)
+ apply(case_tac "x32 = c")
+ prefer 2
+ apply(simp)
+ prefer 2
+ apply(case_tac "bnullable x42")
+ apply(simp)
+ apply(simp)
+
+ apply(case_tac "a2")
+ apply(simp)
+ apply(simp)
+ apply(case_tac "x32 = c")
+ prefer 2
+ apply(simp)
+ apply(simp)
+ apply(case_tac "bnullable x42a")
+ apply(simp)
+ apply(subst go_inside_flts)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply (simp add: WWW4)
+ apply(simp)
+ apply (simp add: WWW4)
+ apply (simp add: go_inside_flts)
+ apply (metis (no_types, lifting) go_inside_flts k0 list.simps(8) list.simps(9))
+ by (smt bder.simps(6) flts.simps(1) flts.simps(6) flts.simps(7) go_inside_flts k0 list.inject list.simps(9))
+
+lemma big0:
+ shows "bsimp (AALT x51 (AALTs bs1 as1) (AALTs bs2 as2)) =
+ bsimp (AALTs x51 ((map (fuse bs1) as1) @ (map (fuse bs2) as2)))"
+ by (smt WWW3 bsimp.simps(2) k0 k00 list.simps(8) list.simps(9) map_append)
+
+lemma bignA:
+ shows "bsimp (AALTs x51 (AALTs bs1 as1 # as2)) =
+ bsimp (AALTs x51 ((map (fuse bs1) as1) @ as2))"
+ apply(simp)
+ apply(subst k0)
+ apply(subst WWW3)
+ apply(simp add: flts_append)
+ done
+
+lemma hardest:
+ shows "bsimp (bder c (bsimp_AALTs x51 (flts [bsimp a1, bsimp a2]))) =
+ bsimp (AALT x51 (bder c (bsimp a1)) (bder c (bsimp a2)))"
+ apply(case_tac "bsimp a1")
+ apply(case_tac "bsimp a2")
+ apply simp
+ apply simp
+ apply(rule_tac t="bsimp a1"
+and s="AZERO" in subst)
+ apply simp
+ apply(rule_tac t="bsimp a2"
+and s="ACHAR x31 x32" in subst)
+ apply simp
+ apply simp
+ apply(rule_tac t="bsimp a1"
+and s="AZERO" in subst)
+ apply simp
+ apply(rule_tac t="bsimp a2"
+and s="ASEQ x41 x42 x43" in subst)
+ apply simp
+ apply(case_tac "bnullable x42")
+ apply(simp only: bder.simps)
+ apply(simp)
+ apply(case_tac "flts
+ [bsimp_ASEQ [] (bsimp (bder c x42)) (bsimp x43),
+ bsimp (fuse (bmkeps x42) (bder c x43))]")
+ apply(simp)
+ apply simp
+(*counterexample finder*)
+
+
+lemma XXX2a_long_without_good:
+ shows "bsimp (bder c (bsimp a)) = bsimp (bder c a)"
+ apply(induct a arbitrary: c taking: "\<lambda>a. asize a" rule: measure_induct)
+ apply(case_tac x)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 3
+ apply(simp)
+ (* AALT case *)
+ prefer 2
+ apply(simp only:)
+ apply(case_tac "\<exists>a1 a2. x52 = [a1, a2]")
+ apply(clarify)
+ apply(simp del: bsimp.simps)
+ apply(subst (2) CT1)
+ apply(simp del: bsimp.simps)
+ apply(rule_tac t="bsimp (bder c a1)" and s="bsimp (bder c (bsimp a1))" in subst)
+ apply(simp del: bsimp.simps)
+ apply(rule_tac t="bsimp (bder c a2)" and s="bsimp (bder c (bsimp a2))" in subst)
+ apply(simp del: bsimp.simps)
+ apply(subst CT1a[symmetric])
+ apply(subst bsimp.simps)
+ apply(simp del: bsimp.simps)
+(*bsimp_AALTs x51 (map (bder c) (flts [a1, a2])) =
+ bsimp_AALTs x51 (flts (map (bder c) [a1, a2]))*)
+ apply(case_tac "\<exists>bs1 as1. bsimp a1 = AALTs bs1 as1")
+ apply(case_tac "\<exists>bs2 as2. bsimp a2 = AALTs bs2 as2")
+ apply(clarify)
+ apply(simp only:)
+ apply(simp del: bsimp.simps bder.simps)
+ apply(subst bsimp_AALTs_qq)
+ prefer 2
+ apply(simp del: bsimp.simps)
+ apply(subst big0)
+ apply(simp add: WWW4)
+ apply (metis One_nat_def Suc_eq_plus1 Suc_lessI arexp.distinct(7) bsimp.simps(2) bsimp_AALTs.simps(1) bsimp_idem flts.simps(1) length_append length_greater_0_conv length_map not_add_less2 not_less_eq)
+ oops
+
+lemma XXX2a_long_without_good:
+ shows "bsimp (bder c (bsimp a)) = bsimp (bder c a)"
+ apply(induct a arbitrary: c taking: "\<lambda>a. asize a" rule: measure_induct)
+ apply(case_tac x)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 3
+ apply(simp)
+ (* AALT case *)
+ prefer 2
+ apply(subgoal_tac "nonnested (bsimp x)")
+ prefer 2
+ using nn1b apply blast
+ apply(simp only:)
+ apply(drule_tac x="AALTs x51 (flts x52)" in spec)
+ apply(drule mp)
+ defer
+ apply(drule_tac x="c" in spec)
+ apply(simp)
+ apply(rotate_tac 2)
+
+ apply(drule sym)
+ apply(simp)
+
+ apply(simp only: bder.simps)
+ apply(simp only: bsimp.simps)
+ apply(subst bder_bsimp_AALTs)
+ apply(case_tac x52)
+ apply(simp)
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ apply(case_tac a)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ defer
+ apply(simp)
+
+
+ (* case AALTs list is not empty *)
+ apply(simp)
+ apply(subst k0)
+ apply(subst (2) k0)
+ apply(simp)
+ apply(case_tac "bsimp a = AZERO")
+ apply(subgoal_tac "bsimp (bder c a) = AZERO")
+ prefer 2
+ using less_iff_Suc_add apply auto[1]
+ apply(simp)
+ apply(drule_tac x="AALTs x51 list" in spec)
+ apply(drule mp)
+ apply(simp add: asize0)
+ apply(drule_tac x="c" in spec)
+ apply(simp add: bder_bsimp_AALTs)
+ apply(case_tac "nonalt (bsimp a)")
+ prefer 2
+ apply(drule_tac x="bsimp (AALTs x51 (a#list))" in spec)
+ apply(drule mp)
+ apply(rule order_class.order.strict_trans2)
+ apply(rule bsimp_AALTs_size3)
+ apply(auto)[1]
+ apply(simp)
+ apply(subst (asm) bsimp_idem)
+ apply(drule_tac x="c" in spec)
+ apply(simp)
+ find_theorems "_ < _ \<Longrightarrow> _ \<le> _ \<Longrightarrow>_ < _"
+ apply(rule le_trans)
+ apply(subgoal_tac "flts [bsimp a] = [bsimp a]")
+ prefer 2
+ using k0b apply blast
+ apply(simp)
+ find_theorems "asize _ < asize _"
+
+ using bder_bsimp_AALTs
+ apply(case_tac list)
+ apply(simp)
+ sledgeha mmer [timeout=6000]
+
+ apply(case_tac "\<exists>r \<in> set (map bsimp x52). \<not>nonalt r")
+ apply(drule_tac x="bsimp (AALTs x51 x52)" in spec)
+ apply(drule mp)
+ using bsimp_AALTs_size3 apply blast
+ apply(drule_tac x="c" in spec)
+ apply(subst (asm) (2) test)
+
+ apply(case_tac x52)
+ apply(simp)
+ apply(simp)
+ apply(case_tac "bsimp a = AZERO")
+ apply(simp)
+ apply(subgoal_tac "bsimp (bder c a) = AZERO")
+ prefer 2
+ apply auto[1]
+ apply (metis L.simps(1) L_bsimp_erase der.simps(1) der_correctness erase.simps(1) erase_bder xxx_bder2)
+ apply(simp)
+ apply(drule_tac x="AALTs x51 list" in spec)
+ apply(drule mp)
+ apply(simp add: asize0)
+ apply(simp)
+ apply(case_tac list)
+ prefer 2
+ apply(simp)
+ apply(case_tac "bsimp aa = AZERO")
+ apply(simp)
+ apply(subgoal_tac "bsimp (bder c aa) = AZERO")
+ prefer 2
+ apply auto[1]
+ apply (metis add.left_commute bder.simps(1) bsimp.simps(3) less_add_Suc1)
+ apply(simp)
+ apply(drule_tac x="AALTs x51 (a#lista)" in spec)
+ apply(drule mp)
+ apply(simp add: asize0)
+ apply(simp)
+ apply (metis flts.simps(2) k0)
+ apply(subst k0)
+ apply(subst (2) k0)
+
+
+ using less_add_Suc1 apply fastforce
+ apply(subst k0)
+
+
+ apply(simp)
+ apply(case_tac "bsimp a = AZERO")
+ apply(simp)
+ apply(subgoal_tac "bsimp (bder c a) = AZERO")
+ prefer 2
+ apply auto[1]
+ apply(simp)
+ apply(case_tac "nonalt (bsimp a)")
+ apply(subst bsimp_AALTs1)
+ apply(simp)
+ using less_add_Suc1 apply fastforce
+
+ apply(subst bsimp_AALTs1)
+
+ using nn11a apply b last
+
+ (* SEQ case *)
+ apply(clarify)
+ apply(subst bsimp.simps)
+ apply(simp del: bsimp.simps)
+ apply(auto simp del: bsimp.simps)[1]
+ apply(subgoal_tac "bsimp x42 \<noteq> AZERO")
+ prefer 2
+ using b3 apply force
+ apply(case_tac "bsimp x43 = AZERO")
+ apply(simp)
+ apply (simp add: bsimp_ASEQ0)
+ apply (metis bder.simps(1) bsimp.simps(3) bsimp_AALTs.simps(1) bsimp_fuse flts.simps(1) flts.simps(2) fuse.simps(1) less_add_Suc2)
+ apply(case_tac "\<exists>bs. bsimp x42 = AONE bs")
+ apply(clarify)
+ apply(simp)
+ apply(subst bsimp_ASEQ2)
+ apply(subgoal_tac "bsimp (bder c x42) = AZERO")
+ prefer 2
+ using less_add_Suc1 apply fastforce
+ apply(simp)
+ apply(frule_tac x="x43" in spec)
+ apply(drule mp)
+ apply(simp)
+ apply(drule_tac x="c" in spec)
+ apply(subst bder_fuse)
+ apply(subst bsimp_fuse[symmetric])
+ apply(simp)
+ apply(subgoal_tac "bmkeps x42 = bs")
+ prefer 2
+ apply (simp add: bmkeps_simp)
+ apply(simp)
+ apply(subst bsimp_fuse[symmetric])
+ apply(case_tac "nonalt (bsimp (bder c x43))")
+ apply(subst bsimp_AALTs1)
+ using nn11a apply blast
+ using fuse_append apply blast
+ apply(subgoal_tac "\<exists>bs rs. bsimp (bder c x43) = AALTs bs rs")
+ prefer 2
+ using bbbbs1 apply blast
+ apply(clarify)
+ apply(simp)
+ apply(case_tac rs)
+ apply(simp)
+ apply (metis arexp.distinct(7) good.simps(4) good1)
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ apply (metis arexp.distinct(7) good.simps(5) good1)
+ apply(simp del: bsimp_AALTs.simps)
+ apply(simp only: bsimp_AALTs.simps)
+ apply(simp)
+
+
+
+
+(* HERE *)
+apply(case_tac "x42 = AZERO")
+ apply(simp)
+ apply(case_tac "bsimp x43 = AZERO")
+ apply(simp)
+ apply (simp add: bsimp_ASEQ0)
+ apply(subgoal_tac "bsimp (fuse (bmkeps x42) (bder c x43)) = AZERO")
+ apply(simp)
+ apply (met is bder.simps(1) bsimp.simps(3) bsimp_fuse fuse.simps(1) less_add_Suc2)
+ apply(case_tac "\<exists>bs. bsimp x42 = AONE bs")
+ apply(clarify)
+ apply(simp)
+ apply(subst bsimp_ASEQ2)
+ apply(subgoal_tac "bsimp (bder c x42) = AZERO")
+ apply(simp)
+ prefer 2
+ using less_add_Suc1 apply fastforce
+ apply(subgoal_tac "bmkeps x42 = bs")
+ prefer 2
+ apply (simp add: bmkeps_simp)
+ apply(simp)
+ apply(case_tac "nonalt (bsimp (bder c x43))")
+ apply (metis bder_fuse bsimp_AALTs.simps(1) bsimp_AALTs.simps(2) bsimp_fuse flts.simps(1) flts.simps(2) fuse.simps(1) fuse_append k0b less_add_Suc2 nn11a)
+ apply(subgoal_tac "nonnested (bsimp (bder c x43))")
+ prefer 2
+ using nn1b apply blast
+ apply(case_tac x43)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 3
+ apply(simp)
+ apply (metis arexp.distinct(25) arexp.distinct(7) arexp.distinct(9) bsimp_ASEQ.simps(1) bsimp_ASEQ.simps(11) bsimp_ASEQ1 nn11a nonalt.elims(3) nonalt.simps(6))
+ apply(simp)
+ apply(auto)[1]
+ apply(case_tac "(bsimp (bder c x42a)) = AZERO")
+ apply(simp)
+
+ apply(simp)
+
+
+
+ apply(subgoal_tac "(\<exists>bs1 rs1. 1 < length rs1 \<and> bsimp (bder c x43) = AALTs bs1 rs1 ) \<or>
+ (\<exists>bs1 r. bsimp (bder c x43) = fuse bs1 r)")
+ prefer 2
+ apply (metis fuse_empty)
+ apply(erule disjE)
+ prefer 2
+ apply(clarify)
+ apply(simp only:)
+ apply(simp)
+ apply(simp add: fuse_append)
+ apply(subst bder_fuse)
+ apply(subst bsimp_fuse[symmetric])
+ apply(subst bder_fuse)
+ apply(subst bsimp_fuse[symmetric])
+ apply(subgoal_tac "bsimp (bder c (bsimp x43)) = bsimp (bder c x43)")
+ prefer 2
+ using less_add_Suc2 apply bl ast
+ apply(simp only: )
+ apply(subst bsimp_fuse[symmetric])
+ apply(simp only: )
+
+ apply(simp only: fuse.simps)
+ apply(simp)
+ apply(case_tac rs1)
+ apply(simp)
+ apply (me tis arexp.distinct(7) fuse.simps(1) good.simps(4) good1 good_fuse)
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ apply (me tis arexp.distinct(7) fuse.simps(1) good.simps(5) good1 good_fuse)
+ apply(simp only: bsimp_AALTs.simps map_cons.simps)
+ apply(auto)[1]
+
+
+
+ apply(subst bsimp_fuse[symmetric])
+ apply(subgoal_tac "bmkeps x42 = bs")
+ prefer 2
+ apply (simp add: bmkeps_simp)
+
+
+ apply(simp)
+
+ using b3 apply force
+ using bsimp_ASEQ0 test2 apply fo rce
+ thm good_SEQ test2
+ apply (simp add: good_SEQ test2)
+ apply (simp add: good_SEQ test2)
+ apply(case_tac "x42 = AZERO")
+ apply(simp)
+ apply(case_tac "x43 = AZERO")
+ apply(simp)
+ apply (simp add: bsimp_ASEQ0)
+ apply(case_tac "\<exists>bs. x42 = AONE bs")
+ apply(clarify)
+ apply(simp)
+ apply(subst bsimp_ASEQ1)
+ apply(simp)
+ using bsimp_ASEQ0 test2 apply fo rce
+ apply (simp add: good_SEQ test2)
+ apply (simp add: good_SEQ test2)
+ apply (simp add: good_SEQ test2)
+ (* AALTs case *)
+ apply(simp)
+ using test2 by fa st force
+
+
+lemma XXX4ab:
+ shows "good (bders_simp (bsimp r) s) \<or> bders_simp (bsimp r) s = AZERO"
+ apply(induct s arbitrary: r rule: rev_induct)
+ apply(simp)
+ apply (simp add: good1)
+ apply(simp add: bders_simp_append)
+ apply (simp add: good1)
+ done
+
+lemma XXX4:
+ assumes "good a"
+ shows "bders_simp a s = bsimp (bders a s)"
+ using assms
+ apply(induct s arbitrary: a rule: rev_induct)
+ apply(simp)
+ apply (simp add: test2)
+ apply(simp add: bders_append bders_simp_append)
+ oops
+
+
+lemma MAINMAIN:
+ "blexer r s = blexer_simp r s"
+ apply(induct s arbitrary: r)
+ apply(simp add: blexer_def blexer_simp_def)
+ apply(simp add: blexer_def blexer_simp_def del: bders.simps bders_simp.simps)
+ apply(auto simp del: bders.simps bders_simp.simps)
+ prefer 2
+ apply (metis b4 bders.simps(2) bders_simp.simps(2))
+ prefer 2
+ apply (metis b4 bders.simps(2))
+ apply(subst bmkeps_simp)
+ apply(simp)
+ apply(case_tac s)
+ apply(simp only: bders.simps)
+ apply(subst bders_simp.simps)
+ apply(simp)
+ oops
+
+
+lemma
+ fixes n :: nat
+ shows "(\<Sum>i \<in> {0..n}. i) = n * (n + 1) div 2"
+ apply(induct n)
+ apply(simp)
+ apply(simp)
+ done
+
+
+
+
+
+end
\ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys2/Bounds.thy Sun Oct 10 18:35:21 2021 +0100
@@ -0,0 +1,65 @@
+
+theory Bounds
+ imports "Lexer"
+begin
+
+definition Size :: "rexp \<Rightarrow> nat"
+where "Size r == Max {size (ders s r) | s. True }"
+
+fun bar :: "rexp \<Rightarrow> string \<Rightarrow> rexp" where
+ "bar r [] = r"
+| "bar r (c # s) = ALT (ders (c # s) r) (bar r s)"
+
+lemma size_ALT:
+ "size (ders s (ALT r1 r2)) = Suc (size (ders s r1) + size (ders s r2))"
+apply(induct s arbitrary: r1 r2)
+apply(simp_all)
+done
+
+lemma size_bar_ALT:
+ "size (bar (ALT r1 r2) s) = Suc (size (bar r1 s) + size (bar r2 s))"
+apply(induct s)
+apply(simp)
+apply(simp add: size_ALT)
+done
+
+lemma size_SEQ:
+ "size (ders s (SEQ r1 r2)) \<le> Suc (size (ders s r1)) + size r2 + size (bar (SEQ r1 r2) s)"
+apply(induct s arbitrary: r1 r2)
+apply(simp_all)
+done
+
+(*
+lemma size_bar_SEQ:
+ "size (bar (SEQ r1 r2) s) \<le> Suc (size (bar r1 s) + size (bar r2 s))"
+apply(induct s)
+apply(simp)
+apply(auto simp add: size_SEQ size_ALT)
+apply(rule le_trans)
+apply(rule size_SEQ)
+done
+*)
+
+lemma size_STAR:
+ "size (ders s (STAR r)) \<le> Suc (size (bar r s)) + size (STAR r)"
+apply(induct s arbitrary: r)
+apply(simp)
+apply(simp)
+apply(rule le_trans)
+apply(rule size_SEQ)
+apply(simp)
+oops
+
+lemma Size_ALT:
+ "Size (ALT r1 r2) \<le> Suc (Size r1 + Size r2)"
+unfolding Size_def
+apply(auto)
+apply(simp add: size_ALT)
+apply(subgoal_tac "Max {n. \<exists>s. n = Suc (size (ders s r1) + size (ders s r2))} \<ge>
+ Suc (Max {n. \<exists>s. n = size (ders s r1) + size (ders s r2)})")
+prefer 2
+oops
+
+
+
+end
\ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys2/Exercises.thy Sun Oct 10 18:35:21 2021 +0100
@@ -0,0 +1,253 @@
+theory Exercises
+ imports Spec "~~/src/HOL/Library/Infinite_Set"
+begin
+
+section {* Some Fun Facts *}
+
+fun
+ zeroable :: "rexp \<Rightarrow> bool"
+where
+ "zeroable (ZERO) \<longleftrightarrow> True"
+| "zeroable (ONE) \<longleftrightarrow> False"
+| "zeroable (CH c) \<longleftrightarrow> False"
+| "zeroable (ALT r1 r2) \<longleftrightarrow> zeroable r1 \<and> zeroable r2"
+| "zeroable (SEQ r1 r2) \<longleftrightarrow> zeroable r1 \<or> zeroable r2"
+| "zeroable (STAR r) \<longleftrightarrow> False"
+
+lemma zeroable_correctness:
+ shows "zeroable r \<longleftrightarrow> L r = {}"
+by(induct r)(auto simp add: Sequ_def)
+
+
+fun
+ atmostempty :: "rexp \<Rightarrow> bool"
+where
+ "atmostempty (ZERO) \<longleftrightarrow> True"
+| "atmostempty (ONE) \<longleftrightarrow> True"
+| "atmostempty (CH c) \<longleftrightarrow> False"
+| "atmostempty (ALT r1 r2) \<longleftrightarrow> atmostempty r1 \<and> atmostempty r2"
+| "atmostempty (SEQ r1 r2) \<longleftrightarrow>
+ zeroable r1 \<or> zeroable r2 \<or> (atmostempty r1 \<and> atmostempty r2)"
+| "atmostempty (STAR r) = atmostempty r"
+
+
+
+fun
+ somechars :: "rexp \<Rightarrow> bool"
+where
+ "somechars (ZERO) \<longleftrightarrow> False"
+| "somechars (ONE) \<longleftrightarrow> False"
+| "somechars (CH c) \<longleftrightarrow> True"
+| "somechars (ALT r1 r2) \<longleftrightarrow> somechars r1 \<or> somechars r2"
+| "somechars (SEQ r1 r2) \<longleftrightarrow>
+ (\<not> zeroable r1 \<and> somechars r2) \<or> (\<not> zeroable r2 \<and> somechars r1) \<or>
+ (somechars r1 \<and> nullable r2) \<or> (somechars r2 \<and> nullable r1)"
+| "somechars (STAR r) \<longleftrightarrow> somechars r"
+
+lemma somechars_correctness:
+ shows "somechars r \<longleftrightarrow> (\<exists>s. s \<noteq> [] \<and> s \<in> L r)"
+apply(induct r)
+apply(simp_all add: zeroable_correctness nullable_correctness Sequ_def)
+using Nil_is_append_conv apply blast
+apply blast
+ apply(auto)
+ by (metis Star_decomp hd_Cons_tl list.distinct(1))
+
+lemma atmostempty_correctness_aux:
+ shows "atmostempty r \<longleftrightarrow> \<not> somechars r"
+apply(induct r)
+apply(simp_all)
+apply(auto simp add: zeroable_correctness nullable_correctness somechars_correctness)
+done
+
+lemma atmostempty_correctness:
+ shows "atmostempty r \<longleftrightarrow> L r \<subseteq> {[]}"
+by(auto simp add: atmostempty_correctness_aux somechars_correctness)
+
+fun
+ leastsinglechar :: "rexp \<Rightarrow> bool"
+where
+ "leastsinglechar (ZERO) \<longleftrightarrow> False"
+| "leastsinglechar (ONE) \<longleftrightarrow> False"
+| "leastsinglechar (CH c) \<longleftrightarrow> True"
+| "leastsinglechar (ALT r1 r2) \<longleftrightarrow> leastsinglechar r1 \<or> leastsinglechar r2"
+| "leastsinglechar (SEQ r1 r2) \<longleftrightarrow>
+ (if (zeroable r1 \<or> zeroable r2) then False
+ else ((nullable r1 \<and> leastsinglechar r2) \<or> (nullable r2 \<and> leastsinglechar r1)))"
+| "leastsinglechar (STAR r) \<longleftrightarrow> leastsinglechar r"
+
+lemma leastsinglechar_correctness:
+ "leastsinglechar r \<longleftrightarrow> (\<exists>c. [c] \<in> L r)"
+ apply(induct r)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 2
+ apply(simp)
+ apply(blast)
+ prefer 2
+ apply(simp)
+ using Star.step Star_decomp apply fastforce
+ apply(simp add: Sequ_def zeroable_correctness nullable_correctness)
+ by (metis append_Nil append_is_Nil_conv butlast_append butlast_snoc)
+
+fun
+ infinitestrings :: "rexp \<Rightarrow> bool"
+where
+ "infinitestrings (ZERO) = False"
+| "infinitestrings (ONE) = False"
+| "infinitestrings (CH c) = False"
+| "infinitestrings (ALT r1 r2) = (infinitestrings r1 \<or> infinitestrings r2)"
+| "infinitestrings (SEQ r1 r2) \<longleftrightarrow>
+ (\<not> zeroable r1 \<and> infinitestrings r2) \<or> (\<not> zeroable r2 \<and> infinitestrings r1)"
+| "infinitestrings (STAR r) = (\<not> atmostempty r)"
+
+
+
+
+
+lemma Star_atmostempty:
+ assumes "A \<subseteq> {[]}"
+ shows "A\<star> \<subseteq> {[]}"
+ using assms
+ using Star_decomp concat_eq_Nil_conv empty_iff insert_iff subsetI subset_singletonD
+ apply(auto)
+proof -
+ fix x :: "char list"
+ assume a1: "x \<in> A\<star>"
+ assume "\<And>c x A. c # x \<in> A\<star> \<Longrightarrow> \<exists>s1 s2. x = s1 @ s2 \<and> c # s1 \<in> A \<and> s2 \<in> A\<star>"
+ then have f2: "\<forall>cs C c. \<exists>csa. c # csa \<in> C \<or> c # cs \<notin> C\<star>"
+ by auto
+ obtain cc :: "char list \<Rightarrow> char" and ccs :: "char list \<Rightarrow> char list" where
+ "\<And>cs. cs = [] \<or> cc cs # ccs cs = cs"
+ by (metis (no_types) list.exhaust)
+ then show "x = []"
+ using f2 a1 by (metis assms empty_iff insert_iff list.distinct(1) subset_singletonD)
+qed
+
+
+lemma Star_empty_string_finite:
+ shows "finite ({[]}\<star>)"
+using Star_atmostempty infinite_super by auto
+
+lemma Star_empty_finite:
+ shows "finite ({}\<star>)"
+using Star_atmostempty infinite_super by auto
+
+lemma Star_concat_replicate:
+ assumes "s \<in> A"
+ shows "concat (replicate n s) \<in> A\<star>"
+using assms
+by (induct n) (auto)
+
+
+lemma concat_replicate_inj:
+ assumes "concat (replicate n s) = concat (replicate m s)" "s \<noteq> []"
+ shows "n = m"
+using assms
+apply(induct n arbitrary: m)
+apply(auto)[1]
+apply(auto)
+apply(case_tac m)
+apply(clarify)
+apply(simp only: replicate.simps concat.simps)
+apply blast
+by simp
+
+lemma A0:
+ assumes "finite (A ;; B)" "B \<noteq> {}"
+ shows "finite A"
+apply(subgoal_tac "\<exists>s. s \<in> B")
+apply(erule exE)
+apply(subgoal_tac "finite {s1 @ s |s1. s1 \<in> A}")
+apply(rule_tac f="\<lambda>s1. s1 @ s" in finite_imageD)
+apply(simp add: image_def)
+apply(smt Collect_cong)
+apply(simp add: inj_on_def)
+apply(rule_tac B="A ;; B" in finite_subset)
+apply(auto simp add: Sequ_def)[1]
+apply(rule assms(1))
+using assms(2) by auto
+
+lemma A1:
+ assumes "finite (A ;; B)" "A \<noteq> {}"
+ shows "finite B"
+apply(subgoal_tac "\<exists>s. s \<in> A")
+apply(erule exE)
+apply(subgoal_tac "finite {s @ s1 |s1. s1 \<in> B}")
+apply(rule_tac f="\<lambda>s1. s @ s1" in finite_imageD)
+apply(simp add: image_def)
+apply(smt Collect_cong)
+apply(simp add: inj_on_def)
+apply(rule_tac B="A ;; B" in finite_subset)
+apply(auto simp add: Sequ_def)[1]
+apply(rule assms(1))
+using assms(2) by auto
+
+lemma Sequ_Prod_finite:
+ assumes "A \<noteq> {}" "B \<noteq> {}"
+ shows "finite (A ;; B) \<longleftrightarrow> (finite (A \<times> B))"
+apply(rule iffI)
+apply(rule finite_cartesian_product)
+apply(erule A0)
+apply(rule assms(2))
+apply(erule A1)
+apply(rule assms(1))
+apply(simp add: Sequ_def)
+apply(rule finite_image_set2)
+apply(drule finite_cartesian_productD1)
+apply(rule assms(2))
+apply(simp)
+apply(drule finite_cartesian_productD2)
+apply(rule assms(1))
+apply(simp)
+done
+
+
+lemma Star_non_empty_string_infinite:
+ assumes "s \<in> A" " s \<noteq> []"
+ shows "infinite (A\<star>)"
+proof -
+ have "inj (\<lambda>n. concat (replicate n s))"
+ using assms(2) concat_replicate_inj
+ by(auto simp add: inj_on_def)
+ moreover
+ have "infinite (UNIV::nat set)" by simp
+ ultimately
+ have "infinite ((\<lambda>n. concat (replicate n s)) ` UNIV)"
+ by (simp add: range_inj_infinite)
+ moreover
+ have "((\<lambda>n. concat (replicate n s)) ` UNIV) \<subseteq> (A\<star>)"
+ using Star_concat_replicate assms(1) by auto
+ ultimately show "infinite (A\<star>)"
+ using infinite_super by auto
+qed
+
+lemma infinitestrings_correctness:
+ shows "infinitestrings r \<longleftrightarrow> infinite (L r)"
+apply(induct r)
+apply(simp_all)
+apply(simp add: zeroable_correctness)
+apply(rule iffI)
+apply(erule disjE)
+apply(subst Sequ_Prod_finite)
+apply(auto)[2]
+using finite_cartesian_productD2 apply blast
+apply(subst Sequ_Prod_finite)
+apply(auto)[2]
+using finite_cartesian_productD1 apply blast
+apply(subgoal_tac "L r1 \<noteq> {} \<and> L r2 \<noteq> {}")
+prefer 2
+apply(auto simp add: Sequ_def)[1]
+apply(subst (asm) Sequ_Prod_finite)
+apply(auto)[2]
+apply(auto)[1]
+apply(simp add: atmostempty_correctness)
+apply(rule iffI)
+apply (metis Star_empty_finite Star_empty_string_finite subset_singletonD)
+using Star_non_empty_string_infinite apply blast
+done
+
+unused_thms
+
+end
\ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys2/Lexer.thy Sun Oct 10 18:35:21 2021 +0100
@@ -0,0 +1,415 @@
+
+theory Lexer
+ imports Spec
+begin
+
+section {* The Lexer Functions by Sulzmann and Lu (without simplification) *}
+
+fun
+ mkeps :: "rexp \<Rightarrow> val"
+where
+ "mkeps(ONE) = Void"
+| "mkeps(SEQ r1 r2) = Seq (mkeps r1) (mkeps r2)"
+| "mkeps(ALT r1 r2) = (if nullable(r1) then Left (mkeps r1) else Right (mkeps r2))"
+| "mkeps(STAR r) = Stars []"
+
+fun injval :: "rexp \<Rightarrow> char \<Rightarrow> val \<Rightarrow> val"
+where
+ "injval (CH d) c Void = Char d"
+| "injval (ALT r1 r2) c (Left v1) = Left(injval r1 c v1)"
+| "injval (ALT r1 r2) c (Right v2) = Right(injval r2 c v2)"
+| "injval (SEQ r1 r2) c (Seq v1 v2) = Seq (injval r1 c v1) v2"
+| "injval (SEQ r1 r2) c (Left (Seq v1 v2)) = Seq (injval r1 c v1) v2"
+| "injval (SEQ r1 r2) c (Right v2) = Seq (mkeps r1) (injval r2 c v2)"
+| "injval (STAR r) c (Seq v (Stars vs)) = Stars ((injval r c v) # vs)"
+
+fun
+ lexer :: "rexp \<Rightarrow> string \<Rightarrow> val option"
+where
+ "lexer r [] = (if nullable r then Some(mkeps r) else None)"
+| "lexer r (c#s) = (case (lexer (der c r) s) of
+ None \<Rightarrow> None
+ | Some(v) \<Rightarrow> Some(injval r c v))"
+
+
+
+section {* Mkeps, Injval Properties *}
+
+lemma mkeps_nullable:
+ assumes "nullable(r)"
+ shows "\<Turnstile> mkeps r : r"
+using assms
+by (induct rule: nullable.induct)
+ (auto intro: Prf.intros)
+
+lemma mkeps_flat:
+ assumes "nullable(r)"
+ shows "flat (mkeps r) = []"
+using assms
+by (induct rule: nullable.induct) (auto)
+
+lemma Prf_injval_flat:
+ assumes "\<Turnstile> v : der c r"
+ shows "flat (injval r c v) = c # (flat v)"
+using assms
+apply(induct c r arbitrary: v rule: der.induct)
+apply(auto elim!: Prf_elims intro: mkeps_flat split: if_splits)
+done
+
+lemma Prf_injval:
+ assumes "\<Turnstile> v : der c r"
+ shows "\<Turnstile> (injval r c v) : r"
+using assms
+apply(induct r arbitrary: c v rule: rexp.induct)
+apply(auto intro!: Prf.intros mkeps_nullable elim!: Prf_elims split: if_splits)
+apply(simp add: Prf_injval_flat)
+done
+
+
+
+text {*
+ Mkeps and injval produce, or preserve, Posix values.
+*}
+
+lemma Posix_mkeps:
+ assumes "nullable r"
+ shows "[] \<in> r \<rightarrow> mkeps r"
+using assms
+apply(induct r rule: nullable.induct)
+apply(auto intro: Posix.intros simp add: nullable_correctness Sequ_def)
+apply(subst append.simps(1)[symmetric])
+apply(rule Posix.intros)
+apply(auto)
+done
+
+lemma Posix_injval:
+ assumes "s \<in> (der c r) \<rightarrow> v"
+ shows "(c # s) \<in> r \<rightarrow> (injval r c v)"
+using assms
+proof(induct r arbitrary: s v rule: rexp.induct)
+ case ZERO
+ have "s \<in> der c ZERO \<rightarrow> v" by fact
+ then have "s \<in> ZERO \<rightarrow> v" by simp
+ then have "False" by cases
+ then show "(c # s) \<in> ZERO \<rightarrow> (injval ZERO c v)" by simp
+next
+ case ONE
+ have "s \<in> der c ONE \<rightarrow> v" by fact
+ then have "s \<in> ZERO \<rightarrow> v" by simp
+ then have "False" by cases
+ then show "(c # s) \<in> ONE \<rightarrow> (injval ONE c v)" by simp
+next
+ case (CH d)
+ consider (eq) "c = d" | (ineq) "c \<noteq> d" by blast
+ then show "(c # s) \<in> (CH d) \<rightarrow> (injval (CH d) c v)"
+ proof (cases)
+ case eq
+ have "s \<in> der c (CH d) \<rightarrow> v" by fact
+ then have "s \<in> ONE \<rightarrow> v" using eq by simp
+ then have eqs: "s = [] \<and> v = Void" by cases simp
+ show "(c # s) \<in> CH d \<rightarrow> injval (CH d) c v" using eq eqs
+ by (auto intro: Posix.intros)
+ next
+ case ineq
+ have "s \<in> der c (CH d) \<rightarrow> v" by fact
+ then have "s \<in> ZERO \<rightarrow> v" using ineq by simp
+ then have "False" by cases
+ then show "(c # s) \<in> CH d \<rightarrow> injval (CH d) c v" by simp
+ qed
+next
+ case (ALT r1 r2)
+ have IH1: "\<And>s v. s \<in> der c r1 \<rightarrow> v \<Longrightarrow> (c # s) \<in> r1 \<rightarrow> injval r1 c v" by fact
+ have IH2: "\<And>s v. s \<in> der c r2 \<rightarrow> v \<Longrightarrow> (c # s) \<in> r2 \<rightarrow> injval r2 c v" by fact
+ have "s \<in> der c (ALT r1 r2) \<rightarrow> v" by fact
+ then have "s \<in> ALT (der c r1) (der c r2) \<rightarrow> v" by simp
+ then consider (left) v' where "v = Left v'" "s \<in> der c r1 \<rightarrow> v'"
+ | (right) v' where "v = Right v'" "s \<notin> L (der c r1)" "s \<in> der c r2 \<rightarrow> v'"
+ by cases auto
+ then show "(c # s) \<in> ALT r1 r2 \<rightarrow> injval (ALT r1 r2) c v"
+ proof (cases)
+ case left
+ have "s \<in> der c r1 \<rightarrow> v'" by fact
+ then have "(c # s) \<in> r1 \<rightarrow> injval r1 c v'" using IH1 by simp
+ then have "(c # s) \<in> ALT r1 r2 \<rightarrow> injval (ALT r1 r2) c (Left v')" by (auto intro: Posix.intros)
+ then show "(c # s) \<in> ALT r1 r2 \<rightarrow> injval (ALT r1 r2) c v" using left by simp
+ next
+ case right
+ have "s \<notin> L (der c r1)" by fact
+ then have "c # s \<notin> L r1" by (simp add: der_correctness Der_def)
+ moreover
+ have "s \<in> der c r2 \<rightarrow> v'" by fact
+ then have "(c # s) \<in> r2 \<rightarrow> injval r2 c v'" using IH2 by simp
+ ultimately have "(c # s) \<in> ALT r1 r2 \<rightarrow> injval (ALT r1 r2) c (Right v')"
+ by (auto intro: Posix.intros)
+ then show "(c # s) \<in> ALT r1 r2 \<rightarrow> injval (ALT r1 r2) c v" using right by simp
+ qed
+next
+ case (SEQ r1 r2)
+ have IH1: "\<And>s v. s \<in> der c r1 \<rightarrow> v \<Longrightarrow> (c # s) \<in> r1 \<rightarrow> injval r1 c v" by fact
+ have IH2: "\<And>s v. s \<in> der c r2 \<rightarrow> v \<Longrightarrow> (c # s) \<in> r2 \<rightarrow> injval r2 c v" by fact
+ have "s \<in> der c (SEQ r1 r2) \<rightarrow> v" by fact
+ then consider
+ (left_nullable) v1 v2 s1 s2 where
+ "v = Left (Seq v1 v2)" "s = s1 @ s2"
+ "s1 \<in> der c r1 \<rightarrow> v1" "s2 \<in> r2 \<rightarrow> v2" "nullable r1"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r1) \<and> s\<^sub>4 \<in> L r2)"
+ | (right_nullable) v1 s1 s2 where
+ "v = Right v1" "s = s1 @ s2"
+ "s \<in> der c r2 \<rightarrow> v1" "nullable r1" "s1 @ s2 \<notin> L (SEQ (der c r1) r2)"
+ | (not_nullable) v1 v2 s1 s2 where
+ "v = Seq v1 v2" "s = s1 @ s2"
+ "s1 \<in> der c r1 \<rightarrow> v1" "s2 \<in> r2 \<rightarrow> v2" "\<not>nullable r1"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r1) \<and> s\<^sub>4 \<in> L r2)"
+ by (force split: if_splits elim!: Posix_elims simp add: Sequ_def der_correctness Der_def)
+ then show "(c # s) \<in> SEQ r1 r2 \<rightarrow> injval (SEQ r1 r2) c v"
+ proof (cases)
+ case left_nullable
+ have "s1 \<in> der c r1 \<rightarrow> v1" by fact
+ then have "(c # s1) \<in> r1 \<rightarrow> injval r1 c v1" using IH1 by simp
+ moreover
+ have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r1) \<and> s\<^sub>4 \<in> L r2)" by fact
+ then have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (c # s1) @ s\<^sub>3 \<in> L r1 \<and> s\<^sub>4 \<in> L r2)" by (simp add: der_correctness Der_def)
+ ultimately have "((c # s1) @ s2) \<in> SEQ r1 r2 \<rightarrow> Seq (injval r1 c v1) v2" using left_nullable by (rule_tac Posix.intros)
+ then show "(c # s) \<in> SEQ r1 r2 \<rightarrow> injval (SEQ r1 r2) c v" using left_nullable by simp
+ next
+ case right_nullable
+ have "nullable r1" by fact
+ then have "[] \<in> r1 \<rightarrow> (mkeps r1)" by (rule Posix_mkeps)
+ moreover
+ have "s \<in> der c r2 \<rightarrow> v1" by fact
+ then have "(c # s) \<in> r2 \<rightarrow> (injval r2 c v1)" using IH2 by simp
+ moreover
+ have "s1 @ s2 \<notin> L (SEQ (der c r1) r2)" by fact
+ then have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = c # s \<and> [] @ s\<^sub>3 \<in> L r1 \<and> s\<^sub>4 \<in> L r2)" using right_nullable
+ by(auto simp add: der_correctness Der_def append_eq_Cons_conv Sequ_def)
+ ultimately have "([] @ (c # s)) \<in> SEQ r1 r2 \<rightarrow> Seq (mkeps r1) (injval r2 c v1)"
+ by(rule Posix.intros)
+ then show "(c # s) \<in> SEQ r1 r2 \<rightarrow> injval (SEQ r1 r2) c v" using right_nullable by simp
+ next
+ case not_nullable
+ have "s1 \<in> der c r1 \<rightarrow> v1" by fact
+ then have "(c # s1) \<in> r1 \<rightarrow> injval r1 c v1" using IH1 by simp
+ moreover
+ have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r1) \<and> s\<^sub>4 \<in> L r2)" by fact
+ then have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (c # s1) @ s\<^sub>3 \<in> L r1 \<and> s\<^sub>4 \<in> L r2)" by (simp add: der_correctness Der_def)
+ ultimately have "((c # s1) @ s2) \<in> SEQ r1 r2 \<rightarrow> Seq (injval r1 c v1) v2" using not_nullable
+ by (rule_tac Posix.intros) (simp_all)
+ then show "(c # s) \<in> SEQ r1 r2 \<rightarrow> injval (SEQ r1 r2) c v" using not_nullable by simp
+ qed
+next
+ case (STAR r)
+ have IH: "\<And>s v. s \<in> der c r \<rightarrow> v \<Longrightarrow> (c # s) \<in> r \<rightarrow> injval r c v" by fact
+ have "s \<in> der c (STAR r) \<rightarrow> v" by fact
+ then consider
+ (cons) v1 vs s1 s2 where
+ "v = Seq v1 (Stars vs)" "s = s1 @ s2"
+ "s1 \<in> der c r \<rightarrow> v1" "s2 \<in> (STAR r) \<rightarrow> (Stars vs)"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r) \<and> s\<^sub>4 \<in> L (STAR r))"
+ apply(auto elim!: Posix_elims(1-5) simp add: der_correctness Der_def intro: Posix.intros)
+ apply(rotate_tac 3)
+ apply(erule_tac Posix_elims(6))
+ apply (simp add: Posix.intros(6))
+ using Posix.intros(7) by blast
+ then show "(c # s) \<in> STAR r \<rightarrow> injval (STAR r) c v"
+ proof (cases)
+ case cons
+ have "s1 \<in> der c r \<rightarrow> v1" by fact
+ then have "(c # s1) \<in> r \<rightarrow> injval r c v1" using IH by simp
+ moreover
+ have "s2 \<in> STAR r \<rightarrow> Stars vs" by fact
+ moreover
+ have "(c # s1) \<in> r \<rightarrow> injval r c v1" by fact
+ then have "flat (injval r c v1) = (c # s1)" by (rule Posix1)
+ then have "flat (injval r c v1) \<noteq> []" by simp
+ moreover
+ have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r) \<and> s\<^sub>4 \<in> L (STAR r))" by fact
+ then have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (c # s1) @ s\<^sub>3 \<in> L r \<and> s\<^sub>4 \<in> L (STAR r))"
+ by (simp add: der_correctness Der_def)
+ ultimately
+ have "((c # s1) @ s2) \<in> STAR r \<rightarrow> Stars (injval r c v1 # vs)" by (rule Posix.intros)
+ then show "(c # s) \<in> STAR r \<rightarrow> injval (STAR r) c v" using cons by(simp)
+ qed
+qed
+
+
+section {* Lexer Correctness *}
+
+
+lemma lexer_correct_None:
+ shows "s \<notin> L r \<longleftrightarrow> lexer r s = None"
+ apply(induct s arbitrary: r)
+ apply(simp)
+ apply(simp add: nullable_correctness)
+ apply(simp)
+ apply(drule_tac x="der a r" in meta_spec)
+ apply(auto)
+ apply(auto simp add: der_correctness Der_def)
+done
+
+lemma lexer_correct_Some:
+ shows "s \<in> L r \<longleftrightarrow> (\<exists>v. lexer r s = Some(v) \<and> s \<in> r \<rightarrow> v)"
+ apply(induct s arbitrary : r)
+ apply(simp only: lexer.simps)
+ apply(simp)
+ apply(simp add: nullable_correctness Posix_mkeps)
+ apply(drule_tac x="der a r" in meta_spec)
+ apply(simp (no_asm_use) add: der_correctness Der_def del: lexer.simps)
+ apply(simp del: lexer.simps)
+ apply(simp only: lexer.simps)
+ apply(case_tac "lexer (der a r) s = None")
+ apply(auto)[1]
+ apply(simp)
+ apply(erule exE)
+ apply(simp)
+ apply(rule iffI)
+ apply(simp add: Posix_injval)
+ apply(simp add: Posix1(1))
+done
+
+lemma lexer_correctness:
+ shows "(lexer r s = Some v) \<longleftrightarrow> s \<in> r \<rightarrow> v"
+ and "(lexer r s = None) \<longleftrightarrow> \<not>(\<exists>v. s \<in> r \<rightarrow> v)"
+using Posix1(1) Posix_determ lexer_correct_None lexer_correct_Some apply fastforce
+using Posix1(1) lexer_correct_None lexer_correct_Some by blast
+
+
+subsection {* A slight reformulation of the lexer algorithm using stacked functions*}
+
+fun flex :: "rexp \<Rightarrow> (val \<Rightarrow> val) => string \<Rightarrow> (val \<Rightarrow> val)"
+ where
+ "flex r f [] = f"
+| "flex r f (c#s) = flex (der c r) (\<lambda>v. f (injval r c v)) s"
+
+lemma flex_fun_apply:
+ shows "g (flex r f s v) = flex r (g o f) s v"
+ apply(induct s arbitrary: g f r v)
+ apply(simp_all add: comp_def)
+ by meson
+
+lemma flex_fun_apply2:
+ shows "g (flex r id s v) = flex r g s v"
+ by (simp add: flex_fun_apply)
+
+
+lemma flex_append:
+ shows "flex r f (s1 @ s2) = flex (ders s1 r) (flex r f s1) s2"
+ apply(induct s1 arbitrary: s2 r f)
+ apply(simp_all)
+ done
+
+lemma lexer_flex:
+ shows "lexer r s = (if nullable (ders s r)
+ then Some(flex r id s (mkeps (ders s r))) else None)"
+ apply(induct s arbitrary: r)
+ apply(simp_all add: flex_fun_apply)
+ done
+
+lemma Posix_flex:
+ assumes "s2 \<in> (ders s1 r) \<rightarrow> v"
+ shows "(s1 @ s2) \<in> r \<rightarrow> flex r id s1 v"
+ using assms
+ apply(induct s1 arbitrary: r v s2)
+ apply(simp)
+ apply(simp)
+ apply(drule_tac x="der a r" in meta_spec)
+ apply(drule_tac x="v" in meta_spec)
+ apply(drule_tac x="s2" in meta_spec)
+ apply(simp)
+ using Posix_injval
+ apply(drule_tac Posix_injval)
+ apply(subst (asm) (5) flex_fun_apply)
+ apply(simp)
+ done
+
+lemma injval_inj:
+ assumes "\<Turnstile> a : (der c r)" "\<Turnstile> v : (der c r)" "injval r c a = injval r c v"
+ shows "a = v"
+ using assms
+ apply(induct r arbitrary: a c v)
+ apply(auto)
+ using Prf_elims(1) apply blast
+ using Prf_elims(1) apply blast
+ apply(case_tac "c = x")
+ apply(auto)
+ using Prf_elims(4) apply auto[1]
+ using Prf_elims(1) apply blast
+ prefer 2
+ apply (smt Prf_elims(3) injval.simps(2) injval.simps(3) val.distinct(25) val.inject(3) val.inject(4))
+ apply(case_tac "nullable r1")
+ apply(auto)
+ apply(erule Prf_elims)
+ apply(erule Prf_elims)
+ apply(erule Prf_elims)
+ apply(erule Prf_elims)
+ apply(auto)
+ apply (metis Prf_injval_flat list.distinct(1) mkeps_flat)
+ apply(erule Prf_elims)
+ apply(erule Prf_elims)
+ apply(auto)
+ using Prf_injval_flat mkeps_flat apply fastforce
+ apply(erule Prf_elims)
+ apply(erule Prf_elims)
+ apply(auto)
+ apply(erule Prf_elims)
+ apply(erule Prf_elims)
+ apply(auto)
+ apply (smt Prf_elims(6) injval.simps(7) list.inject val.inject(5))
+ by (smt Prf_elims(6) injval.simps(7) list.inject val.inject(5))
+
+
+
+lemma uu:
+ assumes "(c # s) \<in> r \<rightarrow> injval r c v" "\<Turnstile> v : (der c r)"
+ shows "s \<in> der c r \<rightarrow> v"
+ using assms
+ apply -
+ apply(subgoal_tac "lexer r (c # s) = Some (injval r c v)")
+ prefer 2
+ using lexer_correctness(1) apply blast
+ apply(simp add: )
+ apply(case_tac "lexer (der c r) s")
+ apply(simp)
+ apply(simp)
+ apply(case_tac "s \<in> der c r \<rightarrow> a")
+ prefer 2
+ apply (simp add: lexer_correctness(1))
+ apply(subgoal_tac "\<Turnstile> a : (der c r)")
+ prefer 2
+ using Posix_Prf apply blast
+ using injval_inj by blast
+
+
+lemma Posix_flex2:
+ assumes "(s1 @ s2) \<in> r \<rightarrow> flex r id s1 v" "\<Turnstile> v : ders s1 r"
+ shows "s2 \<in> (ders s1 r) \<rightarrow> v"
+ using assms
+ apply(induct s1 arbitrary: r v s2 rule: rev_induct)
+ apply(simp)
+ apply(simp)
+ apply(drule_tac x="r" in meta_spec)
+ apply(drule_tac x="injval (ders xs r) x v" in meta_spec)
+ apply(drule_tac x="x#s2" in meta_spec)
+ apply(simp add: flex_append ders_append)
+ using Prf_injval uu by blast
+
+lemma Posix_flex3:
+ assumes "s1 \<in> r \<rightarrow> flex r id s1 v" "\<Turnstile> v : ders s1 r"
+ shows "[] \<in> (ders s1 r) \<rightarrow> v"
+ using assms
+ by (simp add: Posix_flex2)
+
+lemma flex_injval:
+ shows "flex (der a r) (injval r a) s v = injval r a (flex (der a r) id s v)"
+ by (simp add: flex_fun_apply)
+
+lemma Prf_flex:
+ assumes "\<Turnstile> v : ders s r"
+ shows "\<Turnstile> flex r id s v : r"
+ using assms
+ apply(induct s arbitrary: v r)
+ apply(simp)
+ apply(simp)
+ by (simp add: Prf_injval flex_injval)
+
+
+end
\ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys2/LexerExt.thy Sun Oct 10 18:35:21 2021 +0100
@@ -0,0 +1,649 @@
+
+theory LexerExt
+ imports SpecExt
+begin
+
+
+section {* The Lexer Functions by Sulzmann and Lu *}
+
+fun
+ mkeps :: "rexp \<Rightarrow> val"
+where
+ "mkeps(ONE) = Void"
+| "mkeps(SEQ r1 r2) = Seq (mkeps r1) (mkeps r2)"
+| "mkeps(ALT r1 r2) = (if nullable(r1) then Left (mkeps r1) else Right (mkeps r2))"
+| "mkeps(STAR r) = Stars []"
+| "mkeps(UPNTIMES r n) = Stars []"
+| "mkeps(NTIMES r n) = Stars (replicate n (mkeps r))"
+| "mkeps(FROMNTIMES r n) = Stars (replicate n (mkeps r))"
+| "mkeps(NMTIMES r n m) = Stars (replicate n (mkeps r))"
+
+fun injval :: "rexp \<Rightarrow> char \<Rightarrow> val \<Rightarrow> val"
+where
+ "injval (CHAR d) c Void = Char d"
+| "injval (ALT r1 r2) c (Left v1) = Left(injval r1 c v1)"
+| "injval (ALT r1 r2) c (Right v2) = Right(injval r2 c v2)"
+| "injval (SEQ r1 r2) c (Seq v1 v2) = Seq (injval r1 c v1) v2"
+| "injval (SEQ r1 r2) c (Left (Seq v1 v2)) = Seq (injval r1 c v1) v2"
+| "injval (SEQ r1 r2) c (Right v2) = Seq (mkeps r1) (injval r2 c v2)"
+| "injval (STAR r) c (Seq v (Stars vs)) = Stars ((injval r c v) # vs)"
+| "injval (NTIMES r n) c (Seq v (Stars vs)) = Stars ((injval r c v) # vs)"
+| "injval (FROMNTIMES r n) c (Seq v (Stars vs)) = Stars ((injval r c v) # vs)"
+| "injval (UPNTIMES r n) c (Seq v (Stars vs)) = Stars ((injval r c v) # vs)"
+| "injval (NMTIMES r n m) c (Seq v (Stars vs)) = Stars ((injval r c v) # vs)"
+
+fun
+ lexer :: "rexp \<Rightarrow> string \<Rightarrow> val option"
+where
+ "lexer r [] = (if nullable r then Some(mkeps r) else None)"
+| "lexer r (c#s) = (case (lexer (der c r) s) of
+ None \<Rightarrow> None
+ | Some(v) \<Rightarrow> Some(injval r c v))"
+
+
+
+section {* Mkeps, Injval Properties *}
+
+lemma mkeps_flat:
+ assumes "nullable(r)"
+ shows "flat (mkeps r) = []"
+using assms
+ apply(induct rule: nullable.induct)
+ apply(auto)
+ by presburger
+
+
+lemma mkeps_nullable:
+ assumes "nullable(r)"
+ shows "\<Turnstile> mkeps r : r"
+using assms
+apply(induct rule: nullable.induct)
+ apply(auto intro: Prf.intros split: if_splits)
+ using Prf.intros(8) apply force
+ apply(subst append.simps(1)[symmetric])
+ apply(rule Prf.intros)
+ apply(simp)
+ apply(simp)
+ apply (simp add: mkeps_flat)
+ apply(simp)
+ using Prf.intros(9) apply force
+ apply(subst append.simps(1)[symmetric])
+ apply(rule Prf.intros)
+ apply(simp)
+ apply(simp)
+ apply (simp add: mkeps_flat)
+ apply(simp)
+ using Prf.intros(11) apply force
+ apply(subst append.simps(1)[symmetric])
+ apply(rule Prf.intros)
+ apply(simp)
+ apply(simp)
+ apply (simp add: mkeps_flat)
+ apply(simp)
+ apply(simp)
+done
+
+
+lemma Prf_injval_flat:
+ assumes "\<Turnstile> v : der c r"
+ shows "flat (injval r c v) = c # (flat v)"
+using assms
+apply(induct arbitrary: v rule: der.induct)
+apply(auto elim!: Prf_elims intro: mkeps_flat split: if_splits)
+done
+
+lemma Prf_injval:
+ assumes "\<Turnstile> v : der c r"
+ shows "\<Turnstile> (injval r c v) : r"
+using assms
+apply(induct r arbitrary: c v rule: rexp.induct)
+apply(auto intro!: Prf.intros mkeps_nullable elim!: Prf_elims split: if_splits)[6]
+ apply(simp add: Prf_injval_flat)
+ apply(simp)
+ apply(case_tac x2)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ using Prf.intros(7) Prf_injval_flat apply auto[1]
+ apply(simp)
+ apply(case_tac x2)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(subst append.simps(2)[symmetric])
+ apply(rule Prf.intros)
+ apply(simp add: Prf_injval_flat)
+ apply(simp)
+ apply(simp)
+ prefer 2
+ apply(simp)
+ apply(case_tac "x3a < x2")
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(case_tac x2)
+ apply(simp)
+ apply(case_tac x3a)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ using Prf.intros(12) Prf_injval_flat apply auto[1]
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(subst append.simps(2)[symmetric])
+ apply(rule Prf.intros)
+ apply(simp add: Prf_injval_flat)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ using Prf.intros(12) Prf_injval_flat apply auto[1]
+ apply(case_tac x2)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp_all)
+ apply (simp add: Prf.intros(10) Prf_injval_flat)
+ using Prf.intros(10) Prf_injval_flat apply auto[1]
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp_all)
+ apply(subst append.simps(2)[symmetric])
+ apply(rule Prf.intros)
+ apply(simp add: Prf_injval_flat)
+ apply(simp)
+ apply(simp)
+done
+
+
+
+text {*
+ Mkeps and injval produce, or preserve, Posix values.
+*}
+
+lemma Posix_mkeps:
+ assumes "nullable r"
+ shows "[] \<in> r \<rightarrow> mkeps r"
+using assms
+apply(induct r rule: nullable.induct)
+apply(auto intro: Posix.intros simp add: nullable_correctness Sequ_def)
+apply(subst append.simps(1)[symmetric])
+apply(rule Posix.intros)
+ apply(auto)
+ done
+
+
+lemma Posix_injval:
+ assumes "s \<in> (der c r) \<rightarrow> v"
+ shows "(c # s) \<in> r \<rightarrow> (injval r c v)"
+using assms
+proof(induct r arbitrary: s v rule: rexp.induct)
+ case ZERO
+ have "s \<in> der c ZERO \<rightarrow> v" by fact
+ then have "s \<in> ZERO \<rightarrow> v" by simp
+ then have "False" by cases
+ then show "(c # s) \<in> ZERO \<rightarrow> (injval ZERO c v)" by simp
+next
+ case ONE
+ have "s \<in> der c ONE \<rightarrow> v" by fact
+ then have "s \<in> ZERO \<rightarrow> v" by simp
+ then have "False" by cases
+ then show "(c # s) \<in> ONE \<rightarrow> (injval ONE c v)" by simp
+next
+ case (CHAR d)
+ consider (eq) "c = d" | (ineq) "c \<noteq> d" by blast
+ then show "(c # s) \<in> (CHAR d) \<rightarrow> (injval (CHAR d) c v)"
+ proof (cases)
+ case eq
+ have "s \<in> der c (CHAR d) \<rightarrow> v" by fact
+ then have "s \<in> ONE \<rightarrow> v" using eq by simp
+ then have eqs: "s = [] \<and> v = Void" by cases simp
+ show "(c # s) \<in> CHAR d \<rightarrow> injval (CHAR d) c v" using eq eqs
+ by (auto intro: Posix.intros)
+ next
+ case ineq
+ have "s \<in> der c (CHAR d) \<rightarrow> v" by fact
+ then have "s \<in> ZERO \<rightarrow> v" using ineq by simp
+ then have "False" by cases
+ then show "(c # s) \<in> CHAR d \<rightarrow> injval (CHAR d) c v" by simp
+ qed
+next
+ case (ALT r1 r2)
+ have IH1: "\<And>s v. s \<in> der c r1 \<rightarrow> v \<Longrightarrow> (c # s) \<in> r1 \<rightarrow> injval r1 c v" by fact
+ have IH2: "\<And>s v. s \<in> der c r2 \<rightarrow> v \<Longrightarrow> (c # s) \<in> r2 \<rightarrow> injval r2 c v" by fact
+ have "s \<in> der c (ALT r1 r2) \<rightarrow> v" by fact
+ then have "s \<in> ALT (der c r1) (der c r2) \<rightarrow> v" by simp
+ then consider (left) v' where "v = Left v'" "s \<in> der c r1 \<rightarrow> v'"
+ | (right) v' where "v = Right v'" "s \<notin> L (der c r1)" "s \<in> der c r2 \<rightarrow> v'"
+ by cases auto
+ then show "(c # s) \<in> ALT r1 r2 \<rightarrow> injval (ALT r1 r2) c v"
+ proof (cases)
+ case left
+ have "s \<in> der c r1 \<rightarrow> v'" by fact
+ then have "(c # s) \<in> r1 \<rightarrow> injval r1 c v'" using IH1 by simp
+ then have "(c # s) \<in> ALT r1 r2 \<rightarrow> injval (ALT r1 r2) c (Left v')" by (auto intro: Posix.intros)
+ then show "(c # s) \<in> ALT r1 r2 \<rightarrow> injval (ALT r1 r2) c v" using left by simp
+ next
+ case right
+ have "s \<notin> L (der c r1)" by fact
+ then have "c # s \<notin> L r1" by (simp add: der_correctness Der_def)
+ moreover
+ have "s \<in> der c r2 \<rightarrow> v'" by fact
+ then have "(c # s) \<in> r2 \<rightarrow> injval r2 c v'" using IH2 by simp
+ ultimately have "(c # s) \<in> ALT r1 r2 \<rightarrow> injval (ALT r1 r2) c (Right v')"
+ by (auto intro: Posix.intros)
+ then show "(c # s) \<in> ALT r1 r2 \<rightarrow> injval (ALT r1 r2) c v" using right by simp
+ qed
+next
+ case (SEQ r1 r2)
+ have IH1: "\<And>s v. s \<in> der c r1 \<rightarrow> v \<Longrightarrow> (c # s) \<in> r1 \<rightarrow> injval r1 c v" by fact
+ have IH2: "\<And>s v. s \<in> der c r2 \<rightarrow> v \<Longrightarrow> (c # s) \<in> r2 \<rightarrow> injval r2 c v" by fact
+ have "s \<in> der c (SEQ r1 r2) \<rightarrow> v" by fact
+ then consider
+ (left_nullable) v1 v2 s1 s2 where
+ "v = Left (Seq v1 v2)" "s = s1 @ s2"
+ "s1 \<in> der c r1 \<rightarrow> v1" "s2 \<in> r2 \<rightarrow> v2" "nullable r1"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r1) \<and> s\<^sub>4 \<in> L r2)"
+ | (right_nullable) v1 s1 s2 where
+ "v = Right v1" "s = s1 @ s2"
+ "s \<in> der c r2 \<rightarrow> v1" "nullable r1" "s1 @ s2 \<notin> L (SEQ (der c r1) r2)"
+ | (not_nullable) v1 v2 s1 s2 where
+ "v = Seq v1 v2" "s = s1 @ s2"
+ "s1 \<in> der c r1 \<rightarrow> v1" "s2 \<in> r2 \<rightarrow> v2" "\<not>nullable r1"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r1) \<and> s\<^sub>4 \<in> L r2)"
+ by (force split: if_splits elim!: Posix_elims simp add: Sequ_def der_correctness Der_def)
+ then show "(c # s) \<in> SEQ r1 r2 \<rightarrow> injval (SEQ r1 r2) c v"
+ proof (cases)
+ case left_nullable
+ have "s1 \<in> der c r1 \<rightarrow> v1" by fact
+ then have "(c # s1) \<in> r1 \<rightarrow> injval r1 c v1" using IH1 by simp
+ moreover
+ have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r1) \<and> s\<^sub>4 \<in> L r2)" by fact
+ then have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (c # s1) @ s\<^sub>3 \<in> L r1 \<and> s\<^sub>4 \<in> L r2)" by (simp add: der_correctness Der_def)
+ ultimately have "((c # s1) @ s2) \<in> SEQ r1 r2 \<rightarrow> Seq (injval r1 c v1) v2" using left_nullable by (rule_tac Posix.intros)
+ then show "(c # s) \<in> SEQ r1 r2 \<rightarrow> injval (SEQ r1 r2) c v" using left_nullable by simp
+ next
+ case right_nullable
+ have "nullable r1" by fact
+ then have "[] \<in> r1 \<rightarrow> (mkeps r1)" by (rule Posix_mkeps)
+ moreover
+ have "s \<in> der c r2 \<rightarrow> v1" by fact
+ then have "(c # s) \<in> r2 \<rightarrow> (injval r2 c v1)" using IH2 by simp
+ moreover
+ have "s1 @ s2 \<notin> L (SEQ (der c r1) r2)" by fact
+ then have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = c # s \<and> [] @ s\<^sub>3 \<in> L r1 \<and> s\<^sub>4 \<in> L r2)" using right_nullable
+ by(auto simp add: der_correctness Der_def append_eq_Cons_conv Sequ_def)
+ ultimately have "([] @ (c # s)) \<in> SEQ r1 r2 \<rightarrow> Seq (mkeps r1) (injval r2 c v1)"
+ by(rule Posix.intros)
+ then show "(c # s) \<in> SEQ r1 r2 \<rightarrow> injval (SEQ r1 r2) c v" using right_nullable by simp
+ next
+ case not_nullable
+ have "s1 \<in> der c r1 \<rightarrow> v1" by fact
+ then have "(c # s1) \<in> r1 \<rightarrow> injval r1 c v1" using IH1 by simp
+ moreover
+ have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r1) \<and> s\<^sub>4 \<in> L r2)" by fact
+ then have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (c # s1) @ s\<^sub>3 \<in> L r1 \<and> s\<^sub>4 \<in> L r2)" by (simp add: der_correctness Der_def)
+ ultimately have "((c # s1) @ s2) \<in> SEQ r1 r2 \<rightarrow> Seq (injval r1 c v1) v2" using not_nullable
+ by (rule_tac Posix.intros) (simp_all)
+ then show "(c # s) \<in> SEQ r1 r2 \<rightarrow> injval (SEQ r1 r2) c v" using not_nullable by simp
+ qed
+next
+case (UPNTIMES r n s v)
+ have IH: "\<And>s v. s \<in> der c r \<rightarrow> v \<Longrightarrow> (c # s) \<in> r \<rightarrow> injval r c v" by fact
+ have "s \<in> der c (UPNTIMES r n) \<rightarrow> v" by fact
+ then consider
+ (cons) v1 vs s1 s2 where
+ "v = Seq v1 (Stars vs)" "s = s1 @ s2"
+ "s1 \<in> der c r \<rightarrow> v1" "s2 \<in> (UPNTIMES r (n - 1)) \<rightarrow> (Stars vs)" "0 < n"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r) \<and> s\<^sub>4 \<in> L (UPNTIMES r (n - 1)))"
+ (* here *)
+ apply(auto elim: Posix_elims simp add: der_correctness Der_def intro: Posix.intros split: if_splits)
+ apply(erule Posix_elims)
+ apply(simp)
+ apply(subgoal_tac "\<exists>vss. v2 = Stars vss")
+ apply(clarify)
+ apply(drule_tac x="v1" in meta_spec)
+ apply(drule_tac x="vss" in meta_spec)
+ apply(drule_tac x="s1" in meta_spec)
+ apply(drule_tac x="s2" in meta_spec)
+ apply(simp add: der_correctness Der_def)
+ apply(erule Posix_elims)
+ apply(auto)
+ done
+ then show "(c # s) \<in> (UPNTIMES r n) \<rightarrow> injval (UPNTIMES r n) c v"
+ proof (cases)
+ case cons
+ have "s1 \<in> der c r \<rightarrow> v1" by fact
+ then have "(c # s1) \<in> r \<rightarrow> injval r c v1" using IH by simp
+ moreover
+ have "s2 \<in> (UPNTIMES r (n - 1)) \<rightarrow> Stars vs" by fact
+ moreover
+ have "(c # s1) \<in> r \<rightarrow> injval r c v1" by fact
+ then have "flat (injval r c v1) = (c # s1)" by (rule Posix1)
+ then have "flat (injval r c v1) \<noteq> []" by simp
+ moreover
+ have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r) \<and> s\<^sub>4 \<in> L (UPNTIMES r (n - 1)))" by fact
+ then have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (c # s1) @ s\<^sub>3 \<in> L r \<and> s\<^sub>4 \<in> L (UPNTIMES r (n - 1)))"
+ by (simp add: der_correctness Der_def)
+ ultimately
+ have "((c # s1) @ s2) \<in> UPNTIMES r n \<rightarrow> Stars (injval r c v1 # vs)"
+ thm Posix.intros
+ apply (rule_tac Posix.intros)
+ apply(simp_all)
+ apply(case_tac n)
+ apply(simp)
+ using Posix_elims(1) UPNTIMES.prems apply auto[1]
+ apply(simp)
+ done
+ then show "(c # s) \<in> UPNTIMES r n \<rightarrow> injval (UPNTIMES r n) c v" using cons by(simp)
+ qed
+ next
+ case (STAR r)
+ have IH: "\<And>s v. s \<in> der c r \<rightarrow> v \<Longrightarrow> (c # s) \<in> r \<rightarrow> injval r c v" by fact
+ have "s \<in> der c (STAR r) \<rightarrow> v" by fact
+ then consider
+ (cons) v1 vs s1 s2 where
+ "v = Seq v1 (Stars vs)" "s = s1 @ s2"
+ "s1 \<in> der c r \<rightarrow> v1" "s2 \<in> (STAR r) \<rightarrow> (Stars vs)"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r) \<and> s\<^sub>4 \<in> L (STAR r))"
+ apply(auto elim!: Posix_elims(1-5) simp add: der_correctness Der_def intro: Posix.intros)
+ apply(rotate_tac 3)
+ apply(erule_tac Posix_elims(6))
+ apply (simp add: Posix.intros(6))
+ using Posix.intros(7) by blast
+ then show "(c # s) \<in> STAR r \<rightarrow> injval (STAR r) c v"
+ proof (cases)
+ case cons
+ have "s1 \<in> der c r \<rightarrow> v1" by fact
+ then have "(c # s1) \<in> r \<rightarrow> injval r c v1" using IH by simp
+ moreover
+ have "s2 \<in> STAR r \<rightarrow> Stars vs" by fact
+ moreover
+ have "(c # s1) \<in> r \<rightarrow> injval r c v1" by fact
+ then have "flat (injval r c v1) = (c # s1)" by (rule Posix1)
+ then have "flat (injval r c v1) \<noteq> []" by simp
+ moreover
+ have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r) \<and> s\<^sub>4 \<in> L (STAR r))" by fact
+ then have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (c # s1) @ s\<^sub>3 \<in> L r \<and> s\<^sub>4 \<in> L (STAR r))"
+ by (simp add: der_correctness Der_def)
+ ultimately
+ have "((c # s1) @ s2) \<in> STAR r \<rightarrow> Stars (injval r c v1 # vs)" by (rule Posix.intros)
+ then show "(c # s) \<in> STAR r \<rightarrow> injval (STAR r) c v" using cons by(simp)
+ qed
+ next
+ case (NTIMES r n s v)
+ have IH: "\<And>s v. s \<in> der c r \<rightarrow> v \<Longrightarrow> (c # s) \<in> r \<rightarrow> injval r c v" by fact
+ have "s \<in> der c (NTIMES r n) \<rightarrow> v" by fact
+ then consider
+ (cons) v1 vs s1 s2 where
+ "v = Seq v1 (Stars vs)" "s = s1 @ s2"
+ "s1 \<in> der c r \<rightarrow> v1" "s2 \<in> (NTIMES r (n - 1)) \<rightarrow> (Stars vs)" "0 < n"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r) \<and> s\<^sub>4 \<in> L (NTIMES r (n - 1)))"
+ apply(auto elim: Posix_elims simp add: der_correctness Der_def intro: Posix.intros split: if_splits)
+ apply(erule Posix_elims)
+ apply(simp)
+ apply(subgoal_tac "\<exists>vss. v2 = Stars vss")
+ apply(clarify)
+ apply(drule_tac x="v1" in meta_spec)
+ apply(drule_tac x="vss" in meta_spec)
+ apply(drule_tac x="s1" in meta_spec)
+ apply(drule_tac x="s2" in meta_spec)
+ apply(simp add: der_correctness Der_def)
+ apply(erule Posix_elims)
+ apply(auto)
+ done
+ then show "(c # s) \<in> (NTIMES r n) \<rightarrow> injval (NTIMES r n) c v"
+ proof (cases)
+ case cons
+ have "s1 \<in> der c r \<rightarrow> v1" by fact
+ then have "(c # s1) \<in> r \<rightarrow> injval r c v1" using IH by simp
+ moreover
+ have "s2 \<in> (NTIMES r (n - 1)) \<rightarrow> Stars vs" by fact
+ moreover
+ have "(c # s1) \<in> r \<rightarrow> injval r c v1" by fact
+ then have "flat (injval r c v1) = (c # s1)" by (rule Posix1)
+ then have "flat (injval r c v1) \<noteq> []" by simp
+ moreover
+ have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r) \<and> s\<^sub>4 \<in> L (NTIMES r (n - 1)))" by fact
+ then have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (c # s1) @ s\<^sub>3 \<in> L r \<and> s\<^sub>4 \<in> L (NTIMES r (n - 1)))"
+ by (simp add: der_correctness Der_def)
+ ultimately
+ have "((c # s1) @ s2) \<in> NTIMES r n \<rightarrow> Stars (injval r c v1 # vs)"
+ apply (rule_tac Posix.intros)
+ apply(simp_all)
+ apply(case_tac n)
+ apply(simp)
+ using Posix_elims(1) NTIMES.prems apply auto[1]
+ apply(simp)
+ done
+ then show "(c # s) \<in> NTIMES r n \<rightarrow> injval (NTIMES r n) c v" using cons by(simp)
+ qed
+ next
+ case (FROMNTIMES r n s v)
+ have IH: "\<And>s v. s \<in> der c r \<rightarrow> v \<Longrightarrow> (c # s) \<in> r \<rightarrow> injval r c v" by fact
+ have "s \<in> der c (FROMNTIMES r n) \<rightarrow> v" by fact
+ then consider
+ (cons) v1 vs s1 s2 where
+ "v = Seq v1 (Stars vs)" "s = s1 @ s2"
+ "s1 \<in> der c r \<rightarrow> v1" "s2 \<in> (FROMNTIMES r (n - 1)) \<rightarrow> (Stars vs)" "0 < n"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r) \<and> s\<^sub>4 \<in> L (FROMNTIMES r (n - 1)))"
+ | (null) v1 vs s1 s2 where
+ "v = Seq v1 (Stars vs)" "s = s1 @ s2" "s2 \<in> (STAR r) \<rightarrow> (Stars vs)"
+ "s1 \<in> der c r \<rightarrow> v1" "n = 0"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r) \<and> s\<^sub>4 \<in> L (STAR r))"
+ apply(auto elim: Posix_elims simp add: der_correctness Der_def intro: Posix.intros split: if_splits)
+ prefer 2
+ apply(erule Posix_elims)
+ apply(simp)
+ apply(subgoal_tac "\<exists>vss. v2 = Stars vss")
+ apply(clarify)
+ apply(drule_tac x="v1" in meta_spec)
+ apply(drule_tac x="vss" in meta_spec)
+ apply(drule_tac x="s1" in meta_spec)
+ apply(drule_tac x="s2" in meta_spec)
+ apply(simp add: der_correctness Der_def)
+ apply(rotate_tac 5)
+ apply(erule Posix_elims)
+ apply(auto)[2]
+ apply(erule Posix_elims)
+ apply(simp)
+ apply blast
+ apply(erule Posix_elims)
+ apply(auto)
+ apply(auto elim: Posix_elims simp add: der_correctness Der_def intro: Posix.intros split: if_splits)
+ apply(subgoal_tac "\<exists>vss. v2 = Stars vss")
+ apply(clarify)
+ apply simp
+ apply(rotate_tac 6)
+ apply(erule Posix_elims)
+ apply(auto)[2]
+ done
+ then show "(c # s) \<in> (FROMNTIMES r n) \<rightarrow> injval (FROMNTIMES r n) c v"
+ proof (cases)
+ case cons
+ have "s1 \<in> der c r \<rightarrow> v1" by fact
+ then have "(c # s1) \<in> r \<rightarrow> injval r c v1" using IH by simp
+ moreover
+ have "s2 \<in> (FROMNTIMES r (n - 1)) \<rightarrow> Stars vs" by fact
+ moreover
+ have "(c # s1) \<in> r \<rightarrow> injval r c v1" by fact
+ then have "flat (injval r c v1) = (c # s1)" by (rule Posix1)
+ then have "flat (injval r c v1) \<noteq> []" by simp
+ moreover
+ have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r) \<and> s\<^sub>4 \<in> L (FROMNTIMES r (n - 1)))" by fact
+ then have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (c # s1) @ s\<^sub>3 \<in> L r \<and> s\<^sub>4 \<in> L (FROMNTIMES r (n - 1)))"
+ by (simp add: der_correctness Der_def)
+ ultimately
+ have "((c # s1) @ s2) \<in> FROMNTIMES r n \<rightarrow> Stars (injval r c v1 # vs)"
+ apply (rule_tac Posix.intros)
+ apply(simp_all)
+ apply(case_tac n)
+ apply(simp)
+ using Posix_elims(1) FROMNTIMES.prems apply auto[1]
+ using cons(5) apply blast
+ apply(simp)
+ done
+ then show "(c # s) \<in> FROMNTIMES r n \<rightarrow> injval (FROMNTIMES r n) c v" using cons by(simp)
+ next
+ case null
+ have "s1 \<in> der c r \<rightarrow> v1" by fact
+ then have "(c # s1) \<in> r \<rightarrow> injval r c v1" using IH by simp
+ moreover
+ have "s2 \<in> STAR r \<rightarrow> Stars vs" by fact
+ moreover
+ have "(c # s1) \<in> r \<rightarrow> injval r c v1" by fact
+ then have "flat (injval r c v1) = (c # s1)" by (rule Posix1)
+ then have "flat (injval r c v1) \<noteq> []" by simp
+ moreover
+ moreover
+ have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r) \<and> s\<^sub>4 \<in> L (STAR r))" by fact
+ then have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (c # s1) @ s\<^sub>3 \<in> L r \<and> s\<^sub>4 \<in> L (STAR r))"
+ by (simp add: der_correctness Der_def)
+ ultimately
+ have "((c # s1) @ s2) \<in> FROMNTIMES r 0 \<rightarrow> Stars (injval r c v1 # vs)"
+ apply (rule_tac Posix.intros) back
+ apply(simp_all)
+ done
+ then show "(c # s) \<in> FROMNTIMES r n \<rightarrow> injval (FROMNTIMES r n) c v" using null
+ apply(simp)
+ done
+ qed
+ next
+ case (NMTIMES r n m s v)
+ have IH: "\<And>s v. s \<in> der c r \<rightarrow> v \<Longrightarrow> (c # s) \<in> r \<rightarrow> injval r c v" by fact
+ have "s \<in> der c (NMTIMES r n m) \<rightarrow> v" by fact
+ then consider
+ (cons) v1 vs s1 s2 where
+ "v = Seq v1 (Stars vs)" "s = s1 @ s2"
+ "s1 \<in> der c r \<rightarrow> v1" "s2 \<in> (NMTIMES r (n - 1) (m - 1)) \<rightarrow> (Stars vs)" "0 < n" "n \<le> m"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r) \<and> s\<^sub>4 \<in> L (NMTIMES r (n - 1) (m - 1)))"
+ | (null) v1 vs s1 s2 where
+ "v = Seq v1 (Stars vs)" "s = s1 @ s2" "s2 \<in> (UPNTIMES r (m - 1)) \<rightarrow> (Stars vs)"
+ "s1 \<in> der c r \<rightarrow> v1" "n = 0" "0 < m"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r) \<and> s\<^sub>4 \<in> L (UPNTIMES r (m - 1)))"
+ apply(auto elim: Posix_elims simp add: der_correctness Der_def intro: Posix.intros split: if_splits)
+ prefer 2
+ apply(erule Posix_elims)
+ apply(simp)
+ apply(subgoal_tac "\<exists>vss. v2 = Stars vss")
+ apply(clarify)
+ apply(drule_tac x="v1" in meta_spec)
+ apply(drule_tac x="vss" in meta_spec)
+ apply(drule_tac x="s1" in meta_spec)
+ apply(drule_tac x="s2" in meta_spec)
+ apply(simp add: der_correctness Der_def)
+ apply(rotate_tac 5)
+ apply(erule Posix_elims)
+ apply(auto)[2]
+ apply(erule Posix_elims)
+ apply(simp)
+ apply blast
+
+ apply(erule Posix_elims)
+ apply(auto)
+ apply(auto elim: Posix_elims simp add: der_correctness Der_def intro: Posix.intros split: if_splits)
+ apply(subgoal_tac "\<exists>vss. v2 = Stars vss")
+ apply(clarify)
+ apply simp
+ apply(rotate_tac 6)
+ apply(erule Posix_elims)
+ apply(auto)[2]
+ done
+ then show "(c # s) \<in> (NMTIMES r n m) \<rightarrow> injval (NMTIMES r n m) c v"
+ proof (cases)
+ case cons
+ have "s1 \<in> der c r \<rightarrow> v1" by fact
+ then have "(c # s1) \<in> r \<rightarrow> injval r c v1" using IH by simp
+ moreover
+ have "s2 \<in> (NMTIMES r (n - 1) (m - 1)) \<rightarrow> Stars vs" by fact
+ moreover
+ have "(c # s1) \<in> r \<rightarrow> injval r c v1" by fact
+ then have "flat (injval r c v1) = (c # s1)" by (rule Posix1)
+ then have "flat (injval r c v1) \<noteq> []" by simp
+ moreover
+ have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r) \<and> s\<^sub>4 \<in> L (NMTIMES r (n - 1) (m - 1)))" by fact
+ then have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (c # s1) @ s\<^sub>3 \<in> L r \<and> s\<^sub>4 \<in> L (NMTIMES r (n - 1) (m - 1)))"
+ by (simp add: der_correctness Der_def)
+ ultimately
+ have "((c # s1) @ s2) \<in> NMTIMES r n m \<rightarrow> Stars (injval r c v1 # vs)"
+ apply (rule_tac Posix.intros)
+ apply(simp_all)
+ apply(case_tac n)
+ apply(simp)
+ using Posix_elims(1) NMTIMES.prems apply auto[1]
+ using cons(5) apply blast
+ apply(simp)
+ apply(rule cons)
+ done
+ then show "(c # s) \<in> NMTIMES r n m \<rightarrow> injval (NMTIMES r n m) c v" using cons by(simp)
+ next
+ case null
+ have "s1 \<in> der c r \<rightarrow> v1" by fact
+ then have "(c # s1) \<in> r \<rightarrow> injval r c v1" using IH by simp
+ moreover
+ have "s2 \<in> UPNTIMES r (m - 1) \<rightarrow> Stars vs" by fact
+ moreover
+ have "(c # s1) \<in> r \<rightarrow> injval r c v1" by fact
+ then have "flat (injval r c v1) = (c # s1)" by (rule Posix1)
+ then have "flat (injval r c v1) \<noteq> []" by simp
+ moreover
+ moreover
+ have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L (der c r) \<and> s\<^sub>4 \<in> L (UPNTIMES r (m - 1)))" by fact
+ then have "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (c # s1) @ s\<^sub>3 \<in> L r \<and> s\<^sub>4 \<in> L (UPNTIMES r (m - 1)))"
+ by (simp add: der_correctness Der_def)
+ ultimately
+ have "((c # s1) @ s2) \<in> NMTIMES r 0 m \<rightarrow> Stars (injval r c v1 # vs)"
+ apply (rule_tac Posix.intros) back
+ apply(simp_all)
+ apply(rule null)
+ done
+ then show "(c # s) \<in> NMTIMES r n m \<rightarrow> injval (NMTIMES r n m) c v" using null
+ apply(simp)
+ done
+ qed
+qed
+
+section {* Lexer Correctness *}
+
+lemma lexer_correct_None:
+ shows "s \<notin> L r \<longleftrightarrow> lexer r s = None"
+apply(induct s arbitrary: r)
+apply(simp add: nullable_correctness)
+apply(drule_tac x="der a r" in meta_spec)
+apply(auto simp add: der_correctness Der_def)
+done
+
+lemma lexer_correct_Some:
+ shows "s \<in> L r \<longleftrightarrow> (\<exists>v. lexer r s = Some(v) \<and> s \<in> r \<rightarrow> v)"
+apply(induct s arbitrary: r)
+apply(auto simp add: Posix_mkeps nullable_correctness)[1]
+apply(drule_tac x="der a r" in meta_spec)
+apply(simp add: der_correctness Der_def)
+apply(rule iffI)
+apply(auto intro: Posix_injval simp add: Posix1(1))
+done
+
+lemma lexer_correctness:
+ shows "(lexer r s = Some v) \<longleftrightarrow> s \<in> r \<rightarrow> v"
+ and "(lexer r s = None) \<longleftrightarrow> \<not>(\<exists>v. s \<in> r \<rightarrow> v)"
+using Posix1(1) Posix_determ lexer_correct_None lexer_correct_Some apply fastforce
+using Posix1(1) lexer_correct_None lexer_correct_Some by blast
+
+end
\ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys2/PDerivs.thy Sun Oct 10 18:35:21 2021 +0100
@@ -0,0 +1,561 @@
+
+theory PDerivs
+ imports Spec
+begin
+
+
+
+abbreviation
+ "SEQs rs r \<equiv> (\<Union>r' \<in> rs. {SEQ r' r})"
+
+lemma SEQs_eq_image:
+ "SEQs rs r = (\<lambda>r'. SEQ r' r) ` rs"
+ by auto
+
+primrec
+ pder :: "char \<Rightarrow> rexp \<Rightarrow> rexp set"
+where
+ "pder c ZERO = {}"
+| "pder c ONE = {}"
+| "pder c (CHAR d) = (if c = d then {ONE} else {})"
+| "pder c (ALT r1 r2) = (pder c r1) \<union> (pder c r2)"
+| "pder c (SEQ r1 r2) =
+ (if nullable r1 then SEQs (pder c r1) r2 \<union> pder c r2 else SEQs (pder c r1) r2)"
+| "pder c (STAR r) = SEQs (pder c r) (STAR r)"
+
+primrec
+ pders :: "char list \<Rightarrow> rexp \<Rightarrow> rexp set"
+where
+ "pders [] r = {r}"
+| "pders (c # s) r = \<Union> (pders s ` pder c r)"
+
+abbreviation
+ pder_set :: "char \<Rightarrow> rexp set \<Rightarrow> rexp set"
+where
+ "pder_set c rs \<equiv> \<Union> (pder c ` rs)"
+
+abbreviation
+ pders_set :: "char list \<Rightarrow> rexp set \<Rightarrow> rexp set"
+where
+ "pders_set s rs \<equiv> \<Union> (pders s ` rs)"
+
+lemma pders_append:
+ "pders (s1 @ s2) r = \<Union> (pders s2 ` pders s1 r)"
+by (induct s1 arbitrary: r) (simp_all)
+
+lemma pders_snoc:
+ shows "pders (s @ [c]) r = pder_set c (pders s r)"
+by (simp add: pders_append)
+
+lemma pders_simps [simp]:
+ shows "pders s ZERO = (if s = [] then {ZERO} else {})"
+ and "pders s ONE = (if s = [] then {ONE} else {})"
+ and "pders s (ALT r1 r2) = (if s = [] then {ALT r1 r2} else (pders s r1) \<union> (pders s r2))"
+by (induct s) (simp_all)
+
+lemma pders_CHAR:
+ shows "pders s (CHAR c) \<subseteq> {CHAR c, ONE}"
+by (induct s) (simp_all)
+
+subsection \<open>Relating left-quotients and partial derivatives\<close>
+
+lemma Sequ_UNION_distrib:
+shows "A ;; \<Union>(M ` I) = \<Union>((\<lambda>i. A ;; M i) ` I)"
+and "\<Union>(M ` I) ;; A = \<Union>((\<lambda>i. M i ;; A) ` I)"
+by (auto simp add: Sequ_def)
+
+
+lemma Der_pder:
+ shows "Der c (L r) = \<Union> (L ` pder c r)"
+by (induct r) (simp_all add: nullable_correctness Sequ_UNION_distrib)
+
+lemma Ders_pders:
+ shows "Ders s (L r) = \<Union> (L ` pders s r)"
+proof (induct s arbitrary: r)
+ case (Cons c s)
+ have ih: "\<And>r. Ders s (L r) = \<Union> (L ` pders s r)" by fact
+ have "Ders (c # s) (L r) = Ders s (Der c (L r))" by (simp add: Ders_def Der_def)
+ also have "\<dots> = Ders s (\<Union> (L ` pder c r))" by (simp add: Der_pder)
+ also have "\<dots> = (\<Union>A\<in>(L ` (pder c r)). (Ders s A))"
+ by (auto simp add: Ders_def)
+ also have "\<dots> = \<Union> (L ` (pders_set s (pder c r)))"
+ using ih by auto
+ also have "\<dots> = \<Union> (L ` (pders (c # s) r))" by simp
+ finally show "Ders (c # s) (L r) = \<Union> (L ` pders (c # s) r)" .
+qed (simp add: Ders_def)
+
+subsection \<open>Relating derivatives and partial derivatives\<close>
+
+lemma der_pder:
+ shows "\<Union> (L ` (pder c r)) = L (der c r)"
+unfolding der_correctness Der_pder by simp
+
+lemma ders_pders:
+ shows "\<Union> (L ` (pders s r)) = L (ders s r)"
+unfolding der_correctness ders_correctness Ders_pders by simp
+
+
+subsection \<open>Finiteness property of partial derivatives\<close>
+
+definition
+ pders_Set :: "string set \<Rightarrow> rexp \<Rightarrow> rexp set"
+where
+ "pders_Set A r \<equiv> \<Union>x \<in> A. pders x r"
+
+lemma pders_Set_subsetI:
+ assumes "\<And>s. s \<in> A \<Longrightarrow> pders s r \<subseteq> C"
+ shows "pders_Set A r \<subseteq> C"
+using assms unfolding pders_Set_def by (rule UN_least)
+
+lemma pders_Set_union:
+ shows "pders_Set (A \<union> B) r = (pders_Set A r \<union> pders_Set B r)"
+by (simp add: pders_Set_def)
+
+lemma pders_Set_subset:
+ shows "A \<subseteq> B \<Longrightarrow> pders_Set A r \<subseteq> pders_Set B r"
+by (auto simp add: pders_Set_def)
+
+definition
+ "UNIV1 \<equiv> UNIV - {[]}"
+
+lemma pders_Set_ZERO [simp]:
+ shows "pders_Set UNIV1 ZERO = {}"
+unfolding UNIV1_def pders_Set_def by auto
+
+lemma pders_Set_ONE [simp]:
+ shows "pders_Set UNIV1 ONE = {}"
+unfolding UNIV1_def pders_Set_def by (auto split: if_splits)
+
+lemma pders_Set_CHAR [simp]:
+ shows "pders_Set UNIV1 (CHAR c) = {ONE}"
+unfolding UNIV1_def pders_Set_def
+apply(auto)
+apply(frule rev_subsetD)
+apply(rule pders_CHAR)
+apply(simp)
+apply(case_tac xa)
+apply(auto split: if_splits)
+done
+
+lemma pders_Set_ALT [simp]:
+ shows "pders_Set UNIV1 (ALT r1 r2) = pders_Set UNIV1 r1 \<union> pders_Set UNIV1 r2"
+unfolding UNIV1_def pders_Set_def by auto
+
+
+text \<open>Non-empty suffixes of a string (needed for the cases of @{const SEQ} and @{const STAR} below)\<close>
+
+definition
+ "PSuf s \<equiv> {v. v \<noteq> [] \<and> (\<exists>u. u @ v = s)}"
+
+lemma PSuf_snoc:
+ shows "PSuf (s @ [c]) = (PSuf s) ;; {[c]} \<union> {[c]}"
+unfolding PSuf_def Sequ_def
+by (auto simp add: append_eq_append_conv2 append_eq_Cons_conv)
+
+lemma PSuf_Union:
+ shows "(\<Union>v \<in> PSuf s ;; {[c]}. f v) = (\<Union>v \<in> PSuf s. f (v @ [c]))"
+by (auto simp add: Sequ_def)
+
+lemma pders_Set_snoc:
+ shows "pders_Set (PSuf s ;; {[c]}) r = (pder_set c (pders_Set (PSuf s) r))"
+unfolding pders_Set_def
+by (simp add: PSuf_Union pders_snoc)
+
+lemma pders_SEQ:
+ shows "pders s (SEQ r1 r2) \<subseteq> SEQs (pders s r1) r2 \<union> (pders_Set (PSuf s) r2)"
+proof (induct s rule: rev_induct)
+ case (snoc c s)
+ have ih: "pders s (SEQ r1 r2) \<subseteq> SEQs (pders s r1) r2 \<union> (pders_Set (PSuf s) r2)"
+ by fact
+ have "pders (s @ [c]) (SEQ r1 r2) = pder_set c (pders s (SEQ r1 r2))"
+ by (simp add: pders_snoc)
+ also have "\<dots> \<subseteq> pder_set c (SEQs (pders s r1) r2 \<union> (pders_Set (PSuf s) r2))"
+ using ih by fastforce
+ also have "\<dots> = pder_set c (SEQs (pders s r1) r2) \<union> pder_set c (pders_Set (PSuf s) r2)"
+ by (simp)
+ also have "\<dots> = pder_set c (SEQs (pders s r1) r2) \<union> pders_Set (PSuf s ;; {[c]}) r2"
+ by (simp add: pders_Set_snoc)
+ also
+ have "\<dots> \<subseteq> pder_set c (SEQs (pders s r1) r2) \<union> pder c r2 \<union> pders_Set (PSuf s ;; {[c]}) r2"
+ by auto
+ also
+ have "\<dots> \<subseteq> SEQs (pder_set c (pders s r1)) r2 \<union> pder c r2 \<union> pders_Set (PSuf s ;; {[c]}) r2"
+ by (auto simp add: if_splits)
+ also have "\<dots> = SEQs (pders (s @ [c]) r1) r2 \<union> pder c r2 \<union> pders_Set (PSuf s ;; {[c]}) r2"
+ by (simp add: pders_snoc)
+ also have "\<dots> \<subseteq> SEQs (pders (s @ [c]) r1) r2 \<union> pders_Set (PSuf (s @ [c])) r2"
+ unfolding pders_Set_def by (auto simp add: PSuf_snoc)
+ finally show ?case .
+qed (simp)
+
+lemma pders_Set_SEQ_aux1:
+ assumes a: "s \<in> UNIV1"
+ shows "pders_Set (PSuf s) r \<subseteq> pders_Set UNIV1 r"
+using a unfolding UNIV1_def PSuf_def pders_Set_def by auto
+
+lemma pders_Set_SEQ_aux2:
+ assumes a: "s \<in> UNIV1"
+ shows "SEQs (pders s r1) r2 \<subseteq> SEQs (pders_Set UNIV1 r1) r2"
+using a unfolding pders_Set_def by auto
+
+lemma pders_Set_SEQ:
+ shows "pders_Set UNIV1 (SEQ r1 r2) \<subseteq> SEQs (pders_Set UNIV1 r1) r2 \<union> pders_Set UNIV1 r2"
+apply(rule pders_Set_subsetI)
+apply(rule subset_trans)
+apply(rule pders_SEQ)
+using pders_Set_SEQ_aux1 pders_Set_SEQ_aux2
+apply auto
+apply blast
+done
+
+lemma pders_STAR:
+ assumes a: "s \<noteq> []"
+ shows "pders s (STAR r) \<subseteq> SEQs (pders_Set (PSuf s) r) (STAR r)"
+using a
+proof (induct s rule: rev_induct)
+ case (snoc c s)
+ have ih: "s \<noteq> [] \<Longrightarrow> pders s (STAR r) \<subseteq> SEQs (pders_Set (PSuf s) r) (STAR r)" by fact
+ { assume asm: "s \<noteq> []"
+ have "pders (s @ [c]) (STAR r) = pder_set c (pders s (STAR r))" by (simp add: pders_snoc)
+ also have "\<dots> \<subseteq> pder_set c (SEQs (pders_Set (PSuf s) r) (STAR r))"
+ using ih[OF asm] by fast
+ also have "\<dots> \<subseteq> SEQs (pder_set c (pders_Set (PSuf s) r)) (STAR r) \<union> pder c (STAR r)"
+ by (auto split: if_splits)
+ also have "\<dots> \<subseteq> SEQs (pders_Set (PSuf (s @ [c])) r) (STAR r) \<union> (SEQs (pder c r) (STAR r))"
+ by (simp only: PSuf_snoc pders_Set_snoc pders_Set_union)
+ (auto simp add: pders_Set_def)
+ also have "\<dots> = SEQs (pders_Set (PSuf (s @ [c])) r) (STAR r)"
+ by (auto simp add: PSuf_snoc PSuf_Union pders_snoc pders_Set_def)
+ finally have ?case .
+ }
+ moreover
+ { assume asm: "s = []"
+ then have ?case by (auto simp add: pders_Set_def pders_snoc PSuf_def)
+ }
+ ultimately show ?case by blast
+qed (simp)
+
+lemma pders_Set_STAR:
+ shows "pders_Set UNIV1 (STAR r) \<subseteq> SEQs (pders_Set UNIV1 r) (STAR r)"
+apply(rule pders_Set_subsetI)
+apply(rule subset_trans)
+apply(rule pders_STAR)
+apply(simp add: UNIV1_def)
+apply(simp add: UNIV1_def PSuf_def)
+apply(auto simp add: pders_Set_def)
+done
+
+lemma finite_SEQs [simp]:
+ assumes a: "finite A"
+ shows "finite (SEQs A r)"
+using a by auto
+
+thm finite.intros
+
+lemma finite_pders_Set_UNIV1:
+ shows "finite (pders_Set UNIV1 r)"
+apply(induct r)
+apply(simp_all add:
+ finite_subset[OF pders_Set_SEQ]
+ finite_subset[OF pders_Set_STAR])
+done
+
+lemma pders_Set_UNIV:
+ shows "pders_Set UNIV r = pders [] r \<union> pders_Set UNIV1 r"
+unfolding UNIV1_def pders_Set_def
+by blast
+
+lemma finite_pders_Set_UNIV:
+ shows "finite (pders_Set UNIV r)"
+unfolding pders_Set_UNIV
+by (simp add: finite_pders_Set_UNIV1)
+
+lemma finite_pders_set:
+ shows "finite (pders_Set A r)"
+by (metis finite_pders_Set_UNIV pders_Set_subset rev_finite_subset subset_UNIV)
+
+
+text \<open>The following relationship between the alphabetic width of regular expressions
+(called \<open>awidth\<close> below) and the number of partial derivatives was proved
+by Antimirov~\cite{Antimirov95} and formalized by Max Haslbeck.\<close>
+
+fun awidth :: "rexp \<Rightarrow> nat" where
+"awidth ZERO = 0" |
+"awidth ONE = 0" |
+"awidth (CHAR a) = 1" |
+"awidth (ALT r1 r2) = awidth r1 + awidth r2" |
+"awidth (SEQ r1 r2) = awidth r1 + awidth r2" |
+"awidth (STAR r1) = awidth r1"
+
+lemma card_SEQs_pders_Set_le:
+ shows "card (SEQs (pders_Set A r) s) \<le> card (pders_Set A r)"
+ using finite_pders_set
+ unfolding SEQs_eq_image
+ by (rule card_image_le)
+
+lemma card_pders_set_UNIV1_le_awidth:
+ shows "card (pders_Set UNIV1 r) \<le> awidth r"
+proof (induction r)
+ case (ALT r1 r2)
+ have "card (pders_Set UNIV1 (ALT r1 r2)) = card (pders_Set UNIV1 r1 \<union> pders_Set UNIV1 r2)" by simp
+ also have "\<dots> \<le> card (pders_Set UNIV1 r1) + card (pders_Set UNIV1 r2)"
+ by(simp add: card_Un_le)
+ also have "\<dots> \<le> awidth (ALT r1 r2)" using ALT.IH by simp
+ finally show ?case .
+next
+ case (SEQ r1 r2)
+ have "card (pders_Set UNIV1 (SEQ r1 r2)) \<le> card (SEQs (pders_Set UNIV1 r1) r2 \<union> pders_Set UNIV1 r2)"
+ by (simp add: card_mono finite_pders_set pders_Set_SEQ)
+ also have "\<dots> \<le> card (SEQs (pders_Set UNIV1 r1) r2) + card (pders_Set UNIV1 r2)"
+ by (simp add: card_Un_le)
+ also have "\<dots> \<le> card (pders_Set UNIV1 r1) + card (pders_Set UNIV1 r2)"
+ by (simp add: card_SEQs_pders_Set_le)
+ also have "\<dots> \<le> awidth (SEQ r1 r2)" using SEQ.IH by simp
+ finally show ?case .
+next
+ case (STAR r)
+ have "card (pders_Set UNIV1 (STAR r)) \<le> card (SEQs (pders_Set UNIV1 r) (STAR r))"
+ by (simp add: card_mono finite_pders_set pders_Set_STAR)
+ also have "\<dots> \<le> card (pders_Set UNIV1 r)" by (rule card_SEQs_pders_Set_le)
+ also have "\<dots> \<le> awidth (STAR r)" by (simp add: STAR.IH)
+ finally show ?case .
+qed (auto)
+
+text\<open>Antimirov's Theorem 3.4:\<close>
+
+theorem card_pders_set_UNIV_le_awidth:
+ shows "card (pders_Set UNIV r) \<le> awidth r + 1"
+proof -
+ have "card (insert r (pders_Set UNIV1 r)) \<le> Suc (card (pders_Set UNIV1 r))"
+ by(auto simp: card_insert_if[OF finite_pders_Set_UNIV1])
+ also have "\<dots> \<le> Suc (awidth r)" by(simp add: card_pders_set_UNIV1_le_awidth)
+ finally show ?thesis by(simp add: pders_Set_UNIV)
+qed
+
+text\<open>Antimirov's Corollary 3.5:\<close>
+
+corollary card_pders_set_le_awidth:
+ shows "card (pders_Set A r) \<le> awidth r + 1"
+proof -
+ have "card (pders_Set A r) \<le> card (pders_Set UNIV r)"
+ by (simp add: card_mono finite_pders_set pders_Set_subset)
+ also have "... \<le> awidth r + 1"
+ by (rule card_pders_set_UNIV_le_awidth)
+ finally show "card (pders_Set A r) \<le> awidth r + 1" by simp
+qed
+
+(* other result by antimirov *)
+
+lemma card_pders_awidth:
+ shows "card (pders s r) \<le> awidth r + 1"
+proof -
+ have "pders s r \<subseteq> pders_Set UNIV r"
+ using pders_Set_def by auto
+ then have "card (pders s r) \<le> card (pders_Set UNIV r)"
+ by (simp add: card_mono finite_pders_set)
+ then show "card (pders s r) \<le> awidth r + 1"
+ using card_pders_set_le_awidth order_trans by blast
+qed
+
+
+
+
+
+fun subs :: "rexp \<Rightarrow> rexp set" where
+"subs ZERO = {ZERO}" |
+"subs ONE = {ONE}" |
+"subs (CHAR a) = {CHAR a, ONE}" |
+"subs (ALT r1 r2) = (subs r1 \<union> subs r2 \<union> {ALT r1 r2})" |
+"subs (SEQ r1 r2) = (subs r1 \<union> subs r2 \<union> {SEQ r1 r2} \<union> SEQs (subs r1) r2)" |
+"subs (STAR r1) = (subs r1 \<union> {STAR r1} \<union> SEQs (subs r1) (STAR r1))"
+
+lemma subs_finite:
+ shows "finite (subs r)"
+ apply(induct r)
+ apply(simp_all)
+ done
+
+
+
+lemma pders_subs:
+ shows "pders s r \<subseteq> subs r"
+ apply(induct r arbitrary: s)
+ apply(simp)
+ apply(simp)
+ apply(simp add: pders_CHAR)
+(* SEQ case *)
+ apply(simp)
+ apply(rule subset_trans)
+ apply(rule pders_SEQ)
+ defer
+(* ALT case *)
+ apply(simp)
+ apply(rule impI)
+ apply(rule conjI)
+ apply blast
+ apply blast
+(* STAR case *)
+ apply(case_tac s)
+ apply(simp)
+ apply(rule subset_trans)
+ thm pders_STAR
+ apply(rule pders_STAR)
+ apply(simp)
+ apply(auto simp add: pders_Set_def)[1]
+ apply(simp)
+ apply(rule conjI)
+ apply blast
+apply(auto simp add: pders_Set_def)[1]
+ done
+
+fun size2 :: "rexp \<Rightarrow> nat" where
+ "size2 ZERO = 1" |
+ "size2 ONE = 1" |
+ "size2 (CHAR c) = 1" |
+ "size2 (ALT r1 r2) = Suc (size2 r1 + size2 r2)" |
+ "size2 (SEQ r1 r2) = Suc (size2 r1 + size2 r2)" |
+ "size2 (STAR r1) = Suc (size2 r1)"
+
+
+lemma size_rexp:
+ fixes r :: rexp
+ shows "1 \<le> size2 r"
+ apply(induct r)
+ apply(simp)
+ apply(simp_all)
+ done
+
+lemma subs_card:
+ shows "card (subs r) \<le> Suc (size2 r + size2 r)"
+ apply(induct r)
+ apply(auto)
+ apply(subst card_insert)
+ apply(simp add: subs_finite)
+ apply(simp add: subs_finite)
+ oops
+
+lemma subs_size2:
+ shows "\<forall>r1 \<in> subs r. size2 r1 \<le> Suc (size2 r * size2 r)"
+ apply(induct r)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+(* SEQ case *)
+ apply(simp)
+ apply(auto)[1]
+ apply (smt Suc_n_not_le_n add.commute distrib_left le_Suc_eq left_add_mult_distrib nat_le_linear trans_le_add1)
+ apply (smt Suc_le_mono Suc_n_not_le_n le_trans nat_le_linear power2_eq_square power2_sum semiring_normalization_rules(23) trans_le_add2)
+ apply (smt Groups.add_ac(3) Suc_n_not_le_n distrib_left le_Suc_eq left_add_mult_distrib nat_le_linear trans_le_add1)
+(* ALT case *)
+ apply(simp)
+ apply(auto)[1]
+ apply (smt Groups.add_ac(2) Suc_le_mono Suc_n_not_le_n le_add2 linear order_trans power2_eq_square power2_sum)
+ apply (smt Groups.add_ac(2) Suc_le_mono Suc_n_not_le_n left_add_mult_distrib linear mult.commute order.trans trans_le_add1)
+(* STAR case *)
+ apply(auto)[1]
+ apply(drule_tac x="r'" in bspec)
+ apply(simp)
+ apply(rule le_trans)
+ apply(assumption)
+ apply(simp)
+ using size_rexp
+ apply(simp)
+ done
+
+lemma awidth_size:
+ shows "awidth r \<le> size2 r"
+ apply(induct r)
+ apply(simp_all)
+ done
+
+lemma Sum1:
+ fixes A B :: "nat set"
+ assumes "A \<subseteq> B" "finite A" "finite B"
+ shows "\<Sum>A \<le> \<Sum>B"
+ using assms
+ by (simp add: sum_mono2)
+
+lemma Sum2:
+ fixes A :: "rexp set"
+ and f g :: "rexp \<Rightarrow> nat"
+ assumes "finite A" "\<forall>x \<in> A. f x \<le> g x"
+ shows "sum f A \<le> sum g A"
+ using assms
+ apply(induct A)
+ apply(auto)
+ done
+
+
+
+
+
+lemma pders_max_size:
+ shows "(sum size2 (pders s r)) \<le> (Suc (size2 r)) ^ 3"
+proof -
+ have "(sum size2 (pders s r)) \<le> sum (\<lambda>_. Suc (size2 r * size2 r)) (pders s r)"
+ apply(rule_tac Sum2)
+ apply (meson pders_subs rev_finite_subset subs_finite)
+ using pders_subs subs_size2 by blast
+ also have "... \<le> (Suc (size2 r * size2 r)) * (sum (\<lambda>_. 1) (pders s r))"
+ by simp
+ also have "... \<le> (Suc (size2 r * size2 r)) * card (pders s r)"
+ by simp
+ also have "... \<le> (Suc (size2 r * size2 r)) * (Suc (awidth r))"
+ using Suc_eq_plus1 card_pders_awidth mult_le_mono2 by presburger
+ also have "... \<le> (Suc (size2 r * size2 r)) * (Suc (size2 r))"
+ using Suc_le_mono awidth_size mult_le_mono2 by presburger
+ also have "... \<le> (Suc (size2 r)) ^ 3"
+ by (smt One_nat_def Suc_1 Suc_mult_le_cancel1 Suc_n_not_le_n antisym_conv le_Suc_eq mult.commute nat_le_linear numeral_3_eq_3 power2_eq_square power2_le_imp_le power_Suc size_rexp)
+ finally show ?thesis .
+qed
+
+lemma pders_Set_max_size:
+ shows "(sum size2 (pders_Set A r)) \<le> (Suc (size2 r)) ^ 3"
+proof -
+ have "(sum size2 (pders_Set A r)) \<le> sum (\<lambda>_. Suc (size2 r * size2 r)) (pders_Set A r)"
+ apply(rule_tac Sum2)
+ apply (simp add: finite_pders_set)
+ by (meson pders_Set_subsetI pders_subs subs_size2 subsetD)
+ also have "... \<le> (Suc (size2 r * size2 r)) * (sum (\<lambda>_. 1) (pders_Set A r))"
+ by simp
+ also have "... \<le> (Suc (size2 r * size2 r)) * card (pders_Set A r)"
+ by simp
+ also have "... \<le> (Suc (size2 r * size2 r)) * (Suc (awidth r))"
+ using Suc_eq_plus1 card_pders_set_le_awidth mult_le_mono2 by presburger
+ also have "... \<le> (Suc (size2 r * size2 r)) * (Suc (size2 r))"
+ using Suc_le_mono awidth_size mult_le_mono2 by presburger
+ also have "... \<le> (Suc (size2 r)) ^ 3"
+ by (smt One_nat_def Suc_1 Suc_mult_le_cancel1 Suc_n_not_le_n antisym_conv le_Suc_eq mult.commute nat_le_linear numeral_3_eq_3 power2_eq_square power2_le_imp_le power_Suc size_rexp)
+ finally show ?thesis .
+qed
+
+fun height :: "rexp \<Rightarrow> nat" where
+ "height ZERO = 1" |
+ "height ONE = 1" |
+ "height (CHAR c) = 1" |
+ "height (ALT r1 r2) = Suc (max (height r1) (height r2))" |
+ "height (SEQ r1 r2) = Suc (max (height r1) (height r2))" |
+ "height (STAR r1) = Suc (height r1)"
+
+lemma height_size2:
+ shows "height r \<le> size2 r"
+ apply(induct r)
+ apply(simp_all)
+ done
+
+lemma height_rexp:
+ fixes r :: rexp
+ shows "1 \<le> height r"
+ apply(induct r)
+ apply(simp_all)
+ done
+
+lemma subs_height:
+ shows "\<forall>r1 \<in> subs r. height r1 \<le> Suc (height r)"
+ apply(induct r)
+ apply(auto)+
+ done
+
+
+
+end
\ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys2/Positions.thy Sun Oct 10 18:35:21 2021 +0100
@@ -0,0 +1,776 @@
+
+theory Positions
+ imports "Spec" "Lexer"
+begin
+
+chapter \<open>An alternative definition for POSIX values\<close>
+
+section \<open>Positions in Values\<close>
+
+fun
+ at :: "val \<Rightarrow> nat list \<Rightarrow> val"
+where
+ "at v [] = v"
+| "at (Left v) (0#ps)= at v ps"
+| "at (Right v) (Suc 0#ps)= at v ps"
+| "at (Seq v1 v2) (0#ps)= at v1 ps"
+| "at (Seq v1 v2) (Suc 0#ps)= at v2 ps"
+| "at (Stars vs) (n#ps)= at (nth vs n) ps"
+
+
+
+fun Pos :: "val \<Rightarrow> (nat list) set"
+where
+ "Pos (Void) = {[]}"
+| "Pos (Char c) = {[]}"
+| "Pos (Left v) = {[]} \<union> {0#ps | ps. ps \<in> Pos v}"
+| "Pos (Right v) = {[]} \<union> {1#ps | ps. ps \<in> Pos v}"
+| "Pos (Seq v1 v2) = {[]} \<union> {0#ps | ps. ps \<in> Pos v1} \<union> {1#ps | ps. ps \<in> Pos v2}"
+| "Pos (Stars []) = {[]}"
+| "Pos (Stars (v#vs)) = {[]} \<union> {0#ps | ps. ps \<in> Pos v} \<union> {Suc n#ps | n ps. n#ps \<in> Pos (Stars vs)}"
+
+
+lemma Pos_stars:
+ "Pos (Stars vs) = {[]} \<union> (\<Union>n < length vs. {n#ps | ps. ps \<in> Pos (vs ! n)})"
+apply(induct vs)
+apply(auto simp add: insert_ident less_Suc_eq_0_disj)
+done
+
+lemma Pos_empty:
+ shows "[] \<in> Pos v"
+by (induct v rule: Pos.induct)(auto)
+
+
+abbreviation
+ "intlen vs \<equiv> int (length vs)"
+
+
+definition pflat_len :: "val \<Rightarrow> nat list => int"
+where
+ "pflat_len v p \<equiv> (if p \<in> Pos v then intlen (flat (at v p)) else -1)"
+
+lemma pflat_len_simps:
+ shows "pflat_len (Seq v1 v2) (0#p) = pflat_len v1 p"
+ and "pflat_len (Seq v1 v2) (Suc 0#p) = pflat_len v2 p"
+ and "pflat_len (Left v) (0#p) = pflat_len v p"
+ and "pflat_len (Left v) (Suc 0#p) = -1"
+ and "pflat_len (Right v) (Suc 0#p) = pflat_len v p"
+ and "pflat_len (Right v) (0#p) = -1"
+ and "pflat_len (Stars (v#vs)) (Suc n#p) = pflat_len (Stars vs) (n#p)"
+ and "pflat_len (Stars (v#vs)) (0#p) = pflat_len v p"
+ and "pflat_len v [] = intlen (flat v)"
+by (auto simp add: pflat_len_def Pos_empty)
+
+lemma pflat_len_Stars_simps:
+ assumes "n < length vs"
+ shows "pflat_len (Stars vs) (n#p) = pflat_len (vs!n) p"
+using assms
+apply(induct vs arbitrary: n p)
+apply(auto simp add: less_Suc_eq_0_disj pflat_len_simps)
+done
+
+lemma pflat_len_outside:
+ assumes "p \<notin> Pos v1"
+ shows "pflat_len v1 p = -1 "
+using assms by (simp add: pflat_len_def)
+
+
+
+section \<open>Orderings\<close>
+
+
+definition prefix_list:: "'a list \<Rightarrow> 'a list \<Rightarrow> bool" ("_ \<sqsubseteq>pre _" [60,59] 60)
+where
+ "ps1 \<sqsubseteq>pre ps2 \<equiv> \<exists>ps'. ps1 @ps' = ps2"
+
+definition sprefix_list:: "'a list \<Rightarrow> 'a list \<Rightarrow> bool" ("_ \<sqsubset>spre _" [60,59] 60)
+where
+ "ps1 \<sqsubset>spre ps2 \<equiv> ps1 \<sqsubseteq>pre ps2 \<and> ps1 \<noteq> ps2"
+
+inductive lex_list :: "nat list \<Rightarrow> nat list \<Rightarrow> bool" ("_ \<sqsubset>lex _" [60,59] 60)
+where
+ "[] \<sqsubset>lex (p#ps)"
+| "ps1 \<sqsubset>lex ps2 \<Longrightarrow> (p#ps1) \<sqsubset>lex (p#ps2)"
+| "p1 < p2 \<Longrightarrow> (p1#ps1) \<sqsubset>lex (p2#ps2)"
+
+lemma lex_irrfl:
+ fixes ps1 ps2 :: "nat list"
+ assumes "ps1 \<sqsubset>lex ps2"
+ shows "ps1 \<noteq> ps2"
+using assms
+by(induct rule: lex_list.induct)(auto)
+
+lemma lex_simps [simp]:
+ fixes xs ys :: "nat list"
+ shows "[] \<sqsubset>lex ys \<longleftrightarrow> ys \<noteq> []"
+ and "xs \<sqsubset>lex [] \<longleftrightarrow> False"
+ and "(x # xs) \<sqsubset>lex (y # ys) \<longleftrightarrow> (x < y \<or> (x = y \<and> xs \<sqsubset>lex ys))"
+by (auto simp add: neq_Nil_conv elim: lex_list.cases intro: lex_list.intros)
+
+lemma lex_trans:
+ fixes ps1 ps2 ps3 :: "nat list"
+ assumes "ps1 \<sqsubset>lex ps2" "ps2 \<sqsubset>lex ps3"
+ shows "ps1 \<sqsubset>lex ps3"
+using assms
+by (induct arbitrary: ps3 rule: lex_list.induct)
+ (auto elim: lex_list.cases)
+
+
+lemma lex_trichotomous:
+ fixes p q :: "nat list"
+ shows "p = q \<or> p \<sqsubset>lex q \<or> q \<sqsubset>lex p"
+apply(induct p arbitrary: q)
+apply(auto elim: lex_list.cases)
+apply(case_tac q)
+apply(auto)
+done
+
+
+
+
+section \<open>POSIX Ordering of Values According to Okui \& Suzuki\<close>
+
+
+definition PosOrd:: "val \<Rightarrow> nat list \<Rightarrow> val \<Rightarrow> bool" ("_ \<sqsubset>val _ _" [60, 60, 59] 60)
+where
+ "v1 \<sqsubset>val p v2 \<equiv> pflat_len v1 p > pflat_len v2 p \<and>
+ (\<forall>q \<in> Pos v1 \<union> Pos v2. q \<sqsubset>lex p \<longrightarrow> pflat_len v1 q = pflat_len v2 q)"
+
+lemma PosOrd_def2:
+ shows "v1 \<sqsubset>val p v2 \<longleftrightarrow>
+ pflat_len v1 p > pflat_len v2 p \<and>
+ (\<forall>q \<in> Pos v1. q \<sqsubset>lex p \<longrightarrow> pflat_len v1 q = pflat_len v2 q) \<and>
+ (\<forall>q \<in> Pos v2. q \<sqsubset>lex p \<longrightarrow> pflat_len v1 q = pflat_len v2 q)"
+unfolding PosOrd_def
+apply(auto)
+done
+
+
+definition PosOrd_ex:: "val \<Rightarrow> val \<Rightarrow> bool" ("_ :\<sqsubset>val _" [60, 59] 60)
+where
+ "v1 :\<sqsubset>val v2 \<equiv> \<exists>p. v1 \<sqsubset>val p v2"
+
+definition PosOrd_ex_eq:: "val \<Rightarrow> val \<Rightarrow> bool" ("_ :\<sqsubseteq>val _" [60, 59] 60)
+where
+ "v1 :\<sqsubseteq>val v2 \<equiv> v1 :\<sqsubset>val v2 \<or> v1 = v2"
+
+
+lemma PosOrd_trans:
+ assumes "v1 :\<sqsubset>val v2" "v2 :\<sqsubset>val v3"
+ shows "v1 :\<sqsubset>val v3"
+proof -
+ from assms obtain p p'
+ where as: "v1 \<sqsubset>val p v2" "v2 \<sqsubset>val p' v3" unfolding PosOrd_ex_def by blast
+ then have pos: "p \<in> Pos v1" "p' \<in> Pos v2" unfolding PosOrd_def pflat_len_def
+ by (smt not_int_zless_negative)+
+ have "p = p' \<or> p \<sqsubset>lex p' \<or> p' \<sqsubset>lex p"
+ by (rule lex_trichotomous)
+ moreover
+ { assume "p = p'"
+ with as have "v1 \<sqsubset>val p v3" unfolding PosOrd_def pflat_len_def
+ by (smt Un_iff)
+ then have " v1 :\<sqsubset>val v3" unfolding PosOrd_ex_def by blast
+ }
+ moreover
+ { assume "p \<sqsubset>lex p'"
+ with as have "v1 \<sqsubset>val p v3" unfolding PosOrd_def pflat_len_def
+ by (smt Un_iff lex_trans)
+ then have " v1 :\<sqsubset>val v3" unfolding PosOrd_ex_def by blast
+ }
+ moreover
+ { assume "p' \<sqsubset>lex p"
+ with as have "v1 \<sqsubset>val p' v3" unfolding PosOrd_def
+ by (smt Un_iff lex_trans pflat_len_def)
+ then have "v1 :\<sqsubset>val v3" unfolding PosOrd_ex_def by blast
+ }
+ ultimately show "v1 :\<sqsubset>val v3" by blast
+qed
+
+lemma PosOrd_irrefl:
+ assumes "v :\<sqsubset>val v"
+ shows "False"
+using assms unfolding PosOrd_ex_def PosOrd_def
+by auto
+
+lemma PosOrd_assym:
+ assumes "v1 :\<sqsubset>val v2"
+ shows "\<not>(v2 :\<sqsubset>val v1)"
+using assms
+using PosOrd_irrefl PosOrd_trans by blast
+
+(*
+ :\<sqsubseteq>val and :\<sqsubset>val are partial orders.
+*)
+
+lemma PosOrd_ordering:
+ shows "ordering (\<lambda>v1 v2. v1 :\<sqsubseteq>val v2) (\<lambda> v1 v2. v1 :\<sqsubset>val v2)"
+unfolding ordering_def PosOrd_ex_eq_def
+apply(auto)
+using PosOrd_irrefl apply blast
+using PosOrd_assym apply blast
+using PosOrd_trans by blast
+
+lemma PosOrd_order:
+ shows "class.order (\<lambda>v1 v2. v1 :\<sqsubseteq>val v2) (\<lambda> v1 v2. v1 :\<sqsubset>val v2)"
+using PosOrd_ordering
+apply(simp add: class.order_def class.preorder_def class.order_axioms_def)
+unfolding ordering_def
+by blast
+
+
+lemma PosOrd_ex_eq2:
+ shows "v1 :\<sqsubset>val v2 \<longleftrightarrow> (v1 :\<sqsubseteq>val v2 \<and> v1 \<noteq> v2)"
+using PosOrd_ordering
+unfolding ordering_def
+by auto
+
+lemma PosOrdeq_trans:
+ assumes "v1 :\<sqsubseteq>val v2" "v2 :\<sqsubseteq>val v3"
+ shows "v1 :\<sqsubseteq>val v3"
+using assms PosOrd_ordering
+unfolding ordering_def
+by blast
+
+lemma PosOrdeq_antisym:
+ assumes "v1 :\<sqsubseteq>val v2" "v2 :\<sqsubseteq>val v1"
+ shows "v1 = v2"
+using assms PosOrd_ordering
+unfolding ordering_def
+by blast
+
+lemma PosOrdeq_refl:
+ shows "v :\<sqsubseteq>val v"
+unfolding PosOrd_ex_eq_def
+by auto
+
+
+lemma PosOrd_shorterE:
+ assumes "v1 :\<sqsubset>val v2"
+ shows "length (flat v2) \<le> length (flat v1)"
+using assms unfolding PosOrd_ex_def PosOrd_def
+apply(auto)
+apply(case_tac p)
+apply(simp add: pflat_len_simps)
+apply(drule_tac x="[]" in bspec)
+apply(simp add: Pos_empty)
+apply(simp add: pflat_len_simps)
+done
+
+lemma PosOrd_shorterI:
+ assumes "length (flat v2) < length (flat v1)"
+ shows "v1 :\<sqsubset>val v2"
+unfolding PosOrd_ex_def PosOrd_def pflat_len_def
+using assms Pos_empty by force
+
+lemma PosOrd_spreI:
+ assumes "flat v' \<sqsubset>spre flat v"
+ shows "v :\<sqsubset>val v'"
+using assms
+apply(rule_tac PosOrd_shorterI)
+unfolding prefix_list_def sprefix_list_def
+by (metis append_Nil2 append_eq_conv_conj drop_all le_less_linear)
+
+lemma pflat_len_inside:
+ assumes "pflat_len v2 p < pflat_len v1 p"
+ shows "p \<in> Pos v1"
+using assms
+unfolding pflat_len_def
+by (auto split: if_splits)
+
+
+lemma PosOrd_Left_Right:
+ assumes "flat v1 = flat v2"
+ shows "Left v1 :\<sqsubset>val Right v2"
+unfolding PosOrd_ex_def
+apply(rule_tac x="[0]" in exI)
+apply(auto simp add: PosOrd_def pflat_len_simps assms)
+done
+
+lemma PosOrd_LeftE:
+ assumes "Left v1 :\<sqsubset>val Left v2" "flat v1 = flat v2"
+ shows "v1 :\<sqsubset>val v2"
+using assms
+unfolding PosOrd_ex_def PosOrd_def2
+apply(auto simp add: pflat_len_simps)
+apply(frule pflat_len_inside)
+apply(auto simp add: pflat_len_simps)
+by (metis lex_simps(3) pflat_len_simps(3))
+
+lemma PosOrd_LeftI:
+ assumes "v1 :\<sqsubset>val v2" "flat v1 = flat v2"
+ shows "Left v1 :\<sqsubset>val Left v2"
+using assms
+unfolding PosOrd_ex_def PosOrd_def2
+apply(auto simp add: pflat_len_simps)
+by (metis less_numeral_extra(3) lex_simps(3) pflat_len_simps(3))
+
+lemma PosOrd_Left_eq:
+ assumes "flat v1 = flat v2"
+ shows "Left v1 :\<sqsubset>val Left v2 \<longleftrightarrow> v1 :\<sqsubset>val v2"
+using assms PosOrd_LeftE PosOrd_LeftI
+by blast
+
+
+lemma PosOrd_RightE:
+ assumes "Right v1 :\<sqsubset>val Right v2" "flat v1 = flat v2"
+ shows "v1 :\<sqsubset>val v2"
+using assms
+unfolding PosOrd_ex_def PosOrd_def2
+apply(auto simp add: pflat_len_simps)
+apply(frule pflat_len_inside)
+apply(auto simp add: pflat_len_simps)
+by (metis lex_simps(3) pflat_len_simps(5))
+
+lemma PosOrd_RightI:
+ assumes "v1 :\<sqsubset>val v2" "flat v1 = flat v2"
+ shows "Right v1 :\<sqsubset>val Right v2"
+using assms
+unfolding PosOrd_ex_def PosOrd_def2
+apply(auto simp add: pflat_len_simps)
+by (metis lex_simps(3) nat_neq_iff pflat_len_simps(5))
+
+
+lemma PosOrd_Right_eq:
+ assumes "flat v1 = flat v2"
+ shows "Right v1 :\<sqsubset>val Right v2 \<longleftrightarrow> v1 :\<sqsubset>val v2"
+using assms PosOrd_RightE PosOrd_RightI
+by blast
+
+
+lemma PosOrd_SeqI1:
+ assumes "v1 :\<sqsubset>val w1" "flat (Seq v1 v2) = flat (Seq w1 w2)"
+ shows "Seq v1 v2 :\<sqsubset>val Seq w1 w2"
+using assms(1)
+apply(subst (asm) PosOrd_ex_def)
+apply(subst (asm) PosOrd_def)
+apply(clarify)
+apply(subst PosOrd_ex_def)
+apply(rule_tac x="0#p" in exI)
+apply(subst PosOrd_def)
+apply(rule conjI)
+apply(simp add: pflat_len_simps)
+apply(rule ballI)
+apply(rule impI)
+apply(simp only: Pos.simps)
+apply(auto)[1]
+apply(simp add: pflat_len_simps)
+apply(auto simp add: pflat_len_simps)
+using assms(2)
+apply(simp)
+apply(metis length_append of_nat_add)
+done
+
+lemma PosOrd_SeqI2:
+ assumes "v2 :\<sqsubset>val w2" "flat v2 = flat w2"
+ shows "Seq v v2 :\<sqsubset>val Seq v w2"
+using assms(1)
+apply(subst (asm) PosOrd_ex_def)
+apply(subst (asm) PosOrd_def)
+apply(clarify)
+apply(subst PosOrd_ex_def)
+apply(rule_tac x="Suc 0#p" in exI)
+apply(subst PosOrd_def)
+apply(rule conjI)
+apply(simp add: pflat_len_simps)
+apply(rule ballI)
+apply(rule impI)
+apply(simp only: Pos.simps)
+apply(auto)[1]
+apply(simp add: pflat_len_simps)
+using assms(2)
+apply(simp)
+apply(auto simp add: pflat_len_simps)
+done
+
+lemma PosOrd_Seq_eq:
+ assumes "flat v2 = flat w2"
+ shows "(Seq v v2) :\<sqsubset>val (Seq v w2) \<longleftrightarrow> v2 :\<sqsubset>val w2"
+using assms
+apply(auto)
+prefer 2
+apply(simp add: PosOrd_SeqI2)
+apply(simp add: PosOrd_ex_def)
+apply(auto)
+apply(case_tac p)
+apply(simp add: PosOrd_def pflat_len_simps)
+apply(case_tac a)
+apply(simp add: PosOrd_def pflat_len_simps)
+apply(clarify)
+apply(case_tac nat)
+prefer 2
+apply(simp add: PosOrd_def pflat_len_simps pflat_len_outside)
+apply(rule_tac x="list" in exI)
+apply(auto simp add: PosOrd_def2 pflat_len_simps)
+apply(smt Collect_disj_eq lex_list.intros(2) mem_Collect_eq pflat_len_simps(2))
+apply(smt Collect_disj_eq lex_list.intros(2) mem_Collect_eq pflat_len_simps(2))
+done
+
+
+
+lemma PosOrd_StarsI:
+ assumes "v1 :\<sqsubset>val v2" "flats (v1#vs1) = flats (v2#vs2)"
+ shows "Stars (v1#vs1) :\<sqsubset>val Stars (v2#vs2)"
+using assms(1)
+apply(subst (asm) PosOrd_ex_def)
+apply(subst (asm) PosOrd_def)
+apply(clarify)
+apply(subst PosOrd_ex_def)
+apply(subst PosOrd_def)
+apply(rule_tac x="0#p" in exI)
+apply(simp add: pflat_len_Stars_simps pflat_len_simps)
+using assms(2)
+apply(simp add: pflat_len_simps)
+apply(auto simp add: pflat_len_Stars_simps pflat_len_simps)
+by (metis length_append of_nat_add)
+
+lemma PosOrd_StarsI2:
+ assumes "Stars vs1 :\<sqsubset>val Stars vs2" "flats vs1 = flats vs2"
+ shows "Stars (v#vs1) :\<sqsubset>val Stars (v#vs2)"
+using assms(1)
+apply(subst (asm) PosOrd_ex_def)
+apply(subst (asm) PosOrd_def)
+apply(clarify)
+apply(subst PosOrd_ex_def)
+apply(subst PosOrd_def)
+apply(case_tac p)
+apply(simp add: pflat_len_simps)
+apply(rule_tac x="Suc a#list" in exI)
+apply(auto simp add: pflat_len_Stars_simps pflat_len_simps assms(2))
+done
+
+lemma PosOrd_Stars_appendI:
+ assumes "Stars vs1 :\<sqsubset>val Stars vs2" "flat (Stars vs1) = flat (Stars vs2)"
+ shows "Stars (vs @ vs1) :\<sqsubset>val Stars (vs @ vs2)"
+using assms
+apply(induct vs)
+apply(simp)
+apply(simp add: PosOrd_StarsI2)
+done
+
+lemma PosOrd_StarsE2:
+ assumes "Stars (v # vs1) :\<sqsubset>val Stars (v # vs2)"
+ shows "Stars vs1 :\<sqsubset>val Stars vs2"
+using assms
+apply(subst (asm) PosOrd_ex_def)
+apply(erule exE)
+apply(case_tac p)
+apply(simp)
+apply(simp add: PosOrd_def pflat_len_simps)
+apply(subst PosOrd_ex_def)
+apply(rule_tac x="[]" in exI)
+apply(simp add: PosOrd_def pflat_len_simps Pos_empty)
+apply(simp)
+apply(case_tac a)
+apply(clarify)
+apply(auto simp add: pflat_len_simps PosOrd_def pflat_len_def split: if_splits)[1]
+apply(clarify)
+apply(simp add: PosOrd_ex_def)
+apply(rule_tac x="nat#list" in exI)
+apply(auto simp add: PosOrd_def pflat_len_simps)[1]
+apply(case_tac q)
+apply(simp add: PosOrd_def pflat_len_simps)
+apply(clarify)
+apply(drule_tac x="Suc a # lista" in bspec)
+apply(simp)
+apply(auto simp add: PosOrd_def pflat_len_simps)[1]
+apply(case_tac q)
+apply(simp add: PosOrd_def pflat_len_simps)
+apply(clarify)
+apply(drule_tac x="Suc a # lista" in bspec)
+apply(simp)
+apply(auto simp add: PosOrd_def pflat_len_simps)[1]
+done
+
+lemma PosOrd_Stars_appendE:
+ assumes "Stars (vs @ vs1) :\<sqsubset>val Stars (vs @ vs2)"
+ shows "Stars vs1 :\<sqsubset>val Stars vs2"
+using assms
+apply(induct vs)
+apply(simp)
+apply(simp add: PosOrd_StarsE2)
+done
+
+lemma PosOrd_Stars_append_eq:
+ assumes "flats vs1 = flats vs2"
+ shows "Stars (vs @ vs1) :\<sqsubset>val Stars (vs @ vs2) \<longleftrightarrow> Stars vs1 :\<sqsubset>val Stars vs2"
+using assms
+apply(rule_tac iffI)
+apply(erule PosOrd_Stars_appendE)
+apply(rule PosOrd_Stars_appendI)
+apply(auto)
+done
+
+lemma PosOrd_almost_trichotomous:
+ shows "v1 :\<sqsubset>val v2 \<or> v2 :\<sqsubset>val v1 \<or> (length (flat v1) = length (flat v2))"
+apply(auto simp add: PosOrd_ex_def)
+apply(auto simp add: PosOrd_def)
+apply(rule_tac x="[]" in exI)
+apply(auto simp add: Pos_empty pflat_len_simps)
+apply(drule_tac x="[]" in spec)
+apply(auto simp add: Pos_empty pflat_len_simps)
+done
+
+
+
+section \<open>The Posix Value is smaller than any other Value\<close>
+
+
+lemma Posix_PosOrd:
+ assumes "s \<in> r \<rightarrow> v1" "v2 \<in> LV r s"
+ shows "v1 :\<sqsubseteq>val v2"
+using assms
+proof (induct arbitrary: v2 rule: Posix.induct)
+ case (Posix_ONE v)
+ have "v \<in> LV ONE []" by fact
+ then have "v = Void"
+ by (simp add: LV_simps)
+ then show "Void :\<sqsubseteq>val v"
+ by (simp add: PosOrd_ex_eq_def)
+next
+ case (Posix_CH c v)
+ have "v \<in> LV (CH c) [c]" by fact
+ then have "v = Char c"
+ by (simp add: LV_simps)
+ then show "Char c :\<sqsubseteq>val v"
+ by (simp add: PosOrd_ex_eq_def)
+next
+ case (Posix_ALT1 s r1 v r2 v2)
+ have as1: "s \<in> r1 \<rightarrow> v" by fact
+ have IH: "\<And>v2. v2 \<in> LV r1 s \<Longrightarrow> v :\<sqsubseteq>val v2" by fact
+ have "v2 \<in> LV (ALT r1 r2) s" by fact
+ then have "\<Turnstile> v2 : ALT r1 r2" "flat v2 = s"
+ by(auto simp add: LV_def prefix_list_def)
+ then consider
+ (Left) v3 where "v2 = Left v3" "\<Turnstile> v3 : r1" "flat v3 = s"
+ | (Right) v3 where "v2 = Right v3" "\<Turnstile> v3 : r2" "flat v3 = s"
+ by (auto elim: Prf.cases)
+ then show "Left v :\<sqsubseteq>val v2"
+ proof(cases)
+ case (Left v3)
+ have "v3 \<in> LV r1 s" using Left(2,3)
+ by (auto simp add: LV_def prefix_list_def)
+ with IH have "v :\<sqsubseteq>val v3" by simp
+ moreover
+ have "flat v3 = flat v" using as1 Left(3)
+ by (simp add: Posix1(2))
+ ultimately have "Left v :\<sqsubseteq>val Left v3"
+ by (simp add: PosOrd_ex_eq_def PosOrd_Left_eq)
+ then show "Left v :\<sqsubseteq>val v2" unfolding Left .
+ next
+ case (Right v3)
+ have "flat v3 = flat v" using as1 Right(3)
+ by (simp add: Posix1(2))
+ then have "Left v :\<sqsubseteq>val Right v3"
+ unfolding PosOrd_ex_eq_def
+ by (simp add: PosOrd_Left_Right)
+ then show "Left v :\<sqsubseteq>val v2" unfolding Right .
+ qed
+next
+ case (Posix_ALT2 s r2 v r1 v2)
+ have as1: "s \<in> r2 \<rightarrow> v" by fact
+ have as2: "s \<notin> L r1" by fact
+ have IH: "\<And>v2. v2 \<in> LV r2 s \<Longrightarrow> v :\<sqsubseteq>val v2" by fact
+ have "v2 \<in> LV (ALT r1 r2) s" by fact
+ then have "\<Turnstile> v2 : ALT r1 r2" "flat v2 = s"
+ by(auto simp add: LV_def prefix_list_def)
+ then consider
+ (Left) v3 where "v2 = Left v3" "\<Turnstile> v3 : r1" "flat v3 = s"
+ | (Right) v3 where "v2 = Right v3" "\<Turnstile> v3 : r2" "flat v3 = s"
+ by (auto elim: Prf.cases)
+ then show "Right v :\<sqsubseteq>val v2"
+ proof (cases)
+ case (Right v3)
+ have "v3 \<in> LV r2 s" using Right(2,3)
+ by (auto simp add: LV_def prefix_list_def)
+ with IH have "v :\<sqsubseteq>val v3" by simp
+ moreover
+ have "flat v3 = flat v" using as1 Right(3)
+ by (simp add: Posix1(2))
+ ultimately have "Right v :\<sqsubseteq>val Right v3"
+ by (auto simp add: PosOrd_ex_eq_def PosOrd_RightI)
+ then show "Right v :\<sqsubseteq>val v2" unfolding Right .
+ next
+ case (Left v3)
+ have "v3 \<in> LV r1 s" using Left(2,3) as2
+ by (auto simp add: LV_def prefix_list_def)
+ then have "flat v3 = flat v \<and> \<Turnstile> v3 : r1" using as1 Left(3)
+ by (simp add: Posix1(2) LV_def)
+ then have "False" using as1 as2 Left
+ by (auto simp add: Posix1(2) L_flat_Prf1)
+ then show "Right v :\<sqsubseteq>val v2" by simp
+ qed
+next
+ case (Posix_SEQ s1 r1 v1 s2 r2 v2 v3)
+ have "s1 \<in> r1 \<rightarrow> v1" "s2 \<in> r2 \<rightarrow> v2" by fact+
+ then have as1: "s1 = flat v1" "s2 = flat v2" by (simp_all add: Posix1(2))
+ have IH1: "\<And>v3. v3 \<in> LV r1 s1 \<Longrightarrow> v1 :\<sqsubseteq>val v3" by fact
+ have IH2: "\<And>v3. v3 \<in> LV r2 s2 \<Longrightarrow> v2 :\<sqsubseteq>val v3" by fact
+ have cond: "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L r1 \<and> s\<^sub>4 \<in> L r2)" by fact
+ have "v3 \<in> LV (SEQ r1 r2) (s1 @ s2)" by fact
+ then obtain v3a v3b where eqs:
+ "v3 = Seq v3a v3b" "\<Turnstile> v3a : r1" "\<Turnstile> v3b : r2"
+ "flat v3a @ flat v3b = s1 @ s2"
+ by (force simp add: prefix_list_def LV_def elim: Prf.cases)
+ with cond have "flat v3a \<sqsubseteq>pre s1" unfolding prefix_list_def
+ by (smt L_flat_Prf1 append_eq_append_conv2 append_self_conv)
+ then have "flat v3a \<sqsubset>spre s1 \<or> (flat v3a = s1 \<and> flat v3b = s2)" using eqs
+ by (simp add: sprefix_list_def append_eq_conv_conj)
+ then have q2: "v1 :\<sqsubset>val v3a \<or> (flat v3a = s1 \<and> flat v3b = s2)"
+ using PosOrd_spreI as1(1) eqs by blast
+ then have "v1 :\<sqsubset>val v3a \<or> (v3a \<in> LV r1 s1 \<and> v3b \<in> LV r2 s2)" using eqs(2,3)
+ by (auto simp add: LV_def)
+ then have "v1 :\<sqsubset>val v3a \<or> (v1 :\<sqsubseteq>val v3a \<and> v2 :\<sqsubseteq>val v3b)" using IH1 IH2 by blast
+ then have "Seq v1 v2 :\<sqsubseteq>val Seq v3a v3b" using eqs q2 as1
+ unfolding PosOrd_ex_eq_def by (auto simp add: PosOrd_SeqI1 PosOrd_Seq_eq)
+ then show "Seq v1 v2 :\<sqsubseteq>val v3" unfolding eqs by blast
+next
+ case (Posix_STAR1 s1 r v s2 vs v3)
+ have "s1 \<in> r \<rightarrow> v" "s2 \<in> STAR r \<rightarrow> Stars vs" by fact+
+ then have as1: "s1 = flat v" "s2 = flat (Stars vs)" by (auto dest: Posix1(2))
+ have IH1: "\<And>v3. v3 \<in> LV r s1 \<Longrightarrow> v :\<sqsubseteq>val v3" by fact
+ have IH2: "\<And>v3. v3 \<in> LV (STAR r) s2 \<Longrightarrow> Stars vs :\<sqsubseteq>val v3" by fact
+ have cond: "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L r \<and> s\<^sub>4 \<in> L (STAR r))" by fact
+ have cond2: "flat v \<noteq> []" by fact
+ have "v3 \<in> LV (STAR r) (s1 @ s2)" by fact
+ then consider
+ (NonEmpty) v3a vs3 where "v3 = Stars (v3a # vs3)"
+ "\<Turnstile> v3a : r" "\<Turnstile> Stars vs3 : STAR r"
+ "flat (Stars (v3a # vs3)) = s1 @ s2"
+ | (Empty) "v3 = Stars []"
+ unfolding LV_def
+ apply(auto)
+ apply(erule Prf.cases)
+ apply(auto)
+ apply(case_tac vs)
+ apply(auto intro: Prf.intros)
+ done
+ then show "Stars (v # vs) :\<sqsubseteq>val v3"
+ proof (cases)
+ case (NonEmpty v3a vs3)
+ have "flat (Stars (v3a # vs3)) = s1 @ s2" using NonEmpty(4) .
+ with cond have "flat v3a \<sqsubseteq>pre s1" using NonEmpty(2,3)
+ unfolding prefix_list_def
+ by (smt L_flat_Prf1 append_Nil2 append_eq_append_conv2 flat.simps(7))
+ then have "flat v3a \<sqsubset>spre s1 \<or> (flat v3a = s1 \<and> flat (Stars vs3) = s2)" using NonEmpty(4)
+ by (simp add: sprefix_list_def append_eq_conv_conj)
+ then have q2: "v :\<sqsubset>val v3a \<or> (flat v3a = s1 \<and> flat (Stars vs3) = s2)"
+ using PosOrd_spreI as1(1) NonEmpty(4) by blast
+ then have "v :\<sqsubset>val v3a \<or> (v3a \<in> LV r s1 \<and> Stars vs3 \<in> LV (STAR r) s2)"
+ using NonEmpty(2,3) by (auto simp add: LV_def)
+ then have "v :\<sqsubset>val v3a \<or> (v :\<sqsubseteq>val v3a \<and> Stars vs :\<sqsubseteq>val Stars vs3)" using IH1 IH2 by blast
+ then have "v :\<sqsubset>val v3a \<or> (v = v3a \<and> Stars vs :\<sqsubseteq>val Stars vs3)"
+ unfolding PosOrd_ex_eq_def by auto
+ then have "Stars (v # vs) :\<sqsubseteq>val Stars (v3a # vs3)" using NonEmpty(4) q2 as1
+ unfolding PosOrd_ex_eq_def
+ using PosOrd_StarsI PosOrd_StarsI2 by auto
+ then show "Stars (v # vs) :\<sqsubseteq>val v3" unfolding NonEmpty by blast
+ next
+ case Empty
+ have "v3 = Stars []" by fact
+ then show "Stars (v # vs) :\<sqsubseteq>val v3"
+ unfolding PosOrd_ex_eq_def using cond2
+ by (simp add: PosOrd_shorterI)
+ qed
+next
+ case (Posix_STAR2 r v2)
+ have "v2 \<in> LV (STAR r) []" by fact
+ then have "v2 = Stars []"
+ unfolding LV_def by (auto elim: Prf.cases)
+ then show "Stars [] :\<sqsubseteq>val v2"
+ by (simp add: PosOrd_ex_eq_def)
+qed
+
+
+lemma Posix_PosOrd_reverse:
+ assumes "s \<in> r \<rightarrow> v1"
+ shows "\<not>(\<exists>v2 \<in> LV r s. v2 :\<sqsubset>val v1)"
+using assms
+by (metis Posix_PosOrd less_irrefl PosOrd_def
+ PosOrd_ex_eq_def PosOrd_ex_def PosOrd_trans)
+
+lemma PosOrd_Posix:
+ assumes "v1 \<in> LV r s" "\<forall>v\<^sub>2 \<in> LV r s. \<not> v\<^sub>2 :\<sqsubset>val v1"
+ shows "s \<in> r \<rightarrow> v1"
+proof -
+ have "s \<in> L r" using assms(1) unfolding LV_def
+ using L_flat_Prf1 by blast
+ then obtain vposix where vp: "s \<in> r \<rightarrow> vposix"
+ using lexer_correct_Some by blast
+ with assms(1) have "vposix :\<sqsubseteq>val v1" by (simp add: Posix_PosOrd)
+ then have "vposix = v1 \<or> vposix :\<sqsubset>val v1" unfolding PosOrd_ex_eq2 by auto
+ moreover
+ { assume "vposix :\<sqsubset>val v1"
+ moreover
+ have "vposix \<in> LV r s" using vp
+ using Posix_LV by blast
+ ultimately have "False" using assms(2) by blast
+ }
+ ultimately show "s \<in> r \<rightarrow> v1" using vp by blast
+qed
+
+lemma Least_existence:
+ assumes "LV r s \<noteq> {}"
+ shows " \<exists>vmin \<in> LV r s. \<forall>v \<in> LV r s. vmin :\<sqsubseteq>val v"
+proof -
+ from assms
+ obtain vposix where "s \<in> r \<rightarrow> vposix"
+ unfolding LV_def
+ using L_flat_Prf1 lexer_correct_Some by blast
+ then have "\<forall>v \<in> LV r s. vposix :\<sqsubseteq>val v"
+ by (simp add: Posix_PosOrd)
+ then show "\<exists>vmin \<in> LV r s. \<forall>v \<in> LV r s. vmin :\<sqsubseteq>val v"
+ using Posix_LV \<open>s \<in> r \<rightarrow> vposix\<close> by blast
+qed
+
+lemma Least_existence1:
+ assumes "LV r s \<noteq> {}"
+ shows " \<exists>!vmin \<in> LV r s. \<forall>v \<in> LV r s. vmin :\<sqsubseteq>val v"
+using Least_existence[OF assms] assms
+using PosOrdeq_antisym by blast
+
+lemma Least_existence2:
+ assumes "LV r s \<noteq> {}"
+ shows " \<exists>!vmin \<in> LV r s. lexer r s = Some vmin \<and> (\<forall>v \<in> LV r s. vmin :\<sqsubseteq>val v)"
+using Least_existence[OF assms] assms
+using PosOrdeq_antisym
+ using PosOrd_Posix PosOrd_ex_eq2 lexer_correctness(1) by auto
+
+
+lemma Least_existence1_pre:
+ assumes "LV r s \<noteq> {}"
+ shows " \<exists>!vmin \<in> LV r s. \<forall>v \<in> (LV r s \<union> {v'. flat v' \<sqsubset>spre s}). vmin :\<sqsubseteq>val v"
+using Least_existence[OF assms] assms
+apply -
+apply(erule bexE)
+apply(rule_tac a="vmin" in ex1I)
+apply(auto)[1]
+apply (metis PosOrd_Posix PosOrd_ex_eq2 PosOrd_spreI PosOrdeq_antisym Posix1(2))
+apply(auto)[1]
+apply(simp add: PosOrdeq_antisym)
+done
+
+lemma
+ shows "partial_order_on UNIV {(v1, v2). v1 :\<sqsubseteq>val v2}"
+apply(simp add: partial_order_on_def)
+apply(simp add: preorder_on_def refl_on_def)
+apply(simp add: PosOrdeq_refl)
+apply(auto)
+apply(rule transI)
+apply(auto intro: PosOrdeq_trans)[1]
+apply(rule antisymI)
+apply(simp add: PosOrdeq_antisym)
+done
+
+lemma
+ "wf {(v1, v2). v1 :\<sqsubset>val v2 \<and> v1 \<in> LV r s \<and> v2 \<in> LV r s}"
+apply(rule finite_acyclic_wf)
+prefer 2
+apply(simp add: acyclic_def)
+apply(induct_tac rule: trancl.induct)
+apply(auto)[1]
+oops
+
+
+unused_thms
+
+end
\ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys2/PositionsExt.thy Sun Oct 10 18:35:21 2021 +0100
@@ -0,0 +1,1153 @@
+
+theory PositionsExt
+ imports "SpecExt" "LexerExt"
+begin
+
+section {* Positions in Values *}
+
+fun
+ at :: "val \<Rightarrow> nat list \<Rightarrow> val"
+where
+ "at v [] = v"
+| "at (Left v) (0#ps)= at v ps"
+| "at (Right v) (Suc 0#ps)= at v ps"
+| "at (Seq v1 v2) (0#ps)= at v1 ps"
+| "at (Seq v1 v2) (Suc 0#ps)= at v2 ps"
+| "at (Stars vs) (n#ps)= at (nth vs n) ps"
+
+
+
+fun Pos :: "val \<Rightarrow> (nat list) set"
+where
+ "Pos (Void) = {[]}"
+| "Pos (Char c) = {[]}"
+| "Pos (Left v) = {[]} \<union> {0#ps | ps. ps \<in> Pos v}"
+| "Pos (Right v) = {[]} \<union> {1#ps | ps. ps \<in> Pos v}"
+| "Pos (Seq v1 v2) = {[]} \<union> {0#ps | ps. ps \<in> Pos v1} \<union> {1#ps | ps. ps \<in> Pos v2}"
+| "Pos (Stars []) = {[]}"
+| "Pos (Stars (v#vs)) = {[]} \<union> {0#ps | ps. ps \<in> Pos v} \<union> {Suc n#ps | n ps. n#ps \<in> Pos (Stars vs)}"
+
+
+lemma Pos_stars:
+ "Pos (Stars vs) = {[]} \<union> (\<Union>n < length vs. {n#ps | ps. ps \<in> Pos (vs ! n)})"
+apply(induct vs)
+apply(auto simp add: insert_ident less_Suc_eq_0_disj)
+done
+
+lemma Pos_empty:
+ shows "[] \<in> Pos v"
+by (induct v rule: Pos.induct)(auto)
+
+
+abbreviation
+ "intlen vs \<equiv> int (length vs)"
+
+
+definition pflat_len :: "val \<Rightarrow> nat list => int"
+where
+ "pflat_len v p \<equiv> (if p \<in> Pos v then intlen (flat (at v p)) else -1)"
+
+lemma pflat_len_simps:
+ shows "pflat_len (Seq v1 v2) (0#p) = pflat_len v1 p"
+ and "pflat_len (Seq v1 v2) (Suc 0#p) = pflat_len v2 p"
+ and "pflat_len (Left v) (0#p) = pflat_len v p"
+ and "pflat_len (Left v) (Suc 0#p) = -1"
+ and "pflat_len (Right v) (Suc 0#p) = pflat_len v p"
+ and "pflat_len (Right v) (0#p) = -1"
+ and "pflat_len (Stars (v#vs)) (Suc n#p) = pflat_len (Stars vs) (n#p)"
+ and "pflat_len (Stars (v#vs)) (0#p) = pflat_len v p"
+ and "pflat_len v [] = intlen (flat v)"
+by (auto simp add: pflat_len_def Pos_empty)
+
+lemma pflat_len_Stars_simps:
+ assumes "n < length vs"
+ shows "pflat_len (Stars vs) (n#p) = pflat_len (vs!n) p"
+using assms
+apply(induct vs arbitrary: n p)
+apply(auto simp add: less_Suc_eq_0_disj pflat_len_simps)
+done
+
+lemma pflat_len_outside:
+ assumes "p \<notin> Pos v1"
+ shows "pflat_len v1 p = -1 "
+using assms by (simp add: pflat_len_def)
+
+
+
+section {* Orderings *}
+
+
+definition prefix_list:: "'a list \<Rightarrow> 'a list \<Rightarrow> bool" ("_ \<sqsubseteq>pre _" [60,59] 60)
+where
+ "ps1 \<sqsubseteq>pre ps2 \<equiv> \<exists>ps'. ps1 @ps' = ps2"
+
+definition sprefix_list:: "'a list \<Rightarrow> 'a list \<Rightarrow> bool" ("_ \<sqsubset>spre _" [60,59] 60)
+where
+ "ps1 \<sqsubset>spre ps2 \<equiv> ps1 \<sqsubseteq>pre ps2 \<and> ps1 \<noteq> ps2"
+
+inductive lex_list :: "nat list \<Rightarrow> nat list \<Rightarrow> bool" ("_ \<sqsubset>lex _" [60,59] 60)
+where
+ "[] \<sqsubset>lex (p#ps)"
+| "ps1 \<sqsubset>lex ps2 \<Longrightarrow> (p#ps1) \<sqsubset>lex (p#ps2)"
+| "p1 < p2 \<Longrightarrow> (p1#ps1) \<sqsubset>lex (p2#ps2)"
+
+lemma lex_irrfl:
+ fixes ps1 ps2 :: "nat list"
+ assumes "ps1 \<sqsubset>lex ps2"
+ shows "ps1 \<noteq> ps2"
+using assms
+by(induct rule: lex_list.induct)(auto)
+
+lemma lex_simps [simp]:
+ fixes xs ys :: "nat list"
+ shows "[] \<sqsubset>lex ys \<longleftrightarrow> ys \<noteq> []"
+ and "xs \<sqsubset>lex [] \<longleftrightarrow> False"
+ and "(x # xs) \<sqsubset>lex (y # ys) \<longleftrightarrow> (x < y \<or> (x = y \<and> xs \<sqsubset>lex ys))"
+by (auto simp add: neq_Nil_conv elim: lex_list.cases intro: lex_list.intros)
+
+lemma lex_trans:
+ fixes ps1 ps2 ps3 :: "nat list"
+ assumes "ps1 \<sqsubset>lex ps2" "ps2 \<sqsubset>lex ps3"
+ shows "ps1 \<sqsubset>lex ps3"
+using assms
+by (induct arbitrary: ps3 rule: lex_list.induct)
+ (auto elim: lex_list.cases)
+
+
+lemma lex_trichotomous:
+ fixes p q :: "nat list"
+ shows "p = q \<or> p \<sqsubset>lex q \<or> q \<sqsubset>lex p"
+apply(induct p arbitrary: q)
+apply(auto elim: lex_list.cases)
+apply(case_tac q)
+apply(auto)
+done
+
+
+
+
+section {* POSIX Ordering of Values According to Okui \& Suzuki *}
+
+
+definition PosOrd:: "val \<Rightarrow> nat list \<Rightarrow> val \<Rightarrow> bool" ("_ \<sqsubset>val _ _" [60, 60, 59] 60)
+where
+ "v1 \<sqsubset>val p v2 \<equiv> pflat_len v1 p > pflat_len v2 p \<and>
+ (\<forall>q \<in> Pos v1 \<union> Pos v2. q \<sqsubset>lex p \<longrightarrow> pflat_len v1 q = pflat_len v2 q)"
+
+lemma PosOrd_def2:
+ shows "v1 \<sqsubset>val p v2 \<longleftrightarrow>
+ pflat_len v1 p > pflat_len v2 p \<and>
+ (\<forall>q \<in> Pos v1. q \<sqsubset>lex p \<longrightarrow> pflat_len v1 q = pflat_len v2 q) \<and>
+ (\<forall>q \<in> Pos v2. q \<sqsubset>lex p \<longrightarrow> pflat_len v1 q = pflat_len v2 q)"
+unfolding PosOrd_def
+apply(auto)
+done
+
+
+definition PosOrd_ex:: "val \<Rightarrow> val \<Rightarrow> bool" ("_ :\<sqsubset>val _" [60, 59] 60)
+where
+ "v1 :\<sqsubset>val v2 \<equiv> \<exists>p. v1 \<sqsubset>val p v2"
+
+definition PosOrd_ex_eq:: "val \<Rightarrow> val \<Rightarrow> bool" ("_ :\<sqsubseteq>val _" [60, 59] 60)
+where
+ "v1 :\<sqsubseteq>val v2 \<equiv> v1 :\<sqsubset>val v2 \<or> v1 = v2"
+
+
+lemma PosOrd_trans:
+ assumes "v1 :\<sqsubset>val v2" "v2 :\<sqsubset>val v3"
+ shows "v1 :\<sqsubset>val v3"
+proof -
+ from assms obtain p p'
+ where as: "v1 \<sqsubset>val p v2" "v2 \<sqsubset>val p' v3" unfolding PosOrd_ex_def by blast
+ then have pos: "p \<in> Pos v1" "p' \<in> Pos v2" unfolding PosOrd_def pflat_len_def
+ by (smt not_int_zless_negative)+
+ have "p = p' \<or> p \<sqsubset>lex p' \<or> p' \<sqsubset>lex p"
+ by (rule lex_trichotomous)
+ moreover
+ { assume "p = p'"
+ with as have "v1 \<sqsubset>val p v3" unfolding PosOrd_def pflat_len_def
+ by (smt Un_iff)
+ then have " v1 :\<sqsubset>val v3" unfolding PosOrd_ex_def by blast
+ }
+ moreover
+ { assume "p \<sqsubset>lex p'"
+ with as have "v1 \<sqsubset>val p v3" unfolding PosOrd_def pflat_len_def
+ by (smt Un_iff lex_trans)
+ then have " v1 :\<sqsubset>val v3" unfolding PosOrd_ex_def by blast
+ }
+ moreover
+ { assume "p' \<sqsubset>lex p"
+ with as have "v1 \<sqsubset>val p' v3" unfolding PosOrd_def
+ by (smt Un_iff lex_trans pflat_len_def)
+ then have "v1 :\<sqsubset>val v3" unfolding PosOrd_ex_def by blast
+ }
+ ultimately show "v1 :\<sqsubset>val v3" by blast
+qed
+
+lemma PosOrd_irrefl:
+ assumes "v :\<sqsubset>val v"
+ shows "False"
+using assms unfolding PosOrd_ex_def PosOrd_def
+by auto
+
+lemma PosOrd_assym:
+ assumes "v1 :\<sqsubset>val v2"
+ shows "\<not>(v2 :\<sqsubset>val v1)"
+using assms
+using PosOrd_irrefl PosOrd_trans by blast
+
+(*
+ :\<sqsubseteq>val and :\<sqsubset>val are partial orders.
+*)
+
+lemma PosOrd_ordering:
+ shows "ordering (\<lambda>v1 v2. v1 :\<sqsubseteq>val v2) (\<lambda> v1 v2. v1 :\<sqsubset>val v2)"
+unfolding ordering_def PosOrd_ex_eq_def
+apply(auto)
+using PosOrd_irrefl apply blast
+using PosOrd_assym apply blast
+using PosOrd_trans by blast
+
+lemma PosOrd_order:
+ shows "class.order (\<lambda>v1 v2. v1 :\<sqsubseteq>val v2) (\<lambda> v1 v2. v1 :\<sqsubset>val v2)"
+using PosOrd_ordering
+apply(simp add: class.order_def class.preorder_def class.order_axioms_def)
+unfolding ordering_def
+by blast
+
+
+lemma PosOrd_ex_eq2:
+ shows "v1 :\<sqsubset>val v2 \<longleftrightarrow> (v1 :\<sqsubseteq>val v2 \<and> v1 \<noteq> v2)"
+using PosOrd_ordering
+unfolding ordering_def
+by auto
+
+lemma PosOrdeq_trans:
+ assumes "v1 :\<sqsubseteq>val v2" "v2 :\<sqsubseteq>val v3"
+ shows "v1 :\<sqsubseteq>val v3"
+using assms PosOrd_ordering
+unfolding ordering_def
+by blast
+
+lemma PosOrdeq_antisym:
+ assumes "v1 :\<sqsubseteq>val v2" "v2 :\<sqsubseteq>val v1"
+ shows "v1 = v2"
+using assms PosOrd_ordering
+unfolding ordering_def
+by blast
+
+lemma PosOrdeq_refl:
+ shows "v :\<sqsubseteq>val v"
+unfolding PosOrd_ex_eq_def
+by auto
+
+
+lemma PosOrd_shorterE:
+ assumes "v1 :\<sqsubset>val v2"
+ shows "length (flat v2) \<le> length (flat v1)"
+using assms unfolding PosOrd_ex_def PosOrd_def
+apply(auto)
+apply(case_tac p)
+apply(simp add: pflat_len_simps)
+apply(drule_tac x="[]" in bspec)
+apply(simp add: Pos_empty)
+apply(simp add: pflat_len_simps)
+done
+
+lemma PosOrd_shorterI:
+ assumes "length (flat v2) < length (flat v1)"
+ shows "v1 :\<sqsubset>val v2"
+unfolding PosOrd_ex_def PosOrd_def pflat_len_def
+using assms Pos_empty by force
+
+lemma PosOrd_spreI:
+ assumes "flat v' \<sqsubset>spre flat v"
+ shows "v :\<sqsubset>val v'"
+using assms
+apply(rule_tac PosOrd_shorterI)
+unfolding prefix_list_def sprefix_list_def
+by (metis append_Nil2 append_eq_conv_conj drop_all le_less_linear)
+
+lemma pflat_len_inside:
+ assumes "pflat_len v2 p < pflat_len v1 p"
+ shows "p \<in> Pos v1"
+using assms
+unfolding pflat_len_def
+by (auto split: if_splits)
+
+
+lemma PosOrd_Left_Right:
+ assumes "flat v1 = flat v2"
+ shows "Left v1 :\<sqsubset>val Right v2"
+unfolding PosOrd_ex_def
+apply(rule_tac x="[0]" in exI)
+apply(auto simp add: PosOrd_def pflat_len_simps assms)
+done
+
+lemma PosOrd_LeftE:
+ assumes "Left v1 :\<sqsubset>val Left v2" "flat v1 = flat v2"
+ shows "v1 :\<sqsubset>val v2"
+using assms
+unfolding PosOrd_ex_def PosOrd_def2
+apply(auto simp add: pflat_len_simps)
+apply(frule pflat_len_inside)
+apply(auto simp add: pflat_len_simps)
+by (metis lex_simps(3) pflat_len_simps(3))
+
+lemma PosOrd_LeftI:
+ assumes "v1 :\<sqsubset>val v2" "flat v1 = flat v2"
+ shows "Left v1 :\<sqsubset>val Left v2"
+using assms
+unfolding PosOrd_ex_def PosOrd_def2
+apply(auto simp add: pflat_len_simps)
+by (metis less_numeral_extra(3) lex_simps(3) pflat_len_simps(3))
+
+lemma PosOrd_Left_eq:
+ assumes "flat v1 = flat v2"
+ shows "Left v1 :\<sqsubset>val Left v2 \<longleftrightarrow> v1 :\<sqsubset>val v2"
+using assms PosOrd_LeftE PosOrd_LeftI
+by blast
+
+
+lemma PosOrd_RightE:
+ assumes "Right v1 :\<sqsubset>val Right v2" "flat v1 = flat v2"
+ shows "v1 :\<sqsubset>val v2"
+using assms
+unfolding PosOrd_ex_def PosOrd_def2
+apply(auto simp add: pflat_len_simps)
+apply(frule pflat_len_inside)
+apply(auto simp add: pflat_len_simps)
+by (metis lex_simps(3) pflat_len_simps(5))
+
+lemma PosOrd_RightI:
+ assumes "v1 :\<sqsubset>val v2" "flat v1 = flat v2"
+ shows "Right v1 :\<sqsubset>val Right v2"
+using assms
+unfolding PosOrd_ex_def PosOrd_def2
+apply(auto simp add: pflat_len_simps)
+by (metis lex_simps(3) nat_neq_iff pflat_len_simps(5))
+
+
+lemma PosOrd_Right_eq:
+ assumes "flat v1 = flat v2"
+ shows "Right v1 :\<sqsubset>val Right v2 \<longleftrightarrow> v1 :\<sqsubset>val v2"
+using assms PosOrd_RightE PosOrd_RightI
+by blast
+
+
+lemma PosOrd_SeqI1:
+ assumes "v1 :\<sqsubset>val w1" "flat (Seq v1 v2) = flat (Seq w1 w2)"
+ shows "Seq v1 v2 :\<sqsubset>val Seq w1 w2"
+using assms(1)
+apply(subst (asm) PosOrd_ex_def)
+apply(subst (asm) PosOrd_def)
+apply(clarify)
+apply(subst PosOrd_ex_def)
+apply(rule_tac x="0#p" in exI)
+apply(subst PosOrd_def)
+apply(rule conjI)
+apply(simp add: pflat_len_simps)
+apply(rule ballI)
+apply(rule impI)
+apply(simp only: Pos.simps)
+apply(auto)[1]
+apply(simp add: pflat_len_simps)
+apply(auto simp add: pflat_len_simps)
+using assms(2)
+apply(simp)
+apply(metis length_append of_nat_add)
+done
+
+lemma PosOrd_SeqI2:
+ assumes "v2 :\<sqsubset>val w2" "flat v2 = flat w2"
+ shows "Seq v v2 :\<sqsubset>val Seq v w2"
+using assms(1)
+apply(subst (asm) PosOrd_ex_def)
+apply(subst (asm) PosOrd_def)
+apply(clarify)
+apply(subst PosOrd_ex_def)
+apply(rule_tac x="Suc 0#p" in exI)
+apply(subst PosOrd_def)
+apply(rule conjI)
+apply(simp add: pflat_len_simps)
+apply(rule ballI)
+apply(rule impI)
+apply(simp only: Pos.simps)
+apply(auto)[1]
+apply(simp add: pflat_len_simps)
+using assms(2)
+apply(simp)
+apply(auto simp add: pflat_len_simps)
+done
+
+lemma PosOrd_Seq_eq:
+ assumes "flat v2 = flat w2"
+ shows "(Seq v v2) :\<sqsubset>val (Seq v w2) \<longleftrightarrow> v2 :\<sqsubset>val w2"
+using assms
+apply(auto)
+prefer 2
+apply(simp add: PosOrd_SeqI2)
+apply(simp add: PosOrd_ex_def)
+apply(auto)
+apply(case_tac p)
+apply(simp add: PosOrd_def pflat_len_simps)
+apply(case_tac a)
+apply(simp add: PosOrd_def pflat_len_simps)
+apply(clarify)
+apply(case_tac nat)
+prefer 2
+apply(simp add: PosOrd_def pflat_len_simps pflat_len_outside)
+apply(rule_tac x="list" in exI)
+apply(auto simp add: PosOrd_def2 pflat_len_simps)
+apply(smt Collect_disj_eq lex_list.intros(2) mem_Collect_eq pflat_len_simps(2))
+apply(smt Collect_disj_eq lex_list.intros(2) mem_Collect_eq pflat_len_simps(2))
+done
+
+
+
+lemma PosOrd_StarsI:
+ assumes "v1 :\<sqsubset>val v2" "flats (v1#vs1) = flats (v2#vs2)"
+ shows "Stars (v1#vs1) :\<sqsubset>val Stars (v2#vs2)"
+using assms(1)
+apply(subst (asm) PosOrd_ex_def)
+apply(subst (asm) PosOrd_def)
+apply(clarify)
+apply(subst PosOrd_ex_def)
+apply(subst PosOrd_def)
+apply(rule_tac x="0#p" in exI)
+apply(simp add: pflat_len_Stars_simps pflat_len_simps)
+using assms(2)
+apply(simp add: pflat_len_simps)
+apply(auto simp add: pflat_len_Stars_simps pflat_len_simps)
+by (metis length_append of_nat_add)
+
+lemma PosOrd_StarsI2:
+ assumes "Stars vs1 :\<sqsubset>val Stars vs2" "flats vs1 = flats vs2"
+ shows "Stars (v#vs1) :\<sqsubset>val Stars (v#vs2)"
+using assms(1)
+apply(subst (asm) PosOrd_ex_def)
+apply(subst (asm) PosOrd_def)
+apply(clarify)
+apply(subst PosOrd_ex_def)
+apply(subst PosOrd_def)
+apply(case_tac p)
+apply(simp add: pflat_len_simps)
+apply(rule_tac x="Suc a#list" in exI)
+apply(auto simp add: pflat_len_Stars_simps pflat_len_simps assms(2))
+done
+
+lemma PosOrd_Stars_appendI:
+ assumes "Stars vs1 :\<sqsubset>val Stars vs2" "flat (Stars vs1) = flat (Stars vs2)"
+ shows "Stars (vs @ vs1) :\<sqsubset>val Stars (vs @ vs2)"
+using assms
+apply(induct vs)
+apply(simp)
+apply(simp add: PosOrd_StarsI2)
+done
+
+lemma PosOrd_eq_Stars_zipI:
+ assumes "\<forall>(v1, v2) \<in> set (zip vs1 vs2). v1 :\<sqsubseteq>val v2"
+ "length vs1 = length vs2" "flats vs1 = flats vs2"
+ shows "Stars vs1 :\<sqsubseteq>val Stars vs2"
+ using assms
+ apply(induct vs1 arbitrary: vs2)
+ apply(case_tac vs2)
+apply(simp add: PosOrd_ex_eq_def)
+ apply(simp)
+ apply(case_tac vs2)
+ apply(simp)
+ apply(simp)
+ apply(auto)
+apply(subst (asm) (2)PosOrd_ex_eq_def)
+ apply(auto)
+ apply(subst PosOrd_ex_eq_def)
+ apply(rule disjI1)
+ apply(rule PosOrd_StarsI)
+ apply(simp)
+ apply(simp)
+ using PosOrd_StarsI2 PosOrd_ex_eq_def by fastforce
+
+lemma PosOrd_StarsE2:
+ assumes "Stars (v # vs1) :\<sqsubset>val Stars (v # vs2)"
+ shows "Stars vs1 :\<sqsubset>val Stars vs2"
+using assms
+apply(subst (asm) PosOrd_ex_def)
+apply(erule exE)
+apply(case_tac p)
+apply(simp)
+apply(simp add: PosOrd_def pflat_len_simps)
+apply(subst PosOrd_ex_def)
+apply(rule_tac x="[]" in exI)
+apply(simp add: PosOrd_def pflat_len_simps Pos_empty)
+apply(simp)
+apply(case_tac a)
+apply(clarify)
+apply(auto simp add: pflat_len_simps PosOrd_def pflat_len_def split: if_splits)[1]
+apply(clarify)
+apply(simp add: PosOrd_ex_def)
+apply(rule_tac x="nat#list" in exI)
+apply(auto simp add: PosOrd_def pflat_len_simps)[1]
+apply(case_tac q)
+apply(simp add: PosOrd_def pflat_len_simps)
+apply(clarify)
+apply(drule_tac x="Suc a # lista" in bspec)
+apply(simp)
+apply(auto simp add: PosOrd_def pflat_len_simps)[1]
+apply(case_tac q)
+apply(simp add: PosOrd_def pflat_len_simps)
+apply(clarify)
+apply(drule_tac x="Suc a # lista" in bspec)
+apply(simp)
+apply(auto simp add: PosOrd_def pflat_len_simps)[1]
+done
+
+lemma PosOrd_Stars_appendE:
+ assumes "Stars (vs @ vs1) :\<sqsubset>val Stars (vs @ vs2)"
+ shows "Stars vs1 :\<sqsubset>val Stars vs2"
+using assms
+apply(induct vs)
+apply(simp)
+apply(simp add: PosOrd_StarsE2)
+done
+
+lemma PosOrd_Stars_append_eq:
+ assumes "flats vs1 = flats vs2"
+ shows "Stars (vs @ vs1) :\<sqsubset>val Stars (vs @ vs2) \<longleftrightarrow> Stars vs1 :\<sqsubset>val Stars vs2"
+using assms
+apply(rule_tac iffI)
+apply(erule PosOrd_Stars_appendE)
+apply(rule PosOrd_Stars_appendI)
+apply(auto)
+done
+
+lemma PosOrd_almost_trichotomous:
+ shows "v1 :\<sqsubset>val v2 \<or> v2 :\<sqsubset>val v1 \<or> (length (flat v1) = length (flat v2))"
+apply(auto simp add: PosOrd_ex_def)
+apply(auto simp add: PosOrd_def)
+apply(rule_tac x="[]" in exI)
+apply(auto simp add: Pos_empty pflat_len_simps)
+apply(drule_tac x="[]" in spec)
+apply(auto simp add: Pos_empty pflat_len_simps)
+done
+
+
+
+section {* The Posix Value is smaller than any other Value *}
+
+
+lemma Posix_PosOrd:
+ assumes "s \<in> r \<rightarrow> v1" "v2 \<in> LV r s"
+ shows "v1 :\<sqsubseteq>val v2"
+using assms
+proof (induct arbitrary: v2 rule: Posix.induct)
+ case (Posix_ONE v)
+ have "v \<in> LV ONE []" by fact
+ then have "v = Void"
+ by (simp add: LV_simps)
+ then show "Void :\<sqsubseteq>val v"
+ by (simp add: PosOrd_ex_eq_def)
+next
+ case (Posix_CHAR c v)
+ have "v \<in> LV (CHAR c) [c]" by fact
+ then have "v = Char c"
+ by (simp add: LV_simps)
+ then show "Char c :\<sqsubseteq>val v"
+ by (simp add: PosOrd_ex_eq_def)
+next
+ case (Posix_ALT1 s r1 v r2 v2)
+ have as1: "s \<in> r1 \<rightarrow> v" by fact
+ have IH: "\<And>v2. v2 \<in> LV r1 s \<Longrightarrow> v :\<sqsubseteq>val v2" by fact
+ have "v2 \<in> LV (ALT r1 r2) s" by fact
+ then have "\<Turnstile> v2 : ALT r1 r2" "flat v2 = s"
+ by(auto simp add: LV_def prefix_list_def)
+ then consider
+ (Left) v3 where "v2 = Left v3" "\<Turnstile> v3 : r1" "flat v3 = s"
+ | (Right) v3 where "v2 = Right v3" "\<Turnstile> v3 : r2" "flat v3 = s"
+ by (auto elim: Prf.cases)
+ then show "Left v :\<sqsubseteq>val v2"
+ proof(cases)
+ case (Left v3)
+ have "v3 \<in> LV r1 s" using Left(2,3)
+ by (auto simp add: LV_def prefix_list_def)
+ with IH have "v :\<sqsubseteq>val v3" by simp
+ moreover
+ have "flat v3 = flat v" using as1 Left(3)
+ by (simp add: Posix1(2))
+ ultimately have "Left v :\<sqsubseteq>val Left v3"
+ by (simp add: PosOrd_ex_eq_def PosOrd_Left_eq)
+ then show "Left v :\<sqsubseteq>val v2" unfolding Left .
+ next
+ case (Right v3)
+ have "flat v3 = flat v" using as1 Right(3)
+ by (simp add: Posix1(2))
+ then have "Left v :\<sqsubseteq>val Right v3"
+ unfolding PosOrd_ex_eq_def
+ by (simp add: PosOrd_Left_Right)
+ then show "Left v :\<sqsubseteq>val v2" unfolding Right .
+ qed
+next
+ case (Posix_ALT2 s r2 v r1 v2)
+ have as1: "s \<in> r2 \<rightarrow> v" by fact
+ have as2: "s \<notin> L r1" by fact
+ have IH: "\<And>v2. v2 \<in> LV r2 s \<Longrightarrow> v :\<sqsubseteq>val v2" by fact
+ have "v2 \<in> LV (ALT r1 r2) s" by fact
+ then have "\<Turnstile> v2 : ALT r1 r2" "flat v2 = s"
+ by(auto simp add: LV_def prefix_list_def)
+ then consider
+ (Left) v3 where "v2 = Left v3" "\<Turnstile> v3 : r1" "flat v3 = s"
+ | (Right) v3 where "v2 = Right v3" "\<Turnstile> v3 : r2" "flat v3 = s"
+ by (auto elim: Prf.cases)
+ then show "Right v :\<sqsubseteq>val v2"
+ proof (cases)
+ case (Right v3)
+ have "v3 \<in> LV r2 s" using Right(2,3)
+ by (auto simp add: LV_def prefix_list_def)
+ with IH have "v :\<sqsubseteq>val v3" by simp
+ moreover
+ have "flat v3 = flat v" using as1 Right(3)
+ by (simp add: Posix1(2))
+ ultimately have "Right v :\<sqsubseteq>val Right v3"
+ by (auto simp add: PosOrd_ex_eq_def PosOrd_RightI)
+ then show "Right v :\<sqsubseteq>val v2" unfolding Right .
+ next
+ case (Left v3)
+ have "v3 \<in> LV r1 s" using Left(2,3) as2
+ by (auto simp add: LV_def prefix_list_def)
+ then have "flat v3 = flat v \<and> \<Turnstile> v3 : r1" using as1 Left(3)
+ by (simp add: Posix1(2) LV_def)
+ then have "False" using as1 as2 Left
+ by (auto simp add: Posix1(2) L_flat_Prf1)
+ then show "Right v :\<sqsubseteq>val v2" by simp
+ qed
+next
+ case (Posix_SEQ s1 r1 v1 s2 r2 v2 v3)
+ have "s1 \<in> r1 \<rightarrow> v1" "s2 \<in> r2 \<rightarrow> v2" by fact+
+ then have as1: "s1 = flat v1" "s2 = flat v2" by (simp_all add: Posix1(2))
+ have IH1: "\<And>v3. v3 \<in> LV r1 s1 \<Longrightarrow> v1 :\<sqsubseteq>val v3" by fact
+ have IH2: "\<And>v3. v3 \<in> LV r2 s2 \<Longrightarrow> v2 :\<sqsubseteq>val v3" by fact
+ have cond: "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L r1 \<and> s\<^sub>4 \<in> L r2)" by fact
+ have "v3 \<in> LV (SEQ r1 r2) (s1 @ s2)" by fact
+ then obtain v3a v3b where eqs:
+ "v3 = Seq v3a v3b" "\<Turnstile> v3a : r1" "\<Turnstile> v3b : r2"
+ "flat v3a @ flat v3b = s1 @ s2"
+ by (force simp add: prefix_list_def LV_def elim: Prf.cases)
+ with cond have "flat v3a \<sqsubseteq>pre s1" unfolding prefix_list_def
+ by (smt L_flat_Prf1 append_eq_append_conv2 append_self_conv)
+ then have "flat v3a \<sqsubset>spre s1 \<or> (flat v3a = s1 \<and> flat v3b = s2)" using eqs
+ by (simp add: sprefix_list_def append_eq_conv_conj)
+ then have q2: "v1 :\<sqsubset>val v3a \<or> (flat v3a = s1 \<and> flat v3b = s2)"
+ using PosOrd_spreI as1(1) eqs by blast
+ then have "v1 :\<sqsubset>val v3a \<or> (v3a \<in> LV r1 s1 \<and> v3b \<in> LV r2 s2)" using eqs(2,3)
+ by (auto simp add: LV_def)
+ then have "v1 :\<sqsubset>val v3a \<or> (v1 :\<sqsubseteq>val v3a \<and> v2 :\<sqsubseteq>val v3b)" using IH1 IH2 by blast
+ then have "Seq v1 v2 :\<sqsubseteq>val Seq v3a v3b" using eqs q2 as1
+ unfolding PosOrd_ex_eq_def by (auto simp add: PosOrd_SeqI1 PosOrd_Seq_eq)
+ then show "Seq v1 v2 :\<sqsubseteq>val v3" unfolding eqs by blast
+next
+ case (Posix_STAR1 s1 r v s2 vs v3)
+ have "s1 \<in> r \<rightarrow> v" "s2 \<in> STAR r \<rightarrow> Stars vs" by fact+
+ then have as1: "s1 = flat v" "s2 = flat (Stars vs)" by (auto dest: Posix1(2))
+ have IH1: "\<And>v3. v3 \<in> LV r s1 \<Longrightarrow> v :\<sqsubseteq>val v3" by fact
+ have IH2: "\<And>v3. v3 \<in> LV (STAR r) s2 \<Longrightarrow> Stars vs :\<sqsubseteq>val v3" by fact
+ have cond: "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L r \<and> s\<^sub>4 \<in> L (STAR r))" by fact
+ have cond2: "flat v \<noteq> []" by fact
+ have "v3 \<in> LV (STAR r) (s1 @ s2)" by fact
+ then consider
+ (NonEmpty) v3a vs3 where "v3 = Stars (v3a # vs3)"
+ "\<Turnstile> v3a : r" "\<Turnstile> Stars vs3 : STAR r"
+ "flat (Stars (v3a # vs3)) = s1 @ s2"
+ | (Empty) "v3 = Stars []"
+ unfolding LV_def
+ apply(auto)
+ apply(erule Prf.cases)
+ apply(auto)
+ apply(case_tac vs)
+ apply(auto intro: Prf.intros)
+ done
+ then show "Stars (v # vs) :\<sqsubseteq>val v3"
+ proof (cases)
+ case (NonEmpty v3a vs3)
+ have "flat (Stars (v3a # vs3)) = s1 @ s2" using NonEmpty(4) .
+ with cond have "flat v3a \<sqsubseteq>pre s1" using NonEmpty(2,3)
+ unfolding prefix_list_def
+ by (smt L_flat_Prf1 append_Nil2 append_eq_append_conv2 flat.simps(7))
+ then have "flat v3a \<sqsubset>spre s1 \<or> (flat v3a = s1 \<and> flat (Stars vs3) = s2)" using NonEmpty(4)
+ by (simp add: sprefix_list_def append_eq_conv_conj)
+ then have q2: "v :\<sqsubset>val v3a \<or> (flat v3a = s1 \<and> flat (Stars vs3) = s2)"
+ using PosOrd_spreI as1(1) NonEmpty(4) by blast
+ then have "v :\<sqsubset>val v3a \<or> (v3a \<in> LV r s1 \<and> Stars vs3 \<in> LV (STAR r) s2)"
+ using NonEmpty(2,3) by (auto simp add: LV_def)
+ then have "v :\<sqsubset>val v3a \<or> (v :\<sqsubseteq>val v3a \<and> Stars vs :\<sqsubseteq>val Stars vs3)" using IH1 IH2 by blast
+ then have "v :\<sqsubset>val v3a \<or> (v = v3a \<and> Stars vs :\<sqsubseteq>val Stars vs3)"
+ unfolding PosOrd_ex_eq_def by auto
+ then have "Stars (v # vs) :\<sqsubseteq>val Stars (v3a # vs3)" using NonEmpty(4) q2 as1
+ unfolding PosOrd_ex_eq_def
+ using PosOrd_StarsI PosOrd_StarsI2 by auto
+ then show "Stars (v # vs) :\<sqsubseteq>val v3" unfolding NonEmpty by blast
+ next
+ case Empty
+ have "v3 = Stars []" by fact
+ then show "Stars (v # vs) :\<sqsubseteq>val v3"
+ unfolding PosOrd_ex_eq_def using cond2
+ by (simp add: PosOrd_shorterI)
+ qed
+next
+ case (Posix_STAR2 r v2)
+ have "v2 \<in> LV (STAR r) []" by fact
+ then have "v2 = Stars []"
+ unfolding LV_def by (auto elim: Prf.cases)
+ then show "Stars [] :\<sqsubseteq>val v2"
+ by (simp add: PosOrd_ex_eq_def)
+next
+ case (Posix_NTIMES1 s1 r v s2 n vs v3)
+ have "s1 \<in> r \<rightarrow> v" "s2 \<in> NTIMES r (n - 1) \<rightarrow> Stars vs" by fact+
+ then have as1: "s1 = flat v" "s2 = flats vs" by (auto dest: Posix1(2))
+ have IH1: "\<And>v3. v3 \<in> LV r s1 \<Longrightarrow> v :\<sqsubseteq>val v3" by fact
+ have IH2: "\<And>v3. v3 \<in> LV (NTIMES r (n - 1)) s2 \<Longrightarrow> Stars vs :\<sqsubseteq>val v3" by fact
+ have cond: "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L r \<and> s\<^sub>4 \<in> L (NTIMES r (n - 1)))" by fact
+ have cond2: "flat v \<noteq> []" by fact
+ have "v3 \<in> LV (NTIMES r n) (s1 @ s2)" by fact
+ then consider
+ (NonEmpty) v3a vs3 where "v3 = Stars (v3a # vs3)"
+ "\<Turnstile> v3a : r" "\<Turnstile> Stars vs3 : NTIMES r (n - 1)"
+ "flats (v3a # vs3) = s1 @ s2"
+ | (Empty) "v3 = Stars []"
+ unfolding LV_def
+ apply(auto)
+ apply(erule Prf.cases)
+ apply(auto)
+ apply(case_tac vs1)
+ apply(auto intro: Prf.intros)
+ apply(case_tac vs2)
+ apply(auto intro: Prf.intros)
+ apply (simp add: as1(1) cond2 flats_empty)
+ by (simp add: Prf.intros(8))
+ then show "Stars (v # vs) :\<sqsubseteq>val v3"
+ proof (cases)
+ case (NonEmpty v3a vs3)
+ have "flats (v3a # vs3) = s1 @ s2" using NonEmpty(4) .
+ with cond have "flat v3a \<sqsubseteq>pre s1" using NonEmpty(2,3)
+ unfolding prefix_list_def
+ by (smt L_flat_Prf1 append_Nil2 append_eq_append_conv2 flat.simps(7) flat_Stars)
+ then have "flat v3a \<sqsubset>spre s1 \<or> (flat v3a = s1 \<and> flat (Stars vs3) = s2)" using NonEmpty(4)
+ by (simp add: sprefix_list_def append_eq_conv_conj)
+ then have q2: "v :\<sqsubset>val v3a \<or> (flat v3a = s1 \<and> flat (Stars vs3) = s2)"
+ using PosOrd_spreI as1(1) NonEmpty(4) by blast
+ then have "v :\<sqsubset>val v3a \<or> (v3a \<in> LV r s1 \<and> Stars vs3 \<in> LV (NTIMES r (n - 1)) s2)"
+ using NonEmpty(2,3) by (auto simp add: LV_def)
+ then have "v :\<sqsubset>val v3a \<or> (v :\<sqsubseteq>val v3a \<and> Stars vs :\<sqsubseteq>val Stars vs3)" using IH1 IH2 by blast
+ then have "v :\<sqsubset>val v3a \<or> (v = v3a \<and> Stars vs :\<sqsubseteq>val Stars vs3)"
+ unfolding PosOrd_ex_eq_def by auto
+ then have "Stars (v # vs) :\<sqsubseteq>val Stars (v3a # vs3)" using NonEmpty(4) q2 as1
+ unfolding PosOrd_ex_eq_def
+ using PosOrd_StarsI PosOrd_StarsI2 by auto
+ then show "Stars (v # vs) :\<sqsubseteq>val v3" unfolding NonEmpty by blast
+ next
+ case Empty
+ have "v3 = Stars []" by fact
+ then show "Stars (v # vs) :\<sqsubseteq>val v3"
+ unfolding PosOrd_ex_eq_def using cond2
+ by (simp add: PosOrd_shorterI)
+ qed
+next
+ case (Posix_NTIMES2 vs r n v2)
+ then show "Stars vs :\<sqsubseteq>val v2"
+ apply(simp add: LV_def)
+ apply(auto)
+ apply(erule Prf_elims)
+ apply(auto)
+ apply(rule PosOrd_eq_Stars_zipI)
+ prefer 2
+ apply(simp)
+ prefer 2
+ apply (metis Posix1(2) flats_empty)
+ apply(auto)
+ by (meson in_set_zipE)
+next
+ case (Posix_UPNTIMES2 r n v2)
+ then show "Stars [] :\<sqsubseteq>val v2"
+ apply(simp add: LV_def)
+ apply(auto)
+ apply(erule Prf_elims)
+ apply(auto)
+ unfolding PosOrd_ex_eq_def by simp
+next
+ case (Posix_UPNTIMES1 s1 r v s2 n vs v3)
+ have "s1 \<in> r \<rightarrow> v" "s2 \<in> UPNTIMES r (n - 1) \<rightarrow> Stars vs" by fact+
+ then have as1: "s1 = flat v" "s2 = flat (Stars vs)" by (auto dest: Posix1(2))
+ have IH1: "\<And>v3. v3 \<in> LV r s1 \<Longrightarrow> v :\<sqsubseteq>val v3" by fact
+ have IH2: "\<And>v3. v3 \<in> LV (UPNTIMES r (n - 1)) s2 \<Longrightarrow> Stars vs :\<sqsubseteq>val v3" by fact
+ have cond: "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L r \<and> s\<^sub>4 \<in> L (UPNTIMES r (n - 1)))" by fact
+ have cond2: "flat v \<noteq> []" by fact
+ have "v3 \<in> LV (UPNTIMES r n) (s1 @ s2)" by fact
+ then consider
+ (NonEmpty) v3a vs3 where "v3 = Stars (v3a # vs3)"
+ "\<Turnstile> v3a : r" "\<Turnstile> Stars vs3 : UPNTIMES r (n - 1)"
+ "flats (v3a # vs3) = s1 @ s2"
+ | (Empty) "v3 = Stars []"
+ unfolding LV_def
+ apply(auto)
+ apply(erule Prf.cases)
+ apply(auto)
+ apply(case_tac vs)
+ apply(auto intro: Prf.intros)
+ by (simp add: Prf.intros(7) as1(1) cond2)
+ then show "Stars (v # vs) :\<sqsubseteq>val v3"
+ proof (cases)
+ case (NonEmpty v3a vs3)
+ have "flats (v3a # vs3) = s1 @ s2" using NonEmpty(4) .
+ with cond have "flat v3a \<sqsubseteq>pre s1" using NonEmpty(2,3)
+ unfolding prefix_list_def
+ apply(simp)
+ apply(simp add: append_eq_append_conv2)
+ apply(auto)
+ by (metis L_flat_Prf1 One_nat_def cond flat_Stars)
+ then have "flat v3a \<sqsubset>spre s1 \<or> (flat v3a = s1 \<and> flat (Stars vs3) = s2)" using NonEmpty(4)
+ by (simp add: sprefix_list_def append_eq_conv_conj)
+ then have q2: "v :\<sqsubset>val v3a \<or> (flat v3a = s1 \<and> flat (Stars vs3) = s2)"
+ using PosOrd_spreI as1(1) NonEmpty(4) by blast
+ then have "v :\<sqsubset>val v3a \<or> (v3a \<in> LV r s1 \<and> Stars vs3 \<in> LV (UPNTIMES r (n - 1)) s2)"
+ using NonEmpty(2,3) by (auto simp add: LV_def)
+ then have "v :\<sqsubset>val v3a \<or> (v :\<sqsubseteq>val v3a \<and> Stars vs :\<sqsubseteq>val Stars vs3)" using IH1 IH2 by blast
+ then have "v :\<sqsubset>val v3a \<or> (v = v3a \<and> Stars vs :\<sqsubseteq>val Stars vs3)"
+ unfolding PosOrd_ex_eq_def by auto
+ then have "Stars (v # vs) :\<sqsubseteq>val Stars (v3a # vs3)" using NonEmpty(4) q2 as1
+ unfolding PosOrd_ex_eq_def
+ using PosOrd_StarsI PosOrd_StarsI2 by auto
+ then show "Stars (v # vs) :\<sqsubseteq>val v3" unfolding NonEmpty by blast
+ next
+ case Empty
+ have "v3 = Stars []" by fact
+ then show "Stars (v # vs) :\<sqsubseteq>val v3"
+ unfolding PosOrd_ex_eq_def using cond2
+ by (simp add: PosOrd_shorterI)
+ qed
+next
+ case (Posix_FROMNTIMES2 vs r n v2)
+ then show "Stars vs :\<sqsubseteq>val v2"
+ apply(simp add: LV_def)
+ apply(auto)
+ apply(erule Prf_elims)
+ apply(auto)
+ apply(rule PosOrd_eq_Stars_zipI)
+ prefer 2
+ apply(simp)
+ prefer 2
+ apply (metis Posix1(2) flats_empty)
+ apply(auto)
+ by (meson in_set_zipE)
+next
+ case (Posix_FROMNTIMES1 s1 r v s2 n vs v3)
+ have "s1 \<in> r \<rightarrow> v" "s2 \<in> FROMNTIMES r (n - 1) \<rightarrow> Stars vs" by fact+
+ then have as1: "s1 = flat v" "s2 = flats vs" by (auto dest: Posix1(2))
+ have IH1: "\<And>v3. v3 \<in> LV r s1 \<Longrightarrow> v :\<sqsubseteq>val v3" by fact
+ have IH2: "\<And>v3. v3 \<in> LV (FROMNTIMES r (n - 1)) s2 \<Longrightarrow> Stars vs :\<sqsubseteq>val v3" by fact
+ have cond: "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L r \<and> s\<^sub>4 \<in> L (FROMNTIMES r (n - 1)))" by fact
+ have cond2: "flat v \<noteq> []" by fact
+ have "v3 \<in> LV (FROMNTIMES r n) (s1 @ s2)" by fact
+ then consider
+ (NonEmpty) v3a vs3 where "v3 = Stars (v3a # vs3)"
+ "\<Turnstile> v3a : r" "\<Turnstile> Stars vs3 : FROMNTIMES r (n - 1)"
+ "flats (v3a # vs3) = s1 @ s2"
+ | (Empty) "v3 = Stars []"
+ unfolding LV_def
+ apply(auto)
+ apply(erule Prf.cases)
+ apply(auto)
+ apply(case_tac vs1)
+ apply(auto intro: Prf.intros)
+ apply(case_tac vs2)
+ apply(auto intro: Prf.intros)
+ apply (simp add: as1(1) cond2 flats_empty)
+ apply (simp add: Prf.intros)
+ apply(case_tac vs)
+ apply(auto)
+ using Posix_FROMNTIMES1.hyps(6) Prf.intros(10) by auto
+ then show "Stars (v # vs) :\<sqsubseteq>val v3"
+ proof (cases)
+ case (NonEmpty v3a vs3)
+ have "flats (v3a # vs3) = s1 @ s2" using NonEmpty(4) .
+ with cond have "flat v3a \<sqsubseteq>pre s1" using NonEmpty(2,3)
+ unfolding prefix_list_def
+ by (smt L_flat_Prf1 append_Nil2 append_eq_append_conv2 flat.simps(7) flat_Stars)
+ then have "flat v3a \<sqsubset>spre s1 \<or> (flat v3a = s1 \<and> flat (Stars vs3) = s2)" using NonEmpty(4)
+ by (simp add: sprefix_list_def append_eq_conv_conj)
+ then have q2: "v :\<sqsubset>val v3a \<or> (flat v3a = s1 \<and> flat (Stars vs3) = s2)"
+ using PosOrd_spreI as1(1) NonEmpty(4) by blast
+ then have "v :\<sqsubset>val v3a \<or> (v3a \<in> LV r s1 \<and> Stars vs3 \<in> LV (FROMNTIMES r (n - 1)) s2)"
+ using NonEmpty(2,3) by (auto simp add: LV_def)
+ then have "v :\<sqsubset>val v3a \<or> (v :\<sqsubseteq>val v3a \<and> Stars vs :\<sqsubseteq>val Stars vs3)" using IH1 IH2 by blast
+ then have "v :\<sqsubset>val v3a \<or> (v = v3a \<and> Stars vs :\<sqsubseteq>val Stars vs3)"
+ unfolding PosOrd_ex_eq_def by auto
+ then have "Stars (v # vs) :\<sqsubseteq>val Stars (v3a # vs3)" using NonEmpty(4) q2 as1
+ unfolding PosOrd_ex_eq_def
+ using PosOrd_StarsI PosOrd_StarsI2 by auto
+ then show "Stars (v # vs) :\<sqsubseteq>val v3" unfolding NonEmpty by blast
+ next
+ case Empty
+ have "v3 = Stars []" by fact
+ then show "Stars (v # vs) :\<sqsubseteq>val v3"
+ unfolding PosOrd_ex_eq_def using cond2
+ by (simp add: PosOrd_shorterI)
+ qed
+next
+ case (Posix_FROMNTIMES3 s1 r v s2 vs v3)
+ have "s1 \<in> r \<rightarrow> v" "s2 \<in> STAR r \<rightarrow> Stars vs" by fact+
+ then have as1: "s1 = flat v" "s2 = flat (Stars vs)" by (auto dest: Posix1(2))
+ have IH1: "\<And>v3. v3 \<in> LV r s1 \<Longrightarrow> v :\<sqsubseteq>val v3" by fact
+ have IH2: "\<And>v3. v3 \<in> LV (STAR r) s2 \<Longrightarrow> Stars vs :\<sqsubseteq>val v3" by fact
+ have cond: "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L r \<and> s\<^sub>4 \<in> L (STAR r))" by fact
+ have cond2: "flat v \<noteq> []" by fact
+ have "v3 \<in> LV (FROMNTIMES r 0) (s1 @ s2)" by fact
+ then consider
+ (NonEmpty) v3a vs3 where "v3 = Stars (v3a # vs3)"
+ "\<Turnstile> v3a : r" "\<Turnstile> Stars vs3 : STAR r"
+ "flat (Stars (v3a # vs3)) = s1 @ s2"
+ | (Empty) "v3 = Stars []"
+ unfolding LV_def
+ apply(auto)
+ apply(erule Prf.cases)
+ apply(auto)
+ apply(case_tac vs)
+ apply(auto intro: Prf.intros)
+ done
+ then show "Stars (v # vs) :\<sqsubseteq>val v3"
+ proof (cases)
+ case (NonEmpty v3a vs3)
+ have "flat (Stars (v3a # vs3)) = s1 @ s2" using NonEmpty(4) .
+ with cond have "flat v3a \<sqsubseteq>pre s1" using NonEmpty(2,3)
+ unfolding prefix_list_def
+ by (smt L_flat_Prf1 append_Nil2 append_eq_append_conv2 flat.simps(7))
+ then have "flat v3a \<sqsubset>spre s1 \<or> (flat v3a = s1 \<and> flat (Stars vs3) = s2)" using NonEmpty(4)
+ by (simp add: sprefix_list_def append_eq_conv_conj)
+ then have q2: "v :\<sqsubset>val v3a \<or> (flat v3a = s1 \<and> flat (Stars vs3) = s2)"
+ using PosOrd_spreI as1(1) NonEmpty(4) by blast
+ then have "v :\<sqsubset>val v3a \<or> (v3a \<in> LV r s1 \<and> Stars vs3 \<in> LV (STAR r) s2)"
+ using NonEmpty(2,3) by (auto simp add: LV_def)
+ then have "v :\<sqsubset>val v3a \<or> (v :\<sqsubseteq>val v3a \<and> Stars vs :\<sqsubseteq>val Stars vs3)" using IH1 IH2 by blast
+ then have "v :\<sqsubset>val v3a \<or> (v = v3a \<and> Stars vs :\<sqsubseteq>val Stars vs3)"
+ unfolding PosOrd_ex_eq_def by auto
+ then have "Stars (v # vs) :\<sqsubseteq>val Stars (v3a # vs3)" using NonEmpty(4) q2 as1
+ unfolding PosOrd_ex_eq_def
+ using PosOrd_StarsI PosOrd_StarsI2 by auto
+ then show "Stars (v # vs) :\<sqsubseteq>val v3" unfolding NonEmpty by blast
+ next
+ case Empty
+ have "v3 = Stars []" by fact
+ then show "Stars (v # vs) :\<sqsubseteq>val v3"
+ unfolding PosOrd_ex_eq_def using cond2
+ by (simp add: PosOrd_shorterI)
+ qed
+next
+ case (Posix_NMTIMES2 vs r n m v2)
+ then show "Stars vs :\<sqsubseteq>val v2"
+ apply(auto simp add: LV_def)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(rule PosOrd_eq_Stars_zipI)
+ apply(auto)
+ apply (meson in_set_zipE)
+ by (metis Posix1(2) flats_empty)
+next
+ case (Posix_NMTIMES1 s1 r v s2 n m vs v3)
+ have "s1 \<in> r \<rightarrow> v" "s2 \<in> NMTIMES r (n - 1) (m - 1) \<rightarrow> Stars vs" by fact+
+ then have as1: "s1 = flat v" "s2 = flats vs" by (auto dest: Posix1(2))
+ have IH1: "\<And>v3. v3 \<in> LV r s1 \<Longrightarrow> v :\<sqsubseteq>val v3" by fact
+ have IH2: "\<And>v3. v3 \<in> LV (NMTIMES r (n - 1) (m - 1)) s2 \<Longrightarrow> Stars vs :\<sqsubseteq>val v3" by fact
+ have cond: "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L r \<and> s\<^sub>4 \<in> L (NMTIMES r (n - 1) (m - 1)))" by fact
+ have cond2: "flat v \<noteq> []" by fact
+ have "v3 \<in> LV (NMTIMES r n m) (s1 @ s2)" by fact
+ then consider
+ (NonEmpty) v3a vs3 where "v3 = Stars (v3a # vs3)"
+ "\<Turnstile> v3a : r" "\<Turnstile> Stars vs3 : NMTIMES r (n - 1) (m - 1)"
+ "flats (v3a # vs3) = s1 @ s2"
+ | (Empty) "v3 = Stars []"
+ unfolding LV_def
+ apply(auto)
+ apply(erule Prf.cases)
+ apply(auto)
+ apply(case_tac n)
+ apply(auto intro: Prf.intros)
+ apply(case_tac vs1)
+ apply(auto intro: Prf.intros)
+ apply (simp add: as1(1) cond2 flats_empty)
+ apply (simp add: Prf.intros(11))
+ apply(case_tac n)
+ apply(simp)
+ using Posix_NMTIMES1.hyps(6) apply blast
+ apply(simp)
+ apply(case_tac vs)
+ apply(auto)
+ by (simp add: Prf.intros(12))
+ then show "Stars (v # vs) :\<sqsubseteq>val v3"
+ proof (cases)
+ case (NonEmpty v3a vs3)
+ have "flats (v3a # vs3) = s1 @ s2" using NonEmpty(4) .
+ with cond have "flat v3a \<sqsubseteq>pre s1" using NonEmpty(2,3)
+ unfolding prefix_list_def
+ by (smt L_flat_Prf1 append_Nil2 append_eq_append_conv2 flat.simps(7) flat_Stars)
+ then have "flat v3a \<sqsubset>spre s1 \<or> (flat v3a = s1 \<and> flat (Stars vs3) = s2)" using NonEmpty(4)
+ by (simp add: sprefix_list_def append_eq_conv_conj)
+ then have q2: "v :\<sqsubset>val v3a \<or> (flat v3a = s1 \<and> flat (Stars vs3) = s2)"
+ using PosOrd_spreI as1(1) NonEmpty(4) by blast
+ then have "v :\<sqsubset>val v3a \<or> (v3a \<in> LV r s1 \<and> Stars vs3 \<in> LV (NMTIMES r (n - 1) (m - 1)) s2)"
+ using NonEmpty(2,3) by (auto simp add: LV_def)
+ then have "v :\<sqsubset>val v3a \<or> (v :\<sqsubseteq>val v3a \<and> Stars vs :\<sqsubseteq>val Stars vs3)" using IH1 IH2 by blast
+ then have "v :\<sqsubset>val v3a \<or> (v = v3a \<and> Stars vs :\<sqsubseteq>val Stars vs3)"
+ unfolding PosOrd_ex_eq_def by auto
+ then have "Stars (v # vs) :\<sqsubseteq>val Stars (v3a # vs3)" using NonEmpty(4) q2 as1
+ unfolding PosOrd_ex_eq_def
+ using PosOrd_StarsI PosOrd_StarsI2 by auto
+ then show "Stars (v # vs) :\<sqsubseteq>val v3" unfolding NonEmpty by blast
+ next
+ case Empty
+ have "v3 = Stars []" by fact
+ then show "Stars (v # vs) :\<sqsubseteq>val v3"
+ unfolding PosOrd_ex_eq_def using cond2
+ by (simp add: PosOrd_shorterI)
+ qed
+next
+ case (Posix_NMTIMES3 s1 r v s2 m vs v3)
+ have "s1 \<in> r \<rightarrow> v" "s2 \<in> UPNTIMES r (m - 1) \<rightarrow> Stars vs" by fact+
+ then have as1: "s1 = flat v" "s2 = flat (Stars vs)" by (auto dest: Posix1(2))
+ have IH1: "\<And>v3. v3 \<in> LV r s1 \<Longrightarrow> v :\<sqsubseteq>val v3" by fact
+ have IH2: "\<And>v3. v3 \<in> LV (UPNTIMES r (m - 1)) s2 \<Longrightarrow> Stars vs :\<sqsubseteq>val v3" by fact
+ have cond: "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L r \<and> s\<^sub>4 \<in> L (UPNTIMES r (m - 1)))" by fact
+ have cond2: "flat v \<noteq> []" by fact
+ have "v3 \<in> LV (NMTIMES r 0 m) (s1 @ s2)" by fact
+ then consider
+ (NonEmpty) v3a vs3 where "v3 = Stars (v3a # vs3)"
+ "\<Turnstile> v3a : r" "\<Turnstile> Stars vs3 : UPNTIMES r (m - 1)"
+ "flats (v3a # vs3) = s1 @ s2"
+ | (Empty) "v3 = Stars []"
+ unfolding LV_def
+ apply(auto)
+ apply(erule Prf.cases)
+ apply(auto)
+ apply(case_tac vs)
+ apply(auto intro: Prf.intros)
+ by (simp add: Prf.intros(7) as1(1) cond2)
+ then show "Stars (v # vs) :\<sqsubseteq>val v3"
+ proof (cases)
+ case (NonEmpty v3a vs3)
+ have "flats (v3a # vs3) = s1 @ s2" using NonEmpty(4) .
+ with cond have "flat v3a \<sqsubseteq>pre s1" using NonEmpty(2,3)
+ unfolding prefix_list_def
+ apply(simp)
+ apply(simp add: append_eq_append_conv2)
+ apply(auto)
+ by (metis L_flat_Prf1 One_nat_def cond flat_Stars)
+ then have "flat v3a \<sqsubset>spre s1 \<or> (flat v3a = s1 \<and> flat (Stars vs3) = s2)" using NonEmpty(4)
+ by (simp add: sprefix_list_def append_eq_conv_conj)
+ then have q2: "v :\<sqsubset>val v3a \<or> (flat v3a = s1 \<and> flat (Stars vs3) = s2)"
+ using PosOrd_spreI as1(1) NonEmpty(4) by blast
+ then have "v :\<sqsubset>val v3a \<or> (v3a \<in> LV r s1 \<and> Stars vs3 \<in> LV (UPNTIMES r (m - 1)) s2)"
+ using NonEmpty(2,3) by (auto simp add: LV_def)
+ then have "v :\<sqsubset>val v3a \<or> (v :\<sqsubseteq>val v3a \<and> Stars vs :\<sqsubseteq>val Stars vs3)" using IH1 IH2 by blast
+ then have "v :\<sqsubset>val v3a \<or> (v = v3a \<and> Stars vs :\<sqsubseteq>val Stars vs3)"
+ unfolding PosOrd_ex_eq_def by auto
+ then have "Stars (v # vs) :\<sqsubseteq>val Stars (v3a # vs3)" using NonEmpty(4) q2 as1
+ unfolding PosOrd_ex_eq_def
+ using PosOrd_StarsI PosOrd_StarsI2 by auto
+ then show "Stars (v # vs) :\<sqsubseteq>val v3" unfolding NonEmpty by blast
+ next
+ case Empty
+ have "v3 = Stars []" by fact
+ then show "Stars (v # vs) :\<sqsubseteq>val v3"
+ unfolding PosOrd_ex_eq_def using cond2
+ by (simp add: PosOrd_shorterI)
+ qed
+qed
+
+
+lemma Posix_PosOrd_reverse:
+ assumes "s \<in> r \<rightarrow> v1"
+ shows "\<not>(\<exists>v2 \<in> LV r s. v2 :\<sqsubset>val v1)"
+using assms
+by (metis Posix_PosOrd less_irrefl PosOrd_def
+ PosOrd_ex_eq_def PosOrd_ex_def PosOrd_trans)
+
+lemma PosOrd_Posix:
+ assumes "v1 \<in> LV r s" "\<forall>v\<^sub>2 \<in> LV r s. \<not> v\<^sub>2 :\<sqsubset>val v1"
+ shows "s \<in> r \<rightarrow> v1"
+proof -
+ have "s \<in> L r" using assms(1) unfolding LV_def
+ using L_flat_Prf1 by blast
+ then obtain vposix where vp: "s \<in> r \<rightarrow> vposix"
+ using lexer_correct_Some by blast
+ with assms(1) have "vposix :\<sqsubseteq>val v1" by (simp add: Posix_PosOrd)
+ then have "vposix = v1 \<or> vposix :\<sqsubset>val v1" unfolding PosOrd_ex_eq2 by auto
+ moreover
+ { assume "vposix :\<sqsubset>val v1"
+ moreover
+ have "vposix \<in> LV r s" using vp
+ using Posix_LV by blast
+ ultimately have "False" using assms(2) by blast
+ }
+ ultimately show "s \<in> r \<rightarrow> v1" using vp by blast
+qed
+
+lemma Least_existence:
+ assumes "LV r s \<noteq> {}"
+ shows " \<exists>vmin \<in> LV r s. \<forall>v \<in> LV r s. vmin :\<sqsubseteq>val v"
+proof -
+ from assms
+ obtain vposix where "s \<in> r \<rightarrow> vposix"
+ unfolding LV_def
+ using L_flat_Prf1 lexer_correct_Some by blast
+ then have "\<forall>v \<in> LV r s. vposix :\<sqsubseteq>val v"
+ by (simp add: Posix_PosOrd)
+ then show "\<exists>vmin \<in> LV r s. \<forall>v \<in> LV r s. vmin :\<sqsubseteq>val v"
+ using Posix_LV \<open>s \<in> r \<rightarrow> vposix\<close> by blast
+qed
+
+lemma Least_existence1:
+ assumes "LV r s \<noteq> {}"
+ shows " \<exists>!vmin \<in> LV r s. \<forall>v \<in> LV r s. vmin :\<sqsubseteq>val v"
+using Least_existence[OF assms] assms
+ using PosOrdeq_antisym by blast
+
+
+
+
+
+lemma Least_existence1_pre:
+ assumes "LV r s \<noteq> {}"
+ shows " \<exists>!vmin \<in> LV r s. \<forall>v \<in> (LV r s \<union> {v'. flat v' \<sqsubset>spre s}). vmin :\<sqsubseteq>val v"
+using Least_existence[OF assms] assms
+apply -
+apply(erule bexE)
+apply(rule_tac a="vmin" in ex1I)
+apply(auto)[1]
+apply (metis PosOrd_Posix PosOrd_ex_eq2 PosOrd_spreI PosOrdeq_antisym Posix1(2))
+apply(auto)[1]
+apply(simp add: PosOrdeq_antisym)
+done
+
+lemma
+ shows "partial_order_on UNIV {(v1, v2). v1 :\<sqsubseteq>val v2}"
+apply(simp add: partial_order_on_def)
+apply(simp add: preorder_on_def refl_on_def)
+apply(simp add: PosOrdeq_refl)
+apply(auto)
+apply(rule transI)
+apply(auto intro: PosOrdeq_trans)[1]
+apply(rule antisymI)
+apply(simp add: PosOrdeq_antisym)
+done
+
+lemma
+ "wf {(v1, v2). v1 :\<sqsubset>val v2 \<and> v1 \<in> LV r s \<and> v2 \<in> LV r s}"
+apply(rule finite_acyclic_wf)
+prefer 2
+apply(simp add: acyclic_def)
+apply(induct_tac rule: trancl.induct)
+ apply(auto)[1]
+ prefer 3
+
+oops
+
+
+unused_thms
+
+end
\ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys2/README Sun Oct 10 18:35:21 2021 +0100
@@ -0,0 +1,27 @@
+Theories:
+=========
+
+ Lexer.thy
+ Simplifying.thy
+
+The repository can be checked using Isabelle 2017.
+
+ isabelle build -c -v -d . Lex
+
+ isabelle build -c -v -d . Paper
+
+ isabelle build -c -v -d . Journal
+
+Other directories are:
+=====================
+
+ Paper
+ Journal
+ Literature
+
+
+
+
+
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys2/ROOT Sun Oct 10 18:35:21 2021 +0100
@@ -0,0 +1,24 @@
+
+
+
+session Journal in Journal = "HOL" +
+ options [ document_output = "..", document_variants="journal", document = pdf]
+ sessions
+ "HOL-Library"
+ directories
+ ".."
+ theories [document = false]
+ "HOL-Library.LaTeXsugar"
+ "HOL-Library.Sublist"
+ "../Spec"
+ "../Lexer"
+ "../RegLangs"
+ "../Simplifying"
+ "../Sulzmann"
+ "../Positions"
+ theories [document = true]
+ "Paper"
+ document_files
+ "root.bib"
+ "root.tex"
+ "llncs.cls"
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys2/Re.thy Sun Oct 10 18:35:21 2021 +0100
@@ -0,0 +1,3515 @@
+
+theory Re
+ imports "Main"
+begin
+
+
+section {* Sequential Composition of Sets *}
+
+definition
+ Sequ :: "string set \<Rightarrow> string set \<Rightarrow> string set" ("_ ;; _" [100,100] 100)
+where
+ "A ;; B = {s1 @ s2 | s1 s2. s1 \<in> A \<and> s2 \<in> B}"
+
+text {* Two Simple Properties about Sequential Composition *}
+
+lemma seq_empty [simp]:
+ shows "A ;; {[]} = A"
+ and "{[]} ;; A = A"
+by (simp_all add: Sequ_def)
+
+lemma seq_null [simp]:
+ shows "A ;; {} = {}"
+ and "{} ;; A = {}"
+by (simp_all add: Sequ_def)
+
+section {* Regular Expressions *}
+
+datatype rexp =
+ NULL
+| EMPTY
+| CHAR char
+| SEQ rexp rexp
+| ALT rexp rexp
+
+section {* Semantics of Regular Expressions *}
+
+fun
+ L :: "rexp \<Rightarrow> string set"
+where
+ "L (NULL) = {}"
+| "L (EMPTY) = {[]}"
+| "L (CHAR c) = {[c]}"
+| "L (SEQ r1 r2) = (L r1) ;; (L r2)"
+| "L (ALT r1 r2) = (L r1) \<union> (L r2)"
+
+fun
+ nullable :: "rexp \<Rightarrow> bool"
+where
+ "nullable (NULL) = False"
+| "nullable (EMPTY) = True"
+| "nullable (CHAR c) = False"
+| "nullable (ALT r1 r2) = (nullable r1 \<or> nullable r2)"
+| "nullable (SEQ r1 r2) = (nullable r1 \<and> nullable r2)"
+
+lemma nullable_correctness:
+ shows "nullable r \<longleftrightarrow> [] \<in> (L r)"
+apply (induct r)
+apply(auto simp add: Sequ_def)
+done
+
+section {* Values *}
+
+datatype val =
+ Void
+| Char char
+| Seq val val
+| Right val
+| Left val
+
+section {* The string behind a value *}
+
+fun
+ flat :: "val \<Rightarrow> string"
+where
+ "flat(Void) = []"
+| "flat(Char c) = [c]"
+| "flat(Left v) = flat(v)"
+| "flat(Right v) = flat(v)"
+| "flat(Seq v1 v2) = flat(v1) @ flat(v2)"
+
+section {* Relation between values and regular expressions *}
+
+inductive
+ Prf :: "val \<Rightarrow> rexp \<Rightarrow> bool" ("\<turnstile> _ : _" [100, 100] 100)
+where
+ "\<lbrakk>\<turnstile> v1 : r1; \<turnstile> v2 : r2\<rbrakk> \<Longrightarrow> \<turnstile> Seq v1 v2 : SEQ r1 r2"
+| "\<turnstile> v1 : r1 \<Longrightarrow> \<turnstile> Left v1 : ALT r1 r2"
+| "\<turnstile> v2 : r2 \<Longrightarrow> \<turnstile> Right v2 : ALT r1 r2"
+| "\<turnstile> Void : EMPTY"
+| "\<turnstile> Char c : CHAR c"
+
+lemma not_nullable_flat:
+ assumes "\<turnstile> v : r" "\<not>nullable r"
+ shows "flat v \<noteq> []"
+using assms
+apply(induct)
+apply(auto)
+done
+
+lemma Prf_flat_L:
+ assumes "\<turnstile> v : r" shows "flat v \<in> L r"
+using assms
+apply(induct v r rule: Prf.induct)
+apply(auto simp add: Sequ_def)
+done
+
+lemma L_flat_Prf:
+ "L(r) = {flat v | v. \<turnstile> v : r}"
+apply(induct r)
+apply(auto dest: Prf_flat_L simp add: Sequ_def)
+apply (metis Prf.intros(4) flat.simps(1))
+apply (metis Prf.intros(5) flat.simps(2))
+apply (metis Prf.intros(1) flat.simps(5))
+apply (metis Prf.intros(2) flat.simps(3))
+apply (metis Prf.intros(3) flat.simps(4))
+apply(erule Prf.cases)
+apply(auto)
+done
+
+section {* Greedy Ordering according to Frisch/Cardelli *}
+
+inductive
+ GrOrd :: "val \<Rightarrow> val \<Rightarrow> bool" ("_ gr\<succ> _")
+where
+ "v1 gr\<succ> v1' \<Longrightarrow> (Seq v1 v2) gr\<succ> (Seq v1' v2')"
+| "v2 gr\<succ> v2' \<Longrightarrow> (Seq v1 v2) gr\<succ> (Seq v1 v2')"
+| "v1 gr\<succ> v2 \<Longrightarrow> (Left v1) gr\<succ> (Left v2)"
+| "v1 gr\<succ> v2 \<Longrightarrow> (Right v1) gr\<succ> (Right v2)"
+| "(Left v2) gr\<succ>(Right v1)"
+| "(Char c) gr\<succ> (Char c)"
+| "(Void) gr\<succ> (Void)"
+
+lemma Gr_refl:
+ assumes "\<turnstile> v : r"
+ shows "v gr\<succ> v"
+using assms
+apply(induct)
+apply(auto intro: GrOrd.intros)
+done
+
+lemma Gr_total:
+ assumes "\<turnstile> v1 : r" "\<turnstile> v2 : r"
+ shows "v1 gr\<succ> v2 \<or> v2 gr\<succ> v1"
+using assms
+apply(induct v1 r arbitrary: v2 rule: Prf.induct)
+apply(rotate_tac 4)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply (metis GrOrd.intros(1) GrOrd.intros(2))
+apply(rotate_tac 2)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(clarify)
+apply (metis GrOrd.intros(3))
+apply(clarify)
+apply (metis GrOrd.intros(5))
+apply(rotate_tac 2)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(clarify)
+apply (metis GrOrd.intros(5))
+apply(clarify)
+apply (metis GrOrd.intros(4))
+apply(erule Prf.cases)
+apply(simp_all)
+apply (metis GrOrd.intros(7))
+apply(erule Prf.cases)
+apply(simp_all)
+apply (metis GrOrd.intros(6))
+done
+
+lemma Gr_trans:
+ assumes "v1 gr\<succ> v2" "v2 gr\<succ> v3"
+ and "\<turnstile> v1 : r" "\<turnstile> v2 : r" "\<turnstile> v3 : r"
+ shows "v1 gr\<succ> v3"
+using assms
+apply(induct r arbitrary: v1 v2 v3)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+defer
+(* ALT case *)
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(clarify)
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply (metis GrOrd.intros(3))
+apply(clarify)
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply (metis GrOrd.intros(5))
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(clarify)
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply (metis GrOrd.intros(5))
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(clarify)
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply(clarify)
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(clarify)
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply(clarify)
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply (metis GrOrd.intros(4))
+(* SEQ case *)
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(clarify)
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply(clarify)
+apply (metis GrOrd.intros(1))
+apply (metis GrOrd.intros(1))
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply (metis GrOrd.intros(1))
+by (metis GrOrd.intros(1) Gr_refl)
+
+
+section {* Values Sets *}
+
+definition prefix :: "string \<Rightarrow> string \<Rightarrow> bool" ("_ \<sqsubseteq> _" [100, 100] 100)
+where
+ "s1 \<sqsubseteq> s2 \<equiv> \<exists>s3. s1 @ s3 = s2"
+
+definition sprefix :: "string \<Rightarrow> string \<Rightarrow> bool" ("_ \<sqsubset> _" [100, 100] 100)
+where
+ "s1 \<sqsubset> s2 \<equiv> (s1 \<sqsubseteq> s2 \<and> s1 \<noteq> s2)"
+
+lemma length_sprefix:
+ "s1 \<sqsubset> s2 \<Longrightarrow> length s1 < length s2"
+unfolding sprefix_def prefix_def
+by (auto)
+
+definition Prefixes :: "string \<Rightarrow> string set" where
+ "Prefixes s \<equiv> {sp. sp \<sqsubseteq> s}"
+
+definition Suffixes :: "string \<Rightarrow> string set" where
+ "Suffixes s \<equiv> rev ` (Prefixes (rev s))"
+
+lemma Suffixes_in:
+ "\<exists>s1. s1 @ s2 = s3 \<Longrightarrow> s2 \<in> Suffixes s3"
+unfolding Suffixes_def Prefixes_def prefix_def image_def
+apply(auto)
+by (metis rev_rev_ident)
+
+lemma Prefixes_Cons:
+ "Prefixes (c # s) = {[]} \<union> {c # sp | sp. sp \<in> Prefixes s}"
+unfolding Prefixes_def prefix_def
+apply(auto simp add: append_eq_Cons_conv)
+done
+
+lemma finite_Prefixes:
+ "finite (Prefixes s)"
+apply(induct s)
+apply(auto simp add: Prefixes_def prefix_def)[1]
+apply(simp add: Prefixes_Cons)
+done
+
+lemma finite_Suffixes:
+ "finite (Suffixes s)"
+unfolding Suffixes_def
+apply(rule finite_imageI)
+apply(rule finite_Prefixes)
+done
+
+lemma prefix_Cons:
+ "((c # s1) \<sqsubseteq> (c # s2)) = (s1 \<sqsubseteq> s2)"
+apply(auto simp add: prefix_def)
+done
+
+lemma prefix_append:
+ "((s @ s1) \<sqsubseteq> (s @ s2)) = (s1 \<sqsubseteq> s2)"
+apply(induct s)
+apply(simp)
+apply(simp add: prefix_Cons)
+done
+
+
+definition Values :: "rexp \<Rightarrow> string \<Rightarrow> val set" where
+ "Values r s \<equiv> {v. \<turnstile> v : r \<and> flat v \<sqsubseteq> s}"
+
+definition rest :: "val \<Rightarrow> string \<Rightarrow> string" where
+ "rest v s \<equiv> drop (length (flat v)) s"
+
+lemma rest_flat:
+ assumes "flat v1 \<sqsubseteq> s"
+ shows "flat v1 @ rest v1 s = s"
+using assms
+apply(auto simp add: rest_def prefix_def)
+done
+
+
+lemma rest_Suffixes:
+ "rest v s \<in> Suffixes s"
+unfolding rest_def
+by (metis Suffixes_in append_take_drop_id)
+
+
+lemma Values_recs:
+ "Values (NULL) s = {}"
+ "Values (EMPTY) s = {Void}"
+ "Values (CHAR c) s = (if [c] \<sqsubseteq> s then {Char c} else {})"
+ "Values (ALT r1 r2) s = {Left v | v. v \<in> Values r1 s} \<union> {Right v | v. v \<in> Values r2 s}"
+ "Values (SEQ r1 r2) s = {Seq v1 v2 | v1 v2. v1 \<in> Values r1 s \<and> v2 \<in> Values r2 (rest v1 s)}"
+unfolding Values_def
+apply(auto)
+(*NULL*)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+(*EMPTY*)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rule Prf.intros)
+apply (metis append_Nil prefix_def)
+(*CHAR*)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rule Prf.intros)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+(*ALT*)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis Prf.intros(2))
+apply (metis Prf.intros(3))
+(*SEQ*)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (simp add: append_eq_conv_conj prefix_def rest_def)
+apply (metis Prf.intros(1))
+apply (simp add: append_eq_conv_conj prefix_def rest_def)
+done
+
+lemma Values_finite:
+ "finite (Values r s)"
+apply(induct r arbitrary: s)
+apply(simp_all add: Values_recs)
+thm finite_surj
+apply(rule_tac f="\<lambda>(x, y). Seq x y" and
+ A="{(v1, v2) | v1 v2. v1 \<in> Values r1 s \<and> v2 \<in> Values r2 (rest v1 s)}" in finite_surj)
+prefer 2
+apply(auto)[1]
+apply(rule_tac B="\<Union>sp \<in> Suffixes s. {(v1, v2). v1 \<in> Values r1 s \<and> v2 \<in> Values r2 sp}" in finite_subset)
+apply(auto)[1]
+apply (metis rest_Suffixes)
+apply(rule finite_UN_I)
+apply(rule finite_Suffixes)
+apply(simp)
+done
+
+section {* Sulzmann functions *}
+
+fun
+ mkeps :: "rexp \<Rightarrow> val"
+where
+ "mkeps(EMPTY) = Void"
+| "mkeps(SEQ r1 r2) = Seq (mkeps r1) (mkeps r2)"
+| "mkeps(ALT r1 r2) = (if nullable(r1) then Left (mkeps r1) else Right (mkeps r2))"
+
+section {* Derivatives *}
+
+fun
+ der :: "char \<Rightarrow> rexp \<Rightarrow> rexp"
+where
+ "der c (NULL) = NULL"
+| "der c (EMPTY) = NULL"
+| "der c (CHAR c') = (if c = c' then EMPTY else NULL)"
+| "der c (ALT r1 r2) = ALT (der c r1) (der c r2)"
+| "der c (SEQ r1 r2) =
+ (if nullable r1
+ then ALT (SEQ (der c r1) r2) (der c r2)
+ else SEQ (der c r1) r2)"
+
+fun
+ ders :: "string \<Rightarrow> rexp \<Rightarrow> rexp"
+where
+ "ders [] r = r"
+| "ders (c # s) r = ders s (der c r)"
+
+
+section {* Injection function *}
+
+fun injval :: "rexp \<Rightarrow> char \<Rightarrow> val \<Rightarrow> val"
+where
+ "injval (EMPTY) c Void = Char c"
+| "injval (CHAR d) c Void = Char d"
+| "injval (CHAR d) c (Char c') = Seq (Char d) (Char c')"
+| "injval (ALT r1 r2) c (Left v1) = Left(injval r1 c v1)"
+| "injval (ALT r1 r2) c (Right v2) = Right(injval r2 c v2)"
+| "injval (SEQ r1 r2) c (Char c') = Seq (Char c) (Char c')"
+| "injval (SEQ r1 r2) c (Seq v1 v2) = Seq (injval r1 c v1) v2"
+| "injval (SEQ r1 r2) c (Left (Seq v1 v2)) = Seq (injval r1 c v1) v2"
+| "injval (SEQ r1 r2) c (Right v2) = Seq (mkeps r1) (injval r2 c v2)"
+
+fun
+ lex :: "rexp \<Rightarrow> string \<Rightarrow> val option"
+where
+ "lex r [] = (if nullable r then Some(mkeps r) else None)"
+| "lex r (c#s) = (case (lex (der c r) s) of
+ None \<Rightarrow> None
+ | Some(v) \<Rightarrow> Some(injval r c v))"
+
+fun
+ lex2 :: "rexp \<Rightarrow> string \<Rightarrow> val"
+where
+ "lex2 r [] = mkeps r"
+| "lex2 r (c#s) = injval r c (lex2 (der c r) s)"
+
+
+section {* Projection function *}
+
+fun projval :: "rexp \<Rightarrow> char \<Rightarrow> val \<Rightarrow> val"
+where
+ "projval (CHAR d) c _ = Void"
+| "projval (ALT r1 r2) c (Left v1) = Left (projval r1 c v1)"
+| "projval (ALT r1 r2) c (Right v2) = Right (projval r2 c v2)"
+| "projval (SEQ r1 r2) c (Seq v1 v2) =
+ (if flat v1 = [] then Right(projval r2 c v2)
+ else if nullable r1 then Left (Seq (projval r1 c v1) v2)
+ else Seq (projval r1 c v1) v2)"
+
+
+
+lemma mkeps_nullable:
+ assumes "nullable(r)"
+ shows "\<turnstile> mkeps r : r"
+using assms
+apply(induct rule: nullable.induct)
+apply(auto intro: Prf.intros)
+done
+
+lemma mkeps_flat:
+ assumes "nullable(r)"
+ shows "flat (mkeps r) = []"
+using assms
+apply(induct rule: nullable.induct)
+apply(auto)
+done
+
+lemma v3:
+ assumes "\<turnstile> v : der c r"
+ shows "\<turnstile> (injval r c v) : r"
+using assms
+apply(induct arbitrary: v rule: der.induct)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(case_tac "c = c'")
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis Prf.intros(5))
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis Prf.intros(2))
+apply (metis Prf.intros(3))
+apply(simp)
+apply(case_tac "nullable r1")
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply (metis Prf.intros(1))
+apply(auto)[1]
+apply (metis Prf.intros(1) mkeps_nullable)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply(rule Prf.intros)
+apply(auto)[2]
+done
+
+lemma v3_proj:
+ assumes "\<turnstile> v : r" and "\<exists>s. (flat v) = c # s"
+ shows "\<turnstile> (projval r c v) : der c r"
+using assms
+apply(induct rule: Prf.induct)
+prefer 4
+apply(simp)
+prefer 4
+apply(simp)
+apply (metis Prf.intros(4))
+prefer 2
+apply(simp)
+apply (metis Prf.intros(2))
+prefer 2
+apply(simp)
+apply (metis Prf.intros(3))
+apply(auto)
+apply(rule Prf.intros)
+apply(simp)
+apply (metis Prf_flat_L nullable_correctness)
+apply(rule Prf.intros)
+apply(rule Prf.intros)
+apply (metis Cons_eq_append_conv)
+apply(simp)
+apply(rule Prf.intros)
+apply (metis Cons_eq_append_conv)
+apply(simp)
+done
+
+lemma v4:
+ assumes "\<turnstile> v : der c r"
+ shows "flat (injval r c v) = c # (flat v)"
+using assms
+apply(induct arbitrary: v rule: der.induct)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(case_tac "c = c'")
+apply(simp)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(case_tac "nullable r1")
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(simp only: injval.simps flat.simps)
+apply(auto)[1]
+apply (metis mkeps_flat)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+done
+
+lemma v4_proj:
+ assumes "\<turnstile> v : r" and "\<exists>s. (flat v) = c # s"
+ shows "c # flat (projval r c v) = flat v"
+using assms
+apply(induct rule: Prf.induct)
+prefer 4
+apply(simp)
+prefer 4
+apply(simp)
+prefer 2
+apply(simp)
+prefer 2
+apply(simp)
+apply(auto)
+by (metis Cons_eq_append_conv)
+
+lemma v4_proj2:
+ assumes "\<turnstile> v : r" and "(flat v) = c # s"
+ shows "flat (projval r c v) = s"
+using assms
+by (metis list.inject v4_proj)
+
+
+section {* Alternative Posix definition *}
+
+inductive
+ PMatch :: "string \<Rightarrow> rexp \<Rightarrow> val \<Rightarrow> bool" ("_ \<in> _ \<rightarrow> _" [100, 100, 100] 100)
+where
+ "[] \<in> EMPTY \<rightarrow> Void"
+| "[c] \<in> (CHAR c) \<rightarrow> (Char c)"
+| "s \<in> r1 \<rightarrow> v \<Longrightarrow> s \<in> (ALT r1 r2) \<rightarrow> (Left v)"
+| "\<lbrakk>s \<in> r2 \<rightarrow> v; s \<notin> L(r1)\<rbrakk> \<Longrightarrow> s \<in> (ALT r1 r2) \<rightarrow> (Right v)"
+| "\<lbrakk>s1 \<in> r1 \<rightarrow> v1; s2 \<in> r2 \<rightarrow> v2;
+ \<not>(\<exists>s3 s4. s3 \<noteq> [] \<and> s3 @ s4 = s2 \<and> (s1 @ s3) \<in> L r1 \<and> s4 \<in> L r2)\<rbrakk> \<Longrightarrow>
+ (s1 @ s2) \<in> (SEQ r1 r2) \<rightarrow> (Seq v1 v2)"
+
+
+lemma PMatch_mkeps:
+ assumes "nullable r"
+ shows "[] \<in> r \<rightarrow> mkeps r"
+using assms
+apply(induct r)
+apply(auto)
+apply (metis PMatch.intros(1))
+apply(subst append.simps(1)[symmetric])
+apply (rule PMatch.intros)
+apply(simp)
+apply(simp)
+apply(auto)[1]
+apply (rule PMatch.intros)
+apply(simp)
+apply (rule PMatch.intros)
+apply(simp)
+apply (rule PMatch.intros)
+apply(simp)
+by (metis nullable_correctness)
+
+
+lemma PMatch1:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "\<turnstile> v : r" "flat v = s"
+using assms
+apply(induct s r v rule: PMatch.induct)
+apply(auto)
+apply (metis Prf.intros(4))
+apply (metis Prf.intros(5))
+apply (metis Prf.intros(2))
+apply (metis Prf.intros(3))
+apply (metis Prf.intros(1))
+done
+
+lemma PMatch_Values:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "v \<in> Values r s"
+using assms
+apply(simp add: Values_def PMatch1)
+by (metis append_Nil2 prefix_def)
+
+lemma PMatch2:
+ assumes "s \<in> (der c r) \<rightarrow> v"
+ shows "(c#s) \<in> r \<rightarrow> (injval r c v)"
+using assms
+apply(induct c r arbitrary: s v rule: der.induct)
+apply(auto)
+apply(erule PMatch.cases)
+apply(simp_all)[5]
+apply(erule PMatch.cases)
+apply(simp_all)[5]
+apply(case_tac "c = c'")
+apply(simp)
+apply(erule PMatch.cases)
+apply(simp_all)[5]
+apply (metis PMatch.intros(2))
+apply(simp)
+apply(erule PMatch.cases)
+apply(simp_all)[5]
+apply(erule PMatch.cases)
+apply(simp_all)[5]
+apply (metis PMatch.intros(3))
+apply(clarify)
+apply(rule PMatch.intros)
+apply metis
+apply(simp add: L_flat_Prf)
+apply(auto)[1]
+thm v3_proj
+apply(frule_tac c="c" in v3_proj)
+apply metis
+apply(drule_tac x="projval r1 c v" in spec)
+apply(drule mp)
+apply (metis v4_proj2)
+apply(simp)
+apply(case_tac "nullable r1")
+apply(simp)
+defer
+apply(simp)
+apply(erule PMatch.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(subst append.simps(2)[symmetric])
+apply(rule PMatch.intros)
+apply metis
+apply metis
+apply(auto)[1]
+apply(simp add: L_flat_Prf)
+apply(auto)[1]
+apply(frule_tac c="c" in v3_proj)
+apply metis
+apply(drule_tac x="s3" in spec)
+apply(drule mp)
+apply(rule_tac x="projval r1 c v" in exI)
+apply(rule conjI)
+apply (metis v4_proj2)
+apply(simp)
+apply metis
+(* nullable case *)
+apply(erule PMatch.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(erule PMatch.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(subst append.simps(2)[symmetric])
+apply(rule PMatch.intros)
+apply metis
+apply metis
+apply(auto)[1]
+apply(simp add: L_flat_Prf)
+apply(auto)[1]
+apply(frule_tac c="c" in v3_proj)
+apply metis
+apply(drule_tac x="s3" in spec)
+apply(drule mp)
+apply (metis v4_proj2)
+apply(simp)
+(* interesting case *)
+apply(clarify)
+apply(simp)
+thm L.simps
+apply(subst (asm) L.simps(4)[symmetric])
+apply(simp only: L_flat_Prf)
+apply(simp)
+apply(subst append.simps(1)[symmetric])
+apply(rule PMatch.intros)
+apply (metis PMatch_mkeps)
+apply metis
+apply(auto)
+apply(simp only: L_flat_Prf)
+apply(simp)
+apply(auto)
+apply(drule_tac x="Seq (projval r1 c v) vb" in spec)
+apply(drule mp)
+apply(simp)
+apply (metis append_Cons butlast_snoc last_snoc neq_Nil_conv rotate1.simps(2) v4_proj2)
+apply(subgoal_tac "\<turnstile> projval r1 c v : der c r1")
+apply (metis Prf.intros(1))
+apply(rule v3_proj)
+apply(simp)
+by (metis Cons_eq_append_conv)
+
+lemma lex_correct1:
+ assumes "s \<notin> L r"
+ shows "lex r s = None"
+using assms
+apply(induct s arbitrary: r)
+apply(simp)
+apply (metis nullable_correctness)
+apply(auto)
+apply(drule_tac x="der a r" in meta_spec)
+apply(drule meta_mp)
+apply(auto)
+apply(simp add: L_flat_Prf)
+by (metis v3 v4)
+
+
+lemma lex_correct2:
+ assumes "s \<in> L r"
+ shows "\<exists>v. lex r s = Some(v) \<and> \<turnstile> v : r \<and> flat v = s"
+using assms
+apply(induct s arbitrary: r)
+apply(simp)
+apply (metis mkeps_flat mkeps_nullable nullable_correctness)
+apply(drule_tac x="der a r" in meta_spec)
+apply(drule meta_mp)
+apply(simp add: L_flat_Prf)
+apply(auto)
+apply (metis v3_proj v4_proj2)
+apply (metis v3)
+apply(rule v4)
+by metis
+
+lemma lex_correct3:
+ assumes "s \<in> L r"
+ shows "\<exists>v. lex r s = Some(v) \<and> s \<in> r \<rightarrow> v"
+using assms
+apply(induct s arbitrary: r)
+apply(simp)
+apply (metis PMatch_mkeps nullable_correctness)
+apply(drule_tac x="der a r" in meta_spec)
+apply(drule meta_mp)
+apply(simp add: L_flat_Prf)
+apply(auto)
+apply (metis v3_proj v4_proj2)
+apply(rule PMatch2)
+apply(simp)
+done
+
+lemma lex_correct4:
+ assumes "s \<in> L r"
+ shows "s \<in> r \<rightarrow> (lex2 r s)"
+using assms
+apply(induct s arbitrary: r)
+apply(simp)
+apply (metis PMatch_mkeps nullable_correctness)
+apply(simp)
+apply(rule PMatch2)
+apply(drule_tac x="der a r" in meta_spec)
+apply(drule meta_mp)
+apply(simp add: L_flat_Prf)
+apply(auto)
+apply (metis v3_proj v4_proj2)
+done
+
+lemma
+ "lex2 (ALT (CHAR a) (ALT (CHAR b) (SEQ (CHAR a) (CHAR b)))) [a,b] = Right (Right (Seq (Char a) (Char b)))"
+apply(simp)
+done
+
+
+section {* Sulzmann's Ordering of values *}
+
+
+inductive ValOrd :: "val \<Rightarrow> rexp \<Rightarrow> val \<Rightarrow> bool" ("_ \<succ>_ _" [100, 100, 100] 100)
+where
+ "v2 \<succ>r2 v2' \<Longrightarrow> (Seq v1 v2) \<succ>(SEQ r1 r2) (Seq v1 v2')"
+| "\<lbrakk>v1 \<succ>r1 v1'; v1 \<noteq> v1'\<rbrakk> \<Longrightarrow> (Seq v1 v2) \<succ>(SEQ r1 r2) (Seq v1' v2')"
+| "length (flat v1) \<ge> length (flat v2) \<Longrightarrow> (Left v1) \<succ>(ALT r1 r2) (Right v2)"
+| "length (flat v2) > length (flat v1) \<Longrightarrow> (Right v2) \<succ>(ALT r1 r2) (Left v1)"
+| "v2 \<succ>r2 v2' \<Longrightarrow> (Right v2) \<succ>(ALT r1 r2) (Right v2')"
+| "v1 \<succ>r1 v1' \<Longrightarrow> (Left v1) \<succ>(ALT r1 r2) (Left v1')"
+| "Void \<succ>EMPTY Void"
+| "(Char c) \<succ>(CHAR c) (Char c)"
+
+inductive ValOrd2 :: "val \<Rightarrow> val \<Rightarrow> bool" ("_ 2\<succ> _" [100, 100] 100)
+where
+ "v2 2\<succ> v2' \<Longrightarrow> (Seq v1 v2) 2\<succ> (Seq v1 v2')"
+| "\<lbrakk>v1 2\<succ> v1'; v1 \<noteq> v1'\<rbrakk> \<Longrightarrow> (Seq v1 v2) 2\<succ> (Seq v1' v2')"
+| "length (flat v1) \<ge> length (flat v2) \<Longrightarrow> (Left v1) 2\<succ> (Right v2)"
+| "length (flat v2) > length (flat v1) \<Longrightarrow> (Right v2) 2\<succ> (Left v1)"
+| "v2 2\<succ> v2' \<Longrightarrow> (Right v2) 2\<succ> (Right v2')"
+| "v1 2\<succ> v1' \<Longrightarrow> (Left v1) 2\<succ> (Left v1')"
+| "Void 2\<succ> Void"
+| "(Char c) 2\<succ> (Char c)"
+
+lemma Ord1:
+ "v1 \<succ>r v2 \<Longrightarrow> v1 2\<succ> v2"
+apply(induct rule: ValOrd.induct)
+apply(auto intro: ValOrd2.intros)
+done
+
+lemma Ord2:
+ "v1 2\<succ> v2 \<Longrightarrow> \<exists>r. v1 \<succ>r v2"
+apply(induct v1 v2 rule: ValOrd2.induct)
+apply(auto intro: ValOrd.intros)
+done
+
+lemma Ord3:
+ "\<lbrakk>v1 2\<succ> v2; \<turnstile> v1 : r\<rbrakk> \<Longrightarrow> v1 \<succ>r v2"
+apply(induct v1 v2 arbitrary: r rule: ValOrd2.induct)
+apply(auto intro: ValOrd.intros elim: Prf.cases)
+done
+
+section {* Posix definition *}
+
+definition POSIX :: "val \<Rightarrow> rexp \<Rightarrow> bool"
+where
+ "POSIX v r \<equiv> (\<turnstile> v : r \<and> (\<forall>v'. (\<turnstile> v' : r \<and> flat v' \<sqsubseteq> flat v) \<longrightarrow> v \<succ>r v'))"
+
+lemma ValOrd_refl:
+ assumes "\<turnstile> v : r"
+ shows "v \<succ>r v"
+using assms
+apply(induct)
+apply(auto intro: ValOrd.intros)
+done
+
+lemma ValOrd_total:
+ shows "\<lbrakk>\<turnstile> v1 : r; \<turnstile> v2 : r\<rbrakk> \<Longrightarrow> v1 \<succ>r v2 \<or> v2 \<succ>r v1"
+apply(induct r arbitrary: v1 v2)
+apply(auto)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(7))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(8))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(case_tac "v1a = v1b")
+apply(simp)
+apply(rule ValOrd.intros(1))
+apply (metis ValOrd.intros(1))
+apply(rule ValOrd.intros(2))
+apply(auto)[2]
+apply(erule contrapos_np)
+apply(rule ValOrd.intros(2))
+apply(auto)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis Ord1 Ord3 Prf.intros(2) ValOrd2.intros(6))
+apply(rule ValOrd.intros)
+apply(erule contrapos_np)
+apply(rule ValOrd.intros)
+apply (metis le_eq_less_or_eq neq_iff)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rule ValOrd.intros)
+apply(erule contrapos_np)
+apply(rule ValOrd.intros)
+apply (metis le_eq_less_or_eq neq_iff)
+apply(rule ValOrd.intros)
+apply(erule contrapos_np)
+apply(rule ValOrd.intros)
+by metis
+
+lemma ValOrd_anti:
+ shows "\<lbrakk>\<turnstile> v1 : r; \<turnstile> v2 : r; v1 \<succ>r v2; v2 \<succ>r v1\<rbrakk> \<Longrightarrow> v1 = v2"
+apply(induct r arbitrary: v1 v2)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+done
+
+lemma POSIX_ALT_I1:
+ assumes "POSIX v1 r1"
+ shows "POSIX (Left v1) (ALT r1 r2)"
+using assms
+unfolding POSIX_def
+apply(auto)
+apply (metis Prf.intros(2))
+apply(rotate_tac 2)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)
+apply(rule ValOrd.intros)
+apply(auto)
+apply(rule ValOrd.intros)
+by (metis le_eq_less_or_eq length_sprefix sprefix_def)
+
+lemma POSIX_ALT_I2:
+ assumes "POSIX v2 r2" "\<forall>v'. \<turnstile> v' : r1 \<longrightarrow> length (flat v2) > length (flat v')"
+ shows "POSIX (Right v2) (ALT r1 r2)"
+using assms
+unfolding POSIX_def
+apply(auto)
+apply (metis Prf.intros)
+apply(rotate_tac 3)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)
+apply(rule ValOrd.intros)
+apply metis
+apply(rule ValOrd.intros)
+apply metis
+done
+
+section {* tryout with all-mkeps *}
+
+fun
+ alleps :: "rexp \<Rightarrow> val set"
+where
+ "alleps(NULL) = {}"
+| "alleps(EMPTY) = {Void}"
+| "alleps(CHAR c) = {}"
+| "alleps(SEQ r1 r2) = {Seq v1 v2 | v1 v2. v1 \<in> alleps r1 \<and> v2 \<in> alleps r2}"
+| "alleps(ALT r1 r2) = {Left v1 | v1. v1 \<in> alleps r1} \<union> {Right v2 | v2. v2 \<in> alleps r2}"
+
+fun injall :: "rexp \<Rightarrow> char \<Rightarrow> val \<Rightarrow> val set"
+where
+ "injall (EMPTY) c Void = {}"
+| "injall (CHAR d) c Void = (if c = d then {Char d} else {})"
+| "injall (ALT r1 r2) c (Left v1) = {Left v | v. v \<in> injall r1 c v1}"
+| "injall (ALT r1 r2) c (Right v2) = {Right v | v. v \<in> injall r2 c v2}"
+| "injall (SEQ r1 r2) c (Seq v1 v2) = {Seq v v2 | v. v \<in> injall r1 c v1}"
+| "injall (SEQ r1 r2) c (Left (Seq v1 v2)) = {Seq v v2 | v. v \<in> injall r1 c v1}"
+| "injall (SEQ r1 r2) c (Right v2) = {Seq v v' | v v'. v \<in> alleps r1 \<and> v' \<in> injall r2 c v2}"
+
+fun
+ allvals :: "rexp \<Rightarrow> string \<Rightarrow> val set"
+where
+ "allvals r [] = alleps r"
+| "allvals r (c#s) = {v | v v'. v \<in> injall r c v' \<and> v' \<in> allvals (der c r) s}"
+
+lemma q1:
+ assumes "v \<in> alleps r"
+ shows "\<turnstile> v : r \<and> flat v = []"
+using assms
+apply(induct r arbitrary: v)
+apply(auto intro: Prf.intros)
+done
+
+
+lemma allvals_NULL:
+ shows "allvals (NULL) s = {}"
+apply(induct_tac s)
+apply(simp)
+apply(simp)
+done
+
+lemma allvals_EMPTY:
+ shows "allvals (EMPTY) [] = {Void}"
+ and "s \<noteq> [] \<Longrightarrow> allvals (EMPTY) s = {}"
+apply(simp)
+apply(case_tac s)
+apply(simp)
+apply(simp add: allvals_NULL)
+done
+
+lemma allvals_CHAR:
+ shows "allvals (CHAR c) [c] = {Char c}"
+ and "s \<noteq> [c] \<Longrightarrow> allvals (CHAR c) s = {}"
+apply(simp)
+apply(case_tac s)
+apply(simp)
+apply(case_tac "c = a")
+apply(simp add: allvals_EMPTY)
+apply(simp add: allvals_NULL)
+done
+
+lemma allvals_ALT:
+ shows "allvals (ALT r1 r2) s = {Left v1 | v1. v1 \<in> allvals r1 s} \<union>
+ {Right v2 | v2. v2 \<in> allvals r2 s}"
+apply(induct s arbitrary: r1 r2)
+apply(simp)
+apply(simp)
+apply(auto)
+apply blast
+apply(rule_tac x="Left v'" in exI)
+apply(simp)
+apply(rule_tac x="Right v'" in exI)
+apply(simp)
+done
+
+lemma allvals_SEQ_Nil:
+ "allvals (SEQ r1 r2) [] = {Seq v1 v2 | v1 v2. v1 \<in> allvals r1 [] \<and> v2 \<in> allvals r2 []}"
+by simp
+
+lemma allvals_SEQ:
+ shows "allvals (SEQ r1 r2) s = {Seq v1 v2 | v1 v2 s1 s2.
+ s = s1 @ s2 \<and> v1 \<in> allvals r1 s1 \<and> v2 \<in> allvals r2 s2}"
+using assms
+apply(induct s arbitrary: r1 r2)
+apply(simp)
+apply(simp)
+apply(auto)
+apply(simp_all add: allvals_ALT)
+apply(auto)
+apply (metis (mono_tags, lifting) allvals.simps(2) append_Cons mem_Collect_eq)
+apply fastforce
+prefer 2
+apply(rule_tac x="a#s1" in exI)
+apply(rule_tac x="s2" in exI)
+apply(simp)
+apply(fastforce)
+prefer 2
+apply(subst (asm) Cons_eq_append_conv)
+apply(auto)[1]
+using Prf_flat_L nullable_correctness q1 apply fastforce
+apply(rule_tac x="Seq v' v2" in exI)
+apply(simp)
+apply(rule_tac x="ys'" in exI)
+apply(rule_tac x="s2" in exI)
+apply(simp)
+apply(subst (asm) Cons_eq_append_conv)
+apply(auto)[1]
+apply(rule_tac x="Right v'" in exI)
+apply(simp)
+apply(rule_tac x="Left (Seq v' v2)" in exI)
+apply(simp)
+apply(auto)[1]
+done
+
+lemma q11:
+ assumes "nullable r" "\<turnstile> v : r" "flat v = []"
+ shows "v \<in> alleps r"
+using assms
+apply(induct r arbitrary: v)
+apply(auto)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(auto)
+apply(subgoal_tac "nullable r2a")
+apply(auto)
+using not_nullable_flat apply auto[1]
+ apply(erule Prf.cases)
+apply(simp_all)
+apply(auto)
+apply(subgoal_tac "nullable r1a")
+apply(auto)
+using not_nullable_flat apply auto[1]
+done
+
+lemma q33:
+ assumes "nullable r"
+ shows "alleps r = {v. \<turnstile> v : r \<and> flat v = []}"
+using assms
+apply(auto)
+apply (simp_all add: q1)
+by (simp add: q11)
+
+
+lemma k0:
+ assumes "\<turnstile> v : der a r" "v' \<in> injall r a v"
+ shows "flat v' = a # flat v"
+using assms
+apply(induct a r arbitrary: v v' rule: der.induct)
+apply(simp_all)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(case_tac "c = c'")
+apply(erule Prf.cases)
+apply(simp_all)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(auto)[1]
+apply(auto)[1]
+apply(case_tac "nullable r1")
+apply(auto)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(auto)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(auto)
+using q1 apply blast
+apply(erule Prf.cases)
+apply(simp_all)
+apply(auto)
+done
+
+lemma k:
+ assumes "\<turnstile> v' : der a r" "v \<in> injall r a v'"
+ shows "\<turnstile> v : r"
+using assms
+apply(induct a r arbitrary: v v' rule: der.induct)
+apply(simp_all)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(case_tac "c = c'")
+apply(erule Prf.cases)
+apply(simp_all)
+apply(rule Prf.intros)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(auto intro: Prf.intros)[1]
+apply(auto intro: Prf.intros)[1]
+apply(case_tac "nullable r1")
+apply(auto)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(auto)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(auto)
+apply(auto intro: Prf.intros)[1]
+using Prf.intros(1) q1 apply blast
+apply(erule Prf.cases)
+apply(simp_all)
+apply(auto)
+using Prf.intros(1) by auto
+
+
+
+lemma q22:
+ assumes "v \<in> allvals r s"
+ shows "\<turnstile> v : r \<and> s \<in> L (r) \<and> flat v = s"
+using assms
+apply(induct s arbitrary: v r)
+apply(auto)
+apply(simp_all add: q1)
+using Prf_flat_L q1 apply fastforce
+apply(drule_tac x="v'" in meta_spec)
+apply(drule_tac x="der a r" in meta_spec)
+apply(simp)
+apply(clarify)
+apply(rule k)
+apply(assumption)
+apply(assumption)
+apply(drule_tac x="v'" in meta_spec)
+apply(drule_tac x="der a r" in meta_spec)
+apply(simp)
+apply(clarify)
+using Prf_flat_L v3 v4 apply fastforce
+apply(drule_tac x="v'" in meta_spec)
+apply(drule_tac x="der a r" in meta_spec)
+apply(simp)
+apply(clarify)
+using k0 by blast
+
+lemma ra:
+ assumes "v \<in> allvals r1 s"
+ shows "Left v \<in> allvals (ALT r1 r2) s"
+using assms
+apply(induct s arbitrary: r1 r2 v)
+apply(simp)
+apply(auto)
+apply(rule_tac x="Left v'" in exI)
+apply(simp)
+done
+
+lemma rb:
+ assumes "v \<in> allvals r2 s"
+ shows "Right v \<in> allvals (ALT r1 r2) s"
+using assms
+apply(induct s arbitrary: r1 r2 v)
+apply(simp)
+apply(auto)
+apply(rule_tac x="Right v'" in exI)
+apply(simp)
+done
+
+lemma r1:
+ assumes "v1 \<in> alleps r1" "v2 \<in> allvals r2 s2"
+ shows "Seq v1 v2 \<in> allvals (SEQ r1 r2) s2"
+using assms
+apply(induct s2 arbitrary: r1 r2 v1 v2)
+apply(simp)
+apply(simp)
+apply(auto)
+apply(rule_tac x="Right v'" in exI)
+apply(simp)
+apply(rule rb)
+apply(simp)
+using not_nullable_flat q1 by blast
+
+lemma r2:
+ assumes "v1 \<in> allvals r1 s1" "v2 \<in> allvals r2 s2"
+ shows "Seq v1 v2 \<in> allvals (SEQ r1 r2) (s1 @ s2)"
+using assms
+apply(induct s1 arbitrary: r1 r2 v1 v2 s2)
+apply(simp)
+apply(rule r1)
+apply(simp)
+apply(simp)
+apply(simp)
+apply(auto)
+apply(drule_tac x="der a r1" in meta_spec)
+apply(drule_tac x="r2" in meta_spec)
+apply(drule_tac x="v'" in meta_spec)
+apply(drule_tac x="v2" in meta_spec)
+apply(drule_tac x="s2" in meta_spec)
+apply(simp)
+apply(rule_tac x="Left (Seq v' v2)" in exI)
+apply(simp)
+apply(rule ra)
+apply(simp)
+apply(drule_tac x="der a r1" in meta_spec)
+apply(drule_tac x="r2" in meta_spec)
+apply(drule_tac x="v'" in meta_spec)
+apply(drule_tac x="v2" in meta_spec)
+apply(drule_tac x="s2" in meta_spec)
+apply(simp)
+apply(rule_tac x="Seq v' v2" in exI)
+apply(simp)
+done
+
+lemma q22a:
+ assumes " s \<in> L (r)"
+ shows "\<exists>v. v \<in> allvals r s \<and> flat v = s"
+using assms
+apply(induct r arbitrary: s)
+apply(auto)
+apply(simp add: Sequ_def)
+apply(auto)
+apply(drule_tac x="s1" in meta_spec)
+apply(drule_tac x="s2" in meta_spec)
+apply(auto)
+apply(rule_tac x="Seq v va" in exI)
+apply(simp)
+apply(rule r2)
+apply(simp)
+apply(simp)
+apply(drule_tac x="s" in meta_spec)
+apply(simp)
+apply(auto)
+apply(rule_tac x="Left v" in exI)
+apply(simp)
+apply(rule ra)
+apply(simp)
+apply(drule_tac x="s" in meta_spec)
+apply(drule_tac x="s" in meta_spec)
+apply(simp)
+apply(auto)
+apply(rule_tac x="Right v" in exI)
+apply(simp)
+apply(rule rb)
+apply(simp)
+done
+
+lemma q22b:
+ assumes " s \<in> L (r)" "\<turnstile> v : r" "flat v = s"
+ shows "v \<in> allvals r s"
+using assms
+apply(induct r arbitrary: s v)
+apply(auto)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(simp add: Sequ_def)
+apply(auto)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(simp add: append_eq_append_conv2)
+apply(auto)
+apply (metis Prf_flat_L append_assoc r2)
+apply (metis Prf_flat_L r2)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(auto intro: ra rb)[2]
+apply(rule rb)
+apply (simp add: Prf_flat_L)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(auto intro: ra rb)[2]
+apply(rule ra)
+by (simp add: Prf_flat_L)
+
+
+lemma q2:
+ assumes "s \<in> L(r)"
+ shows "allvals r s = {v. \<turnstile> v : r \<and> s \<in> L (r) \<and> flat v = s}"
+using assms
+apply(auto)
+apply (simp add: q22)
+apply (simp add: q22)
+by (simp add: q22b)
+
+lemma r3a:
+ assumes "v' \<in> allvals (SEQ r1 r2) (s1 @ s2)"
+ "(s1 @ s2) \<in> L (SEQ r1 r2)"
+ shows "\<exists>v1 v2. v' = Seq v1 v2 \<and> v1 \<in> allvals r1 s1 \<and> v2 \<in> allvals r2 s2"
+using assms
+apply(subst (asm) q2)
+apply(auto)
+apply(erule_tac Prf.cases)
+apply(simp_all)
+apply(rule conjI)
+apply(simp add: append_eq_append_conv2)
+apply(auto)
+apply(subst q2)
+oops
+
+lemma r3:
+ assumes "Seq v1 v2 \<in> allvals (SEQ r1 r2) (s1 @ s2)"
+ "flat v1 = s1" "flat v2 = s2"
+ "(s1 @ s2) \<in> L (SEQ r1 r2)"
+ shows "v1 \<in> allvals r1 s1" "v2 \<in> allvals r2 s2"
+using assms
+apply(subst (asm) q2)
+apply(auto)
+apply(erule_tac Prf.cases)
+apply(simp_all)
+apply(subst q2)
+apply(auto)
+using Prf_flat_L apply blast
+using Prf_flat_L apply blast
+using assms
+apply(subst (asm) q2)
+apply(auto)
+apply(erule_tac Prf.cases)
+apply(simp_all)
+apply(subst q2)
+apply(auto)
+using Prf_flat_L apply blast
+using Prf_flat_L apply blast
+done
+
+
+definition POSIX2 :: "val \<Rightarrow> rexp \<Rightarrow> string \<Rightarrow> bool"
+where
+ "POSIX2 v r s \<equiv> (\<turnstile> v : r \<and> flat v = s \<and> (\<forall>v'\<in>allvals r s. v \<succ>r v'))"
+
+
+
+
+lemma k1:
+ assumes "nullable r"
+ shows "POSIX2 v r [] \<Longrightarrow> \<forall>v' \<in> alleps r. v \<succ>r v'"
+using assms
+apply(induct r arbitrary: v)
+apply(simp_all)
+apply(simp add: POSIX2_def)
+apply(auto)
+apply(simp add: POSIX2_def)
+apply(simp add: POSIX2_def)
+apply(simp add: POSIX2_def)
+apply(simp add: POSIX2_def)
+apply(simp add: POSIX2_def)
+done
+
+lemma k2:
+ assumes "s \<in> L r"
+ shows "POSIX2 v r s \<Longrightarrow> \<forall>v' \<in> allvals r s. v \<succ>r v'"
+using assms
+apply(induct s arbitrary: r v)
+apply(simp)
+apply(rule k1)
+apply (simp add: nullable_correctness)
+apply(simp)
+apply(simp)
+apply(auto)
+apply(simp only: POSIX2_def)
+apply(simp)
+apply(clarify)
+apply(drule_tac x="x" in spec)
+apply(drule mp)
+apply(auto)
+done
+
+lemma pos:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "v \<in> allvals r s"
+using assms
+apply(subst q2)
+using PMatch1(1) PMatch1(2) Prf_flat_L apply blast
+apply(simp)
+using PMatch1(1) PMatch1(2) Prf_flat_L by blast
+
+lemma mkeps_val:
+ assumes "nullable r"
+ shows "mkeps r \<in> alleps r"
+using assms
+apply(induct r)
+apply(auto)
+done
+
+lemma injval_injall:
+ assumes "\<turnstile> v : der a r"
+ shows "injval r a v \<in> injall r a v"
+using assms
+apply(induct a r arbitrary: v rule: der.induct)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(case_tac "c = c'")
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(case_tac "nullable r1")
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(auto)
+apply(erule Prf.cases)
+apply(simp_all)
+using mkeps_val apply blast
+apply(erule Prf.cases)
+apply(simp_all)
+done
+
+
+lemma mkeps_val1:
+ assumes "nullable r" "v \<succ>r mkeps r" "flat v = []" "\<turnstile> v : r"
+ shows "v = mkeps r"
+using assms
+apply(induct r arbitrary: v)
+apply(auto)
+apply(erule ValOrd.cases)
+apply(auto)
+apply(erule ValOrd.cases)
+apply(auto)
+apply(erule Prf.cases)
+apply(auto)
+apply(erule Prf.cases)
+apply(auto)
+apply(erule Prf.cases)
+apply(auto)
+apply(erule ValOrd.cases)
+apply(auto)
+apply(erule ValOrd.cases)
+apply(auto)
+apply(erule Prf.cases)
+apply(auto)
+apply(erule ValOrd.cases)
+apply(auto)
+apply(erule ValOrd.cases)
+apply(auto)
+apply(erule Prf.cases)
+apply(auto)
+apply(erule ValOrd.cases)
+apply(auto)
+apply (simp add: not_nullable_flat)
+apply(erule ValOrd.cases)
+apply(auto)
+done
+
+lemma sulzmann_our:
+ assumes "v \<in> alleps r" "nullable r"
+ shows "mkeps r \<succ>r v"
+using assms
+apply(induct r arbitrary: v)
+apply(simp_all)
+apply(rule ValOrd.intros)
+apply(auto)[1]
+apply(case_tac "mkeps r1 = v1")
+apply(simp)
+apply(rule ValOrd.intros)
+apply(blast)
+apply(rule ValOrd.intros)
+apply(blast)
+apply(simp)
+apply(auto)
+apply(rule ValOrd.intros)
+apply(blast)
+apply(rule ValOrd.intros)
+apply(blast)
+apply(rule ValOrd.intros)
+using not_nullable_flat q1 apply blast
+apply(rule ValOrd.intros)
+using q1 apply auto[1]
+apply(rule ValOrd.intros)
+apply (simp add: q1)
+apply(rule ValOrd.intros)
+apply(blast)
+done
+
+lemma destruct:
+ assumes "\<forall>s3. s1 @ s3 \<in> L r1 \<longrightarrow> s3 = [] \<or> (\<forall>s4. s3 @ s4 = s2 \<longrightarrow> s4 \<notin> L r2)"
+ and "s1 \<in> L r1" "s2 \<in> L r2" "(s1' @ s2') \<sqsubseteq> (s1 @ s2)"
+ and "s1'@ s2' \<in> L (SEQ r1 r2)" "s1' \<in> L r1"
+ shows "s1' \<sqsubseteq> s1"
+using assms
+apply(simp add: prefix_def)
+apply(auto)
+apply(simp add: append_eq_append_conv2)
+apply(auto)
+apply(simp add: Sequ_def)
+apply(auto)
+apply(drule_tac x="us" in spec)
+apply(simp)
+apply(auto)
+apply(simp add: append_eq_append_conv2)
+apply(auto)
+oops
+
+lemma inj_ord:
+ assumes "v1 \<succ>(der a r) v2" "s \<in> (der a r) \<rightarrow> v1" "s' \<in> L (der a r)"
+ "v1 \<in> allvals (der a r) s" "v2 \<in> allvals (der a r) s'" "s' \<sqsubseteq> s"
+ shows "injval r a v1 \<succ>r injval r a v2"
+using assms
+apply(induct a r arbitrary: s s' v1 v2 rule: der.induct)
+apply(simp_all)
+(*apply(simp add: allvals_NULL)
+apply(simp add: allvals_NULL)*)
+apply(case_tac "c = c'")
+apply(simp)
+apply(case_tac "s = []")
+apply(subgoal_tac "s' = []")
+prefer 2
+using allvals_EMPTY(2) apply blast
+apply(simp add: allvals_EMPTY)
+apply(rule ValOrd.intros)
+apply(simp add: allvals_EMPTY)
+apply(simp)
+(*apply(simp add: allvals_NULL)*)
+(* ALT case *)
+apply(simp add: allvals_ALT)
+apply(auto)[1]
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(rule ValOrd.intros)
+apply(erule PMatch.cases)
+apply(simp_all)
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(rule ValOrd.intros)
+apply(subst v4)
+apply(simp)
+apply (simp add: q22)
+apply(subst v4)
+apply(simp)
+apply (simp add: q22)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(rule ValOrd.intros)
+apply(subst v4)
+apply (simp add: q22)
+apply(subst v4)
+apply (simp add: q22)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(rule ValOrd.intros)
+apply(erule PMatch.cases)
+apply(simp_all)
+using q22 apply auto[1]
+apply(erule PMatch.cases)
+apply(simp_all)
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(rule ValOrd.intros)
+using q22 apply auto[1]
+apply(erule PMatch.cases)
+apply(simp_all)
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(rule ValOrd.intros)
+apply(subst v4)
+apply (simp add: q22)
+apply(subst v4)
+apply (simp add: q22)
+apply(simp)
+apply(erule PMatch.cases)
+apply(simp_all)
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(rule ValOrd.intros)
+apply(subst v4)
+apply (simp add: q22)
+apply(subst v4)
+apply (simp add: q22)
+apply(simp)
+using q22 apply auto[1]
+apply(erule PMatch.cases)
+apply(simp_all)
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(rule ValOrd.intros)
+using q22 apply auto[1]
+(* seq case *)
+apply(case_tac "nullable r1")
+apply(simp)
+prefer 2
+apply(simp)
+apply(simp add: allvals_SEQ)
+apply(auto)[1]
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(clarify)
+apply(rule ValOrd.intros)
+apply(simp)
+apply(rule ValOrd.intros)
+apply(erule PMatch.cases)
+apply(simp_all)
+apply(clarify)
+apply(rotate_tac 1)
+apply(drule_tac x="s1b" in meta_spec)
+apply(rotate_tac 13)
+apply(drule_tac x="s1a" in meta_spec)
+apply(drule_tac x="v1c" in meta_spec)
+apply(drule_tac x="v1'" in meta_spec)
+apply(simp)
+apply(subgoal_tac "s1 = s1b")
+prefer 2
+apply (metis PMatch1(2) q22)
+apply(simp)
+apply(clarify)
+apply(drule destruct)
+apply (metis PMatch1(2) q22)
+apply (metis PMatch1(2) q22)
+apply(assumption)
+apply (metis PMatch1(2) q22)
+apply (metis PMatch1(2) q22)
+apply(subgoal_tac "s2a = s2b")
+prefer 2
+apply (metis PMatch1(2) q22)
+apply(drule destruct)
+apply (metis PMatch1(2) q22)
+apply (metis PMatch1(2) q22)
+apply(assumption)
+back
+apply (metis PMatch1(2) q22)
+apply (metis PMatch1(2) q22)
+
+
+
+apply(simp add: allvals_ALT)
+apply(auto)
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(clarify)
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(clarify)
+apply(rule ValOrd.intros)
+apply(blast)
+apply(rule ValOrd.intros)
+apply(clarify)
+apply(simp add: allvals_SEQ)
+apply(auto)[1]
+apply(erule PMatch.cases)
+apply(simp_all)
+apply(clarify)
+apply(erule PMatch.cases)
+apply(simp_all)
+apply(auto)
+apply(drule_tac x="s1b" in meta_spec)
+apply(drule_tac x="v1" in meta_spec)
+apply(drule_tac x="v1'a" in meta_spec)
+apply(simp)
+apply(drule_tac meta_mp)
+apply(subgoal_tac "s1 = s1b")
+apply(simp)
+apply (metis PMatch1(2) q22)
+apply(drule_tac meta_mp)
+apply(subgoal_tac "s1a = s1b")
+apply(simp)
+apply(simp add: append_eq_append_conv2)
+apply(auto)[1]
+apply(subgoal_tac "s2 = s2a")
+apply(simp)
+apply(clarify)
+prefer 2
+using q22 apply blast
+using q22 apply blast
+using q22 apply blast
+apply(subgoal_tac "usa = []")
+apply(simp)
+prefer 2
+using q22 apply blast
+prefer 3
+apply(simp)
+prefer 4
+apply(erule PMatch.cases)
+apply(simp_all)
+apply(clarify)
+apply(erule PMatch.cases)
+apply(simp_all)
+apply(auto)
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(clarify)
+apply(simp)
+prefer 5
+apply(erule PMatch.cases)
+apply(simp_all)
+apply(clarify)
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(clarify)
+apply(simp add: allvals_SEQ)
+apply(auto)[1]
+apply (simp add: q22)
+apply(simp add: allvals_SEQ)
+apply(auto)[1]
+apply(simp add: append_eq_append_conv2)
+apply(auto)[1]
+apply (simp add: q22)
+thm PMatch2
+apply(drule PMatch2)
+
+
+lemma sulzmann_our:
+ assumes "\<forall>v' \<in> allvals r s. v \<succ>r v'" "s \<in> L r" "\<turnstile> v : r" "flat v = s"
+ shows "s \<in> r \<rightarrow> v"
+using assms
+apply(induct s arbitrary: r v)
+apply(simp_all)
+apply(subst (asm) q33)
+apply (simp add: nullable_correctness)
+apply(simp)
+apply(drule_tac x="mkeps r" in spec)
+apply(drule mp)
+apply(rule conjI)
+using mkeps_val not_nullable_flat q1 apply blast
+using mkeps_flat not_nullable_flat apply blast
+apply(subgoal_tac "nullable r")
+apply(drule mkeps_val1)
+apply(assumption)
+apply(simp)
+apply(simp)
+apply(simp)
+using PMatch_mkeps not_nullable_flat apply blast
+using not_nullable_flat apply blast
+apply(drule_tac x="der a r" in meta_spec)
+apply(drule_tac x="projval r a v" in meta_spec)
+apply(drule meta_mp)
+defer
+apply(drule meta_mp)
+using Prf_flat_L v3_proj v4_proj2 apply blast
+apply(drule meta_mp)
+using v3_proj apply blast
+apply(drule meta_mp)
+apply (simp add: v4_proj2)
+defer
+apply(rule ballI)
+apply(drule_tac x="injval r a x" in spec)
+apply(auto)
+apply(drule_tac x="x" in spec)
+apply(drule mp)
+apply(rule injval_injall)
+using q22 apply blast
+apply(simp)
+(* HERE *)
+
+
+lemma our_sulzmann:
+ assumes "s \<in> r \<rightarrow> v" "v' \<in> allvals r s"
+ shows "v \<succ>r v'"
+using assms
+apply(induct r arbitrary: s v v')
+apply(erule PMatch.cases)
+apply(simp_all)[5]
+apply(erule PMatch.cases)
+apply(simp_all)[5]
+apply(rule ValOrd.intros)
+apply(erule PMatch.cases)
+apply(simp_all)[5]
+apply(rule ValOrd.intros)
+(* SEQ - case *)
+apply(erule PMatch.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(subst (asm) (3) q2)
+apply(simp add: Sequ_def)
+apply(rule_tac x="s1" in exI)
+apply(rule_tac x="s2" in exI)
+apply(simp)
+apply(rule conjI)
+using PMatch1(1) PMatch1(2) Prf_flat_L apply fastforce
+apply (metis PMatch1(1) PMatch1(2) Prf_flat_L)
+apply(simp)
+apply(clarify)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(case_tac "v1 = v1a")
+apply(simp)
+apply(rule ValOrd.intros)
+apply(rotate_tac 1)
+apply(drule_tac x="s2" in meta_spec)
+apply(drule_tac x="v2" in meta_spec)
+apply(drule_tac x="v2a" in meta_spec)
+apply(simp)
+apply(drule_tac meta_mp)
+apply(subst q2)
+using PMatch1(1) PMatch1(2) Prf_flat_L apply fastforce
+apply(simp)
+apply(rule conjI)
+using PMatch1(1) PMatch1(2) Prf_flat_L apply fastforce
+apply (simp add: PMatch1(2))
+apply(simp)
+apply(rule ValOrd.intros)
+prefer 2
+apply(simp)
+apply(drule_tac x="s1" in meta_spec)
+apply(drule_tac x="v1" in meta_spec)
+apply(drule_tac x="v1a" in meta_spec)
+apply(simp)
+apply(drule_tac meta_mp)
+apply(subst q2)
+apply (metis PMatch1(1) PMatch1(2) Prf_flat_L)
+apply(simp)
+apply(rule conjI)
+apply (metis PMatch1(1) PMatch1(2) Prf_flat_L)
+apply(subst (asm) append_eq_append_conv2)
+apply(auto)[1]
+using Prf_flat_L apply fastforce
+
+apply(drule_tac x="us" in spec)
+apply(auto)[1]
+
+using Prf_flat_L apply fastforce
+using Prf_flat_L apply blast
+apply(drule_tac meta_mp)
+apply(subst q2)
+using Prf_flat_L apply fastforce
+apply(simp)
+using Prf_flat_L apply fastforce
+apply(simp)
+apply(drule_tac x="flat v1a" in meta_spec)
+apply(drule_tac x="v1" in meta_spec)
+apply(drule_tac x="v1a" in meta_spec)
+apply(drule_tac meta_mp)
+apply(simp)
+apply(drule meta_mp)
+apply(subst q2)
+apply (metis PMatch1(1) PMatch1(2) Prf_flat_L)
+apply(simp)
+apply(rule conjI)
+apply (metis PMatch1(1) PMatch1(2) Prf_flat_L)
+apply(drule_tac x="[]" in spec)
+apply(auto)[1]
+
+using Prf_flat_L apply fast
+apply(drule_tac x="us" in spec)
+apply(simp)
+
+apply (simp add: Prf_flat_L)
+apply(simp)
+thm PMatch1
+qed
+done
+using PMatch1(1) PMatch1(2) Prf_flat_L apply fastforce
+apply(simp)
+apply(clarify)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(rule ValOrd.intros)
+apply(drule_tac x="v1" in meta_spec)
+apply(drule meta_mp)
+apply(subst q2)
+apply (simp add: Prf_flat_L)
+apply(simp)
+apply (simp add: Prf_flat_L)
+apply(simp)
+apply(rule ValOrd.intros)
+apply(auto)[1]
+apply (simp add: PMatch1(2))
+apply (simp add: PMatch1(2))
+apply(subst (asm) (2) q2)
+using PMatch1(1) PMatch1(2) Prf_flat_L apply fastforce
+apply(simp)
+apply(clarify)
+apply(erule Prf.cases)
+apply(simp_all)
+prefer 2
+apply(rule ValOrd.intros)
+using q22b apply blast
+apply(rule ValOrd.intros)
+apply(auto)
+using Prf_flat_L apply blast
+apply(subst (asm) (3) q2)
+apply(simp add: Sequ_def)
+apply(rule_tac x="s1" in exI)
+apply(rule_tac x="s2" in exI)
+apply(simp)
+using PMatch1(1) PMatch1(2) Prf_flat_L apply fastforce
+apply(simp)
+apply(clarify)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(auto simp add: Sequ_def)[1]
+apply(case_tac "v1 = v1a")
+apply(simp)
+apply(rule ValOrd.intros)
+apply(rotate_tac 3)
+apply(drule_tac x="v2a" in meta_spec)
+apply(drule_tac meta_mp)
+apply(subst q2)
+using PMatch1(1) PMatch1(2) Prf_flat_L apply fastforce
+apply(simp)
+apply(rule conjI)
+using PMatch1(1) PMatch1(2) Prf_flat_L apply fastforce
+apply (metis PMatch1(2) same_append_eq)
+apply(simp)
+apply(rule ValOrd.intros)
+apply(drule_tac x="v1a" in meta_spec)
+apply(drule_tac meta_mp)
+apply(subst q2)
+using PMatch1(1) PMatch1(2) Prf_flat_L apply fastforce
+apply(simp)
+apply(rule conjI)
+using PMatch1(1) PMatch1(2) Prf_flat_L apply fastforce
+prefer 2
+apply(simp)
+prefer 2
+apply(simp)
+apply(rotate_tac 7)
+apply(drule sym)
+apply(simp)
+apply(subst (asm) (2) append_eq_append_conv2)
+apply(auto)[1]
+apply(frule_tac x="us" in spec)
+apply(auto)[1]
+prefer 2
+apply(drule_tac x="flat v2a" in spec)
+apply(auto)[1]
+
+apply(subgoal_tac "flat v2a = s2")
+apply(simp)
+
+apply(simp add: append_eq_append_conv2)
+apply(auto)
+prefer 2
+apply blast
+prefer 2
+apply (metis Prf_flat_L append_self_conv2)
+prefer 4
+
+
+
+lemma our_sulzmann:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "POSIX2 v r s"
+using assms
+apply(induct s r v)
+apply(auto)
+apply(simp add: POSIX2_def)
+using Prf.intros(4) ValOrd.intros(7) apply blast
+apply(simp add: POSIX2_def)
+apply (simp add: Prf.intros(5) ValOrd.intros(8))
+apply(simp add: POSIX2_def)
+apply(auto)
+apply(rule Prf.intros)
+apply(simp)
+apply(subgoal_tac "(\<exists>x1. x = Left x1) \<or> (\<exists>x1. x = Right x1)")
+apply(auto)[1]
+apply(rule ValOrd.intros)
+apply(drule_tac x="x1" in bspec)
+apply(subst (asm) q2)
+apply (simp add: Prf_flat_L)
+apply(simp)
+apply(subst q2)
+apply (simp add: Prf_flat_L)
+apply(auto)[1]
+apply(rotate_tac 2)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(rotate_tac 2)
+apply(erule Prf.cases)
+apply(simp_all)
+apply (simp add: Prf_flat_L)
+apply(rule ValOrd.intros)
+apply(subst (asm) (2) q2)
+apply (simp add: Prf_flat_L)
+apply(auto)[1]
+defer
+apply(simp add: POSIX2_def)
+apply(auto)[1]
+apply(rule Prf.intros)
+apply (simp add: Prf_flat_L)
+apply(subgoal_tac "(\<exists>x1. x = Left x1) \<or> (\<exists>x1. x = Right x1)")
+apply(auto)[1]
+apply(rule ValOrd.intros)
+apply(subst (asm) (2) q2)
+apply (simp add: Prf_flat_L)
+apply(auto)[1]
+apply(rotate_tac 4)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(auto)[1]
+using Prf_flat_L apply force
+apply(rule ValOrd.intros)
+apply(drule_tac x="x1" in bspec)
+apply(subst (asm) q2)
+apply (simp add: Prf_flat_L)
+apply(auto)[1]
+apply(subst q2)
+apply(rotate_tac 3)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(rotate_tac 3)
+apply(erule Prf.cases)
+apply(simp_all)
+defer
+apply(auto)[1]
+apply(simp add: POSIX2_def)
+apply(auto intro: Prf.intros)[1]
+apply(subgoal_tac "(\<exists>x1 x2. x = Seq x1 x2 \<and> flat v1 @ flat v2 = flat x1 @ flat x2)")
+apply(auto)[1]
+apply(case_tac "v1 = x1")
+apply(simp)
+apply(rule ValOrd.intros)
+apply(rotate_tac 6)
+apply(drule_tac x="x2" in bspec)
+apply(subst (asm) q2)
+apply (simp add: Sequ_def Prf_flat_L)
+
+using Prf_flat_L apply blast
+apply(auto)[1]
+apply(rotate_tac 6)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(subst q2)
+apply (simp add: Prf_flat_L)
+apply(auto)[1]
+apply(auto simp add: Sequ_def)
+using Prf_flat_L apply blast
+apply(rule ValOrd.intros)
+apply(rotate_tac 5)
+apply(drule_tac x="x1" in bspec)
+apply(rotate_tac 1)
+apply(subst (asm) q2)
+apply (simp add: Sequ_def Prf_flat_L)
+using Prf_flat_L apply blast
+apply(auto)[1]
+apply(subst q2)
+apply (simp add: Sequ_def Prf_flat_L)
+apply(auto)[1]
+apply(rotate_tac 7)
+apply(erule Prf.cases)
+apply(simp_all)
+apply (simp add: Sequ_def Prf_flat_L)
+apply(rotate_tac 7)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(auto)[1]
+apply(simp add: append_eq_append_conv2)
+apply(auto simp add: Sequ_def)[1]
+using Prf_flat_L apply fastforce
+apply(simp add: append_eq_append_conv2)
+apply(auto simp add: Sequ_def)[1]
+
+apply(auto)[1]
+
+apply(simp add: POSIX2_def)
+apply(simp add: POSIX2_def)
+apply(simp add: POSIX2_def)
+apply(simp add: POSIX2_def)
+apply(simp add: POSIX2_def)
+
+lemma "s \<in> L(r) \<Longrightarrow> \<exists>v. POSIX2 v r s"
+apply(induct r arbitrary: s)
+apply(auto)
+apply(rule_tac x="Void" in exI)
+apply(simp add: POSIX2_def)
+apply (simp add: Prf.intros(4) ValOrd.intros(7))
+apply(rule_tac x="Char x" in exI)
+apply(simp add: POSIX2_def)
+apply (simp add: Prf.intros(5) ValOrd.intros(8))
+defer
+apply(drule_tac x="s" in meta_spec)
+apply(auto)[1]
+apply(rule_tac x="Left v" in exI)
+apply(simp add: POSIX2_def)
+apply(auto)[1]
+using Prf.intros(2) apply blast
+
+apply(case_tac s)
+apply(simp)
+apply(auto)[1]
+apply (simp add: ValOrd.intros(6))
+apply(rule ValOrd.intros)
+
+thm PMatch.intros[no_vars]
+
+lemma POSIX_PMatch:
+ assumes "s \<in> r \<rightarrow> v" "v' \<in> Values r s"
+ shows "v \<succ>r v' \<or> length (flat v') < length (flat v)"
+using assms
+apply(induct r arbitrary: s v v' rule: rexp.induct)
+apply(simp_all add: Values_recs)
+apply(erule PMatch.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(7))
+apply(erule PMatch.cases)
+apply(simp_all)[5]
+apply(simp add: prefix_def)
+apply (metis ValOrd.intros(8))
+apply(auto)[1]
+defer
+apply(auto)[1]
+apply(erule PMatch.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(6))
+apply (metis (no_types, lifting) PMatch1(2) Prf_flat_L Values_def length_sprefix mem_Collect_eq sprefix_def)
+apply(erule PMatch.cases)
+apply(simp_all)[5]
+apply (metis (no_types, lifting) PMatch1(2) ValOrd.intros(3) Values_def length_sprefix mem_Collect_eq order_refl sprefix_def)
+apply (metis ValOrd.intros(5))
+apply(erule PMatch.cases)
+apply(simp_all)[5]
+apply(auto)
+apply(case_tac "v1a = v1")
+apply(simp)
+apply(rule ValOrd.intros(1))
+apply (metis PMatch1(2) append_Nil comm_monoid_diff_class.diff_cancel drop_0 drop_all drop_append order_refl rest_def)
+apply(rule ValOrd.intros(2))
+apply(auto)
+apply(drule_tac x="s1" in meta_spec)
+apply(drule_tac x="v1a" in meta_spec)
+apply(drule_tac x="v1" in meta_spec)
+apply(auto)
+apply(drule meta_mp)
+defer
+apply(auto)[1]
+apply(frule PMatch1)
+apply(drule PMatch1(2))
+apply(frule PMatch1)
+apply(drule PMatch1(2))
+apply(auto)[1]
+apply(simp add: Values_def)
+apply(simp add: prefix_def)
+apply(auto)[1]
+apply(simp add: append_eq_append_conv2)
+apply(auto)[1]
+apply(rotate_tac 10)
+apply(drule sym)
+apply(simp)
+apply(simp add: rest_def)
+apply(case_tac "s3a = []")
+apply(auto)[1]
+
+
+apply (metis ValOrd.intros(6))
+apply (metis (no_types, lifting) PMatch1(2) ValOrd.intros(3) Values_def length_sprefix mem_Collect_eq order_refl sprefix_def)
+apply(auto)[1]
+apply (metis (no_types, lifting) PMatch1(2) Prf_flat_L Values_def length_sprefix mem_Collect_eq sprefix_def)
+apply (metis ValOrd.intros(5))
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule PMatch.cases)
+apply(simp_all)[5]
+defer
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule PMatch.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(simp add: L_flat_Prf)
+
+apply(clarify)
+apply (metis ValOrd.intros(8))
+apply (metis POSIX_ALT_I1)
+apply(rule POSIX_ALT_I2)
+apply(simp)
+apply(auto)[1]
+apply(simp add: POSIX_def)
+apply(frule PMatch1(1))
+apply(frule PMatch1(2))
+apply(simp)
+
+
+lemma POSIX_PMatch:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "POSIX v r"
+using assms
+apply(induct arbitrary: rule: PMatch.induct)
+apply(auto)
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply (metis Prf.intros(4))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(7))
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply (metis Prf.intros(5))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(8))
+apply (metis POSIX_ALT_I1)
+apply(rule POSIX_ALT_I2)
+apply(simp)
+apply(auto)[1]
+apply(simp add: POSIX_def)
+apply(frule PMatch1(1))
+apply(frule PMatch1(2))
+apply(simp)
+
+
+
+lemma ValOrd_PMatch:
+ assumes "s \<in> r \<rightarrow> v1" "\<turnstile> v2 : r" "flat v2 = s"
+ shows "v1 \<succ>r v2"
+using assms
+apply(induct arbitrary: v2 rule: PMatch.induct)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(7))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(8))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply (metis ValOrd.intros(6))
+apply(clarify)
+apply (metis PMatch1(2) ValOrd.intros(3) order_refl)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply (metis Prf_flat_L)
+apply (metis ValOrd.intros(5))
+(* Seq case *)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)
+apply(case_tac "v1 = v1a")
+apply(auto)
+apply (metis PMatch1(2) ValOrd.intros(1) same_append_eq)
+apply(rule ValOrd.intros(2))
+apply(auto)
+apply(drule_tac x="v1a" in meta_spec)
+apply(drule_tac meta_mp)
+apply(simp)
+apply(drule_tac meta_mp)
+prefer 2
+apply(simp)
+apply(simp add: append_eq_append_conv2)
+apply(auto)
+apply (metis Prf_flat_L)
+apply(case_tac "us = []")
+apply(simp)
+apply(drule_tac x="us" in spec)
+apply(drule mp)
+
+thm L_flat_Prf
+apply(simp add: L_flat_Prf)
+thm append_eq_append_conv2
+apply(simp add: append_eq_append_conv2)
+apply(auto)
+apply(drule_tac x="us" in spec)
+apply(drule mp)
+apply metis
+apply (metis append_Nil2)
+apply(case_tac "us = []")
+apply(auto)
+apply(drule_tac x="s2" in spec)
+apply(drule mp)
+
+apply(auto)[1]
+apply(drule_tac x="v1a" in meta_spec)
+apply(simp)
+
+lemma refl_on_ValOrd:
+ "refl_on (Values r s) {(v1, v2). v1 \<succ>r v2 \<and> v1 \<in> Values r s \<and> v2 \<in> Values r s}"
+unfolding refl_on_def
+apply(auto)
+apply(rule ValOrd_refl)
+apply(simp add: Values_def)
+done
+
+
+section {* Posix definition *}
+
+definition POSIX :: "val \<Rightarrow> rexp \<Rightarrow> bool"
+where
+ "POSIX v r \<equiv> (\<turnstile> v : r \<and> (\<forall>v'. (\<turnstile> v' : r \<and> flat v = flat v') \<longrightarrow> v \<succ>r v'))"
+
+definition POSIX2 :: "val \<Rightarrow> rexp \<Rightarrow> bool"
+where
+ "POSIX2 v r \<equiv> (\<turnstile> v : r \<and> (\<forall>v'. (\<turnstile> v' : r \<and> flat v = flat v') \<longrightarrow> v 2\<succ> v'))"
+
+lemma "POSIX v r = POSIX2 v r"
+unfolding POSIX_def POSIX2_def
+apply(auto)
+apply(rule Ord1)
+apply(auto)
+apply(rule Ord3)
+apply(auto)
+done
+
+section {* POSIX for some constructors *}
+
+lemma POSIX_SEQ1:
+ assumes "POSIX (Seq v1 v2) (SEQ r1 r2)" "\<turnstile> v1 : r1" "\<turnstile> v2 : r2"
+ shows "POSIX v1 r1"
+using assms
+unfolding POSIX_def
+apply(auto)
+apply(drule_tac x="Seq v' v2" in spec)
+apply(simp)
+apply(erule impE)
+apply(rule Prf.intros)
+apply(simp)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(clarify)
+by (metis ValOrd_refl)
+
+lemma POSIX_SEQ2:
+ assumes "POSIX (Seq v1 v2) (SEQ r1 r2)" "\<turnstile> v1 : r1" "\<turnstile> v2 : r2"
+ shows "POSIX v2 r2"
+using assms
+unfolding POSIX_def
+apply(auto)
+apply(drule_tac x="Seq v1 v'" in spec)
+apply(simp)
+apply(erule impE)
+apply(rule Prf.intros)
+apply(simp)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)
+done
+
+lemma POSIX_ALT2:
+ assumes "POSIX (Left v1) (ALT r1 r2)"
+ shows "POSIX v1 r1"
+using assms
+unfolding POSIX_def
+apply(auto)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(drule_tac x="Left v'" in spec)
+apply(simp)
+apply(drule mp)
+apply(rule Prf.intros)
+apply(auto)
+apply(erule ValOrd.cases)
+apply(simp_all)
+done
+
+lemma POSIX_ALT1a:
+ assumes "POSIX (Right v2) (ALT r1 r2)"
+ shows "POSIX v2 r2"
+using assms
+unfolding POSIX_def
+apply(auto)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(drule_tac x="Right v'" in spec)
+apply(simp)
+apply(drule mp)
+apply(rule Prf.intros)
+apply(auto)
+apply(erule ValOrd.cases)
+apply(simp_all)
+done
+
+lemma POSIX_ALT1b:
+ assumes "POSIX (Right v2) (ALT r1 r2)"
+ shows "(\<forall>v'. (\<turnstile> v' : r2 \<and> flat v' = flat v2) \<longrightarrow> v2 \<succ>r2 v')"
+using assms
+apply(drule_tac POSIX_ALT1a)
+unfolding POSIX_def
+apply(auto)
+done
+
+lemma POSIX_ALT_I1:
+ assumes "POSIX v1 r1"
+ shows "POSIX (Left v1) (ALT r1 r2)"
+using assms
+unfolding POSIX_def
+apply(auto)
+apply (metis Prf.intros(2))
+apply(rotate_tac 2)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)
+apply(rule ValOrd.intros)
+apply(auto)
+apply(rule ValOrd.intros)
+by simp
+
+lemma POSIX_ALT_I2:
+ assumes "POSIX v2 r2" "\<forall>v'. \<turnstile> v' : r1 \<longrightarrow> length (flat v2) > length (flat v')"
+ shows "POSIX (Right v2) (ALT r1 r2)"
+using assms
+unfolding POSIX_def
+apply(auto)
+apply (metis Prf.intros)
+apply(rotate_tac 3)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)
+apply(rule ValOrd.intros)
+apply metis
+done
+
+lemma mkeps_POSIX:
+ assumes "nullable r"
+ shows "POSIX (mkeps r) r"
+using assms
+apply(induct r)
+apply(auto)[1]
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply (metis Prf.intros(4))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros)
+apply(simp)
+apply(auto)[1]
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply (metis mkeps.simps(2) mkeps_nullable nullable.simps(5))
+apply(rotate_tac 6)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (simp add: mkeps_flat)
+apply(case_tac "mkeps r1a = v1")
+apply(simp)
+apply (metis ValOrd.intros(1))
+apply (rule ValOrd.intros(2))
+apply metis
+apply(simp)
+(* ALT case *)
+thm mkeps.simps
+apply(simp)
+apply(erule disjE)
+apply(simp)
+apply (metis POSIX_ALT_I1)
+(* *)
+apply(auto)[1]
+thm POSIX_ALT_I1
+apply (metis POSIX_ALT_I1)
+apply(simp (no_asm) add: POSIX_def)
+apply(auto)[1]
+apply(rule Prf.intros(3))
+apply(simp only: POSIX_def)
+apply(rotate_tac 4)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+thm mkeps_flat
+apply(simp add: mkeps_flat)
+apply(auto)[1]
+thm Prf_flat_L nullable_correctness
+apply (metis Prf_flat_L nullable_correctness)
+apply(rule ValOrd.intros)
+apply(subst (asm) POSIX_def)
+apply(clarify)
+apply(drule_tac x="v2" in spec)
+by simp
+
+
+
+text {*
+ Injection value is related to r
+*}
+
+
+
+text {*
+ The string behind the injection value is an added c
+*}
+
+
+lemma injval_inj: "inj_on (injval r c) {v. \<turnstile> v : der c r}"
+apply(induct c r rule: der.induct)
+unfolding inj_on_def
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply (metis list.distinct(1) mkeps_flat v4)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(rotate_tac 6)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis list.distinct(1) mkeps_flat v4)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+done
+
+lemma Values_nullable:
+ assumes "nullable r1"
+ shows "mkeps r1 \<in> Values r1 s"
+using assms
+apply(induct r1 arbitrary: s)
+apply(simp_all)
+apply(simp add: Values_recs)
+apply(simp add: Values_recs)
+apply(simp add: Values_recs)
+apply(auto)[1]
+done
+
+lemma Values_injval:
+ assumes "v \<in> Values (der c r) s"
+ shows "injval r c v \<in> Values r (c#s)"
+using assms
+apply(induct c r arbitrary: v s rule: der.induct)
+apply(simp add: Values_recs)
+apply(simp add: Values_recs)
+apply(case_tac "c = c'")
+apply(simp)
+apply(simp add: Values_recs)
+apply(simp add: prefix_def)
+apply(simp)
+apply(simp add: Values_recs)
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(case_tac "nullable r1")
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(simp add: rest_def)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(simp add: Values_def)
+apply(rule Values_nullable)
+apply(assumption)
+apply(simp add: rest_def)
+apply(subst mkeps_flat)
+apply(assumption)
+apply(simp)
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(simp add: rest_def)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(simp add: Values_def)
+done
+
+lemma Values_projval:
+ assumes "v \<in> Values r (c#s)" "\<exists>s. flat v = c # s"
+ shows "projval r c v \<in> Values (der c r) s"
+using assms
+apply(induct r arbitrary: v s c rule: rexp.induct)
+apply(simp add: Values_recs)
+apply(simp add: Values_recs)
+apply(case_tac "c = char")
+apply(simp)
+apply(simp add: Values_recs)
+apply(simp)
+apply(simp add: Values_recs)
+apply(simp add: prefix_def)
+apply(case_tac "nullable rexp1")
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(simp add: rest_def)
+apply (metis hd_Cons_tl hd_append2 list.sel(1))
+apply(simp add: rest_def)
+apply(simp add: append_eq_Cons_conv)
+apply(auto)[1]
+apply(subst v4_proj2)
+apply(simp add: Values_def)
+apply(assumption)
+apply(simp)
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(auto simp add: Values_def not_nullable_flat)[1]
+apply(simp add: append_eq_Cons_conv)
+apply(auto)[1]
+apply(simp add: append_eq_Cons_conv)
+apply(auto)[1]
+apply(simp add: rest_def)
+apply(subst v4_proj2)
+apply(simp add: Values_def)
+apply(assumption)
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+done
+
+
+definition "MValue v r s \<equiv> (v \<in> Values r s \<and> (\<forall>v' \<in> Values r s. v 2\<succ> v'))"
+
+lemma MValue_ALTE:
+ assumes "MValue v (ALT r1 r2) s"
+ shows "(\<exists>vl. v = Left vl \<and> MValue vl r1 s \<and> (\<forall>vr \<in> Values r2 s. length (flat vr) \<le> length (flat vl))) \<or>
+ (\<exists>vr. v = Right vr \<and> MValue vr r2 s \<and> (\<forall>vl \<in> Values r1 s. length (flat vl) < length (flat vr)))"
+using assms
+apply(simp add: MValue_def)
+apply(simp add: Values_recs)
+apply(auto)
+apply(drule_tac x="Left x" in bspec)
+apply(simp)
+apply(erule ValOrd2.cases)
+apply(simp_all)
+apply(drule_tac x="Right vr" in bspec)
+apply(simp)
+apply(erule ValOrd2.cases)
+apply(simp_all)
+apply(drule_tac x="Right x" in bspec)
+apply(simp)
+apply(erule ValOrd2.cases)
+apply(simp_all)
+apply(drule_tac x="Left vl" in bspec)
+apply(simp)
+apply(erule ValOrd2.cases)
+apply(simp_all)
+done
+
+lemma MValue_ALTI1:
+ assumes "MValue vl r1 s" "\<forall>vr \<in> Values r2 s. length (flat vr) \<le> length (flat vl)"
+ shows "MValue (Left vl) (ALT r1 r2) s"
+using assms
+apply(simp add: MValue_def)
+apply(simp add: Values_recs)
+apply(auto)
+apply(rule ValOrd2.intros)
+apply metis
+apply(rule ValOrd2.intros)
+apply metis
+done
+
+lemma MValue_ALTI2:
+ assumes "MValue vr r2 s" "\<forall>vl \<in> Values r1 s. length (flat vl) < length (flat vr)"
+ shows "MValue (Right vr) (ALT r1 r2) s"
+using assms
+apply(simp add: MValue_def)
+apply(simp add: Values_recs)
+apply(auto)
+apply(rule ValOrd2.intros)
+apply metis
+apply(rule ValOrd2.intros)
+apply metis
+done
+
+lemma t: "(c#xs = c#ys) \<Longrightarrow> xs = ys"
+by (metis list.sel(3))
+
+lemma t2: "(xs = ys) \<Longrightarrow> (c#xs) = (c#ys)"
+by (metis)
+
+lemma "\<not>(nullable r) \<Longrightarrow> \<not>(\<exists>v. \<turnstile> v : r \<and> flat v = [])"
+by (metis Prf_flat_L nullable_correctness)
+
+
+lemma LeftRight:
+ assumes "(Left v1) \<succ>(der c (ALT r1 r2)) (Right v2)"
+ and "\<turnstile> v1 : der c r1" "\<turnstile> v2 : der c r2"
+ shows "(injval (ALT r1 r2) c (Left v1)) \<succ>(ALT r1 r2) (injval (ALT r1 r2) c (Right v2))"
+using assms
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd.intros)
+apply(clarify)
+apply(subst v4)
+apply(simp)
+apply(subst v4)
+apply(simp)
+apply(simp)
+done
+
+lemma RightLeft:
+ assumes "(Right v1) \<succ>(der c (ALT r1 r2)) (Left v2)"
+ and "\<turnstile> v1 : der c r2" "\<turnstile> v2 : der c r1"
+ shows "(injval (ALT r1 r2) c (Right v1)) \<succ>(ALT r1 r2) (injval (ALT r1 r2) c (Left v2))"
+using assms
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd.intros)
+apply(clarify)
+apply(subst v4)
+apply(simp)
+apply(subst v4)
+apply(simp)
+apply(simp)
+done
+
+lemma h:
+ assumes "nullable r1" "\<turnstile> v1 : der c r1"
+ shows "injval r1 c v1 \<succ>r1 mkeps r1"
+using assms
+apply(induct r1 arbitrary: v1 rule: der.induct)
+apply(simp)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(auto)[1]
+apply (metis ValOrd.intros(6))
+apply (metis ValOrd.intros(6))
+apply (metis ValOrd.intros(3) le_add2 list.size(3) mkeps_flat monoid_add_class.add.right_neutral)
+apply(auto)[1]
+apply (metis ValOrd.intros(4) length_greater_0_conv list.distinct(1) list.size(3) mkeps_flat v4)
+apply (metis ValOrd.intros(4) length_greater_0_conv list.distinct(1) list.size(3) mkeps_flat v4)
+apply (metis ValOrd.intros(5))
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply (metis ValOrd.intros(2) list.distinct(1) mkeps_flat v4)
+apply(clarify)
+by (metis ValOrd.intros(1))
+
+lemma LeftRightSeq:
+ assumes "(Left (Seq v1 v2)) \<succ>(der c (SEQ r1 r2)) (Right v3)"
+ and "nullable r1" "\<turnstile> v1 : der c r1"
+ shows "(injval (SEQ r1 r2) c (Seq v1 v2)) \<succ>(SEQ r1 r2) (injval (SEQ r1 r2) c (Right v2))"
+using assms
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply(simp)
+apply(rule ValOrd.intros(2))
+prefer 2
+apply (metis list.distinct(1) mkeps_flat v4)
+by (metis h)
+
+lemma rr1:
+ assumes "\<turnstile> v : r" "\<not>nullable r"
+ shows "flat v \<noteq> []"
+using assms
+by (metis Prf_flat_L nullable_correctness)
+
+(* HERE *)
+
+lemma Prf_inj_test:
+ assumes "v1 \<succ>(der c r) v2"
+ "v1 \<in> Values (der c r) s"
+ "v2 \<in> Values (der c r) s"
+ "injval r c v1 \<in> Values r (c#s)"
+ "injval r c v2 \<in> Values r (c#s)"
+ shows "(injval r c v1) 2\<succ> (injval r c v2)"
+using assms
+apply(induct c r arbitrary: v1 v2 s rule: der.induct)
+(* NULL case *)
+apply(simp add: Values_recs)
+(* EMPTY case *)
+apply(simp add: Values_recs)
+(* CHAR case *)
+apply(case_tac "c = c'")
+apply(simp)
+apply(simp add: Values_recs)
+apply (metis ValOrd2.intros(8))
+apply(simp add: Values_recs)
+(* ALT case *)
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply (metis ValOrd2.intros(6))
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd2.intros)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd2.intros)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply (metis ValOrd2.intros(5))
+(* SEQ case*)
+apply(simp)
+apply(case_tac "nullable r1")
+apply(simp)
+defer
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply(rule ValOrd2.intros)
+apply(simp)
+apply (metis Ord1)
+apply(clarify)
+apply(rule ValOrd2.intros)
+apply(subgoal_tac "rest v1 (flat v1 @ flat v2) = flat v2")
+apply(simp)
+apply(subgoal_tac "rest (injval r1 c v1) (c # flat v1 @ flat v2) = flat v2")
+apply(simp)
+oops
+
+lemma Prf_inj_test:
+ assumes "v1 \<succ>(der c r) v2"
+ "v1 \<in> Values (der c r) s"
+ "v2 \<in> Values (der c r) s"
+ "injval r c v1 \<in> Values r (c#s)"
+ "injval r c v2 \<in> Values r (c#s)"
+ shows "(injval r c v1) 2\<succ> (injval r c v2)"
+using assms
+apply(induct c r arbitrary: v1 v2 s rule: der.induct)
+(* NULL case *)
+apply(simp add: Values_recs)
+(* EMPTY case *)
+apply(simp add: Values_recs)
+(* CHAR case *)
+apply(case_tac "c = c'")
+apply(simp)
+apply(simp add: Values_recs)
+apply (metis ValOrd2.intros(8))
+apply(simp add: Values_recs)
+(* ALT case *)
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply (metis ValOrd2.intros(6))
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd2.intros)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd2.intros)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply (metis ValOrd2.intros(5))
+(* SEQ case*)
+apply(simp)
+apply(case_tac "nullable r1")
+apply(simp)
+defer
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply(rule ValOrd2.intros)
+apply(simp)
+apply (metis Ord1)
+apply(clarify)
+apply(rule ValOrd2.intros)
+apply metis
+using injval_inj
+apply(simp add: Values_def inj_on_def)
+apply metis
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply (metis Ord1 ValOrd2.intros(1))
+apply(clarify)
+apply(rule ValOrd2.intros(2))
+apply metis
+using injval_inj
+apply(simp add: Values_def inj_on_def)
+apply metis
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd2.intros(2))
+thm h
+apply(rule Ord1)
+apply(rule h)
+apply(simp)
+apply(simp add: Values_def)
+apply(simp add: Values_def)
+apply (metis list.distinct(1) mkeps_flat v4)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply(simp add: Values_def)
+defer
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply(rule ValOrd2.intros(1))
+apply(rotate_tac 1)
+apply(drule_tac x="v2" in meta_spec)
+apply(rotate_tac 8)
+apply(drule_tac x="v2'" in meta_spec)
+apply(rotate_tac 8)
+oops
+
+lemma POSIX_der:
+ assumes "POSIX v (der c r)" "\<turnstile> v : der c r"
+ shows "POSIX (injval r c v) r"
+using assms
+unfolding POSIX_def
+apply(auto)
+thm v3
+apply (erule v3)
+thm v4
+apply(subst (asm) v4)
+apply(assumption)
+apply(drule_tac x="projval r c v'" in spec)
+apply(drule mp)
+apply(rule conjI)
+thm v3_proj
+apply(rule v3_proj)
+apply(simp)
+apply(rule_tac x="flat v" in exI)
+apply(simp)
+thm t
+apply(rule_tac c="c" in t)
+apply(simp)
+thm v4_proj
+apply(subst v4_proj)
+apply(simp)
+apply(rule_tac x="flat v" in exI)
+apply(simp)
+apply(simp)
+oops
+
+lemma POSIX_der:
+ assumes "POSIX v (der c r)" "\<turnstile> v : der c r"
+ shows "POSIX (injval r c v) r"
+using assms
+apply(induct c r arbitrary: v rule: der.induct)
+(* null case*)
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+(* empty case *)
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+(* char case *)
+apply(simp add: POSIX_def)
+apply(case_tac "c = c'")
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis Prf.intros(5))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(8))
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+(* alt case *)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(simp (no_asm) add: POSIX_def)
+apply(auto)[1]
+apply (metis Prf.intros(2) v3)
+apply(rotate_tac 4)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis POSIX_ALT2 POSIX_def ValOrd.intros(6))
+apply (metis ValOrd.intros(3) order_refl)
+apply(simp (no_asm) add: POSIX_def)
+apply(auto)[1]
+apply (metis Prf.intros(3) v3)
+apply(rotate_tac 4)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+defer
+apply (metis POSIX_ALT1a POSIX_def ValOrd.intros(5))
+prefer 2
+apply(subst (asm) (5) POSIX_def)
+apply(auto)[1]
+apply(rotate_tac 5)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rule ValOrd.intros)
+apply(subst (asm) v4)
+apply(simp)
+apply(drule_tac x="Left (projval r1a c v1)" in spec)
+apply(clarify)
+apply(drule mp)
+apply(rule conjI)
+apply (metis Prf.intros(2) v3_proj)
+apply(simp)
+apply (metis v4_proj2)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply (metis less_not_refl v4_proj2)
+(* seq case *)
+apply(case_tac "nullable r1")
+defer
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis Prf.intros(1) v3)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(subst (asm) (3) v4)
+apply(simp)
+apply(simp)
+apply(subgoal_tac "flat v1a \<noteq> []")
+prefer 2
+apply (metis Prf_flat_L nullable_correctness)
+apply(subgoal_tac "\<exists>s. flat v1a = c # s")
+prefer 2
+apply (metis append_eq_Cons_conv)
+apply(auto)[1]
+oops
+
+
+lemma POSIX_ex: "\<turnstile> v : r \<Longrightarrow> \<exists>v. POSIX v r"
+apply(induct r arbitrary: v)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rule_tac x="Void" in exI)
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply (metis Prf.intros(4))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(7))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rule_tac x="Char c" in exI)
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply (metis Prf.intros(5))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(8))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply(drule_tac x="v1" in meta_spec)
+apply(drule_tac x="v2" in meta_spec)
+apply(auto)[1]
+defer
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply (metis POSIX_ALT_I1)
+apply (metis POSIX_ALT_I1 POSIX_ALT_I2)
+apply(case_tac "nullable r1a")
+apply(rule_tac x="Seq (mkeps r1a) va" in exI)
+apply(auto simp add: POSIX_def)[1]
+apply (metis Prf.intros(1) mkeps_nullable)
+apply(simp add: mkeps_flat)
+apply(rotate_tac 7)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(case_tac "mkeps r1 = v1a")
+apply(simp)
+apply (rule ValOrd.intros(1))
+apply (metis append_Nil mkeps_flat)
+apply (rule ValOrd.intros(2))
+apply(drule mkeps_POSIX)
+apply(simp add: POSIX_def)
+oops
+
+lemma POSIX_ex2: "\<turnstile> v : r \<Longrightarrow> \<exists>v. POSIX v r \<and> \<turnstile> v : r"
+apply(induct r arbitrary: v)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rule_tac x="Void" in exI)
+apply(simp add: POSIX_def)
+apply(auto)[1]
+oops
+
+lemma POSIX_ALT_cases:
+ assumes "\<turnstile> v : (ALT r1 r2)" "POSIX v (ALT r1 r2)"
+ shows "(\<exists>v1. v = Left v1 \<and> POSIX v1 r1) \<or> (\<exists>v2. v = Right v2 \<and> POSIX v2 r2)"
+using assms
+apply(erule_tac Prf.cases)
+apply(simp_all)
+unfolding POSIX_def
+apply(auto)
+apply (metis POSIX_ALT2 POSIX_def assms(2))
+by (metis POSIX_ALT1b assms(2))
+
+lemma POSIX_ALT_cases2:
+ assumes "POSIX v (ALT r1 r2)" "\<turnstile> v : (ALT r1 r2)"
+ shows "(\<exists>v1. v = Left v1 \<and> POSIX v1 r1) \<or> (\<exists>v2. v = Right v2 \<and> POSIX v2 r2)"
+using assms POSIX_ALT_cases by auto
+
+lemma Prf_flat_empty:
+ assumes "\<turnstile> v : r" "flat v = []"
+ shows "nullable r"
+using assms
+apply(induct)
+apply(auto)
+done
+
+lemma POSIX_proj:
+ assumes "POSIX v r" "\<turnstile> v : r" "\<exists>s. flat v = c#s"
+ shows "POSIX (projval r c v) (der c r)"
+using assms
+apply(induct r c v arbitrary: rule: projval.induct)
+defer
+defer
+defer
+defer
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+oops
+
+lemma POSIX_proj:
+ assumes "POSIX v r" "\<turnstile> v : r" "\<exists>s. flat v = c#s"
+ shows "POSIX (projval r c v) (der c r)"
+using assms
+apply(induct r arbitrary: c v rule: rexp.induct)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+oops
+
+lemma POSIX_proj:
+ assumes "POSIX v r" "\<turnstile> v : r" "\<exists>s. flat v = c#s"
+ shows "POSIX (projval r c v) (der c r)"
+using assms
+apply(induct r c v arbitrary: rule: projval.induct)
+defer
+defer
+defer
+defer
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+oops
+
+lemma Prf_inj:
+ assumes "v1 \<succ>(der c r) v2" "\<turnstile> v1 : der c r" "\<turnstile> v2 : der c r" "flat v1 = flat v2"
+ shows "(injval r c v1) \<succ>r (injval r c v2)"
+using assms
+apply(induct arbitrary: v1 v2 rule: der.induct)
+(* NULL case *)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+(* EMPTY case *)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+(* CHAR case *)
+apply(case_tac "c = c'")
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd.intros)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+(* ALT case *)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd.intros)
+apply(subst v4)
+apply(clarify)
+apply(rotate_tac 3)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(subst v4)
+apply(clarify)
+apply(rotate_tac 2)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(rule ValOrd.intros)
+apply(clarify)
+apply(rotate_tac 3)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rule ValOrd.intros)
+apply(clarify)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+(* SEQ case*)
+apply(simp)
+apply(case_tac "nullable r1")
+defer
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(rule ValOrd.intros)
+apply(simp)
+oops
+
+
+text {*
+ Injection followed by projection is the identity.
+*}
+
+lemma proj_inj_id:
+ assumes "\<turnstile> v : der c r"
+ shows "projval r c (injval r c v) = v"
+using assms
+apply(induct r arbitrary: c v rule: rexp.induct)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(case_tac "c = char")
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+defer
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(case_tac "nullable rexp1")
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply (metis list.distinct(1) v4)
+apply(auto)[1]
+apply (metis mkeps_flat)
+apply(auto)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply(simp add: v4)
+done
+
+text {*
+
+ HERE: Crucial lemma that does not go through in the sequence case.
+
+*}
+lemma v5:
+ assumes "\<turnstile> v : der c r" "POSIX v (der c r)"
+ shows "POSIX (injval r c v) r"
+using assms
+apply(induct arbitrary: v rule: der.induct)
+(* NULL case *)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+(* EMPTY case *)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+(* CHAR case *)
+apply(simp)
+apply(case_tac "c = c'")
+apply(auto simp add: POSIX_def)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+oops
\ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys2/Re1.thy Sun Oct 10 18:35:21 2021 +0100
@@ -0,0 +1,3622 @@
+
+theory Re1
+ imports "Main"
+begin
+
+
+section {* Sequential Composition of Sets *}
+
+definition
+ Sequ :: "string set \<Rightarrow> string set \<Rightarrow> string set" ("_ ;; _" [100,100] 100)
+where
+ "A ;; B = {s1 @ s2 | s1 s2. s1 \<in> A \<and> s2 \<in> B}"
+
+text {* Two Simple Properties about Sequential Composition *}
+
+lemma seq_empty [simp]:
+ shows "A ;; {[]} = A"
+ and "{[]} ;; A = A"
+by (simp_all add: Sequ_def)
+
+lemma seq_null [simp]:
+ shows "A ;; {} = {}"
+ and "{} ;; A = {}"
+by (simp_all add: Sequ_def)
+
+section {* Regular Expressions *}
+
+datatype rexp =
+ NULL
+| EMPTY
+| CHAR char
+| SEQ rexp rexp
+| ALT rexp rexp
+
+fun SEQS :: "rexp \<Rightarrow> rexp list \<Rightarrow> rexp"
+where
+ "SEQS r [] = r"
+| "SEQS r (r'#rs) = SEQ r (SEQS r' rs)"
+
+section {* Semantics of Regular Expressions *}
+
+fun
+ L :: "rexp \<Rightarrow> string set"
+where
+ "L (NULL) = {}"
+| "L (EMPTY) = {[]}"
+| "L (CHAR c) = {[c]}"
+| "L (SEQ r1 r2) = (L r1) ;; (L r2)"
+| "L (ALT r1 r2) = (L r1) \<union> (L r2)"
+
+fun zeroable where
+ "zeroable NULL = True"
+| "zeroable EMPTY = False"
+| "zeroable (CHAR c) = False"
+| "zeroable (ALT r1 r2) = (zeroable r1 \<and> zeroable r2)"
+| "zeroable (SEQ r1 r2) = (zeroable r1 \<or> zeroable r2)"
+
+lemma L_ALT_cases:
+ "L (ALT r1 r2) \<noteq> {} \<Longrightarrow> (L r1 \<noteq> {}) \<or> (L r1 = {} \<and> L r2 \<noteq> {})"
+by(auto)
+
+fun
+ nullable :: "rexp \<Rightarrow> bool"
+where
+ "nullable (NULL) = False"
+| "nullable (EMPTY) = True"
+| "nullable (CHAR c) = False"
+| "nullable (ALT r1 r2) = (nullable r1 \<or> nullable r2)"
+| "nullable (SEQ r1 r2) = (nullable r1 \<and> nullable r2)"
+
+lemma nullable_correctness:
+ shows "nullable r \<longleftrightarrow> [] \<in> (L r)"
+apply (induct r)
+apply(auto simp add: Sequ_def)
+done
+
+section {* Values *}
+
+datatype val =
+ Void
+| Char char
+| Seq val val
+| Right val
+| Left val
+
+
+fun Seqs :: "val \<Rightarrow> val list \<Rightarrow> val"
+where
+ "Seqs v [] = v"
+| "Seqs v (v'#vs) = Seqs (Seq v v') vs"
+
+section {* The string behind a value *}
+
+fun flat :: "val \<Rightarrow> string"
+where
+ "flat(Void) = []"
+| "flat(Char c) = [c]"
+| "flat(Left v) = flat(v)"
+| "flat(Right v) = flat(v)"
+| "flat(Seq v1 v2) = flat(v1) @ flat(v2)"
+
+fun flats :: "val \<Rightarrow> string list"
+where
+ "flats(Void) = [[]]"
+| "flats(Char c) = [[c]]"
+| "flats(Left v) = flats(v)"
+| "flats(Right v) = flats(v)"
+| "flats(Seq v1 v2) = (flats v1) @ (flats v2)"
+
+value "flats(Seq(Char c)(Char b))"
+
+section {* Relation between values and regular expressions *}
+
+
+inductive Prfs :: "string \<Rightarrow> val \<Rightarrow> rexp \<Rightarrow> bool" ("\<Turnstile>_ _ : _" [100, 100, 100] 100)
+where
+ "\<lbrakk>\<Turnstile>s1 v1 : r1; \<Turnstile>s2 v2 : r2\<rbrakk> \<Longrightarrow> \<Turnstile>(s1 @ s2) (Seq v1 v2) : SEQ r1 r2"
+| "\<Turnstile>s v1 : r1 \<Longrightarrow> \<Turnstile>s (Left v1) : ALT r1 r2"
+| "\<Turnstile>s v2 : r2 \<Longrightarrow> \<Turnstile>s (Right v2) : ALT r1 r2"
+| "\<Turnstile>[] Void : EMPTY"
+| "\<Turnstile>[c] (Char c) : CHAR c"
+
+lemma Prfs_flat:
+ "\<Turnstile>s v : r \<Longrightarrow> flat v = s"
+apply(induct s v r rule: Prfs.induct)
+apply(auto)
+done
+
+inductive Prfn :: "nat \<Rightarrow> val \<Rightarrow> rexp \<Rightarrow> bool" ("\<TTurnstile>_ _ : _" [100, 100, 100] 100)
+where
+ "\<lbrakk>\<TTurnstile>n1 v1 : r1; \<TTurnstile>n2 v2 : r2\<rbrakk> \<Longrightarrow> \<TTurnstile>(n1 + n2) (Seq v1 v2) : SEQ r1 r2"
+| "\<TTurnstile>n v1 : r1 \<Longrightarrow> \<TTurnstile>n (Left v1) : ALT r1 r2"
+| "\<TTurnstile>n v2 : r2 \<Longrightarrow> \<TTurnstile>n (Right v2) : ALT r1 r2"
+| "\<TTurnstile>0 Void : EMPTY"
+| "\<TTurnstile>1 (Char c) : CHAR c"
+
+lemma Prfn_flat:
+ "\<TTurnstile>n v : r \<Longrightarrow> length (flat v) = n"
+apply(induct rule: Prfn.induct)
+apply(auto)
+done
+
+inductive Prf :: "val \<Rightarrow> rexp \<Rightarrow> bool" ("\<turnstile> _ : _" [100, 100] 100)
+where
+ "\<lbrakk>\<turnstile> v1 : r1; \<turnstile> v2 : r2\<rbrakk> \<Longrightarrow> \<turnstile> Seq v1 v2 : SEQ r1 r2"
+| "\<turnstile> v1 : r1 \<Longrightarrow> \<turnstile> Left v1 : ALT r1 r2"
+| "\<turnstile> v2 : r2 \<Longrightarrow> \<turnstile> Right v2 : ALT r1 r2"
+| "\<turnstile> Void : EMPTY"
+| "\<turnstile> Char c : CHAR c"
+
+lemma Prf_Prfn:
+ shows "\<turnstile> v : r \<Longrightarrow> \<TTurnstile>(length (flat v)) v : r"
+apply(induct v r rule: Prf.induct)
+apply(auto intro: Prfn.intros)
+by (metis One_nat_def Prfn.intros(5))
+
+lemma Prfn_Prf:
+ shows "\<TTurnstile>n v : r \<Longrightarrow> \<turnstile> v : r"
+apply(induct n v r rule: Prfn.induct)
+apply(auto intro: Prf.intros)
+done
+
+lemma Prf_Prfs:
+ shows "\<turnstile> v : r \<Longrightarrow> \<Turnstile>(flat v) v : r"
+apply(induct v r rule: Prf.induct)
+apply(auto intro: Prfs.intros)
+done
+
+lemma Prfs_Prf:
+ shows "\<Turnstile>s v : r \<Longrightarrow> \<turnstile> v : r"
+apply(induct s v r rule: Prfs.induct)
+apply(auto intro: Prf.intros)
+done
+
+lemma not_nullable_flat:
+ assumes "\<turnstile> v : r" "\<not>nullable r"
+ shows "flat v \<noteq> []"
+using assms
+apply(induct)
+apply(auto)
+done
+
+
+fun mkeps :: "rexp \<Rightarrow> val"
+where
+ "mkeps(EMPTY) = Void"
+| "mkeps(SEQ r1 r2) = Seq (mkeps r1) (mkeps r2)"
+| "mkeps(ALT r1 r2) = (if nullable(r1) then Left (mkeps r1) else Right (mkeps r2))"
+
+lemma mkeps_nullable:
+ assumes "nullable(r)" shows "\<turnstile> mkeps r : r"
+using assms
+apply(induct rule: nullable.induct)
+apply(auto intro: Prf.intros)
+done
+
+lemma mkeps_nullable_n:
+ assumes "nullable(r)" shows "\<TTurnstile>0 (mkeps r) : r"
+using assms
+apply(induct rule: nullable.induct)
+apply(auto intro: Prfn.intros)
+apply(drule Prfn.intros(1))
+apply(assumption)
+apply(simp)
+done
+
+lemma mkeps_nullable_s:
+ assumes "nullable(r)" shows "\<Turnstile>[] (mkeps r) : r"
+using assms
+apply(induct rule: nullable.induct)
+apply(auto intro: Prfs.intros)
+apply(drule Prfs.intros(1))
+apply(assumption)
+apply(simp)
+done
+
+lemma mkeps_flat:
+ assumes "nullable(r)" shows "flat (mkeps r) = []"
+using assms
+apply(induct rule: nullable.induct)
+apply(auto)
+done
+
+text {*
+ The value mkeps returns is always the correct POSIX
+ value.
+*}
+
+lemma Prf_flat_L:
+ assumes "\<turnstile> v : r" shows "flat v \<in> L r"
+using assms
+apply(induct v r rule: Prf.induct)
+apply(auto simp add: Sequ_def)
+done
+
+lemma L_flat_Prf:
+ "L(r) = {flat v | v. \<turnstile> v : r}"
+apply(induct r)
+apply(auto dest: Prf_flat_L simp add: Sequ_def)
+apply (metis Prf.intros(4) flat.simps(1))
+apply (metis Prf.intros(5) flat.simps(2))
+apply (metis Prf.intros(1) flat.simps(5))
+apply (metis Prf.intros(2) flat.simps(3))
+apply (metis Prf.intros(3) flat.simps(4))
+apply(erule Prf.cases)
+apply(auto)
+done
+
+
+definition prefix :: "string \<Rightarrow> string \<Rightarrow> bool" ("_ \<sqsubseteq> _" [100, 100] 100)
+where
+ "s1 \<sqsubseteq> s2 \<equiv> \<exists>s3. s1 @ s3 = s2"
+
+definition sprefix :: "string \<Rightarrow> string \<Rightarrow> bool" ("_ \<sqsubset> _" [100, 100] 100)
+where
+ "s1 \<sqsubset> s2 \<equiv> (s1 \<sqsubseteq> s2 \<and> s1 \<noteq> s2)"
+
+lemma length_sprefix:
+ "s1 \<sqsubset> s2 \<Longrightarrow> length s1 < length s2"
+unfolding sprefix_def prefix_def
+by (auto)
+
+definition Prefixes :: "string \<Rightarrow> string set" where
+ "Prefixes s \<equiv> {sp. sp \<sqsubseteq> s}"
+
+definition Suffixes :: "string \<Rightarrow> string set" where
+ "Suffixes s \<equiv> rev ` (Prefixes (rev s))"
+
+lemma Suffixes_in:
+ "\<exists>s1. s1 @ s2 = s3 \<Longrightarrow> s2 \<in> Suffixes s3"
+unfolding Suffixes_def Prefixes_def prefix_def image_def
+apply(auto)
+by (metis rev_rev_ident)
+
+lemma Prefixes_Cons:
+ "Prefixes (c # s) = {[]} \<union> {c # sp | sp. sp \<in> Prefixes s}"
+unfolding Prefixes_def prefix_def
+apply(auto simp add: append_eq_Cons_conv)
+done
+
+lemma finite_Prefixes:
+ "finite (Prefixes s)"
+apply(induct s)
+apply(auto simp add: Prefixes_def prefix_def)[1]
+apply(simp add: Prefixes_Cons)
+done
+
+lemma finite_Suffixes:
+ "finite (Suffixes s)"
+unfolding Suffixes_def
+apply(rule finite_imageI)
+apply(rule finite_Prefixes)
+done
+
+lemma prefix_Cons:
+ "((c # s1) \<sqsubseteq> (c # s2)) = (s1 \<sqsubseteq> s2)"
+apply(auto simp add: prefix_def)
+done
+
+lemma prefix_append:
+ "((s @ s1) \<sqsubseteq> (s @ s2)) = (s1 \<sqsubseteq> s2)"
+apply(induct s)
+apply(simp)
+apply(simp add: prefix_Cons)
+done
+
+
+
+definition Values :: "rexp \<Rightarrow> string \<Rightarrow> val set" where
+ "Values r s \<equiv> {v. \<turnstile> v : r \<and> flat v \<sqsubseteq> s}"
+
+definition rest :: "val \<Rightarrow> string \<Rightarrow> string" where
+ "rest v s \<equiv> drop (length (flat v)) s"
+
+lemma rest_Suffixes:
+ "rest v s \<in> Suffixes s"
+unfolding rest_def
+by (metis Suffixes_in append_take_drop_id)
+
+
+lemma Values_recs:
+ "Values (NULL) s = {}"
+ "Values (EMPTY) s = {Void}"
+ "Values (CHAR c) s = (if [c] \<sqsubseteq> s then {Char c} else {})"
+ "Values (ALT r1 r2) s = {Left v | v. v \<in> Values r1 s} \<union> {Right v | v. v \<in> Values r2 s}"
+ "Values (SEQ r1 r2) s = {Seq v1 v2 | v1 v2. v1 \<in> Values r1 s \<and> v2 \<in> Values r2 (rest v1 s)}"
+unfolding Values_def
+apply(auto)
+(*NULL*)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+(*EMPTY*)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rule Prf.intros)
+apply (metis append_Nil prefix_def)
+(*CHAR*)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rule Prf.intros)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+(*ALT*)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis Prf.intros(2))
+apply (metis Prf.intros(3))
+(*SEQ*)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (simp add: append_eq_conv_conj prefix_def rest_def)
+apply (metis Prf.intros(1))
+apply (simp add: append_eq_conv_conj prefix_def rest_def)
+done
+
+lemma Values_finite:
+ "finite (Values r s)"
+apply(induct r arbitrary: s)
+apply(simp_all add: Values_recs)
+thm finite_surj
+apply(rule_tac f="\<lambda>(x, y). Seq x y" and
+ A="{(v1, v2) | v1 v2. v1 \<in> Values r1 s \<and> v2 \<in> Values r2 (rest v1 s)}" in finite_surj)
+prefer 2
+apply(auto)[1]
+apply(rule_tac B="\<Union>sp \<in> Suffixes s. {(v1, v2). v1 \<in> Values r1 s \<and> v2 \<in> Values r2 sp}" in finite_subset)
+apply(auto)[1]
+apply (metis rest_Suffixes)
+apply(rule finite_UN_I)
+apply(rule finite_Suffixes)
+apply(simp)
+done
+
+section {* Greedy Ordering according to Frisch/Cardelli *}
+
+inductive GrOrd :: "val \<Rightarrow> val \<Rightarrow> bool" ("_ \<prec> _")
+where
+ "v1 \<prec> v1' \<Longrightarrow> (Seq v1 v2) \<prec> (Seq v1' v2')"
+| "v2 \<prec> v2' \<Longrightarrow> (Seq v1 v2) \<prec> (Seq v1 v2')"
+| "v1 \<prec> v2 \<Longrightarrow> (Left v1) \<prec> (Left v2)"
+| "v1 \<prec> v2 \<Longrightarrow> (Right v1) \<prec> (Right v2)"
+| "(Right v1) \<prec> (Left v2)"
+| "(Char c) \<prec> (Char c)"
+| "(Void) \<prec> (Void)"
+
+lemma Gr_refl:
+ assumes "\<turnstile> v : r"
+ shows "v \<prec> v"
+using assms
+apply(induct)
+apply(auto intro: GrOrd.intros)
+done
+
+lemma Gr_total:
+ assumes "\<turnstile> v1 : r" "\<turnstile> v2 : r"
+ shows "v1 \<prec> v2 \<or> v2 \<prec> v1"
+using assms
+apply(induct v1 r arbitrary: v2 rule: Prf.induct)
+apply(rotate_tac 4)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply (metis GrOrd.intros(1) GrOrd.intros(2))
+apply(rotate_tac 2)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(clarify)
+apply (metis GrOrd.intros(3))
+apply(clarify)
+apply (metis GrOrd.intros(5))
+apply(rotate_tac 2)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(clarify)
+apply (metis GrOrd.intros(5))
+apply(clarify)
+apply (metis GrOrd.intros(4))
+apply(erule Prf.cases)
+apply(simp_all)
+apply (metis GrOrd.intros(7))
+apply(erule Prf.cases)
+apply(simp_all)
+apply (metis GrOrd.intros(6))
+done
+
+lemma Gr_trans:
+ assumes "v1 \<prec> v2" "v2 \<prec> v3" "\<turnstile> v1 : r" "\<turnstile> v2 : r" "\<turnstile> v3 : r"
+ shows "v1 \<prec> v3"
+using assms
+apply(induct r arbitrary: v1 v2 v3)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+defer
+(* ALT case *)
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(clarify)
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply (metis GrOrd.intros(3))
+apply(clarify)
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(clarify)
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply(clarify)
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(clarify)
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply (metis GrOrd.intros(5))
+apply(clarify)
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(clarify)
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply (metis GrOrd.intros(5))
+apply(clarify)
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply (metis GrOrd.intros(4))
+(* seq case *)
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(clarify)
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply(clarify)
+apply (metis GrOrd.intros(1))
+apply (metis GrOrd.intros(1))
+apply(erule GrOrd.cases)
+apply(simp_all (no_asm_use))[7]
+apply (metis GrOrd.intros(1))
+by (metis GrOrd.intros(1) Gr_refl)
+
+definition
+ GrMaxM :: "val set => val" where
+ "GrMaxM S == SOME v. v \<in> S \<and> (\<forall>v' \<in> S. v' \<prec> v)"
+
+definition
+ "GrMax r s \<equiv> GrMaxM {v. \<turnstile> v : r \<and> flat v = s}"
+
+inductive ValOrd3 :: "val \<Rightarrow> val \<Rightarrow> bool" ("_ 3\<succ> _" [100, 100] 100)
+where
+ "v2 3\<succ> v2' \<Longrightarrow> (Seq v1 v2) 3\<succ> (Seq v1 v2')"
+| "v1 3\<succ> v1' \<Longrightarrow> (Seq v1 v2) 3\<succ> (Seq v1' v2')"
+| "length (flat v1) \<ge> length (flat v2) \<Longrightarrow> (Left v1) 3\<succ> (Right v2)"
+| "length (flat v2) > length (flat v1) \<Longrightarrow> (Right v2) 3\<succ> (Left v1)"
+| "v2 3\<succ> v2' \<Longrightarrow> (Right v2) 3\<succ> (Right v2')"
+| "v1 3\<succ> v1' \<Longrightarrow> (Left v1) 3\<succ> (Left v1')"
+| "Void 3\<succ> Void"
+| "(Char c) 3\<succ> (Char c)"
+
+
+section {* Sulzmann's Ordering of values *}
+
+inductive ValOrd :: "val \<Rightarrow> rexp \<Rightarrow> val \<Rightarrow> bool" ("_ \<succ>_ _" [100, 100, 100] 100)
+where
+ "v2 \<succ>r2 v2' \<Longrightarrow> (Seq v1 v2) \<succ>(SEQ r1 r2) (Seq v1 v2')"
+| "\<lbrakk>v1 \<succ>r1 v1'; v1 \<noteq> v1'\<rbrakk> \<Longrightarrow> (Seq v1 v2) \<succ>(SEQ r1 r2) (Seq v1' v2')"
+| "length (flat v1) \<ge> length (flat v2) \<Longrightarrow> (Left v1) \<succ>(ALT r1 r2) (Right v2)"
+| "length (flat v2) > length (flat v1) \<Longrightarrow> (Right v2) \<succ>(ALT r1 r2) (Left v1)"
+| "v2 \<succ>r2 v2' \<Longrightarrow> (Right v2) \<succ>(ALT r1 r2) (Right v2')"
+| "v1 \<succ>r1 v1' \<Longrightarrow> (Left v1) \<succ>(ALT r1 r2) (Left v1')"
+| "Void \<succ>EMPTY Void"
+| "(Char c) \<succ>(CHAR c) (Char c)"
+
+inductive ValOrdStr :: "string \<Rightarrow> val \<Rightarrow> val \<Rightarrow> bool" ("_ \<turnstile> _ \<succ>_" [100, 100, 100] 100)
+where
+ "\<lbrakk>s \<turnstile> v1 \<succ> v1'; rest v1 s \<turnstile> v2 \<succ> v2'\<rbrakk> \<Longrightarrow> s \<turnstile> (Seq v1 v2) \<succ> (Seq v1' v2')"
+| "\<lbrakk>flat v2 \<sqsubseteq> flat v1; flat v1 \<sqsubseteq> s\<rbrakk> \<Longrightarrow> s \<turnstile> (Left v1) \<succ> (Right v2)"
+| "\<lbrakk>flat v1 \<sqsubset> flat v2; flat v2 \<sqsubseteq> s\<rbrakk> \<Longrightarrow> s \<turnstile> (Right v2) \<succ> (Left v1)"
+| "s \<turnstile> v2 \<succ> v2' \<Longrightarrow> s \<turnstile> (Right v2) \<succ> (Right v2')"
+| "s \<turnstile> v1 \<succ> v1' \<Longrightarrow> s \<turnstile> (Left v1) \<succ> (Left v1')"
+| "s \<turnstile> Void \<succ> Void"
+| "(c#s) \<turnstile> (Char c) \<succ> (Char c)"
+
+inductive ValOrd2 :: "val \<Rightarrow> val \<Rightarrow> bool" ("_ 2\<succ> _" [100, 100] 100)
+where
+ "v2 2\<succ> v2' \<Longrightarrow> (Seq v1 v2) 2\<succ> (Seq v1 v2')"
+| "\<lbrakk>v1 2\<succ> v1'; v1 \<noteq> v1'\<rbrakk> \<Longrightarrow> (Seq v1 v2) 2\<succ> (Seq v1' v2')"
+| "length (flat v1) \<ge> length (flat v2) \<Longrightarrow> (Left v1) 2\<succ> (Right v2)"
+| "length (flat v2) > length (flat v1) \<Longrightarrow> (Right v2) 2\<succ> (Left v1)"
+| "v2 2\<succ> v2' \<Longrightarrow> (Right v2) 2\<succ> (Right v2')"
+| "v1 2\<succ> v1' \<Longrightarrow> (Left v1) 2\<succ> (Left v1')"
+| "Void 2\<succ> Void"
+| "(Char c) 2\<succ> (Char c)"
+
+lemma Ord1:
+ "v1 \<succ>r v2 \<Longrightarrow> v1 2\<succ> v2"
+apply(induct rule: ValOrd.induct)
+apply(auto intro: ValOrd2.intros)
+done
+
+lemma Ord2:
+ "v1 2\<succ> v2 \<Longrightarrow> \<exists>r. v1 \<succ>r v2"
+apply(induct v1 v2 rule: ValOrd2.induct)
+apply(auto intro: ValOrd.intros)
+done
+
+lemma Ord3:
+ "\<lbrakk>v1 2\<succ> v2; \<turnstile> v1 : r\<rbrakk> \<Longrightarrow> v1 \<succ>r v2"
+apply(induct v1 v2 arbitrary: r rule: ValOrd2.induct)
+apply(auto intro: ValOrd.intros elim: Prf.cases)
+done
+
+
+lemma ValOrd_refl:
+ assumes "\<turnstile> v : r"
+ shows "v \<succ>r v"
+using assms
+apply(induct)
+apply(auto intro: ValOrd.intros)
+done
+
+lemma
+ "flat Void = []"
+ "flat (Seq Void Void) = []"
+apply(simp_all)
+done
+
+
+lemma ValOrd_total:
+ shows "\<lbrakk>\<turnstile> v1 : r; \<turnstile> v2 : r\<rbrakk> \<Longrightarrow> v1 \<succ>r v2 \<or> v2 \<succ>r v1"
+apply(induct r arbitrary: v1 v2)
+apply(auto)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(7))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(8))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(case_tac "v1a = v1b")
+apply(simp)
+apply(rule ValOrd.intros(1))
+apply (metis ValOrd.intros(1))
+apply(rule ValOrd.intros(2))
+apply(auto)[2]
+apply(erule contrapos_np)
+apply(rule ValOrd.intros(2))
+apply(auto)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis Ord1 Ord3 Prf.intros(2) ValOrd2.intros(6))
+apply(rule ValOrd.intros)
+apply(erule contrapos_np)
+apply(rule ValOrd.intros)
+apply (metis le_eq_less_or_eq neq_iff)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rule ValOrd.intros)
+apply(erule contrapos_np)
+apply(rule ValOrd.intros)
+apply (metis le_eq_less_or_eq neq_iff)
+apply(rule ValOrd.intros)
+apply(erule contrapos_np)
+apply(rule ValOrd.intros)
+by metis
+
+lemma ValOrd_anti:
+ shows "\<lbrakk>\<turnstile> v1 : r; \<turnstile> v2 : r; v1 \<succ>r v2; v2 \<succ>r v1\<rbrakk> \<Longrightarrow> v1 = v2"
+apply(induct r arbitrary: v1 v2)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+done
+
+lemma refl_on_ValOrd:
+ "refl_on (Values r s) {(v1, v2). v1 \<succ>r v2 \<and> v1 \<in> Values r s \<and> v2 \<in> Values r s}"
+unfolding refl_on_def
+apply(auto)
+apply(rule ValOrd_refl)
+apply(simp add: Values_def)
+done
+
+(*
+inductive ValOrd3 :: "val \<Rightarrow> rexp \<Rightarrow> val \<Rightarrow> bool" ("_ 3\<succ>_ _" [100, 100, 100] 100)
+where
+ "\<lbrakk>v2 3\<succ>r2 v2'; \<turnstile> v1 : r1\<rbrakk> \<Longrightarrow> (Seq v1 v2) 3\<succ>(SEQ r1 r2) (Seq v1 v2')"
+| "\<lbrakk>v1 3\<succ>r1 v1'; v1 \<noteq> v1'; flat v2 = flat v2'; \<turnstile> v2 : r2; \<turnstile> v2' : r2\<rbrakk>
+ \<Longrightarrow> (Seq v1 v2) 3\<succ>(SEQ r1 r2) (Seq v1' v2')"
+| "length (flat v1) \<ge> length (flat v2) \<Longrightarrow> (Left v1) 3\<succ>(ALT r1 r2) (Right v2)"
+| "length (flat v2) > length (flat v1) \<Longrightarrow> (Right v2) 3\<succ>(ALT r1 r2) (Left v1)"
+| "v2 3\<succ>r2 v2' \<Longrightarrow> (Right v2) 3\<succ>(ALT r1 r2) (Right v2')"
+| "v1 3\<succ>r1 v1' \<Longrightarrow> (Left v1) 3\<succ>(ALT r1 r2) (Left v1')"
+| "Void 3\<succ>EMPTY Void"
+| "(Char c) 3\<succ>(CHAR c) (Char c)"
+*)
+
+section {* Posix definition *}
+
+definition POSIX :: "val \<Rightarrow> rexp \<Rightarrow> bool"
+where
+ "POSIX v r \<equiv> (\<turnstile> v : r \<and> (\<forall>v'. (\<turnstile> v' : r \<and> flat v = flat v') \<longrightarrow> v \<succ>r v'))"
+
+definition POSIX2 :: "val \<Rightarrow> rexp \<Rightarrow> bool"
+where
+ "POSIX2 v r \<equiv> (\<turnstile> v : r \<and> (\<forall>v'. (\<turnstile> v' : r \<and> flat v = flat v') \<longrightarrow> v 2\<succ> v'))"
+
+lemma "POSIX v r = POSIX2 v r"
+unfolding POSIX_def POSIX2_def
+apply(auto)
+apply(rule Ord1)
+apply(auto)
+apply(rule Ord3)
+apply(auto)
+done
+
+definition POSIXs :: "val \<Rightarrow> rexp \<Rightarrow> string \<Rightarrow> bool"
+where
+ "POSIXs v r s \<equiv> (\<Turnstile>s v : r \<and> (\<forall>v'. (\<Turnstile>s v' : r \<longrightarrow> v 2\<succ> v')))"
+
+definition POSIXn :: "val \<Rightarrow> rexp \<Rightarrow> nat \<Rightarrow> bool"
+where
+ "POSIXn v r n \<equiv> (\<TTurnstile>n v : r \<and> (\<forall>v'. (\<TTurnstile>n v' : r \<longrightarrow> v 2\<succ> v')))"
+
+lemma "POSIXn v r (length (flat v)) \<Longrightarrow> POSIX2 v r"
+unfolding POSIXn_def POSIX2_def
+apply(auto)
+apply (metis Prfn_Prf)
+by (metis Prf_Prfn)
+
+lemma Prfs_POSIX:
+ "POSIXs v r s \<Longrightarrow> \<Turnstile>s v: r \<and> flat v = s"
+apply(simp add: POSIXs_def)
+by (metis Prfs_flat)
+
+
+lemma "POSIXs v r (flat v) = POSIX2 v r"
+unfolding POSIXs_def POSIX2_def
+apply(auto)
+apply (metis Prfs_Prf)
+apply (metis Prf_Prfs)
+apply (metis Prf_Prfs)
+by (metis Prfs_Prf Prfs_flat)
+
+section {* POSIX for some constructors *}
+
+lemma POSIX_SEQ1:
+ assumes "POSIX (Seq v1 v2) (SEQ r1 r2)" "\<turnstile> v1 : r1" "\<turnstile> v2 : r2"
+ shows "POSIX v1 r1"
+using assms
+unfolding POSIX_def
+apply(auto)
+apply(drule_tac x="Seq v' v2" in spec)
+apply(simp)
+apply(erule impE)
+apply(rule Prf.intros)
+apply(simp)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(clarify)
+by (metis ValOrd_refl)
+
+lemma POSIXn_SEQ1:
+ assumes "POSIXn (Seq v1 v2) (SEQ r1 r2) (n1 + n2)" "\<TTurnstile>n1 v1 : r1" "\<TTurnstile>n2 v2 : r2"
+ shows "POSIXn v1 r1 n1"
+using assms
+unfolding POSIXn_def
+apply(auto)
+apply(drule_tac x="Seq v' v2" in spec)
+apply(erule impE)
+apply(rule Prfn.intros)
+apply(simp)
+apply(simp)
+apply(erule ValOrd2.cases)
+apply(simp_all)
+apply(clarify)
+by (metis Ord1 Prfn_Prf ValOrd_refl)
+
+lemma POSIXs_SEQ1:
+ assumes "POSIXs (Seq v1 v2) (SEQ r1 r2) (s1 @ s2)" "\<Turnstile>s1 v1 : r1" "\<Turnstile>s2 v2 : r2"
+ shows "POSIXs v1 r1 s1"
+using assms
+unfolding POSIXs_def
+apply(auto)
+apply(drule_tac x="Seq v' v2" in spec)
+apply(erule impE)
+apply(rule Prfs.intros)
+apply(simp)
+apply(simp)
+apply(erule ValOrd2.cases)
+apply(simp_all)
+apply(clarify)
+by (metis Ord1 Prfs_Prf ValOrd_refl)
+
+lemma POSIX_SEQ2:
+ assumes "POSIX (Seq v1 v2) (SEQ r1 r2)" "\<turnstile> v1 : r1" "\<turnstile> v2 : r2"
+ shows "POSIX v2 r2"
+using assms
+unfolding POSIX_def
+apply(auto)
+apply(drule_tac x="Seq v1 v'" in spec)
+apply(simp)
+apply(erule impE)
+apply(rule Prf.intros)
+apply(simp)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)
+done
+
+lemma POSIXn_SEQ2:
+ assumes "POSIXn (Seq v1 v2) (SEQ r1 r2) (n1 + n2)" "\<TTurnstile>n1 v1 : r1" "\<TTurnstile>n2 v2 : r2"
+ shows "POSIXn v2 r2 n2"
+using assms
+unfolding POSIXn_def
+apply(auto)
+apply(drule_tac x="Seq v1 v'" in spec)
+apply(erule impE)
+apply(rule Prfn.intros)
+apply(simp)
+apply(simp)
+apply(erule ValOrd2.cases)
+apply(simp_all)
+done
+
+lemma POSIXs_SEQ2:
+ assumes "POSIXs (Seq v1 v2) (SEQ r1 r2) (s1 @ s2)" "\<Turnstile>s1 v1 : r1" "\<Turnstile>s2 v2 : r2"
+ shows "POSIXs v2 r2 s2"
+using assms
+unfolding POSIXs_def
+apply(auto)
+apply(drule_tac x="Seq v1 v'" in spec)
+apply(erule impE)
+apply(rule Prfs.intros)
+apply(simp)
+apply(simp)
+apply(erule ValOrd2.cases)
+apply(simp_all)
+done
+
+lemma POSIX_ALT2:
+ assumes "POSIX (Left v1) (ALT r1 r2)"
+ shows "POSIX v1 r1"
+using assms
+unfolding POSIX_def
+apply(auto)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(drule_tac x="Left v'" in spec)
+apply(simp)
+apply(drule mp)
+apply(rule Prf.intros)
+apply(auto)
+apply(erule ValOrd.cases)
+apply(simp_all)
+done
+
+lemma POSIXn_ALT2:
+ assumes "POSIXn (Left v1) (ALT r1 r2) n"
+ shows "POSIXn v1 r1 n"
+using assms
+unfolding POSIXn_def
+apply(auto)
+apply(erule Prfn.cases)
+apply(simp_all)[5]
+apply(drule_tac x="Left v'" in spec)
+apply(drule mp)
+apply(rule Prfn.intros)
+apply(auto)
+apply(erule ValOrd2.cases)
+apply(simp_all)
+done
+
+lemma POSIXs_ALT2:
+ assumes "POSIXs (Left v1) (ALT r1 r2) s"
+ shows "POSIXs v1 r1 s"
+using assms
+unfolding POSIXs_def
+apply(auto)
+apply(erule Prfs.cases)
+apply(simp_all)[5]
+apply(drule_tac x="Left v'" in spec)
+apply(drule mp)
+apply(rule Prfs.intros)
+apply(auto)
+apply(erule ValOrd2.cases)
+apply(simp_all)
+done
+
+lemma POSIX_ALT1a:
+ assumes "POSIX (Right v2) (ALT r1 r2)"
+ shows "POSIX v2 r2"
+using assms
+unfolding POSIX_def
+apply(auto)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(drule_tac x="Right v'" in spec)
+apply(simp)
+apply(drule mp)
+apply(rule Prf.intros)
+apply(auto)
+apply(erule ValOrd.cases)
+apply(simp_all)
+done
+
+lemma POSIXn_ALT1a:
+ assumes "POSIXn (Right v2) (ALT r1 r2) n"
+ shows "POSIXn v2 r2 n"
+using assms
+unfolding POSIXn_def
+apply(auto)
+apply(erule Prfn.cases)
+apply(simp_all)[5]
+apply(drule_tac x="Right v'" in spec)
+apply(drule mp)
+apply(rule Prfn.intros)
+apply(auto)
+apply(erule ValOrd2.cases)
+apply(simp_all)
+done
+
+lemma POSIXs_ALT1a:
+ assumes "POSIXs (Right v2) (ALT r1 r2) s"
+ shows "POSIXs v2 r2 s"
+using assms
+unfolding POSIXs_def
+apply(auto)
+apply(erule Prfs.cases)
+apply(simp_all)[5]
+apply(drule_tac x="Right v'" in spec)
+apply(drule mp)
+apply(rule Prfs.intros)
+apply(auto)
+apply(erule ValOrd2.cases)
+apply(simp_all)
+done
+
+lemma POSIX_ALT1b:
+ assumes "POSIX (Right v2) (ALT r1 r2)"
+ shows "(\<forall>v'. (\<turnstile> v' : r2 \<and> flat v' = flat v2) \<longrightarrow> v2 \<succ>r2 v')"
+using assms
+apply(drule_tac POSIX_ALT1a)
+unfolding POSIX_def
+apply(auto)
+done
+
+lemma POSIXn_ALT1b:
+ assumes "POSIXn (Right v2) (ALT r1 r2) n"
+ shows "(\<forall>v'. (\<TTurnstile>n v' : r2 \<longrightarrow> v2 2\<succ> v'))"
+using assms
+apply(drule_tac POSIXn_ALT1a)
+unfolding POSIXn_def
+apply(auto)
+done
+
+lemma POSIXs_ALT1b:
+ assumes "POSIXs (Right v2) (ALT r1 r2) s"
+ shows "(\<forall>v'. (\<Turnstile>s v' : r2 \<longrightarrow> v2 2\<succ> v'))"
+using assms
+apply(drule_tac POSIXs_ALT1a)
+unfolding POSIXs_def
+apply(auto)
+done
+
+lemma POSIX_ALT_I1:
+ assumes "POSIX v1 r1"
+ shows "POSIX (Left v1) (ALT r1 r2)"
+using assms
+unfolding POSIX_def
+apply(auto)
+apply (metis Prf.intros(2))
+apply(rotate_tac 2)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)
+apply(rule ValOrd.intros)
+apply(auto)
+apply(rule ValOrd.intros)
+by simp
+
+lemma POSIXn_ALT_I1:
+ assumes "POSIXn v1 r1 n"
+ shows "POSIXn (Left v1) (ALT r1 r2) n"
+using assms
+unfolding POSIXn_def
+apply(auto)
+apply (metis Prfn.intros(2))
+apply(rotate_tac 2)
+apply(erule Prfn.cases)
+apply(simp_all)[5]
+apply(auto)
+apply(rule ValOrd2.intros)
+apply(auto)
+apply(rule ValOrd2.intros)
+by (metis Prfn_flat order_refl)
+
+lemma POSIXs_ALT_I1:
+ assumes "POSIXs v1 r1 s"
+ shows "POSIXs (Left v1) (ALT r1 r2) s"
+using assms
+unfolding POSIXs_def
+apply(auto)
+apply (metis Prfs.intros(2))
+apply(rotate_tac 2)
+apply(erule Prfs.cases)
+apply(simp_all)[5]
+apply(auto)
+apply(rule ValOrd2.intros)
+apply(auto)
+apply(rule ValOrd2.intros)
+by (metis Prfs_flat order_refl)
+
+lemma POSIX_ALT_I2:
+ assumes "POSIX v2 r2" "\<forall>v'. \<turnstile> v' : r1 \<longrightarrow> length (flat v2) > length (flat v')"
+ shows "POSIX (Right v2) (ALT r1 r2)"
+using assms
+unfolding POSIX_def
+apply(auto)
+apply (metis Prf.intros)
+apply(rotate_tac 3)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)
+apply(rule ValOrd.intros)
+apply metis
+done
+
+lemma POSIXs_ALT_I2:
+ assumes "POSIXs v2 r2 s" "\<forall>s' v'. \<Turnstile>s' v' : r1 \<longrightarrow> length s > length s'"
+ shows "POSIXs (Right v2) (ALT r1 r2) s"
+using assms
+unfolding POSIXs_def
+apply(auto)
+apply (metis Prfs.intros)
+apply(rotate_tac 3)
+apply(erule Prfs.cases)
+apply(simp_all)[5]
+apply(auto)
+apply(rule ValOrd2.intros)
+apply metis
+done
+
+lemma
+ "\<lbrakk>POSIX (mkeps r2) r2; nullable r2; \<not> nullable r1\<rbrakk>
+ \<Longrightarrow> POSIX (Right (mkeps r2)) (ALT r1 r2)"
+apply(auto simp add: POSIX_def)
+apply(rule Prf.intros(3))
+apply(auto)
+apply(rotate_tac 3)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp add: mkeps_flat)
+apply(auto)[1]
+apply (metis Prf_flat_L nullable_correctness)
+apply(rule ValOrd.intros)
+apply(auto)
+done
+
+lemma mkeps_POSIX:
+ assumes "nullable r"
+ shows "POSIX (mkeps r) r"
+using assms
+apply(induct r)
+apply(auto)[1]
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply (metis Prf.intros(4))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros)
+apply(simp)
+apply(auto)[1]
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply (metis mkeps.simps(2) mkeps_nullable nullable.simps(5))
+apply(rotate_tac 6)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (simp add: mkeps_flat)
+apply(case_tac "mkeps r1a = v1")
+apply(simp)
+apply (metis ValOrd.intros(1))
+apply (rule ValOrd.intros(2))
+apply metis
+apply(simp)
+(* ALT case *)
+thm mkeps.simps
+apply(simp)
+apply(erule disjE)
+apply(simp)
+apply (metis POSIX_ALT_I1)
+(* *)
+apply(auto)[1]
+thm POSIX_ALT_I1
+apply (metis POSIX_ALT_I1)
+apply(simp (no_asm) add: POSIX_def)
+apply(auto)[1]
+apply(rule Prf.intros(3))
+apply(simp only: POSIX_def)
+apply(rotate_tac 4)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+thm mkeps_flat
+apply(simp add: mkeps_flat)
+apply(auto)[1]
+thm Prf_flat_L nullable_correctness
+apply (metis Prf_flat_L nullable_correctness)
+apply(rule ValOrd.intros)
+apply(subst (asm) POSIX_def)
+apply(clarify)
+apply(drule_tac x="v2" in spec)
+by simp
+
+
+section {* Derivatives *}
+
+fun
+ der :: "char \<Rightarrow> rexp \<Rightarrow> rexp"
+where
+ "der c (NULL) = NULL"
+| "der c (EMPTY) = NULL"
+| "der c (CHAR c') = (if c = c' then EMPTY else NULL)"
+| "der c (ALT r1 r2) = ALT (der c r1) (der c r2)"
+| "der c (SEQ r1 r2) =
+ (if nullable r1
+ then ALT (SEQ (der c r1) r2) (der c r2)
+ else SEQ (der c r1) r2)"
+
+fun
+ ders :: "string \<Rightarrow> rexp \<Rightarrow> rexp"
+where
+ "ders [] r = r"
+| "ders (c # s) r = ders s (der c r)"
+
+fun
+ red :: "char \<Rightarrow> rexp \<Rightarrow> rexp"
+where
+ "red c (NULL) = NULL"
+| "red c (EMPTY) = CHAR c"
+| "red c (CHAR c') = SEQ (CHAR c) (CHAR c')"
+| "red c (ALT r1 r2) = ALT (red c r1) (red c r2)"
+| "red c (SEQ r1 r2) =
+ (if nullable r1
+ then ALT (SEQ (red c r1) r2) (red c r2)
+ else SEQ (red c r1) r2)"
+
+lemma L_der:
+ shows "L (der c r) = {s. c#s \<in> L r}"
+apply(induct r)
+apply(simp_all)
+apply(simp add: Sequ_def)
+apply(auto)[1]
+apply (metis append_Cons)
+apply (metis append_Nil nullable_correctness)
+apply (metis append_eq_Cons_conv)
+apply (metis append_Cons)
+apply (metis Cons_eq_append_conv nullable_correctness)
+apply(auto)
+done
+
+lemma L_red:
+ shows "L (red c r) = {c#s | s. s \<in> L r}"
+apply(induct r)
+apply(simp_all)
+apply(simp add: Sequ_def)
+apply(simp add: Sequ_def)
+apply(auto)[1]
+apply (metis append_Nil nullable_correctness)
+apply (metis append_Cons)
+apply (metis append_Cons)
+apply(auto)
+done
+
+lemma L_red_der:
+ "L(red c (der c r)) = {c#s | s. c#s \<in> L r}"
+apply(simp add: L_red)
+apply(simp add: L_der)
+done
+
+lemma L_der_red:
+ "L(der c (red c r)) = L r"
+apply(simp add: L_der)
+apply(simp add: L_red)
+done
+
+section {* Injection function *}
+
+fun injval :: "rexp \<Rightarrow> char \<Rightarrow> val \<Rightarrow> val"
+where
+ "injval (EMPTY) c Void = Char c"
+| "injval (CHAR d) c Void = Char d"
+| "injval (CHAR d) c (Char c') = Seq (Char d) (Char c')"
+| "injval (ALT r1 r2) c (Left v1) = Left(injval r1 c v1)"
+| "injval (ALT r1 r2) c (Right v2) = Right(injval r2 c v2)"
+| "injval (SEQ r1 r2) c (Char c') = Seq (Char c) (Char c')"
+| "injval (SEQ r1 r2) c (Seq v1 v2) = Seq (injval r1 c v1) v2"
+| "injval (SEQ r1 r2) c (Left (Seq v1 v2)) = Seq (injval r1 c v1) v2"
+| "injval (SEQ r1 r2) c (Right v2) = Seq (mkeps r1) (injval r2 c v2)"
+
+
+section {* Projection function *}
+
+fun projval :: "rexp \<Rightarrow> char \<Rightarrow> val \<Rightarrow> val"
+where
+ "projval (CHAR d) c _ = Void"
+| "projval (ALT r1 r2) c (Left v1) = Left (projval r1 c v1)"
+| "projval (ALT r1 r2) c (Right v2) = Right (projval r2 c v2)"
+| "projval (SEQ r1 r2) c (Seq v1 v2) =
+ (if flat v1 = [] then Right(projval r2 c v2)
+ else if nullable r1 then Left (Seq (projval r1 c v1) v2)
+ else Seq (projval r1 c v1) v2)"
+
+text {*
+ Injection value is related to r
+*}
+
+lemma v3:
+ assumes "\<turnstile> v : der c r" shows "\<turnstile> (injval r c v) : r"
+using assms
+apply(induct arbitrary: v rule: der.induct)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(case_tac "c = c'")
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis Prf.intros(5))
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis Prf.intros(2))
+apply (metis Prf.intros(3))
+apply(simp)
+apply(case_tac "nullable r1")
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply (metis Prf.intros(1))
+apply(auto)[1]
+apply (metis Prf.intros(1) mkeps_nullable)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply(rule Prf.intros)
+apply(auto)[2]
+done
+
+lemma v3_red:
+ assumes "\<turnstile> v : r" shows "\<turnstile> (injval (red c r) c v) : (red c r)"
+using assms
+apply(induct c r arbitrary: v rule: red.induct)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis Prf.intros(5))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis Prf.intros(1) Prf.intros(5))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis Prf.intros(2))
+apply (metis Prf.intros(3))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)
+prefer 2
+apply (metis Prf.intros(1))
+oops
+
+lemma v3s:
+ assumes "\<Turnstile>s v : der c r" shows "\<Turnstile>(c#s) (injval r c v) : r"
+using assms
+apply(induct arbitrary: s v rule: der.induct)
+apply(simp)
+apply(erule Prfs.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(erule Prfs.cases)
+apply(simp_all)[5]
+apply(case_tac "c = c'")
+apply(simp)
+apply(erule Prfs.cases)
+apply(simp_all)[5]
+apply (metis Prfs.intros(5))
+apply(simp)
+apply(erule Prfs.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(erule Prfs.cases)
+apply(simp_all)[5]
+apply (metis Prfs.intros(2))
+apply (metis Prfs.intros(3))
+apply(simp)
+apply(case_tac "nullable r1")
+apply(simp)
+apply(erule Prfs.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply(erule Prfs.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply (metis Prfs.intros(1) append_Cons)
+apply(auto)[1]
+apply (metis Prfs.intros(1) append_Nil mkeps_nullable_s)
+apply(simp)
+apply(erule Prfs.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+by (metis Prfs.intros(1) append_Cons)
+
+lemma v3n:
+ assumes "\<TTurnstile>n v : der c r" shows "\<TTurnstile>(Suc n) (injval r c v) : r"
+using assms
+apply(induct arbitrary: n v rule: der.induct)
+apply(simp)
+apply(erule Prfn.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(erule Prfn.cases)
+apply(simp_all)[5]
+apply(case_tac "c = c'")
+apply(simp)
+apply(erule Prfn.cases)
+apply(simp_all)[5]
+apply (metis One_nat_def Prfn.intros(5))
+apply(simp)
+apply(erule Prfn.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(erule Prfn.cases)
+apply(simp_all)[5]
+apply (metis Prfn.intros(2))
+apply (metis Prfn.intros(3))
+apply(simp)
+apply(case_tac "nullable r1")
+apply(simp)
+apply(erule Prfn.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply(erule Prfn.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply (metis Prfn.intros(1) add.commute add_Suc_right)
+apply(auto)[1]
+apply (metis Prfn.intros(1) mkeps_nullable_n plus_nat.add_0)
+apply(simp)
+apply(erule Prfn.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+by (metis Prfn.intros(1) add_Suc)
+
+lemma v3_proj:
+ assumes "\<turnstile> v : r" and "\<exists>s. (flat v) = c # s"
+ shows "\<turnstile> (projval r c v) : der c r"
+using assms
+apply(induct rule: Prf.induct)
+prefer 4
+apply(simp)
+prefer 4
+apply(simp)
+apply (metis Prf.intros(4))
+prefer 2
+apply(simp)
+apply (metis Prf.intros(2))
+prefer 2
+apply(simp)
+apply (metis Prf.intros(3))
+apply(auto)
+apply(rule Prf.intros)
+apply(simp)
+apply (metis Prf_flat_L nullable_correctness)
+apply(rule Prf.intros)
+apply(rule Prf.intros)
+apply (metis Cons_eq_append_conv)
+apply(simp)
+apply(rule Prf.intros)
+apply (metis Cons_eq_append_conv)
+apply(simp)
+done
+
+lemma v3s_proj:
+ assumes "\<Turnstile>(c#s) v : r"
+ shows "\<Turnstile>s (projval r c v) : der c r"
+using assms
+apply(induct s\<equiv>"c#s" v r arbitrary: s rule: Prfs.induct)
+prefer 4
+apply(simp)
+apply (metis Prfs.intros(4))
+prefer 2
+apply(simp)
+apply (metis Prfs.intros(2))
+prefer 2
+apply(simp)
+apply (metis Prfs.intros(3))
+apply(auto)
+apply(rule Prfs.intros)
+apply (metis Prfs_flat append_Nil)
+prefer 2
+apply(rule Prfs.intros)
+apply(subst (asm) append_eq_Cons_conv)
+apply(auto)[1]
+apply (metis Prfs_flat)
+apply(rule Prfs.intros)
+apply metis
+apply(simp)
+apply(subst (asm) append_eq_Cons_conv)
+apply(auto)[1]
+apply (metis Prf_flat_L Prfs_Prf nullable_correctness)
+apply (metis Prfs_flat list.distinct(1))
+apply(subst (asm) append_eq_Cons_conv)
+apply(auto)[1]
+apply (metis Prfs_flat)
+by (metis Prfs.intros(1))
+
+text {*
+ The string behind the injection value is an added c
+*}
+
+lemma v4s:
+ assumes "\<Turnstile>s v : der c r" shows "flat (injval r c v) = c # (flat v)"
+using assms
+apply(induct arbitrary: s v rule: der.induct)
+apply(simp)
+apply(erule Prfs.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(erule Prfs.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(case_tac "c = c'")
+apply(simp)
+apply(auto)[1]
+apply(erule Prfs.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(erule Prfs.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(erule Prfs.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(case_tac "nullable r1")
+apply(simp)
+apply(erule Prfs.cases)
+apply(simp_all (no_asm_use))[5]
+apply(auto)[1]
+apply(erule Prfs.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(simp only: injval.simps flat.simps)
+apply(auto)[1]
+apply (metis mkeps_flat)
+apply(simp)
+apply(erule Prfs.cases)
+apply(simp_all)[5]
+done
+
+lemma v4:
+ assumes "\<turnstile> v : der c r" shows "flat (injval r c v) = c # (flat v)"
+using assms
+apply(induct arbitrary: v rule: der.induct)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(case_tac "c = c'")
+apply(simp)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(case_tac "nullable r1")
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(simp only: injval.simps flat.simps)
+apply(auto)[1]
+apply (metis mkeps_flat)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+done
+
+lemma v4_proj:
+ assumes "\<turnstile> v : r" and "\<exists>s. (flat v) = c # s"
+ shows "c # flat (projval r c v) = flat v"
+using assms
+apply(induct rule: Prf.induct)
+prefer 4
+apply(simp)
+prefer 4
+apply(simp)
+prefer 2
+apply(simp)
+prefer 2
+apply(simp)
+apply(auto)
+by (metis Cons_eq_append_conv)
+
+lemma v4_proj2:
+ assumes "\<turnstile> v : r" and "(flat v) = c # s"
+ shows "flat (projval r c v) = s"
+using assms
+by (metis list.inject v4_proj)
+
+lemma injval_inj: "inj_on (injval r c) {v. \<turnstile> v : der c r}"
+apply(induct c r rule: der.induct)
+unfolding inj_on_def
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply (metis list.distinct(1) mkeps_flat v4)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(rotate_tac 6)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis list.distinct(1) mkeps_flat v4)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+done
+
+lemma Values_nullable:
+ assumes "nullable r1"
+ shows "mkeps r1 \<in> Values r1 s"
+using assms
+apply(induct r1 arbitrary: s)
+apply(simp_all)
+apply(simp add: Values_recs)
+apply(simp add: Values_recs)
+apply(simp add: Values_recs)
+apply(auto)[1]
+done
+
+lemma Values_injval:
+ assumes "v \<in> Values (der c r) s"
+ shows "injval r c v \<in> Values r (c#s)"
+using assms
+apply(induct c r arbitrary: v s rule: der.induct)
+apply(simp add: Values_recs)
+apply(simp add: Values_recs)
+apply(case_tac "c = c'")
+apply(simp)
+apply(simp add: Values_recs)
+apply(simp add: prefix_def)
+apply(simp)
+apply(simp add: Values_recs)
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(case_tac "nullable r1")
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(simp add: rest_def)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(simp add: Values_def)
+apply(rule Values_nullable)
+apply(assumption)
+apply(simp add: rest_def)
+apply(subst mkeps_flat)
+apply(assumption)
+apply(simp)
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(simp add: rest_def)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(simp add: Values_def)
+done
+
+lemma Values_projval:
+ assumes "v \<in> Values r (c#s)" "\<exists>s. flat v = c # s"
+ shows "projval r c v \<in> Values (der c r) s"
+using assms
+apply(induct r arbitrary: v s c rule: rexp.induct)
+apply(simp add: Values_recs)
+apply(simp add: Values_recs)
+apply(case_tac "c = x")
+apply(simp)
+apply(simp add: Values_recs)
+apply(simp)
+apply(simp add: Values_recs)
+apply(simp add: prefix_def)
+apply(case_tac "nullable x1")
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(simp add: rest_def)
+apply (metis hd_Cons_tl hd_append2 list.sel(1))
+apply(simp add: rest_def)
+apply(simp add: append_eq_Cons_conv)
+apply(auto)[1]
+apply(subst v4_proj2)
+apply(simp add: Values_def)
+apply(assumption)
+apply(simp)
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(auto simp add: Values_def not_nullable_flat)[1]
+apply(simp add: append_eq_Cons_conv)
+apply(auto)[1]
+apply(simp add: append_eq_Cons_conv)
+apply(auto)[1]
+apply(simp add: rest_def)
+apply(subst v4_proj2)
+apply(simp add: Values_def)
+apply(assumption)
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+done
+
+
+definition "MValue v r s \<equiv> (v \<in> Values r s \<and> (\<forall>v' \<in> Values r s. v 2\<succ> v'))"
+
+lemma
+ assumes "MValue v1 r1 s"
+ shows "MValue (Seq v1 v2) (SEQ r1 r2) s
+
+
+lemma MValue_SEQE:
+ assumes "MValue v (SEQ r1 r2) s"
+ shows "(\<exists>v1 v2. MValue v1 r1 s \<and> MValue v2 r2 (rest v1 s) \<and> v = Seq v1 v2)"
+using assms
+apply(simp add: MValue_def)
+apply(simp add: Values_recs)
+apply(erule conjE)
+apply(erule exE)+
+apply(erule conjE)+
+apply(simp)
+apply(auto)
+apply(drule_tac x="Seq x v2" in spec)
+apply(drule mp)
+apply(rule_tac x="x" in exI)
+apply(rule_tac x="v2" in exI)
+apply(simp)
+oops
+
+
+lemma MValue_ALTE:
+ assumes "MValue v (ALT r1 r2) s"
+ shows "(\<exists>vl. v = Left vl \<and> MValue vl r1 s \<and> (\<forall>vr \<in> Values r2 s. length (flat vr) \<le> length (flat vl))) \<or>
+ (\<exists>vr. v = Right vr \<and> MValue vr r2 s \<and> (\<forall>vl \<in> Values r1 s. length (flat vl) < length (flat vr)))"
+using assms
+apply(simp add: MValue_def)
+apply(simp add: Values_recs)
+apply(auto)
+apply(drule_tac x="Left x" in bspec)
+apply(simp)
+apply(erule ValOrd2.cases)
+apply(simp_all)
+apply(drule_tac x="Right vr" in bspec)
+apply(simp)
+apply(erule ValOrd2.cases)
+apply(simp_all)
+apply(drule_tac x="Right x" in bspec)
+apply(simp)
+apply(erule ValOrd2.cases)
+apply(simp_all)
+apply(drule_tac x="Left vl" in bspec)
+apply(simp)
+apply(erule ValOrd2.cases)
+apply(simp_all)
+done
+
+lemma MValue_ALTI1:
+ assumes "MValue vl r1 s" "\<forall>vr \<in> Values r2 s. length (flat vr) \<le> length (flat vl)"
+ shows "MValue (Left vl) (ALT r1 r2) s"
+using assms
+apply(simp add: MValue_def)
+apply(simp add: Values_recs)
+apply(auto)
+apply(rule ValOrd2.intros)
+apply metis
+apply(rule ValOrd2.intros)
+apply metis
+done
+
+lemma MValue_ALTI2:
+ assumes "MValue vr r2 s" "\<forall>vl \<in> Values r1 s. length (flat vl) < length (flat vr)"
+ shows "MValue (Right vr) (ALT r1 r2) s"
+using assms
+apply(simp add: MValue_def)
+apply(simp add: Values_recs)
+apply(auto)
+apply(rule ValOrd2.intros)
+apply metis
+apply(rule ValOrd2.intros)
+apply metis
+done
+
+lemma MValue_injval:
+ assumes "MValue v (der c r) s"
+ shows "MValue (injval r c v) r (c#s)"
+using assms
+apply(induct c r arbitrary: v s rule: der.induct)
+apply(simp add: MValue_def)
+apply(simp add: Values_recs)
+apply(simp add: MValue_def)
+apply(simp add: Values_recs)
+apply(case_tac "c = c'")
+apply(simp)
+apply(simp add: MValue_def)
+apply(simp add: Values_recs)
+apply(simp add: prefix_def)
+apply(rule ValOrd2.intros)
+apply(simp)
+apply(simp add: MValue_def)
+apply(simp add: Values_recs)
+apply(simp)
+apply(drule MValue_ALTE)
+apply(erule disjE)
+apply(auto)[1]
+apply(rule MValue_ALTI1)
+apply(simp)
+apply(subst v4)
+apply(simp add: MValue_def Values_def)
+apply(rule ballI)
+apply(simp)
+apply(case_tac "flat vr = []")
+apply(simp)
+apply(drule_tac x="projval r2 c vr" in bspec)
+apply(rule Values_projval)
+apply(simp)
+apply(simp add: Values_def prefix_def)
+apply(auto)[1]
+apply(simp add: append_eq_Cons_conv)
+apply(auto)[1]
+apply(simp add: Values_def prefix_def)
+apply(auto)[1]
+apply(simp add: append_eq_Cons_conv)
+apply(auto)[1]
+apply(subst (asm) v4_proj2)
+apply(assumption)
+apply(assumption)
+apply(simp)
+apply(auto)[1]
+apply(rule MValue_ALTI2)
+apply(simp)
+apply(subst v4)
+apply(simp add: MValue_def Values_def)
+apply(rule ballI)
+apply(simp)
+apply(case_tac "flat vl = []")
+apply(simp)
+apply(drule_tac x="projval r1 c vl" in bspec)
+apply(rule Values_projval)
+apply(simp)
+apply(simp add: Values_def prefix_def)
+apply(auto)[1]
+apply(simp add: append_eq_Cons_conv)
+apply(auto)[1]
+apply(simp add: Values_def prefix_def)
+apply(auto)[1]
+apply(simp add: append_eq_Cons_conv)
+apply(auto)[1]
+apply(subst (asm) v4_proj2)
+apply(simp add: MValue_def Values_def)
+apply(assumption)
+apply(assumption)
+apply(case_tac "nullable r1")
+defer
+apply(simp)
+apply(frule MValue_SEQE)
+apply(auto)[1]
+
+
+apply(simp add: MValue_def)
+apply(simp add: Values_recs)
+
+lemma nullable_red:
+ "\<not>nullable (red c r)"
+apply(induct r)
+apply(auto)
+done
+
+lemma twq:
+ assumes "\<turnstile> v : r"
+ shows "\<turnstile> injval r c v : red c r"
+using assms
+apply(induct)
+apply(auto)
+oops
+
+lemma injval_inj_red: "inj_on (injval (red c r) c) {v. \<turnstile> v : r}"
+using injval_inj
+apply(auto simp add: inj_on_def)
+apply(drule_tac x="red c r" in meta_spec)
+apply(drule_tac x="c" in meta_spec)
+apply(drule_tac x="x" in spec)
+apply(drule mp)
+oops
+
+lemma
+ assumes "POSIXs v (der c r) s"
+ shows "POSIXs (injval r c v) r (c # s)"
+using assms
+apply(induct c r arbitrary: v s rule: der.induct)
+apply(auto simp add: POSIXs_def)[1]
+apply(erule Prfs.cases)
+apply(simp_all)[5]
+apply(erule Prfs.cases)
+apply(simp_all)[5]
+apply(auto simp add: POSIXs_def)[1]
+apply(erule Prfs.cases)
+apply(simp_all)[5]
+apply(erule Prfs.cases)
+apply(simp_all)[5]
+apply(case_tac "c = c'")
+apply(auto simp add: POSIXs_def)[1]
+apply(erule Prfs.cases)
+apply(simp_all)[5]
+apply (metis Prfs.intros(5))
+apply(erule Prfs.cases)
+apply(simp_all)[5]
+apply(erule Prfs.cases)
+apply(simp_all)[5]
+apply (metis ValOrd2.intros(8))
+apply(auto simp add: POSIXs_def)[1]
+apply(erule Prfs.cases)
+apply(simp_all)[5]
+apply(erule Prfs.cases)
+apply(simp_all)[5]
+apply(frule Prfs_POSIX)
+apply(drule conjunct1)
+apply(erule Prfs.cases)
+apply(simp_all)[5]
+apply(rule POSIXs_ALT_I1)
+apply (metis POSIXs_ALT2)
+apply(rule POSIXs_ALT_I2)
+apply (metis POSIXs_ALT1a)
+apply(frule POSIXs_ALT1b)
+apply(auto)
+apply(frule POSIXs_ALT1a)
+(* HERE *)
+oops
+
+lemma t: "(c#xs = c#ys) \<Longrightarrow> xs = ys"
+by (metis list.sel(3))
+
+lemma t2: "(xs = ys) \<Longrightarrow> (c#xs) = (c#ys)"
+by (metis)
+
+lemma "\<not>(nullable r) \<Longrightarrow> \<not>(\<exists>v. \<turnstile> v : r \<and> flat v = [])"
+by (metis Prf_flat_L nullable_correctness)
+
+
+lemma LeftRight:
+ assumes "(Left v1) \<succ>(der c (ALT r1 r2)) (Right v2)"
+ and "\<turnstile> v1 : der c r1" "\<turnstile> v2 : der c r2"
+ shows "(injval (ALT r1 r2) c (Left v1)) \<succ>(ALT r1 r2) (injval (ALT r1 r2) c (Right v2))"
+using assms
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd.intros)
+apply(clarify)
+apply(subst v4)
+apply(simp)
+apply(subst v4)
+apply(simp)
+apply(simp)
+done
+
+lemma RightLeft:
+ assumes "(Right v1) \<succ>(der c (ALT r1 r2)) (Left v2)"
+ and "\<turnstile> v1 : der c r2" "\<turnstile> v2 : der c r1"
+ shows "(injval (ALT r1 r2) c (Right v1)) \<succ>(ALT r1 r2) (injval (ALT r1 r2) c (Left v2))"
+using assms
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd.intros)
+apply(clarify)
+apply(subst v4)
+apply(simp)
+apply(subst v4)
+apply(simp)
+apply(simp)
+done
+
+lemma h:
+ assumes "nullable r1" "\<turnstile> v1 : der c r1"
+ shows "injval r1 c v1 \<succ>r1 mkeps r1"
+using assms
+apply(induct r1 arbitrary: v1 rule: der.induct)
+apply(simp)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(auto)[1]
+apply (metis ValOrd.intros(6))
+apply (metis ValOrd.intros(6))
+apply (metis ValOrd.intros(3) le_add2 list.size(3) mkeps_flat monoid_add_class.add.right_neutral)
+apply(auto)[1]
+apply (metis ValOrd.intros(4) length_greater_0_conv list.distinct(1) list.size(3) mkeps_flat v4)
+apply (metis ValOrd.intros(4) length_greater_0_conv list.distinct(1) list.size(3) mkeps_flat v4)
+apply (metis ValOrd.intros(5))
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply (metis ValOrd.intros(2) list.distinct(1) mkeps_flat v4)
+apply(clarify)
+by (metis ValOrd.intros(1))
+
+lemma LeftRightSeq:
+ assumes "(Left (Seq v1 v2)) \<succ>(der c (SEQ r1 r2)) (Right v3)"
+ and "nullable r1" "\<turnstile> v1 : der c r1"
+ shows "(injval (SEQ r1 r2) c (Seq v1 v2)) \<succ>(SEQ r1 r2) (injval (SEQ r1 r2) c (Right v2))"
+using assms
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply(simp)
+apply(rule ValOrd.intros(2))
+prefer 2
+apply (metis list.distinct(1) mkeps_flat v4)
+by (metis h)
+
+lemma rr1:
+ assumes "\<turnstile> v : r" "\<not>nullable r"
+ shows "flat v \<noteq> []"
+using assms
+by (metis Prf_flat_L nullable_correctness)
+
+section {* TESTTEST *}
+
+inductive ValOrdA :: "val \<Rightarrow> rexp \<Rightarrow> val \<Rightarrow> bool" ("_ A\<succ>_ _" [100, 100, 100] 100)
+where
+ "v2 A\<succ>r2 v2' \<Longrightarrow> (Seq v1 v2) A\<succ>(SEQ r1 r2) (Seq v1 v2')"
+| "v1 A\<succ>r1 v1' \<Longrightarrow> (Seq v1 v2) A\<succ>(SEQ r1 r2) (Seq v1' v2')"
+| "length (flat v1) \<ge> length (flat v2) \<Longrightarrow> (Left v1) A\<succ>(ALT r1 r2) (Right v2)"
+| "length (flat v2) > length (flat v1) \<Longrightarrow> (Right v2) A\<succ>(ALT r1 r2) (Left v1)"
+| "v2 A\<succ>r2 v2' \<Longrightarrow> (Right v2) A\<succ>(ALT r1 r2) (Right v2')"
+| "v1 A\<succ>r1 v1' \<Longrightarrow> (Left v1) A\<succ>(ALT r1 r2) (Left v1')"
+| "Void A\<succ>EMPTY Void"
+| "(Char c) A\<succ>(CHAR c) (Char c)"
+
+inductive ValOrd4 :: "val \<Rightarrow> rexp \<Rightarrow> val \<Rightarrow> bool" ("_ 4\<succ> _ _" [100, 100] 100)
+where
+ (*"v1 4\<succ>(der c r) v1' \<Longrightarrow> (injval r c v1) 4\<succ>r (injval r c v1')"
+| "\<lbrakk>v1 4\<succ>r v2; v2 4\<succ>r v3\<rbrakk> \<Longrightarrow> v1 4\<succ>r v3"
+|*)
+ "\<lbrakk>v1 4\<succ>r1 v1'; flat v2 = flat v2'; \<turnstile> v2 : r2; \<turnstile> v2' : r2\<rbrakk> \<Longrightarrow> (Seq v1 v2) 4\<succ>(SEQ r1 r2) (Seq v1' v2')"
+| "\<lbrakk>v2 4\<succ>r2 v2'; \<turnstile> v1 : r1\<rbrakk> \<Longrightarrow> (Seq v1 v2) 4\<succ>(SEQ r1 r2) (Seq v1 v2')"
+| "\<lbrakk>flat v1 = flat v2; \<turnstile> v1 : r1; \<turnstile> v2 : r2\<rbrakk> \<Longrightarrow> (Left v1) 4\<succ>(ALT r1 r2) (Right v2)"
+| "v2 4\<succ>r2 v2' \<Longrightarrow> (Right v2) 4\<succ>(ALT r1 r2) (Right v2')"
+| "v1 4\<succ>r1 v1' \<Longrightarrow> (Left v1) 4\<succ>(ALT r1 r2) (Left v1')"
+| "Void 4\<succ>(EMPTY) Void"
+| "(Char c) 4\<succ>(CHAR c) (Char c)"
+
+lemma ValOrd4_Prf:
+ assumes "v1 4\<succ>r v2"
+ shows "\<turnstile> v1 : r \<and> \<turnstile> v2 : r"
+using assms
+apply(induct v1 r v2)
+apply(auto intro: Prf.intros)
+done
+
+lemma ValOrd4_flat:
+ assumes "v1 4\<succ>r v2"
+ shows "flat v1 = flat v2"
+using assms
+apply(induct v1 r v2)
+apply(simp_all)
+done
+
+lemma ValOrd4_refl:
+ assumes "\<turnstile> v : r"
+ shows "v 4\<succ>r v"
+using assms
+apply(induct v r)
+apply(auto intro: ValOrd4.intros)
+done
+
+lemma
+ assumes "v1 4\<succ>r v2" "v2 4\<succ>r v3"
+ shows "v1 A\<succ>r v3"
+using assms
+apply(induct v1 r v2 arbitrary: v3)
+apply(rotate_tac 5)
+apply(erule ValOrd4.cases)
+apply(simp_all)
+apply(clarify)
+apply (metis ValOrdA.intros(2))
+apply(clarify)
+apply (metis ValOrd4_refl ValOrdA.intros(2))
+apply(rotate_tac 3)
+apply(erule ValOrd4.cases)
+apply(simp_all)
+apply(clarify)
+
+apply (metis ValOrdA.intros(2))
+apply (metis ValOrdA.intros(1))
+apply (metis ValOrdA.intros(3) order_refl)
+apply (auto intro: ValOrdA.intros)
+done
+
+lemma
+ assumes "v1 4\<succ>r v2"
+ shows "v1 A\<succ>r v2"
+using assms
+apply(induct v1 r v2 arbitrary:)
+apply (metis ValOrdA.intros(2))
+apply (metis ValOrdA.intros(1))
+apply (metis ValOrdA.intros(3) order_refl)
+apply (auto intro: ValOrdA.intros)
+done
+
+lemma
+ assumes "v1 \<succ>r v2" "\<turnstile> v1 : r" "\<turnstile> v2 : r" "flat v1 = flat v2"
+ shows "v1 4\<succ>r v2"
+using assms
+apply(induct v1 r v2 arbitrary:)
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(clarify)
+apply (metis ValOrd4.intros(4) ValOrd4_flat ValOrd4_refl)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(clarify)
+
+lemma
+ assumes "v1 \<succ>r v2" "\<turnstile> v1 : r" "\<turnstile> v2 : r" "flat v1 = flat v2"
+ shows "v1 4\<succ>r v2"
+using assms
+apply(induct v1 r v2 arbitrary:)
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(clarify)
+apply (metis ValOrd4.intros(4) ValOrd4_flat ValOrd4_refl)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[5]
+apply(clarify)
+
+
+apply(simp)
+apply(erule Prf.cases)
+
+
+
+
+lemma rr2: "hd (flats v) \<noteq> [] \<Longrightarrow> flats v \<noteq> []"
+apply(induct v)
+apply(auto)
+done
+
+lemma rr3: "flats v = [] \<Longrightarrow> flat v = []"
+apply(induct v)
+apply(auto)
+done
+
+lemma POSIXs_der:
+ assumes "POSIXs v (der c r) s" "\<Turnstile>s v : der c r"
+ shows "POSIXs (injval r c v) r (c#s)"
+using assms
+unfolding POSIXs_def
+apply(auto)
+thm v3s
+apply (erule v3s)
+apply(drule_tac x="projval r c v'" in spec)
+apply(drule mp)
+thm v3s_proj
+apply(rule v3s_proj)
+apply(simp)
+thm v3s_proj
+apply(drule v3s_proj)
+oops
+
+term Values
+(* HERE *)
+
+lemma Prf_inj_test:
+ assumes "v1 \<succ>(der c r) v2"
+ "v1 \<in> Values (der c r) s"
+ "v2 \<in> Values (der c r) s"
+ "injval r c v1 \<in> Values r (c#s)"
+ "injval r c v2 \<in> Values r (c#s)"
+ shows "(injval r c v1) 2\<succ> (injval r c v2)"
+using assms
+apply(induct c r arbitrary: v1 v2 s rule: der.induct)
+(* NULL case *)
+apply(simp add: Values_recs)
+(* EMPTY case *)
+apply(simp add: Values_recs)
+(* CHAR case *)
+apply(case_tac "c = c'")
+apply(simp)
+apply(simp add: Values_recs)
+apply (metis ValOrd2.intros(8))
+apply(simp add: Values_recs)
+(* ALT case *)
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply (metis ValOrd2.intros(6))
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd2.intros)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd2.intros)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply (metis ValOrd2.intros(5))
+(* SEQ case*)
+apply(simp)
+apply(case_tac "nullable r1")
+apply(simp)
+defer
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply(rule ValOrd2.intros)
+apply(simp)
+apply (metis Ord1)
+apply(clarify)
+apply(rule ValOrd2.intros)
+apply(subgoal_tac "rest v1 (flat v1 @ flat v2) = flat v2")
+apply(simp)
+apply(subgoal_tac "rest (injval r1 c v1) (c # flat v1 @ flat v2) = flat v2")
+apply(simp)
+
+apply metis
+using injval_inj
+apply(simp add: Values_def inj_on_def)
+apply metis
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply (metis Ord1 ValOrd2.intros(1))
+apply(clarify)
+apply(rule ValOrd2.intros(2))
+apply metis
+using injval_inj
+apply(simp add: Values_def inj_on_def)
+apply metis
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd2.intros(2))
+thm h
+apply(rule Ord1)
+apply(rule h)
+apply(simp)
+apply(simp add: Values_def)
+apply(simp add: Values_def)
+apply (metis list.distinct(1) mkeps_flat v4)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply(simp add: Values_def)
+defer
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply(rule ValOrd2.intros(1))
+apply(rotate_tac 1)
+apply(drule_tac x="v2" in meta_spec)
+apply(rotate_tac 8)
+apply(drule_tac x="v2'" in meta_spec)
+apply(rotate_tac 8)
+apply(drule_tac x="s" in meta_spec)
+apply(simp)
+apply(drule_tac meta_mp)
+apply(simp add: rest_def mkeps_flat)
+apply(drule_tac meta_mp)
+apply(simp add: rest_def mkeps_flat)
+apply(simp)
+apply(simp add: rest_def mkeps_flat)
+apply(subst (asm) (5) v4)
+apply(simp)
+apply(subst (asm) (5) v4)
+apply(simp)
+apply(subst (asm) (5) v4)
+apply(simp)
+apply(simp)
+apply(clarify)
+apply(simp add: prefix_Cons)
+apply(subgoal_tac "((flat v1c) @ (flat v2b)) \<sqsubseteq> (flat v2)")
+prefer 2
+apply(simp add: prefix_def)
+apply(auto)[1]
+(* HEREHERE *)
+
+
+lemma Prf_inj_test:
+ assumes "v1 \<succ>r v2"
+ "v1 \<in> Values r s"
+ "v2 \<in> Values r s"
+ "injval r c v1 \<in> Values (red c r) (c#s)"
+ "injval r c v2 \<in> Values (red c r) (c#s)"
+ shows "(injval r c v1) \<succ>(red c r) (injval r c v2)"
+using assms
+apply(induct v1 r v2 arbitrary: s rule: ValOrd.induct)
+apply(simp add: Values_recs)
+apply (metis ValOrd.intros(1))
+apply(simp add: Values_recs)
+apply(rule ValOrd.intros(2))
+apply(metis)
+defer
+apply(simp add: Values_recs)
+apply(rule ValOrd.intros)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(subst v4)
+apply(simp add: Values_def)
+using injval_inj_red
+apply(simp add: Values_def inj_on_def)
+apply(rule notI)
+apply(drule_tac x="r1" in meta_spec)
+apply(drule_tac x="c" in meta_spec)
+apply(drule_tac x="injval r1 c v1" in spec)
+apply(simp)
+
+apply(drule_tac x="c" in meta_spec)
+
+apply metis
+apply (metis ValOrd.intros(1))
+
+
+
+done
+(* EMPTY case *)
+apply(simp add: Values_recs)
+(* CHAR case *)
+apply(case_tac "c = c'")
+apply(simp)
+apply(simp add: Values_recs)
+apply (metis ValOrd2.intros(8))
+apply(simp add: Values_recs)
+(* ALT case *)
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply (metis ValOrd2.intros(6))
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd2.intros)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd2.intros)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply (metis ValOrd2.intros(5))
+(* SEQ case*)
+apply(simp)
+apply(case_tac "nullable r1")
+apply(simp)
+defer
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply(rule ValOrd2.intros)
+apply(simp)
+apply (metis Ord1)
+apply(clarify)
+apply(rule ValOrd2.intros)
+apply metis
+using injval_inj
+apply(simp add: Values_def inj_on_def)
+apply metis
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply (metis Ord1 ValOrd2.intros(1))
+apply(clarify)
+apply(rule ValOrd2.intros(2))
+apply metis
+using injval_inj
+apply(simp add: Values_def inj_on_def)
+apply metis
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd2.intros(2))
+thm h
+apply(rule Ord1)
+apply(rule h)
+apply(simp)
+apply(simp add: Values_def)
+apply(simp add: Values_def)
+apply (metis list.distinct(1) mkeps_flat v4)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply(simp add: Values_def)
+defer
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply(rule ValOrd2.intros(1))
+apply(rotate_tac 1)
+apply(drule_tac x="v2" in meta_spec)
+apply(rotate_tac 8)
+apply(drule_tac x="v2'" in meta_spec)
+apply(rotate_tac 8)
+apply(drule_tac x="s" in meta_spec)
+apply(simp)
+apply(drule_tac meta_mp)
+apply(simp add: rest_def mkeps_flat)
+apply(drule_tac meta_mp)
+apply(simp add: rest_def mkeps_flat)
+apply(simp)
+apply(simp add: rest_def mkeps_flat)
+apply(subst (asm) (5) v4)
+apply(simp)
+apply(subst (asm) (5) v4)
+apply(simp)
+apply(subst (asm) (5) v4)
+apply(simp)
+apply(simp)
+apply(clarify)
+apply(simp add: prefix_Cons)
+apply(subgoal_tac "((flat v1c) @ (flat v2b)) \<sqsubseteq> (flat v2)")
+prefer 2
+apply(simp add: prefix_def)
+apply(auto)[1]
+(* HEREHERE *)
+
+lemma Prf_inj_test:
+ assumes "v1 \<succ>(der c r) v2"
+ "v1 \<in> Values (der c r) s"
+ "v2 \<in> Values (der c r) s"
+ "injval r c v1 \<in> Values r (c#s)"
+ "injval r c v2 \<in> Values r (c#s)"
+ shows "(injval r c v1) 2\<succ> (injval r c v2)"
+using assms
+apply(induct c r arbitrary: v1 v2 s rule: der.induct)
+(* NULL case *)
+apply(simp add: Values_recs)
+(* EMPTY case *)
+apply(simp add: Values_recs)
+(* CHAR case *)
+apply(case_tac "c = c'")
+apply(simp)
+apply(simp add: Values_recs)
+apply (metis ValOrd2.intros(8))
+apply(simp add: Values_recs)
+(* ALT case *)
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply (metis ValOrd2.intros(6))
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd2.intros)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd2.intros)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply (metis ValOrd2.intros(5))
+(* SEQ case*)
+apply(simp)
+apply(case_tac "nullable r1")
+apply(simp)
+defer
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply(rule ValOrd2.intros)
+apply(simp)
+apply (metis Ord1)
+apply(clarify)
+apply(rule ValOrd2.intros)
+apply metis
+using injval_inj
+apply(simp add: Values_def inj_on_def)
+apply metis
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply (metis Ord1 ValOrd2.intros(1))
+apply(clarify)
+apply(rule ValOrd2.intros(2))
+apply metis
+using injval_inj
+apply(simp add: Values_def inj_on_def)
+apply metis
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd2.intros(2))
+thm h
+apply(rule Ord1)
+apply(rule h)
+apply(simp)
+apply(simp add: Values_def)
+apply(simp add: Values_def)
+apply (metis list.distinct(1) mkeps_flat v4)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply(simp add: Values_def)
+defer
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply(rule ValOrd2.intros(1))
+apply(rotate_tac 1)
+apply(drule_tac x="v2" in meta_spec)
+apply(rotate_tac 8)
+apply(drule_tac x="v2'" in meta_spec)
+apply(rotate_tac 8)
+apply(drule_tac x="s" in meta_spec)
+apply(simp)
+apply(drule_tac meta_mp)
+apply(simp add: rest_def mkeps_flat)
+apply(drule_tac meta_mp)
+apply(simp add: rest_def mkeps_flat)
+apply(simp)
+apply(simp add: rest_def mkeps_flat)
+apply(subst (asm) (5) v4)
+apply(simp)
+apply(subst (asm) (5) v4)
+apply(simp)
+apply(subst (asm) (5) v4)
+apply(simp)
+apply(simp)
+apply(clarify)
+apply(simp add: prefix_Cons)
+apply(subgoal_tac "((flat v1c) @ (flat v2b)) \<sqsubseteq> (flat v2)")
+prefer 2
+apply(simp add: prefix_def)
+apply(auto)[1]
+(* HEREHERE *)
+
+apply(subst (asm) (7) v4)
+apply(simp)
+
+
+(* HEREHERE *)
+
+apply(simp add: Values_def)
+apply(simp add: Values_recs)
+apply(simp add: Values_recs)
+done
+
+lemma POSIX_der:
+ assumes "POSIX v (der c r)" "\<turnstile> v : der c r"
+ shows "POSIX (injval r c v) r"
+using assms
+unfolding POSIX_def
+apply(auto)
+thm v3
+apply (erule v3)
+thm v4
+apply(subst (asm) v4)
+apply(assumption)
+apply(drule_tac x="projval r c v'" in spec)
+apply(drule mp)
+apply(rule conjI)
+thm v3_proj
+apply(rule v3_proj)
+apply(simp)
+apply(rule_tac x="flat v" in exI)
+apply(simp)
+thm t
+apply(rule_tac c="c" in t)
+apply(simp)
+thm v4_proj
+apply(subst v4_proj)
+apply(simp)
+apply(rule_tac x="flat v" in exI)
+apply(simp)
+apply(simp)
+thm Prf_inj_test
+apply(drule_tac r="r" in Prf_inj_test)
+oops
+
+lemma POSIX_der:
+ assumes "POSIX v (der c r)" "\<turnstile> v : der c r"
+ shows "POSIX (injval r c v) r"
+using assms
+apply(induct c r arbitrary: v rule: der.induct)
+(* null case*)
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+(* empty case *)
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+(* char case *)
+apply(simp add: POSIX_def)
+apply(case_tac "c = c'")
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis Prf.intros(5))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(8))
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+(* alt case *)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(simp (no_asm) add: POSIX_def)
+apply(auto)[1]
+apply (metis Prf.intros(2) v3)
+apply(rotate_tac 4)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis POSIX_ALT2 POSIX_def ValOrd.intros(6))
+apply (metis ValOrd.intros(3) order_refl)
+apply(simp (no_asm) add: POSIX_def)
+apply(auto)[1]
+apply (metis Prf.intros(3) v3)
+apply(rotate_tac 4)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+defer
+apply (metis POSIX_ALT1a POSIX_def ValOrd.intros(5))
+prefer 2
+apply(subst (asm) (5) POSIX_def)
+apply(auto)[1]
+apply(rotate_tac 5)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rule ValOrd.intros)
+apply(subst (asm) v4)
+apply(simp)
+apply(drule_tac x="Left (projval r1a c v1)" in spec)
+apply(clarify)
+apply(drule mp)
+apply(rule conjI)
+apply (metis Prf.intros(2) v3_proj)
+apply(simp)
+apply (metis v4_proj2)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply (metis less_not_refl v4_proj2)
+(* seq case *)
+apply(case_tac "nullable r1")
+defer
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis Prf.intros(1) v3)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(subst (asm) (3) v4)
+apply(simp)
+apply(simp)
+apply(subgoal_tac "flat v1a \<noteq> []")
+prefer 2
+apply (metis Prf_flat_L nullable_correctness)
+apply(subgoal_tac "\<exists>s. flat v1a = c # s")
+prefer 2
+apply (metis append_eq_Cons_conv)
+apply(auto)[1]
+
+
+apply(auto)
+thm v3
+apply (erule v3)
+thm v4
+apply(subst (asm) v4)
+apply(assumption)
+apply(drule_tac x="projval r c v'" in spec)
+apply(drule mp)
+apply(rule conjI)
+thm v3_proj
+apply(rule v3_proj)
+apply(simp)
+apply(rule_tac x="flat v" in exI)
+apply(simp)
+thm t
+apply(rule_tac c="c" in t)
+apply(simp)
+thm v4_proj
+apply(subst v4_proj)
+apply(simp)
+apply(rule_tac x="flat v" in exI)
+apply(simp)
+apply(simp)
+oops
+
+
+lemma POSIX_ex: "\<turnstile> v : r \<Longrightarrow> \<exists>v. POSIX v r"
+apply(induct r arbitrary: v)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rule_tac x="Void" in exI)
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply (metis Prf.intros(4))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(7))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rule_tac x="Char c" in exI)
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply (metis Prf.intros(5))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(8))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply(drule_tac x="v1" in meta_spec)
+apply(drule_tac x="v2" in meta_spec)
+apply(auto)[1]
+defer
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply (metis POSIX_ALT_I1)
+apply (metis POSIX_ALT_I1 POSIX_ALT_I2)
+apply(case_tac "nullable r1a")
+apply(rule_tac x="Seq (mkeps r1a) va" in exI)
+apply(auto simp add: POSIX_def)[1]
+apply (metis Prf.intros(1) mkeps_nullable)
+apply(simp add: mkeps_flat)
+apply(rotate_tac 7)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(case_tac "mkeps r1 = v1a")
+apply(simp)
+apply (rule ValOrd.intros(1))
+apply (metis append_Nil mkeps_flat)
+apply (rule ValOrd.intros(2))
+apply(drule mkeps_POSIX)
+apply(simp add: POSIX_def)
+
+apply metis
+apply(simp)
+apply(simp)
+apply(erule disjE)
+apply(simp)
+
+apply(drule_tac x="v2" in spec)
+
+lemma POSIX_ex2: "\<turnstile> v : r \<Longrightarrow> \<exists>v. POSIX v r \<and> \<turnstile> v : r"
+apply(induct r arbitrary: v)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rule_tac x="Void" in exI)
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(7))
+apply (metis Prf.intros(4))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rule_tac x="Char c" in exI)
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(8))
+apply (metis Prf.intros(5))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply(drule_tac x="v1" in meta_spec)
+apply(drule_tac x="v2" in meta_spec)
+apply(auto)[1]
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply(rule ccontr)
+apply(simp)
+apply(drule_tac x="Seq v va" in spec)
+apply(drule mp)
+defer
+apply (metis Prf.intros(1))
+oops
+
+lemma POSIX_ALT_cases:
+ assumes "\<turnstile> v : (ALT r1 r2)" "POSIX v (ALT r1 r2)"
+ shows "(\<exists>v1. v = Left v1 \<and> POSIX v1 r1) \<or> (\<exists>v2. v = Right v2 \<and> POSIX v2 r2)"
+using assms
+apply(erule_tac Prf.cases)
+apply(simp_all)
+unfolding POSIX_def
+apply(auto)
+apply (metis POSIX_ALT2 POSIX_def assms(2))
+by (metis POSIX_ALT1b assms(2))
+
+lemma POSIX_ALT_cases2:
+ assumes "POSIX v (ALT r1 r2)" "\<turnstile> v : (ALT r1 r2)"
+ shows "(\<exists>v1. v = Left v1 \<and> POSIX v1 r1) \<or> (\<exists>v2. v = Right v2 \<and> POSIX v2 r2)"
+using assms POSIX_ALT_cases by auto
+
+lemma Prf_flat_empty:
+ assumes "\<turnstile> v : r" "flat v = []"
+ shows "nullable r"
+using assms
+apply(induct)
+apply(auto)
+done
+
+lemma POSIX_proj:
+ assumes "POSIX v r" "\<turnstile> v : r" "\<exists>s. flat v = c#s"
+ shows "POSIX (projval r c v) (der c r)"
+using assms
+apply(induct r c v arbitrary: rule: projval.induct)
+defer
+defer
+defer
+defer
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(7))
+apply(erule_tac [!] exE)
+prefer 3
+apply(frule POSIX_SEQ1)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(case_tac "flat v1 = []")
+apply(subgoal_tac "nullable r1")
+apply(simp)
+prefer 2
+apply(rule_tac v="v1" in Prf_flat_empty)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(frule POSIX_SEQ2)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(drule meta_mp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rule ccontr)
+apply(subgoal_tac "\<turnstile> val.Right (projval r2 c v2) : (ALT (SEQ (der c r1) r2) (der c r2))")
+apply(rotate_tac 11)
+apply(frule POSIX_ex)
+apply(erule exE)
+apply(drule POSIX_ALT_cases2)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(drule v3_proj)
+apply(simp)
+apply(simp)
+apply(drule POSIX_ex)
+apply(erule exE)
+apply(frule POSIX_ALT_cases2)
+apply(simp)
+apply(simp)
+apply(erule
+prefer 2
+apply(case_tac "nullable r1")
+prefer 2
+apply(simp)
+apply(rotate_tac 1)
+apply(drule meta_mp)
+apply(rule POSIX_SEQ1)
+apply(assumption)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rotate_tac 7)
+apply(drule meta_mp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rotate_tac 7)
+apply(drule meta_mp)
+apply (metis Cons_eq_append_conv)
+
+
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp add: POSIX_def)
+apply(simp)
+apply(simp)
+apply(simp_all)[5]
+apply(simp add: POSIX_def)
+
+
+lemma POSIX_proj:
+ assumes "POSIX v r" "\<turnstile> v : r" "\<exists>s. flat v = c#s"
+ shows "POSIX (projval r c v) (der c r)"
+using assms
+apply(induct r arbitrary: c v rule: rexp.induct)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(7))
+
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(7))
+apply(erule_tac [!] exE)
+prefer 3
+apply(frule POSIX_SEQ1)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(case_tac "flat v1 = []")
+apply(subgoal_tac "nullable r1")
+apply(simp)
+prefer 2
+apply(rule_tac v="v1" in Prf_flat_empty)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+
+
+lemma POSIX_proj:
+ assumes "POSIX v r" "\<turnstile> v : r" "\<exists>s. flat v = c#s"
+ shows "POSIX (projval r c v) (der c r)"
+using assms
+apply(induct r c v arbitrary: rule: projval.induct)
+defer
+defer
+defer
+defer
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(7))
+apply(erule_tac [!] exE)
+prefer 3
+apply(frule POSIX_SEQ1)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(case_tac "flat v1 = []")
+apply(subgoal_tac "nullable r1")
+apply(simp)
+prefer 2
+apply(rule_tac v="v1" in Prf_flat_empty)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(rule ccontr)
+apply(drule v3_proj)
+apply(simp)
+apply(simp)
+apply(drule POSIX_ex)
+apply(erule exE)
+apply(frule POSIX_ALT_cases2)
+apply(simp)
+apply(simp)
+apply(erule
+prefer 2
+apply(case_tac "nullable r1")
+prefer 2
+apply(simp)
+apply(rotate_tac 1)
+apply(drule meta_mp)
+apply(rule POSIX_SEQ1)
+apply(assumption)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rotate_tac 7)
+apply(drule meta_mp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rotate_tac 7)
+apply(drule meta_mp)
+apply (metis Cons_eq_append_conv)
+
+
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp add: POSIX_def)
+apply(simp)
+apply(simp)
+apply(simp_all)[5]
+apply(simp add: POSIX_def)
+
+done
+(* NULL case *)
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(7))
+apply(rotate_tac 4)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+prefer 2
+apply(simp)
+apply(frule POSIX_ALT1a)
+apply(drule meta_mp)
+apply(simp)
+apply(drule meta_mp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rule POSIX_ALT_I2)
+apply(assumption)
+apply(auto)[1]
+
+thm v4_proj2
+prefer 2
+apply(subst (asm) (13) POSIX_def)
+
+apply(drule_tac x="projval v2" in spec)
+apply(auto)[1]
+apply(drule mp)
+apply(rule conjI)
+apply(simp)
+apply(simp)
+
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+prefer 2
+apply(clarify)
+apply(subst (asm) (2) POSIX_def)
+
+apply (metis ValOrd.intros(5))
+apply(clarify)
+apply(simp)
+apply(rotate_tac 3)
+apply(drule_tac c="c" in t2)
+apply(subst (asm) v4_proj)
+apply(simp)
+apply(simp)
+thm contrapos_np contrapos_nn
+apply(erule contrapos_np)
+apply(rule ValOrd.intros)
+apply(subst v4_proj2)
+apply(simp)
+apply(simp)
+apply(subgoal_tac "\<not>(length (flat v1) < length (flat (projval r2a c v2a)))")
+prefer 2
+apply(erule contrapos_nn)
+apply (metis nat_less_le v4_proj2)
+apply(simp)
+
+apply(blast)
+thm contrapos_nn
+
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(rule ValOrd.intros)
+apply(drule meta_mp)
+apply(auto)[1]
+apply (metis POSIX_ALT2 POSIX_def flat.simps(3))
+apply metis
+apply(clarify)
+apply(rule ValOrd.intros)
+apply(simp)
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(rule ValOrd.intros)
+apply(simp)
+
+apply(drule meta_mp)
+apply(auto)[1]
+apply (metis POSIX_ALT2 POSIX_def flat.simps(3))
+apply metis
+apply(clarify)
+apply(rule ValOrd.intros)
+apply(simp)
+
+
+done
+(* EMPTY case *)
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply(rotate_tac 3)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(drule_tac c="c" in t2)
+apply(subst (asm) v4_proj)
+apply(auto)[2]
+
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+(* CHAR case *)
+apply(case_tac "c = c'")
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd.intros)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+(* ALT case *)
+
+
+unfolding POSIX_def
+apply(auto)
+thm v4
+
+lemma Prf_inj:
+ assumes "v1 \<succ>(der c r) v2" "\<turnstile> v1 : der c r" "\<turnstile> v2 : der c r" "flat v1 = flat v2"
+ shows "(injval r c v1) \<succ>r (injval r c v2)"
+using assms
+apply(induct arbitrary: v1 v2 rule: der.induct)
+(* NULL case *)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+(* EMPTY case *)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+(* CHAR case *)
+apply(case_tac "c = c'")
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd.intros)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+(* ALT case *)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd.intros)
+apply(subst v4)
+apply(clarify)
+apply(rotate_tac 3)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(subst v4)
+apply(clarify)
+apply(rotate_tac 2)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(rule ValOrd.intros)
+apply(clarify)
+apply(rotate_tac 3)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rule ValOrd.intros)
+apply(clarify)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+(* SEQ case*)
+apply(simp)
+apply(case_tac "nullable r1")
+defer
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(rule ValOrd.intros)
+apply(simp)
+apply(simp)
+apply(rule ValOrd.intros(2))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+defer
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all del: injval.simps)[8]
+apply(simp)
+apply(clarify)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(rule ValOrd.intros(2))
+
+
+
+
+done
+
+
+txt {*
+done
+(* nullable case - unfinished *)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all del: injval.simps)[8]
+apply(simp)
+apply(clarify)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(simp)
+apply(rule ValOrd.intros(2))
+oops
+*}
+oops
+
+
+
+text {*
+ Injection followed by projection is the identity.
+*}
+
+lemma proj_inj_id:
+ assumes "\<turnstile> v : der c r"
+ shows "projval r c (injval r c v) = v"
+using assms
+apply(induct r arbitrary: c v rule: rexp.induct)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(case_tac "c = char")
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+defer
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(case_tac "nullable rexp1")
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply (metis list.distinct(1) v4)
+apply(auto)[1]
+apply (metis mkeps_flat)
+apply(auto)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply(simp add: v4)
+done
+
+lemma "L r \<noteq> {} \<Longrightarrow> \<exists>v. POSIX3 v r"
+apply(induct r)
+apply(simp)
+apply(simp add: POSIX3_def)
+apply(rule_tac x="Void" in exI)
+apply(auto)[1]
+apply (metis Prf.intros(4))
+apply (metis POSIX3_def flat.simps(1) mkeps.simps(1) mkeps_POSIX3 nullable.simps(2) order_refl)
+apply(simp add: POSIX3_def)
+apply(rule_tac x="Char char" in exI)
+apply(auto)[1]
+apply (metis Prf.intros(5))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(8))
+apply(simp add: Sequ_def)
+apply(auto)[1]
+apply(drule meta_mp)
+apply(auto)[2]
+apply(drule meta_mp)
+apply(auto)[2]
+apply(rule_tac x="Seq v va" in exI)
+apply(simp (no_asm) add: POSIX3_def)
+apply(auto)[1]
+apply (metis POSIX3_def Prf.intros(1))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(case_tac "v \<succ>r1a v1")
+apply(rule ValOrd.intros(2))
+apply(simp)
+apply(case_tac "v = v1")
+apply(rule ValOrd.intros(1))
+apply(simp)
+apply(simp)
+apply (metis ValOrd_refl)
+apply(simp add: POSIX3_def)
+oops
+
+lemma "\<exists>v. POSIX v r"
+apply(induct r)
+apply(rule exI)
+apply(simp add: POSIX_def)
+apply (metis (full_types) Prf_flat_L der.simps(1) der.simps(2) der.simps(3) flat.simps(1) nullable.simps(1) nullable_correctness proj_inj_id projval.simps(1) v3 v4)
+apply(rule_tac x = "Void" in exI)
+apply(simp add: POSIX_def)
+apply (metis POSIX_def flat.simps(1) mkeps.simps(1) mkeps_POSIX nullable.simps(2))
+apply(rule_tac x = "Char char" in exI)
+apply(simp add: POSIX_def)
+apply(auto) [1]
+apply(erule Prf.cases)
+apply(simp_all) [5]
+apply (metis ValOrd.intros(8))
+defer
+apply(auto)
+apply (metis POSIX_ALT_I1)
+(* maybe it is too early to instantiate this existential quantifier *)
+(* potentially this is the wrong POSIX value *)
+apply(case_tac "r1 = NULL")
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply (metis L.simps(1) L.simps(4) Prf_flat_L mkeps_flat nullable.simps(1) nullable.simps(2) nullable_correctness seq_null(2))
+apply(case_tac "r1 = EMPTY")
+apply(rule_tac x = "Seq Void va" in exI )
+apply(simp (no_asm) add: POSIX_def)
+apply(auto)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)
+apply(rule ValOrd.intros(2))
+apply(rule ValOrd.intros)
+apply(case_tac "\<exists>c. r1 = CHAR c")
+apply(auto)
+apply(rule_tac x = "Seq (Char c) va" in exI )
+apply(simp (no_asm) add: POSIX_def)
+apply(auto)
+apply(erule Prf.cases)
+apply(simp_all)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)
+apply(auto)[1]
+apply(rule ValOrd.intros(2))
+apply(rule ValOrd.intros)
+apply(case_tac "\<exists>r1a r1b. r1 = ALT r1a r1b")
+apply(auto)
+oops (* not sure if this can be proved by induction *)
+
+text {*
+
+ HERE: Crucial lemma that does not go through in the sequence case.
+
+*}
+lemma v5:
+ assumes "\<turnstile> v : der c r" "POSIX v (der c r)"
+ shows "POSIX (injval r c v) r"
+using assms
+apply(induct arbitrary: v rule: der.induct)
+(* NULL case *)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+(* EMPTY case *)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+(* CHAR case *)
+apply(simp)
+apply(case_tac "c = c'")
+apply(auto simp add: POSIX_def)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rule ValOrd.intros)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+(* base cases done *)
+(* ALT case *)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+using POSIX_ALT POSIX_ALT_I1 apply blast
+apply(clarify)
+apply(simp)
+apply(rule POSIX_ALT_I2)
+apply(drule POSIX_ALT1a)
+apply metis
+apply(auto)[1]
+apply(subst v4)
+apply(assumption)
+apply(simp)
+apply(drule POSIX_ALT1a)
+apply(rotate_tac 1)
+apply(drule_tac x="v2" in meta_spec)
+apply(simp)
+
+apply(rotate_tac 4)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rule ValOrd.intros)
+apply(simp)
+apply(subst (asm) v4)
+apply(assumption)
+apply(clarify)
+thm POSIX_ALT1a POSIX_ALT1b POSIX_ALT_I2
+apply(subst (asm) v4)
+apply(auto simp add: POSIX_def)[1]
+apply(subgoal_tac "POSIX v2 (der c r2)")
+prefer 2
+apply(auto simp add: POSIX_def)[1]
+apply (metis POSIX_ALT1a POSIX_def flat.simps(4))
+apply(frule POSIX_ALT1a)
+apply(drule POSIX_ALT1b)
+apply(rule POSIX_ALT_I2)
+apply(rotate_tac 1)
+apply(drule_tac x="v2" in meta_spec)
+apply(simp)
+apply(subgoal_tac "\<turnstile> Right (injval r2 c v2) : (ALT r1 r2)")
+prefer 2
+apply (metis Prf.intros(3) v3)
+apply auto[1]
+apply(subst v4)
+apply(auto)[2]
+apply(subst (asm) (4) POSIX_def)
+apply(subst (asm) v4)
+apply(drule_tac x="v2" in meta_spec)
+apply(simp)
+
+apply(auto)[2]
+
+thm POSIX_ALT_I2
+apply(rule POSIX_ALT_I2)
+
+apply(rule ccontr)
+apply(auto simp add: POSIX_def)[1]
+
+apply(rule allI)
+apply(rule impI)
+apply(erule conjE)
+thm POSIX_ALT_I2
+apply(frule POSIX_ALT1a)
+apply(drule POSIX_ALT1b)
+apply(rule POSIX_ALT_I2)
+apply auto[1]
+apply(subst v4)
+apply(auto)[2]
+apply(rotate_tac 1)
+apply(drule_tac x="v2" in meta_spec)
+apply(simp)
+apply(subst (asm) (4) POSIX_def)
+apply(subst (asm) v4)
+apply(auto)[2]
+(* stuck in the ALT case *)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys2/ReTest.thy Sun Oct 10 18:35:21 2021 +0100
@@ -0,0 +1,3991 @@
+
+theory ReTest
+ imports "Main"
+begin
+
+
+section {* Sequential Composition of Sets *}
+
+definition
+ Sequ :: "string set \<Rightarrow> string set \<Rightarrow> string set" ("_ ;; _" [100,100] 100)
+where
+ "A ;; B = {s1 @ s2 | s1 s2. s1 \<in> A \<and> s2 \<in> B}"
+
+fun spow where
+ "spow s 0 = []"
+| "spow s (Suc n) = s @ spow s n"
+
+text {* Two Simple Properties about Sequential Composition *}
+
+lemma seq_empty [simp]:
+ shows "A ;; {[]} = A"
+ and "{[]} ;; A = A"
+by (simp_all add: Sequ_def)
+
+lemma seq_null [simp]:
+ shows "A ;; {} = {}"
+ and "{} ;; A = {}"
+by (simp_all add: Sequ_def)
+
+definition
+ Der :: "char \<Rightarrow> string set \<Rightarrow> string set"
+where
+ "Der c A \<equiv> {s. [c] @ s \<in> A}"
+
+definition
+ Ders :: "string \<Rightarrow> string set \<Rightarrow> string set"
+where
+ "Ders s A \<equiv> {s' | s'. s @ s' \<in> A}"
+
+lemma Der_null [simp]:
+ shows "Der c {} = {}"
+unfolding Der_def
+by auto
+
+lemma Der_empty [simp]:
+ shows "Der c {[]} = {}"
+unfolding Der_def
+by auto
+
+lemma Der_char [simp]:
+ shows "Der c {[d]} = (if c = d then {[]} else {})"
+unfolding Der_def
+by auto
+
+lemma Der_union [simp]:
+ shows "Der c (A \<union> B) = Der c A \<union> Der c B"
+unfolding Der_def
+by auto
+
+lemma Der_seq [simp]:
+ shows "Der c (A ;; B) = (Der c A) ;; B \<union> (if [] \<in> A then Der c B else {})"
+unfolding Der_def Sequ_def
+apply (auto simp add: Cons_eq_append_conv)
+done
+
+lemma seq_image:
+ assumes "\<forall>s1 s2. f (s1 @ s2) = (f s1) @ (f s2)"
+ shows "f ` (A ;; B) = (f ` A) ;; (f ` B)"
+apply(auto simp add: Sequ_def image_def)
+apply(rule_tac x="f s1" in exI)
+apply(rule_tac x="f s2" in exI)
+using assms
+apply(auto)
+apply(rule_tac x="xa @ xb" in exI)
+using assms
+apply(auto)
+done
+
+section {* Kleene Star for Sets *}
+
+inductive_set
+ Star :: "string set \<Rightarrow> string set" ("_\<star>" [101] 102)
+ for A :: "string set"
+where
+ start[intro]: "[] \<in> A\<star>"
+| step[intro]: "\<lbrakk>s1 \<in> A; s2 \<in> A\<star>\<rbrakk> \<Longrightarrow> s1 @ s2 \<in> A\<star>"
+
+lemma star_cases:
+ shows "A\<star> = {[]} \<union> A ;; A\<star>"
+unfolding Sequ_def
+by (auto) (metis Star.simps)
+
+
+fun
+ pow :: "string set \<Rightarrow> nat \<Rightarrow> string set" ("_ \<up> _" [100,100] 100)
+where
+ "A \<up> 0 = {[]}"
+| "A \<up> (Suc n) = A ;; (A \<up> n)"
+
+lemma star1:
+ shows "s \<in> A\<star> \<Longrightarrow> \<exists>n. s \<in> A \<up> n"
+ apply(induct rule: Star.induct)
+ apply (metis pow.simps(1) insertI1)
+ apply(auto)
+ apply(rule_tac x="Suc n" in exI)
+ apply(auto simp add: Sequ_def)
+ done
+
+lemma star2:
+ shows "s \<in> A \<up> n \<Longrightarrow> s \<in> A\<star>"
+ apply(induct n arbitrary: s)
+ apply (metis pow.simps(1) Star.simps empty_iff insertE)
+ apply(auto simp add: Sequ_def)
+ done
+
+lemma star3:
+ shows "A\<star> = (\<Union>i. A \<up> i)"
+using star1 star2
+apply(auto)
+done
+
+lemma star4:
+ shows "s \<in> A \<up> n \<Longrightarrow> \<exists>ss. s = concat ss \<and> (\<forall>s' \<in> set ss. s' \<in> A)"
+ apply(induct n arbitrary: s)
+ apply(auto simp add: Sequ_def)
+ apply(rule_tac x="[]" in exI)
+ apply(auto)
+ apply(drule_tac x="s2" in meta_spec)
+ apply(auto)
+by (metis concat.simps(2) insertE set_simps(2))
+
+lemma star5:
+ assumes "f [] = []"
+ assumes "\<forall>s1 s2. f (s1 @ s2) = (f s1) @ (f s2)"
+ shows "(f ` A) \<up> n = f ` (A \<up> n)"
+apply(induct n)
+apply(simp add: assms)
+apply(simp)
+apply(subst seq_image[OF assms(2)])
+apply(simp)
+done
+
+lemma star6:
+ assumes "f [] = []"
+ assumes "\<forall>s1 s2. f (s1 @ s2) = (f s1) @ (f s2)"
+ shows "(f ` A)\<star> = f ` (A\<star>)"
+apply(simp add: star3)
+apply(simp add: image_UN)
+apply(subst star5[OF assms])
+apply(simp)
+done
+
+lemma star_decomp:
+ assumes a: "c # x \<in> A\<star>"
+ shows "\<exists>a b. x = a @ b \<and> c # a \<in> A \<and> b \<in> A\<star>"
+using a
+by (induct x\<equiv>"c # x" rule: Star.induct)
+ (auto simp add: append_eq_Cons_conv)
+
+lemma Der_star [simp]:
+ shows "Der c (A\<star>) = (Der c A) ;; A\<star>"
+proof -
+ have "Der c (A\<star>) = Der c ({[]} \<union> A ;; A\<star>)"
+
+ by (simp only: star_cases[symmetric])
+ also have "... = Der c (A ;; A\<star>)"
+ by (simp only: Der_union Der_empty) (simp)
+ also have "... = (Der c A) ;; A\<star> \<union> (if [] \<in> A then Der c (A\<star>) else {})"
+ by simp
+ also have "... = (Der c A) ;; A\<star>"
+ unfolding Sequ_def Der_def
+ by (auto dest: star_decomp)
+ finally show "Der c (A\<star>) = (Der c A) ;; A\<star>" .
+qed
+
+
+
+section {* Regular Expressions *}
+
+datatype rexp =
+ NULL
+| EMPTY
+| CHAR char
+| SEQ rexp rexp
+| ALT rexp rexp
+| STAR rexp
+
+section {* Semantics of Regular Expressions *}
+
+fun
+ L :: "rexp \<Rightarrow> string set"
+where
+ "L (NULL) = {}"
+| "L (EMPTY) = {[]}"
+| "L (CHAR c) = {[c]}"
+| "L (SEQ r1 r2) = (L r1) ;; (L r2)"
+| "L (ALT r1 r2) = (L r1) \<union> (L r2)"
+| "L (STAR r) = (L r)\<star>"
+
+fun
+ nullable :: "rexp \<Rightarrow> bool"
+where
+ "nullable (NULL) = False"
+| "nullable (EMPTY) = True"
+| "nullable (CHAR c) = False"
+| "nullable (ALT r1 r2) = (nullable r1 \<or> nullable r2)"
+| "nullable (SEQ r1 r2) = (nullable r1 \<and> nullable r2)"
+| "nullable (STAR r) = True"
+
+lemma nullable_correctness:
+ shows "nullable r \<longleftrightarrow> [] \<in> (L r)"
+apply (induct r)
+apply(auto simp add: Sequ_def)
+done
+
+
+
+section {* Values *}
+
+datatype val =
+ Void
+| Char char
+| Seq val val
+| Right val
+| Left val
+| Stars "val list"
+
+section {* The string behind a value *}
+
+fun
+ flat :: "val \<Rightarrow> string"
+where
+ "flat (Void) = []"
+| "flat (Char c) = [c]"
+| "flat (Left v) = flat v"
+| "flat (Right v) = flat v"
+| "flat (Seq v1 v2) = (flat v1) @ (flat v2)"
+| "flat (Stars []) = []"
+| "flat (Stars (v#vs)) = (flat v) @ (flat (Stars vs))"
+
+lemma [simp]:
+ "flat (Stars vs) = concat (map flat vs)"
+apply(induct vs)
+apply(auto)
+done
+
+section {* Relation between values and regular expressions *}
+
+inductive
+ NPrf :: "val \<Rightarrow> rexp \<Rightarrow> bool" ("\<Turnstile> _ : _" [100, 100] 100)
+where
+ "\<lbrakk>\<Turnstile> v1 : r1; \<Turnstile> v2 : r2\<rbrakk> \<Longrightarrow> \<Turnstile> Seq v1 v2 : SEQ r1 r2"
+| "\<Turnstile> v1 : r1 \<Longrightarrow> \<Turnstile> Left v1 : ALT r1 r2"
+| "\<Turnstile> v2 : r2 \<Longrightarrow> \<Turnstile> Right v2 : ALT r1 r2"
+| "\<Turnstile> Void : EMPTY"
+| "\<Turnstile> Char c : CHAR c"
+| "\<Turnstile> Stars [] : STAR r"
+| "\<lbrakk>\<Turnstile> v : r; \<Turnstile> Stars vs : STAR r; flat v \<noteq> []\<rbrakk> \<Longrightarrow> \<Turnstile> Stars (v # vs) : STAR r"
+
+inductive
+ Prf :: "val \<Rightarrow> rexp \<Rightarrow> bool" ("\<turnstile> _ : _" [100, 100] 100)
+where
+ "\<lbrakk>\<turnstile> v1 : r1; \<turnstile> v2 : r2\<rbrakk> \<Longrightarrow> \<turnstile> Seq v1 v2 : SEQ r1 r2"
+| "\<turnstile> v1 : r1 \<Longrightarrow> \<turnstile> Left v1 : ALT r1 r2"
+| "\<turnstile> v2 : r2 \<Longrightarrow> \<turnstile> Right v2 : ALT r1 r2"
+| "\<turnstile> Void : EMPTY"
+| "\<turnstile> Char c : CHAR c"
+| "\<turnstile> Stars [] : STAR r"
+| "\<lbrakk>\<turnstile> v : r; \<turnstile> Stars vs : STAR r\<rbrakk> \<Longrightarrow> \<turnstile> Stars (v # vs) : STAR r"
+
+lemma NPrf_imp_Prf:
+ assumes "\<Turnstile> v : r"
+ shows "\<turnstile> v : r"
+using assms
+apply(induct)
+apply(auto intro: Prf.intros)
+done
+
+lemma NPrf_Prf_val:
+ shows "\<turnstile> v : r \<Longrightarrow> \<exists>v'. flat v' = flat v \<and> \<Turnstile> v' : r"
+ and "\<turnstile> Stars vs : r \<Longrightarrow> \<exists>vs'. flat (Stars vs') = flat (Stars vs) \<and> \<Turnstile> Stars vs' : r"
+using assms
+apply(induct v and vs arbitrary: r and r rule: val.inducts)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(rule_tac x="Void" in exI)
+apply(simp)
+apply(rule NPrf.intros)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(rule_tac x="Char c" in exI)
+apply(simp)
+apply(rule NPrf.intros)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(auto)[1]
+apply(drule_tac x="r1" in meta_spec)
+apply(drule_tac x="r2" in meta_spec)
+apply(simp)
+apply(auto)[1]
+apply(rule_tac x="Seq v' v'a" in exI)
+apply(simp)
+apply (metis NPrf.intros(1))
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(clarify)
+apply(drule_tac x="r2" in meta_spec)
+apply(simp)
+apply(auto)[1]
+apply(rule_tac x="Right v'" in exI)
+apply(simp)
+apply (metis NPrf.intros)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(clarify)
+apply(drule_tac x="r1" in meta_spec)
+apply(simp)
+apply(auto)[1]
+apply(rule_tac x="Left v'" in exI)
+apply(simp)
+apply (metis NPrf.intros)
+apply(drule_tac x="r" in meta_spec)
+apply(simp)
+apply(auto)[1]
+apply(rule_tac x="Stars vs'" in exI)
+apply(simp)
+apply(rule_tac x="[]" in exI)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply (metis NPrf.intros(6))
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(auto)[1]
+apply(drule_tac x="ra" in meta_spec)
+apply(simp)
+apply(drule_tac x="STAR ra" in meta_spec)
+apply(simp)
+apply(auto)
+apply(case_tac "flat v = []")
+apply(rule_tac x="vs'" in exI)
+apply(simp)
+apply(rule_tac x="v' # vs'" in exI)
+apply(simp)
+apply(rule NPrf.intros)
+apply(auto)
+done
+
+lemma NPrf_Prf:
+ shows "{flat v | v. \<turnstile> v : r} = {flat v | v. \<Turnstile> v : r}"
+apply(auto)
+apply (metis NPrf_Prf_val(1))
+by (metis NPrf_imp_Prf)
+
+
+lemma not_nullable_flat:
+ assumes "\<turnstile> v : r" "\<not>nullable r"
+ shows "flat v \<noteq> []"
+using assms
+apply(induct)
+apply(auto)
+done
+
+lemma Prf_flat_L:
+ assumes "\<turnstile> v : r" shows "flat v \<in> L r"
+using assms
+apply(induct v r rule: Prf.induct)
+apply(auto simp add: Sequ_def)
+done
+
+lemma NPrf_flat_L:
+ assumes "\<Turnstile> v : r" shows "flat v \<in> L r"
+using assms
+by (metis NPrf_imp_Prf Prf_flat_L)
+
+lemma Prf_Stars:
+ assumes "\<forall>v \<in> set vs. \<turnstile> v : r"
+ shows "\<turnstile> Stars vs : STAR r"
+using assms
+apply(induct vs)
+apply (metis Prf.intros(6))
+by (metis Prf.intros(7) insert_iff set_simps(2))
+
+lemma Star_string:
+ assumes "s \<in> A\<star>"
+ shows "\<exists>ss. concat ss = s \<and> (\<forall>s \<in> set ss. s \<in> A)"
+using assms
+apply(induct rule: Star.induct)
+apply(auto)
+apply(rule_tac x="[]" in exI)
+apply(simp)
+apply(rule_tac x="s1#ss" in exI)
+apply(simp)
+done
+
+lemma Star_val:
+ assumes "\<forall>s\<in>set ss. \<exists>v. s = flat v \<and> \<turnstile> v : r"
+ shows "\<exists>vs. concat (map flat vs) = concat ss \<and> (\<forall>v\<in>set vs. \<turnstile> v : r)"
+using assms
+apply(induct ss)
+apply(auto)
+apply (metis empty_iff list.set(1))
+by (metis concat.simps(2) list.simps(9) set_ConsD)
+
+lemma Star_valN:
+ assumes "\<forall>s\<in>set ss. \<exists>v. s = flat v \<and> \<Turnstile> v : r"
+ shows "\<exists>vs. concat (map flat vs) = concat ss \<and> (\<forall>v\<in>set vs. \<Turnstile> v : r)"
+using assms
+apply(induct ss)
+apply(auto)
+apply (metis empty_iff list.set(1))
+by (metis concat.simps(2) list.simps(9) set_ConsD)
+
+lemma L_flat_Prf:
+ "L(r) = {flat v | v. \<turnstile> v : r}"
+apply(induct r)
+apply(auto dest: Prf_flat_L simp add: Sequ_def)
+apply (metis Prf.intros(4) flat.simps(1))
+apply (metis Prf.intros(5) flat.simps(2))
+apply (metis Prf.intros(1) flat.simps(5))
+apply (metis Prf.intros(2) flat.simps(3))
+apply (metis Prf.intros(3) flat.simps(4))
+apply(erule Prf.cases)
+apply(auto)
+apply(subgoal_tac "\<exists>vs::val list. concat (map flat vs) = x \<and> (\<forall>v \<in> set vs. \<turnstile> v : r)")
+apply(auto)[1]
+apply(rule_tac x="Stars vs" in exI)
+apply(simp)
+apply(rule Prf_Stars)
+apply(simp)
+apply(drule Star_string)
+apply(auto)
+apply(rule Star_val)
+apply(simp)
+done
+
+lemma L_flat_NPrf:
+ "L(r) = {flat v | v. \<Turnstile> v : r}"
+by (metis L_flat_Prf NPrf_Prf)
+
+text {* nicer proofs by Fahad *}
+
+lemma Prf_Star_flat_L:
+ assumes "\<turnstile> v : STAR r" shows "flat v \<in> (L r)\<star>"
+using assms
+apply(induct v r\<equiv>"STAR r" arbitrary: r rule: Prf.induct)
+apply(auto)
+apply(simp add: star3)
+apply(auto)
+apply(rule_tac x="Suc x" in exI)
+apply(auto simp add: Sequ_def)
+apply(rule_tac x="flat v" in exI)
+apply(rule_tac x="flat (Stars vs)" in exI)
+apply(auto)
+by (metis Prf_flat_L)
+
+lemma L_flat_Prf2:
+ "L(r) = {flat v | v. \<turnstile> v : r}"
+apply(induct r)
+apply(auto)
+using L.simps(1) Prf_flat_L
+apply(blast)
+using Prf.intros(4)
+apply(force)
+using L.simps(2) Prf_flat_L
+apply(blast)
+using Prf.intros(5) apply force
+using L.simps(3) Prf_flat_L apply blast
+using L_flat_Prf apply auto[1]
+apply (smt L.simps(4) Sequ_def mem_Collect_eq)
+using Prf_flat_L
+apply(fastforce)
+apply(metis Prf.intros(2) flat.simps(3))
+apply(metis Prf.intros(3) flat.simps(4))
+apply(erule Prf.cases)
+apply(simp)
+apply(simp)
+apply(auto)
+using L_flat_Prf apply auto[1]
+apply (smt Collect_cong L.simps(6) mem_Collect_eq)
+using Prf_Star_flat_L
+apply(fastforce)
+done
+
+
+section {* Values Sets *}
+
+definition prefix :: "string \<Rightarrow> string \<Rightarrow> bool" ("_ \<sqsubseteq> _" [100, 100] 100)
+where
+ "s1 \<sqsubseteq> s2 \<equiv> \<exists>s3. s1 @ s3 = s2"
+
+definition sprefix :: "string \<Rightarrow> string \<Rightarrow> bool" ("_ \<sqsubset> _" [100, 100] 100)
+where
+ "s1 \<sqsubset> s2 \<equiv> (s1 \<sqsubseteq> s2 \<and> s1 \<noteq> s2)"
+
+lemma length_sprefix:
+ "s1 \<sqsubset> s2 \<Longrightarrow> length s1 < length s2"
+unfolding sprefix_def prefix_def
+by (auto)
+
+definition Prefixes :: "string \<Rightarrow> string set" where
+ "Prefixes s \<equiv> {sp. sp \<sqsubseteq> s}"
+
+definition Suffixes :: "string \<Rightarrow> string set" where
+ "Suffixes s \<equiv> rev ` (Prefixes (rev s))"
+
+definition SPrefixes :: "string \<Rightarrow> string set" where
+ "SPrefixes s \<equiv> {sp. sp \<sqsubset> s}"
+
+definition SSuffixes :: "string \<Rightarrow> string set" where
+ "SSuffixes s \<equiv> rev ` (SPrefixes (rev s))"
+
+lemma Suffixes_in:
+ "\<exists>s1. s1 @ s2 = s3 \<Longrightarrow> s2 \<in> Suffixes s3"
+unfolding Suffixes_def Prefixes_def prefix_def image_def
+apply(auto)
+by (metis rev_rev_ident)
+
+lemma SSuffixes_in:
+ "\<exists>s1. s1 \<noteq> [] \<and> s1 @ s2 = s3 \<Longrightarrow> s2 \<in> SSuffixes s3"
+unfolding SSuffixes_def Suffixes_def SPrefixes_def Prefixes_def sprefix_def prefix_def image_def
+apply(auto)
+by (metis append_self_conv rev.simps(1) rev_rev_ident)
+
+lemma Prefixes_Cons:
+ "Prefixes (c # s) = {[]} \<union> {c # sp | sp. sp \<in> Prefixes s}"
+unfolding Prefixes_def prefix_def
+apply(auto simp add: append_eq_Cons_conv)
+done
+
+lemma finite_Prefixes:
+ "finite (Prefixes s)"
+apply(induct s)
+apply(auto simp add: Prefixes_def prefix_def)[1]
+apply(simp add: Prefixes_Cons)
+done
+
+lemma finite_Suffixes:
+ "finite (Suffixes s)"
+unfolding Suffixes_def
+apply(rule finite_imageI)
+apply(rule finite_Prefixes)
+done
+
+lemma prefix_Cons:
+ "((c # s1) \<sqsubseteq> (c # s2)) = (s1 \<sqsubseteq> s2)"
+apply(auto simp add: prefix_def)
+done
+
+lemma prefix_append:
+ "((s @ s1) \<sqsubseteq> (s @ s2)) = (s1 \<sqsubseteq> s2)"
+apply(induct s)
+apply(simp)
+apply(simp add: prefix_Cons)
+done
+
+
+definition Values :: "rexp \<Rightarrow> string \<Rightarrow> val set" where
+ "Values r s \<equiv> {v. \<turnstile> v : r \<and> flat v \<sqsubseteq> s}"
+
+definition SValues :: "rexp \<Rightarrow> string \<Rightarrow> val set" where
+ "SValues r s \<equiv> {v. \<turnstile> v : r \<and> flat v = s}"
+
+
+definition NValues :: "rexp \<Rightarrow> string \<Rightarrow> val set" where
+ "NValues r s \<equiv> {v. \<Turnstile> v : r \<and> flat v \<sqsubseteq> s}"
+
+lemma NValues_STAR_Nil:
+ "NValues (STAR r) [] = {Stars []}"
+apply(auto simp add: NValues_def prefix_def)
+apply(erule NPrf.cases)
+apply(auto)
+by (metis NPrf.intros(6))
+
+
+definition rest :: "val \<Rightarrow> string \<Rightarrow> string" where
+ "rest v s \<equiv> drop (length (flat v)) s"
+
+lemma rest_Nil:
+ "rest v [] = []"
+apply(simp add: rest_def)
+done
+
+lemma rest_Suffixes:
+ "rest v s \<in> Suffixes s"
+unfolding rest_def
+by (metis Suffixes_in append_take_drop_id)
+
+lemma rest_SSuffixes:
+ assumes "flat v \<noteq> []" "s \<noteq> []"
+ shows "rest v s \<in> SSuffixes s"
+using assms
+unfolding rest_def
+thm SSuffixes_in
+apply(rule_tac SSuffixes_in)
+apply(rule_tac x="take (length (flat v)) s" in exI)
+apply(simp add: sprefix_def)
+done
+
+
+lemma Values_recs:
+ "Values (NULL) s = {}"
+ "Values (EMPTY) s = {Void}"
+ "Values (CHAR c) s = (if [c] \<sqsubseteq> s then {Char c} else {})"
+ "Values (ALT r1 r2) s = {Left v | v. v \<in> Values r1 s} \<union> {Right v | v. v \<in> Values r2 s}"
+ "Values (SEQ r1 r2) s = {Seq v1 v2 | v1 v2. v1 \<in> Values r1 s \<and> v2 \<in> Values r2 (rest v1 s)}"
+ "Values (STAR r) s =
+ {Stars []} \<union> {Stars (v # vs) | v vs. v \<in> Values r s \<and> Stars vs \<in> Values (STAR r) (rest v s)}"
+unfolding Values_def
+apply(auto)
+(*NULL*)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+(*EMPTY*)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(rule Prf.intros)
+apply (metis append_Nil prefix_def)
+(*CHAR*)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(rule Prf.intros)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+(*ALT*)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply (metis Prf.intros(2))
+apply (metis Prf.intros(3))
+(*SEQ*)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply (simp add: append_eq_conv_conj prefix_def rest_def)
+apply (metis Prf.intros(1))
+apply (simp add: append_eq_conv_conj prefix_def rest_def)
+(*STAR*)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(rule conjI)
+apply(simp add: prefix_def)
+apply(auto)[1]
+apply(simp add: prefix_def)
+apply(auto)[1]
+apply (metis append_eq_conv_conj rest_def)
+apply (metis Prf.intros(6))
+apply (metis append_Nil prefix_def)
+apply (metis Prf.intros(7))
+by (metis append_eq_conv_conj prefix_append prefix_def rest_def)
+
+lemma NValues_recs:
+ "NValues (NULL) s = {}"
+ "NValues (EMPTY) s = {Void}"
+ "NValues (CHAR c) s = (if [c] \<sqsubseteq> s then {Char c} else {})"
+ "NValues (ALT r1 r2) s = {Left v | v. v \<in> NValues r1 s} \<union> {Right v | v. v \<in> NValues r2 s}"
+ "NValues (SEQ r1 r2) s = {Seq v1 v2 | v1 v2. v1 \<in> NValues r1 s \<and> v2 \<in> NValues r2 (rest v1 s)}"
+ "NValues (STAR r) s =
+ {Stars []} \<union> {Stars (v # vs) | v vs. v \<in> NValues r s \<and> flat v \<noteq> [] \<and> Stars vs \<in> NValues (STAR r) (rest v s)}"
+unfolding NValues_def
+apply(auto)
+(*NULL*)
+apply(erule NPrf.cases)
+apply(simp_all)[7]
+(*EMPTY*)
+apply(erule NPrf.cases)
+apply(simp_all)[7]
+apply(rule NPrf.intros)
+apply (metis append_Nil prefix_def)
+(*CHAR*)
+apply(erule NPrf.cases)
+apply(simp_all)[7]
+apply(rule NPrf.intros)
+apply(erule NPrf.cases)
+apply(simp_all)[7]
+(*ALT*)
+apply(erule NPrf.cases)
+apply(simp_all)[7]
+apply (metis NPrf.intros(2))
+apply (metis NPrf.intros(3))
+(*SEQ*)
+apply(erule NPrf.cases)
+apply(simp_all)[7]
+apply (simp add: append_eq_conv_conj prefix_def rest_def)
+apply (metis NPrf.intros(1))
+apply (simp add: append_eq_conv_conj prefix_def rest_def)
+(*STAR*)
+apply(erule NPrf.cases)
+apply(simp_all)
+apply(rule conjI)
+apply(simp add: prefix_def)
+apply(auto)[1]
+apply(simp add: prefix_def)
+apply(auto)[1]
+apply (metis append_eq_conv_conj rest_def)
+apply (metis NPrf.intros(6))
+apply (metis append_Nil prefix_def)
+apply (metis NPrf.intros(7))
+by (metis append_eq_conv_conj prefix_append prefix_def rest_def)
+
+lemma SValues_recs:
+ "SValues (NULL) s = {}"
+ "SValues (EMPTY) s = (if s = [] then {Void} else {})"
+ "SValues (CHAR c) s = (if [c] = s then {Char c} else {})"
+ "SValues (ALT r1 r2) s = {Left v | v. v \<in> SValues r1 s} \<union> {Right v | v. v \<in> SValues r2 s}"
+ "SValues (SEQ r1 r2) s = {Seq v1 v2 | v1 v2. \<exists>s1 s2. s = s1 @ s2 \<and> v1 \<in> SValues r1 s1 \<and> v2 \<in> SValues r2 s2}"
+ "SValues (STAR r) s = (if s = [] then {Stars []} else {}) \<union>
+ {Stars (v # vs) | v vs. \<exists>s1 s2. s = s1 @ s2 \<and> v \<in> SValues r s1 \<and> Stars vs \<in> SValues (STAR r) s2}"
+unfolding SValues_def
+apply(auto)
+(*NULL*)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+(*EMPTY*)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(rule Prf.intros)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+(*CHAR*)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply (metis Prf.intros(5))
+apply(erule Prf.cases)
+apply(simp_all)[7]
+(*ALT*)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply metis
+apply(erule Prf.intros)
+apply(erule Prf.intros)
+(* SEQ case *)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply (metis Prf.intros(1))
+(* STAR case *)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(rule Prf.intros)
+apply (metis Prf.intros(7))
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply (metis Prf.intros(7))
+by (metis Prf.intros(7))
+
+lemma finite_image_set2:
+ "finite {x. P x} \<Longrightarrow> finite {y. Q y} \<Longrightarrow> finite {(x, y) | x y. P x \<and> Q y}"
+ by (rule finite_subset [where B = "\<Union>x \<in> {x. P x}. \<Union>y \<in> {y. Q y}. {(x, y)}"]) auto
+
+
+lemma NValues_finite_aux:
+ "(\<lambda>(r, s). finite (NValues r s)) (r, s)"
+apply(rule wf_induct[of "measure size <*lex*> measure length",where P="\<lambda>(r, s). finite (NValues r s)"])
+apply (metis wf_lex_prod wf_measure)
+apply(auto)
+apply(case_tac a)
+apply(simp_all)
+apply(simp add: NValues_recs)
+apply(simp add: NValues_recs)
+apply(simp add: NValues_recs)
+apply(simp add: NValues_recs)
+apply(rule_tac f="\<lambda>(x, y). Seq x y" and
+ A="{(v1, v2) | v1 v2. v1 \<in> NValues rexp1 b \<and> v2 \<in> NValues rexp2 (rest v1 b)}" in finite_surj)
+prefer 2
+apply(auto)[1]
+apply(rule_tac B="\<Union>sp \<in> Suffixes b. {(v1, v2). v1 \<in> NValues rexp1 b \<and> v2 \<in> NValues rexp2 sp}" in finite_subset)
+apply(auto)[1]
+apply (metis rest_Suffixes)
+apply(rule finite_UN_I)
+apply(rule finite_Suffixes)
+apply(simp)
+apply(simp add: NValues_recs)
+apply(clarify)
+apply(subst NValues_recs)
+apply(simp)
+apply(rule_tac f="\<lambda>(v, vs). Stars (v # vs)" and
+ A="{(v, vs) | v vs. v \<in> NValues rexp b \<and> (flat v \<noteq> [] \<and> Stars vs \<in> NValues (STAR rexp) (rest v b))}" in finite_surj)
+prefer 2
+apply(auto)[1]
+apply(auto)
+apply(case_tac b)
+apply(simp)
+defer
+apply(rule_tac B="\<Union>sp \<in> SSuffixes b. {(v, vs) | v vs. v \<in> NValues rexp b \<and> Stars vs \<in> NValues (STAR rexp) sp}" in finite_subset)
+apply(auto)[1]
+apply(rule_tac x="rest aa (a # list)" in bexI)
+apply(simp)
+apply (rule rest_SSuffixes)
+apply(simp)
+apply(simp)
+apply(rule finite_UN_I)
+defer
+apply(frule_tac x="rexp" in spec)
+apply(drule_tac x="b" in spec)
+apply(drule conjunct1)
+apply(drule mp)
+apply(simp)
+apply(drule_tac x="STAR rexp" in spec)
+apply(drule_tac x="sp" in spec)
+apply(drule conjunct2)
+apply(drule mp)
+apply(simp)
+apply(simp add: prefix_def SPrefixes_def SSuffixes_def)
+apply(auto)[1]
+apply (metis length_Cons length_rev length_sprefix rev.simps(2))
+apply(simp)
+apply(rule finite_cartesian_product)
+apply(simp)
+apply(rule_tac f="Stars" in finite_imageD)
+prefer 2
+apply(auto simp add: inj_on_def)[1]
+apply (metis finite_subset image_Collect_subsetI)
+apply(simp add: rest_Nil)
+apply(simp add: NValues_STAR_Nil)
+apply(rule_tac B="{(v, vs). v \<in> NValues rexp [] \<and> vs = []}" in finite_subset)
+apply(auto)[1]
+apply(simp)
+apply(rule_tac B="Suffixes b" in finite_subset)
+apply(auto simp add: SSuffixes_def Suffixes_def Prefixes_def SPrefixes_def sprefix_def)[1]
+by (metis finite_Suffixes)
+
+lemma NValues_finite:
+ "finite (NValues r s)"
+using NValues_finite_aux
+apply(simp)
+done
+
+section {* Sulzmann functions *}
+
+fun
+ mkeps :: "rexp \<Rightarrow> val"
+where
+ "mkeps(EMPTY) = Void"
+| "mkeps(SEQ r1 r2) = Seq (mkeps r1) (mkeps r2)"
+| "mkeps(ALT r1 r2) = (if nullable(r1) then Left (mkeps r1) else Right (mkeps r2))"
+| "mkeps(STAR r) = Stars []"
+
+section {* Derivatives *}
+
+fun
+ der :: "char \<Rightarrow> rexp \<Rightarrow> rexp"
+where
+ "der c (NULL) = NULL"
+| "der c (EMPTY) = NULL"
+| "der c (CHAR c') = (if c = c' then EMPTY else NULL)"
+| "der c (ALT r1 r2) = ALT (der c r1) (der c r2)"
+| "der c (SEQ r1 r2) =
+ (if nullable r1
+ then ALT (SEQ (der c r1) r2) (der c r2)
+ else SEQ (der c r1) r2)"
+| "der c (STAR r) = SEQ (der c r) (STAR r)"
+
+fun
+ ders :: "string \<Rightarrow> rexp \<Rightarrow> rexp"
+where
+ "ders [] r = r"
+| "ders (c # s) r = ders s (der c r)"
+
+
+lemma der_correctness:
+ shows "L (der c r) = Der c (L r)"
+apply(induct r)
+apply(simp_all add: nullable_correctness)
+done
+
+lemma ders_correctness:
+ shows "L (ders s r) = Ders s (L r)"
+apply(induct s arbitrary: r)
+apply(simp add: Ders_def)
+apply(simp)
+apply(subst der_correctness)
+apply(simp add: Ders_def Der_def)
+done
+
+section {* Injection function *}
+
+fun injval :: "rexp \<Rightarrow> char \<Rightarrow> val \<Rightarrow> val"
+where
+ "injval (CHAR d) c Void = Char d"
+| "injval (ALT r1 r2) c (Left v1) = Left(injval r1 c v1)"
+| "injval (ALT r1 r2) c (Right v2) = Right(injval r2 c v2)"
+| "injval (SEQ r1 r2) c (Seq v1 v2) = Seq (injval r1 c v1) v2"
+| "injval (SEQ r1 r2) c (Left (Seq v1 v2)) = Seq (injval r1 c v1) v2"
+| "injval (SEQ r1 r2) c (Right v2) = Seq (mkeps r1) (injval r2 c v2)"
+| "injval (STAR r) c (Seq v (Stars vs)) = Stars ((injval r c v) # vs)"
+
+fun
+ lex :: "rexp \<Rightarrow> string \<Rightarrow> val option"
+where
+ "lex r [] = (if nullable r then Some(mkeps r) else None)"
+| "lex r (c#s) = (case (lex (der c r) s) of
+ None \<Rightarrow> None
+ | Some(v) \<Rightarrow> Some(injval r c v))"
+
+fun
+ lex2 :: "rexp \<Rightarrow> string \<Rightarrow> val"
+where
+ "lex2 r [] = mkeps r"
+| "lex2 r (c#s) = injval r c (lex2 (der c r) s)"
+
+
+section {* Projection function *}
+
+fun projval :: "rexp \<Rightarrow> char \<Rightarrow> val \<Rightarrow> val"
+where
+ "projval (CHAR d) c _ = Void"
+| "projval (ALT r1 r2) c (Left v1) = Left (projval r1 c v1)"
+| "projval (ALT r1 r2) c (Right v2) = Right (projval r2 c v2)"
+| "projval (SEQ r1 r2) c (Seq v1 v2) =
+ (if flat v1 = [] then Right(projval r2 c v2)
+ else if nullable r1 then Left (Seq (projval r1 c v1) v2)
+ else Seq (projval r1 c v1) v2)"
+| "projval (STAR r) c (Stars (v # vs)) = Seq (projval r c v) (Stars vs)"
+
+
+
+lemma mkeps_nullable:
+ assumes "nullable(r)"
+ shows "\<turnstile> mkeps r : r"
+using assms
+apply(induct rule: nullable.induct)
+apply(auto intro: Prf.intros)
+done
+
+lemma mkeps_flat:
+ assumes "nullable(r)"
+ shows "flat (mkeps r) = []"
+using assms
+apply(induct rule: nullable.induct)
+apply(auto)
+done
+
+
+lemma v3:
+ assumes "\<turnstile> v : der c r"
+ shows "\<turnstile> (injval r c v) : r"
+using assms
+apply(induct arbitrary: v rule: der.induct)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(case_tac "c = c'")
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply (metis Prf.intros(5))
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply (metis Prf.intros(2))
+apply (metis Prf.intros(3))
+apply(simp)
+apply(case_tac "nullable r1")
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(auto)[1]
+apply (metis Prf.intros(1))
+apply(auto)[1]
+apply (metis Prf.intros(1) mkeps_nullable)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(auto)[1]
+apply(rule Prf.intros)
+apply(auto)[2]
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(clarify)
+apply(rotate_tac 2)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(auto)
+apply (metis Prf.intros(6) Prf.intros(7))
+by (metis Prf.intros(7))
+
+lemma v3_proj:
+ assumes "\<Turnstile> v : r" and "\<exists>s. (flat v) = c # s"
+ shows "\<Turnstile> (projval r c v) : der c r"
+using assms
+apply(induct rule: NPrf.induct)
+prefer 4
+apply(simp)
+prefer 4
+apply(simp)
+apply (metis NPrf.intros(4))
+prefer 2
+apply(simp)
+apply (metis NPrf.intros(2))
+prefer 2
+apply(simp)
+apply (metis NPrf.intros(3))
+apply(auto)
+apply(rule NPrf.intros)
+apply(simp)
+apply (metis NPrf_imp_Prf not_nullable_flat)
+apply(rule NPrf.intros)
+apply(rule NPrf.intros)
+apply (metis Cons_eq_append_conv)
+apply(simp)
+apply(rule NPrf.intros)
+apply (metis Cons_eq_append_conv)
+apply(simp)
+(* Stars case *)
+apply(rule NPrf.intros)
+apply (metis Cons_eq_append_conv)
+apply(auto)
+done
+
+lemma v4:
+ assumes "\<turnstile> v : der c r"
+ shows "flat (injval r c v) = c # (flat v)"
+using assms
+apply(induct arbitrary: v rule: der.induct)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(simp)
+apply(case_tac "c = c'")
+apply(simp)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(simp)
+apply(case_tac "nullable r1")
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all (no_asm_use))[7]
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(clarify)
+apply(simp only: injval.simps flat.simps)
+apply(auto)[1]
+apply (metis mkeps_flat)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(auto)
+apply(rotate_tac 2)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+done
+
+lemma v4_proj:
+ assumes "\<Turnstile> v : r" and "\<exists>s. (flat v) = c # s"
+ shows "c # flat (projval r c v) = flat v"
+using assms
+apply(induct rule: NPrf.induct)
+prefer 4
+apply(simp)
+prefer 4
+apply(simp)
+prefer 2
+apply(simp)
+prefer 2
+apply(simp)
+apply(auto)
+apply (metis Cons_eq_append_conv)
+apply(simp add: append_eq_Cons_conv)
+apply(auto)
+done
+
+lemma v4_proj2:
+ assumes "\<Turnstile> v : r" and "(flat v) = c # s"
+ shows "flat (projval r c v) = s"
+using assms
+by (metis list.inject v4_proj)
+
+
+definition
+ PC31 :: "string \<Rightarrow> rexp \<Rightarrow> rexp \<Rightarrow> bool"
+where
+ "PC31 s r r' \<equiv> s \<notin> L r"
+
+definition
+ PC41 :: "string \<Rightarrow> string \<Rightarrow> rexp \<Rightarrow> rexp \<Rightarrow> bool"
+where
+ "PC41 s s' r r' \<equiv> (\<forall>x. (s @ x \<in> L r \<longrightarrow> s' \<in> {x} ;; L r' \<longrightarrow> x = []))"
+
+
+lemma
+ L1: "\<not>(nullable r1) \<longrightarrow> [] \<in> L r2 \<longrightarrow> PC31 [] r1 r2" and
+ L2: "s1 \<in> L(r1) \<longrightarrow> [] \<in> L(r2) \<longrightarrow> PC41 s1 [] r1 r2" and
+ L3: "s2 \<in> L(der c r2) \<longrightarrow> PC31 s2 (der c r1) (der c r2) \<longrightarrow> PC31 (c#s2) r1 r2" and
+ L4: "s1 \<in> L(der c r1) \<longrightarrow> s2 \<in> L(r2) \<longrightarrow> PC41 s1 s2 (der c r1) r2 \<longrightarrow> PC41 (c#s1) s2 r1 r2" and
+ L5: "nullable(r1) \<longrightarrow> s2 \<in> L(der c r2) \<longrightarrow> PC31 s2 (SEQ (der c r1) r2) (der c r2) \<longrightarrow> PC41 [] (c#s2) r1 r2" and
+ L6: "s0 \<in> L(der c r0) \<longrightarrow> s \<in> L(STAR r0) \<longrightarrow> PC41 s0 s (der c r0) (STAR r0) \<longrightarrow> PC41 (c#s0) s r0 (STAR r0)" and
+ L7: "s' \<in> L(r') \<longrightarrow> s' \<in> L(r) \<longrightarrow> \<not>PC31 s' r r'" and
+ L8: "s \<in> L(r) \<longrightarrow> s' \<in> L(r') \<longrightarrow> s @ x \<in> L(r) \<longrightarrow> s' \<in> {x} ;; (L(r') ;; {y}) \<longrightarrow> x \<noteq> [] \<longrightarrow> \<not>PC41 s s' r r'"
+apply(auto simp add: PC31_def PC41_def)[1]
+apply (metis nullable_correctness)
+apply(auto simp add: PC31_def PC41_def)[1]
+apply(simp add: Sequ_def)
+apply(auto simp add: PC31_def PC41_def)[1]
+apply(simp add: der_correctness Der_def)
+apply(auto simp add: PC31_def PC41_def)[1]
+apply(simp add: der_correctness Der_def Sequ_def)
+apply(auto simp add: PC31_def PC41_def)[1]
+apply(simp add: Sequ_def)
+apply(simp add: der_correctness Der_def)
+apply(auto)[1]
+apply (metis append_eq_Cons_conv)
+apply(auto simp add: PC31_def PC41_def)[1]
+apply(simp add: Sequ_def)
+apply(simp add: der_correctness Der_def)
+apply(auto simp add: PC31_def PC41_def)[1]
+apply(rule impI)+
+apply(rule notI)
+(* 8 fails *)
+oops
+
+definition
+ PC32 :: "string \<Rightarrow> rexp \<Rightarrow> rexp \<Rightarrow> bool"
+where
+ "PC32 s r r' \<equiv> \<forall>y. s \<notin> (L r ;; {y})"
+
+definition
+ PC42 :: "string \<Rightarrow> string \<Rightarrow> rexp \<Rightarrow> rexp \<Rightarrow> bool"
+where
+ "PC42 s s' r r' \<equiv> (\<forall>x. (s @ x \<in> L r \<longrightarrow> (\<exists>y. s' \<in> {x} ;; (L r' ;; {y})) \<longrightarrow> x = []))"
+
+
+lemma
+ L1: "\<not>(nullable r1) \<longrightarrow> [] \<in> L r2 \<longrightarrow> PC32 [] r1 r2" and
+ L2: "s1 \<in> L(r1) \<longrightarrow> [] \<in> L(r2) \<longrightarrow> PC42 s1 [] r1 r2" and
+ L3: "s2 \<in> L(der c r2) \<longrightarrow> PC32 s2 (der c r1) (der c r2) \<longrightarrow> PC32 (c#s2) r1 r2" and
+ L4: "s1 \<in> L(der c r1) \<longrightarrow> s2 \<in> L(r2) \<longrightarrow> PC42 s1 s2 (der c r1) r2 \<longrightarrow> PC42 (c#s1) s2 r1 r2" and
+ L5: "nullable(r1) \<longrightarrow> s2 \<in> L(der c r2) \<longrightarrow> PC32 s2 (SEQ (der c r1) r2) (der c r2) \<longrightarrow> PC42 [] (c#s2) r1 r2" and
+ L6: "s0 \<in> L(der c r0) \<longrightarrow> s \<in> L(STAR r0) \<longrightarrow> PC42 s0 s (der c r0) (STAR r0) \<longrightarrow> PC42 (c#s0) s r0 (STAR r0)" and
+ L7: "s' \<in> L(r') \<longrightarrow> s' \<in> L(r) \<longrightarrow> \<not>PC32 s' r r'" and
+ L8: "s \<in> L(r) \<longrightarrow> s' \<in> L(r') \<longrightarrow> s @ x \<in> L(r) \<longrightarrow> s' \<in> {x} ;; (L(r') ;; {y}) \<longrightarrow> x \<noteq> [] \<longrightarrow> \<not>PC42 s s' r r'"
+apply(auto simp add: PC32_def PC42_def)[1]
+apply(simp add: Sequ_def)
+apply (metis nullable_correctness)
+apply(auto simp add: PC32_def PC42_def Sequ_def)[1]
+apply(auto simp add: PC32_def PC42_def Sequ_def der_correctness Der_def)[1]
+apply(simp add: Cons_eq_append_conv)
+apply(auto)[1]
+defer
+apply(auto simp add: PC32_def PC42_def Sequ_def der_correctness Der_def)[1]
+apply(auto simp add: PC32_def PC42_def Sequ_def der_correctness Der_def nullable_correctness)[1]
+apply (metis append_Cons append_assoc hd_Cons_tl list.discI list.inject)
+apply(auto simp add: PC32_def PC42_def Sequ_def der_correctness Der_def)[1]
+apply(auto simp add: PC32_def PC42_def Sequ_def der_correctness Der_def)[1]
+apply(auto simp add: PC32_def PC42_def Sequ_def der_correctness Der_def)[1]
+oops
+
+definition
+ PC33 :: "string \<Rightarrow> rexp \<Rightarrow> rexp \<Rightarrow> bool"
+where
+ "PC33 s r r' \<equiv> s \<notin> L r"
+
+definition
+ PC43 :: "string \<Rightarrow> string \<Rightarrow> rexp \<Rightarrow> rexp \<Rightarrow> bool"
+where
+ "PC43 s s' r r' \<equiv> (\<forall>x. (s @ x \<in> L r \<longrightarrow> (\<exists>y. s' \<in> {x} ;; (L r' ;; {y})) \<longrightarrow> x = []))"
+
+lemma
+ L1: "\<not>(nullable r1) \<longrightarrow> [] \<in> L r2 \<longrightarrow> PC33 [] r1 r2" and
+ L2: "s1 \<in> L(r1) \<longrightarrow> [] \<in> L(r2) \<longrightarrow> PC43 s1 [] r1 r2" and
+ L3: "s2 \<in> L(der c r2) \<longrightarrow> PC33 s2 (der c r1) (der c r2) \<longrightarrow> PC33 (c#s2) r1 r2" and
+ L4: "s1 \<in> L(der c r1) \<longrightarrow> s2 \<in> L(r2) \<longrightarrow> PC43 s1 s2 (der c r1) r2 \<longrightarrow> PC43 (c#s1) s2 r1 r2" and
+ L5: "nullable(r1) \<longrightarrow> s2 \<in> L(der c r2) \<longrightarrow> PC33 s2 (SEQ (der c r1) r2) (der c r2) \<longrightarrow> PC43 [] (c#s2) r1 r2" and
+ L6: "s0 \<in> L(der c r0) \<longrightarrow> s \<in> L(STAR r0) \<longrightarrow> PC43 s0 s (der c r0) (STAR r0) \<longrightarrow> PC43 (c#s0) s r0 (STAR r0)" and
+ L7: "s' \<in> L(r') \<longrightarrow> s' \<in> L(r) \<longrightarrow> \<not>PC33 s' r r'" and
+ L8: "s \<in> L(r) \<longrightarrow> s' \<in> L(r') \<longrightarrow> s @ x \<in> L(r) \<longrightarrow> s' \<in> {x} ;; (L(r') ;; {y}) \<longrightarrow> x \<noteq> [] \<longrightarrow> \<not>PC43 s s' r r'"
+apply(auto simp add: PC33_def PC43_def)[1]
+apply (metis nullable_correctness)
+apply(auto simp add: PC33_def PC43_def)[1]
+apply(simp add: Sequ_def)
+apply(auto simp add: PC33_def PC43_def)[1]
+apply(simp add: der_correctness Der_def)
+apply(auto simp add: PC33_def PC43_def)[1]
+apply(simp add: der_correctness Der_def Sequ_def)
+apply metis
+(* 5 *)
+apply(auto simp add: PC33_def PC43_def)[1]
+apply(simp add: Sequ_def)
+apply(simp add: der_correctness Der_def)
+apply(auto)[1]
+defer
+apply(auto simp add: PC33_def PC43_def)[1]
+apply(simp add: Sequ_def)
+apply(simp add: der_correctness Der_def)
+apply metis
+apply(auto simp add: PC33_def PC43_def)[1]
+apply(auto simp add: PC33_def PC43_def)[1]
+(* 5 fails *)
+apply(simp add: Cons_eq_append_conv)
+apply(auto)[1]
+apply(drule_tac x="ys'" in spec)
+apply(simp)
+oops
+
+section {* Roy's Definition *}
+
+inductive
+ Roy :: "val \<Rightarrow> rexp \<Rightarrow> bool" ("\<rhd> _ : _" [100, 100] 100)
+where
+ "\<rhd> Void : EMPTY"
+| "\<rhd> Char c : CHAR c"
+| "\<rhd> v : r1 \<Longrightarrow> \<rhd> Left v : ALT r1 r2"
+| "\<lbrakk>\<rhd> v : r2; flat v \<notin> L r1\<rbrakk> \<Longrightarrow> \<rhd> Right v : ALT r1 r2"
+| "\<lbrakk>\<rhd> v1 : r1; \<rhd> v2 : r2; \<not>(\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = flat v2 \<and> (flat v1 @ s\<^sub>3) \<in> L r1 \<and> s\<^sub>4 \<in> L r2)\<rbrakk> \<Longrightarrow>
+ \<rhd> Seq v1 v2 : SEQ r1 r2"
+| "\<lbrakk>\<rhd> v : r; \<rhd> Stars vs : STAR r; flat v \<noteq> [];
+ \<not>(\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = flat (Stars vs) \<and> (flat v @ s\<^sub>3) \<in> L r \<and> s\<^sub>4 \<in> L (STAR r))\<rbrakk> \<Longrightarrow>
+ \<rhd> Stars (v#vs) : STAR r"
+| "\<rhd> Stars [] : STAR r"
+
+lemma drop_append:
+ assumes "s1 \<sqsubseteq> s2"
+ shows "s1 @ drop (length s1) s2 = s2"
+using assms
+apply(simp add: prefix_def)
+apply(auto)
+done
+
+lemma royA:
+ assumes "\<not>(\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = flat v2 \<and> (flat v1 @ s\<^sub>3) \<in> L r1 \<and> s\<^sub>4 \<in> L r2)"
+ shows "\<forall>s. (s \<in> L(ders (flat v1) r1) \<and>
+ s \<sqsubseteq> (flat v2) \<and> drop (length s) (flat v2) \<in> L r2 \<longrightarrow> s = [])"
+using assms
+apply -
+apply(rule allI)
+apply(rule impI)
+apply(simp add: ders_correctness)
+apply(simp add: Ders_def)
+thm rest_def
+apply(drule_tac x="s" in spec)
+apply(simp)
+apply(erule disjE)
+apply(simp)
+apply(drule_tac x="drop (length s) (flat v2)" in spec)
+apply(simp add: drop_append)
+done
+
+lemma royB:
+ assumes "\<forall>s. (s \<in> L(ders (flat v1) r1) \<and>
+ s \<sqsubseteq> (flat v2) \<and> drop (length s) (flat v2) \<in> L r2 \<longrightarrow> s = [])"
+ shows "\<not>(\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = flat v2 \<and> (flat v1 @ s\<^sub>3) \<in> L r1 \<and> s\<^sub>4 \<in> L r2)"
+using assms
+apply -
+apply(auto simp add: prefix_def ders_correctness Ders_def)
+by (metis append_eq_conv_conj)
+
+lemma royC:
+ assumes "\<forall>s t. (s \<in> L(ders (flat v1) r1) \<and>
+ s \<sqsubseteq> (flat v2 @ t) \<and> drop (length s) (flat v2 @ t) \<in> L r2 \<longrightarrow> s = [])"
+ shows "\<not>(\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = flat v2 \<and> (flat v1 @ s\<^sub>3) \<in> L r1 \<and> s\<^sub>4 \<in> L r2)"
+using assms
+apply -
+apply(rule royB)
+apply(rule allI)
+apply(drule_tac x="s" in spec)
+apply(drule_tac x="[]" in spec)
+apply(simp)
+done
+
+inductive
+ Roy2 :: "val \<Rightarrow> rexp \<Rightarrow> bool" ("2\<rhd> _ : _" [100, 100] 100)
+where
+ "2\<rhd> Void : EMPTY"
+| "2\<rhd> Char c : CHAR c"
+| "2\<rhd> v : r1 \<Longrightarrow> 2\<rhd> Left v : ALT r1 r2"
+| "\<lbrakk>2\<rhd> v : r2; \<forall>t. flat v \<notin> (L r1 ;; {t})\<rbrakk> \<Longrightarrow> 2\<rhd> Right v : ALT r1 r2"
+| "\<lbrakk>2\<rhd> v1 : r1; 2\<rhd> v2 : r2;
+ \<forall>s. ((flat v1 @ s \<in> L r1) \<and>
+ (\<exists>t. s \<sqsubseteq> (flat v2 @ t) \<and> drop (length s) (flat v2) \<in> (L r2 ;; {t}))) \<longrightarrow> s = []\<rbrakk> \<Longrightarrow>
+ 2\<rhd> Seq v1 v2 : SEQ r1 r2"
+| "\<lbrakk>2\<rhd> v : r; 2\<rhd> Stars vs : STAR r; flat v \<noteq> [];
+ \<forall>s. ((flat v @ s \<in> L r) \<and>
+ (\<exists>t. s \<sqsubseteq> (flat (Stars vs) @ t) \<and> drop (length s) (flat (Stars vs)) \<in> (L (STAR r) ;; {t}))) \<longrightarrow> s = []\<rbrakk>
+ \<Longrightarrow> 2\<rhd> Stars (v#vs) : STAR r"
+| "2\<rhd> Stars [] : STAR r"
+
+lemma Roy2_props:
+ assumes "2\<rhd> v : r"
+ shows "\<turnstile> v : r"
+using assms
+apply(induct)
+apply(auto intro: Prf.intros)
+done
+
+lemma Roy_mkeps_nullable:
+ assumes "nullable(r)"
+ shows "2\<rhd> (mkeps r) : r"
+using assms
+apply(induct rule: nullable.induct)
+apply(auto intro: Roy2.intros)
+apply(rule Roy2.intros)
+apply(simp_all)
+apply(simp add: mkeps_flat)
+apply(simp add: Sequ_def)
+apply (metis nullable_correctness)
+apply(rule Roy2.intros)
+apply(simp_all)
+apply(rule allI)
+apply(rule impI)
+apply(auto simp add: Sequ_def)
+apply(simp add: mkeps_flat)
+apply(auto simp add: prefix_def)
+done
+
+section {* Alternative Posix definition *}
+
+inductive
+ PMatch :: "string \<Rightarrow> rexp \<Rightarrow> val \<Rightarrow> bool" ("_ \<in> _ \<rightarrow> _" [100, 100, 100] 100)
+where
+ "[] \<in> EMPTY \<rightarrow> Void"
+| "[c] \<in> (CHAR c) \<rightarrow> (Char c)"
+| "s \<in> r1 \<rightarrow> v \<Longrightarrow> s \<in> (ALT r1 r2) \<rightarrow> (Left v)"
+| "\<lbrakk>s \<in> r2 \<rightarrow> v; s \<notin> L(r1)\<rbrakk> \<Longrightarrow> s \<in> (ALT r1 r2) \<rightarrow> (Right v)"
+| "\<lbrakk>s1 \<in> r1 \<rightarrow> v1; s2 \<in> r2 \<rightarrow> v2;
+ \<not>(\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (s1 @ s\<^sub>3) \<in> L r1 \<and> s\<^sub>4 \<in> L r2)\<rbrakk> \<Longrightarrow>
+ (s1 @ s2) \<in> (SEQ r1 r2) \<rightarrow> (Seq v1 v2)"
+| "\<lbrakk>s1 \<in> r \<rightarrow> v; s2 \<in> STAR r \<rightarrow> Stars vs; flat v \<noteq> [];
+ \<not>(\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (s1 @ s\<^sub>3) \<in> L r \<and> s\<^sub>4 \<in> L (STAR r))\<rbrakk>
+ \<Longrightarrow> (s1 @ s2) \<in> STAR r \<rightarrow> Stars (v # vs)"
+| "[] \<in> STAR r \<rightarrow> Stars []"
+
+inductive
+ PMatchX :: "string \<Rightarrow> rexp \<Rightarrow> val \<Rightarrow> bool" ("\<turnstile> _ \<in> _ \<rightarrow> _" [100, 100, 100] 100)
+where
+ "\<turnstile> s \<in> EMPTY \<rightarrow> Void"
+| "\<turnstile> (c # s) \<in> (CHAR c) \<rightarrow> (Char c)"
+| "\<turnstile> s \<in> r1 \<rightarrow> v \<Longrightarrow> \<turnstile> s \<in> (ALT r1 r2) \<rightarrow> (Left v)"
+| "\<lbrakk>\<turnstile> s \<in> r2 \<rightarrow> v; \<not>(\<exists>s'. s' \<sqsubseteq> s \<and> flat v \<sqsubseteq> s' \<and> s' \<in> L(r1))\<rbrakk> \<Longrightarrow> \<turnstile> s \<in> (ALT r1 r2) \<rightarrow> (Right v)"
+| "\<lbrakk>s1 \<in> r1 \<rightarrow> v1; \<turnstile> s2 \<in> r2 \<rightarrow> v2;
+ \<not>(\<exists>s3 s4. s3 \<noteq> [] \<and> (s3 @ s4) \<sqsubseteq> s2 \<and> (s1 @ s3) \<in> L r1 \<and> s4 \<in> L r2)\<rbrakk> \<Longrightarrow>
+ \<turnstile> (s1 @ s2) \<in> (SEQ r1 r2) \<rightarrow> (Seq v1 v2)"
+| "\<lbrakk>s1 \<in> r \<rightarrow> v; \<turnstile> s2 \<in> STAR r \<rightarrow> Stars vs; flat v \<noteq> [];
+ \<not>(\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> (s\<^sub>3 @ s\<^sub>4) \<sqsubseteq> s2 \<and> (s1 @ s\<^sub>3) \<in> L r \<and> s\<^sub>4 \<in> L (STAR r))\<rbrakk>
+ \<Longrightarrow> \<turnstile> (s1 @ s2) \<in> STAR r \<rightarrow> Stars (v # vs)"
+| "\<turnstile> s \<in> STAR r \<rightarrow> Stars []"
+
+lemma PMatch1:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "\<turnstile> v : r" "flat v = s"
+using assms
+apply(induct s r v rule: PMatch.induct)
+apply(auto)
+apply (metis Prf.intros(4))
+apply (metis Prf.intros(5))
+apply (metis Prf.intros(2))
+apply (metis Prf.intros(3))
+apply (metis Prf.intros(1))
+apply (metis Prf.intros(7))
+by (metis Prf.intros(6))
+
+
+lemma PMatchX1:
+ assumes "\<turnstile> s \<in> r \<rightarrow> v"
+ shows "\<turnstile> v : r"
+using assms
+apply(induct s r v rule: PMatchX.induct)
+apply(auto simp add: prefix_def intro: Prf.intros)
+apply (metis PMatch1(1) Prf.intros(1))
+by (metis PMatch1(1) Prf.intros(7))
+
+
+lemma PMatchX:
+ assumes "\<turnstile> s \<in> r \<rightarrow> v"
+ shows "flat v \<sqsubseteq> s"
+using assms
+apply(induct s r v rule: PMatchX.induct)
+apply(auto simp add: prefix_def PMatch1)
+done
+
+lemma PMatchX_PMatch:
+ assumes "\<turnstile> s \<in> r \<rightarrow> v" "flat v = s"
+ shows "s \<in> r \<rightarrow> v"
+using assms
+apply(induct s r v rule: PMatchX.induct)
+apply(auto intro: PMatch.intros)
+apply(rule PMatch.intros)
+apply(simp)
+apply (metis PMatchX Prefixes_def mem_Collect_eq)
+apply (smt2 PMatch.intros(5) PMatch1(2) PMatchX append_Nil2 append_assoc append_self_conv prefix_def)
+by (metis L.simps(6) PMatch.intros(6) PMatch1(2) append_Nil2 append_eq_conv_conj prefix_def)
+
+lemma PMatch_PMatchX:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "\<turnstile> s \<in> r \<rightarrow> v"
+using assms
+apply(induct s r v arbitrary: s' rule: PMatch.induct)
+apply(auto intro: PMatchX.intros)
+apply(rule PMatchX.intros)
+apply(simp)
+apply(rule notI)
+apply(auto)[1]
+apply (metis PMatch1(2) append_eq_conv_conj length_sprefix less_imp_le_nat prefix_def sprefix_def take_all)
+apply(rule PMatchX.intros)
+apply(simp)
+apply(simp)
+apply(auto)[1]
+oops
+
+lemma
+ assumes "\<rhd> v : r"
+ shows "(flat v) \<in> r \<rightarrow> v"
+using assms
+apply(induct)
+apply(auto intro: PMatch.intros)
+apply(rule PMatch.intros)
+apply(simp)
+apply(simp)
+apply(simp)
+apply(auto)[1]
+done
+
+lemma
+ assumes "s \<in> r \<rightarrow> v"
+ shows "\<rhd> v : r"
+using assms
+apply(induct)
+apply(auto intro: Roy.intros)
+apply (metis PMatch1(2) Roy.intros(4))
+apply (metis PMatch1(2) Roy.intros(5))
+by (metis L.simps(6) PMatch1(2) Roy.intros(6))
+
+
+lemma PMatch_mkeps:
+ assumes "nullable r"
+ shows "[] \<in> r \<rightarrow> mkeps r"
+using assms
+apply(induct r)
+apply(auto)
+apply (metis PMatch.intros(1))
+apply(subst append.simps(1)[symmetric])
+apply (rule PMatch.intros)
+apply(simp)
+apply(simp)
+apply(auto)[1]
+apply (rule PMatch.intros)
+apply(simp)
+apply (rule PMatch.intros)
+apply(simp)
+apply (rule PMatch.intros)
+apply(simp)
+apply (metis nullable_correctness)
+apply(metis PMatch.intros(7))
+done
+
+
+lemma PMatch1N:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "\<Turnstile> v : r"
+using assms
+apply(induct s r v rule: PMatch.induct)
+apply(auto)
+apply (metis NPrf.intros(4))
+apply (metis NPrf.intros(5))
+apply (metis NPrf.intros(2))
+apply (metis NPrf.intros(3))
+apply (metis NPrf.intros(1))
+apply(rule NPrf.intros)
+apply(simp)
+apply(simp)
+apply(simp)
+apply(rule NPrf.intros)
+done
+
+lemma PMatch_determ:
+ shows "\<lbrakk>s \<in> r \<rightarrow> v1; s \<in> r \<rightarrow> v2\<rbrakk> \<Longrightarrow> v1 = v2"
+ and "\<lbrakk>s \<in> (STAR r) \<rightarrow> Stars vs1; s \<in> (STAR r) \<rightarrow> Stars vs2\<rbrakk> \<Longrightarrow> vs1 = vs2"
+apply(induct v1 and vs1 arbitrary: s r v2 and s r vs2 rule: val.inducts)
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply(clarify)
+apply(subgoal_tac "s1 = s1a \<and> s2 = s2a")
+apply metis
+apply(rule conjI)
+apply(simp add: append_eq_append_conv2)
+apply(auto)[1]
+apply (metis PMatch1(1) PMatch1(2) Prf_flat_L)
+apply (metis PMatch1(1) PMatch1(2) Prf_flat_L)
+apply(simp add: append_eq_append_conv2)
+apply(auto)[1]
+apply (metis PMatch1(1) PMatch1(2) Prf_flat_L)
+apply (metis PMatch1(1) PMatch1(2) Prf_flat_L)
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply(clarify)
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply(clarify)
+apply (metis NPrf_flat_L PMatch1(2) PMatch1N)
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply(clarify)
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply(clarify)
+apply (metis NPrf_flat_L PMatch1(2) PMatch1N)
+(* star case *)
+defer
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply(clarify)
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply(clarify)
+apply (metis PMatch1(2))
+apply(rotate_tac 3)
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply(clarify)
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply(clarify)
+apply(subgoal_tac "s1 = s1a \<and> s2 = s2a")
+apply metis
+apply(simp add: append_eq_append_conv2)
+apply(auto)[1]
+apply (metis L.simps(6) PMatch1(1) PMatch1(2) Prf_flat_L)
+apply (metis L.simps(6) PMatch1(1) PMatch1(2) Prf_flat_L)
+apply (metis L.simps(6) PMatch1(1) PMatch1(2) Prf_flat_L)
+apply (metis L.simps(6) PMatch1(1) PMatch1(2) Prf_flat_L)
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply(clarify)
+apply (metis PMatch1(2))
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply(clarify)
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply(clarify)
+apply(subgoal_tac "s1 = s1a \<and> s2 = s2a")
+apply(drule_tac x="s1 @ s2" in meta_spec)
+apply(drule_tac x="rb" in meta_spec)
+apply(drule_tac x="(va#vsa)" in meta_spec)
+apply(simp)
+apply(drule meta_mp)
+apply (metis L.simps(6) PMatch.intros(6))
+apply (metis L.simps(6) PMatch.intros(6))
+apply(simp add: append_eq_append_conv2)
+apply(auto)[1]
+apply (metis L.simps(6) NPrf_flat_L PMatch1(2) PMatch1N)
+apply (metis L.simps(6) NPrf_flat_L PMatch1(2) PMatch1N)
+apply (metis L.simps(6) NPrf_flat_L PMatch1(2) PMatch1N)
+apply (metis L.simps(6) NPrf_flat_L PMatch1(2) PMatch1N)
+apply (metis PMatch1(2))
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply(clarify)
+by (metis PMatch1(2))
+
+
+lemma PMatch_Values:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "v \<in> Values r s"
+using assms
+apply(simp add: Values_def PMatch1)
+by (metis append_Nil2 prefix_def)
+
+lemma PMatch2:
+ assumes "s \<in> (der c r) \<rightarrow> v"
+ shows "(c#s) \<in> r \<rightarrow> (injval r c v)"
+using assms
+apply(induct c r arbitrary: s v rule: der.induct)
+apply(auto)
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply(case_tac "c = c'")
+apply(simp)
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply (metis PMatch.intros(2))
+apply(simp)
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply (metis PMatch.intros(3))
+apply(clarify)
+apply(rule PMatch.intros)
+apply metis
+apply(simp add: L_flat_NPrf)
+apply(auto)[1]
+apply(frule_tac c="c" in v3_proj)
+apply metis
+apply(drule_tac x="projval r1 c v" in spec)
+apply(drule mp)
+apply (metis v4_proj2)
+apply (metis NPrf_imp_Prf)
+(* SEQ case *)
+apply(case_tac "nullable r1")
+apply(simp)
+prefer 2
+apply(simp)
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply(clarify)
+apply(subst append.simps(2)[symmetric])
+apply(rule PMatch.intros)
+apply metis
+apply metis
+apply(auto)[1]
+apply(simp add: der_correctness Der_def)
+apply(auto)[1]
+(* nullable case *)
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply(clarify)
+apply(erule PMatch.cases)
+apply(simp_all)[4]
+apply(clarify)
+apply(simp (no_asm))
+apply(subst append.simps(2)[symmetric])
+apply(rule PMatch.intros)
+apply metis
+apply metis
+apply(erule contrapos_nn)
+apply(erule exE)+
+apply(auto)[1]
+apply(simp add: L_flat_NPrf)
+apply(auto)[1]
+thm v3_proj
+apply(frule_tac c="c" in v3_proj)
+apply metis
+apply(rule_tac x="s\<^sub>3" in exI)
+apply(simp)
+apply (metis NPrf_imp_Prf v4_proj2)
+apply(simp)
+(* interesting case *)
+apply(clarify)
+apply(clarify)
+apply(simp)
+apply(subst (asm) L.simps(4)[symmetric])
+apply(simp only: L_flat_Prf)
+apply(simp)
+apply(subst append.simps(1)[symmetric])
+apply(rule PMatch.intros)
+apply (metis PMatch_mkeps)
+apply metis
+apply(auto)
+apply(simp only: L_flat_NPrf)
+apply(simp)
+apply(auto)
+apply(drule_tac x="Seq (projval r1 c v) vb" in spec)
+apply(drule mp)
+apply(simp)
+
+apply (metis append_Cons butlast_snoc list.sel(1) neq_Nil_conv rotate1.simps(2) v4_proj2)
+apply(subgoal_tac "\<turnstile> projval r1 c v : der c r1")
+apply (metis NPrf_imp_Prf Prf.intros(1))
+apply(rule NPrf_imp_Prf)
+apply(rule v3_proj)
+apply(simp)
+apply (metis Cons_eq_append_conv)
+(* Stars case *)
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply(clarify)
+apply(rotate_tac 2)
+apply(frule_tac PMatch1)
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply(subst append.simps(2)[symmetric])
+apply(rule PMatch.intros)
+apply metis
+apply(auto)[1]
+apply(rule PMatch.intros)
+apply(simp)
+apply(simp)
+apply(simp)
+apply (metis L.simps(6))
+apply(subst v4)
+apply (metis NPrf_imp_Prf PMatch1N)
+apply(simp)
+apply(auto)[1]
+apply(drule_tac x="s\<^sub>3" in spec)
+apply(drule mp)
+defer
+apply metis
+apply(clarify)
+apply(drule_tac x="s1" in meta_spec)
+apply(drule_tac x="v1" in meta_spec)
+apply(simp)
+apply(rotate_tac 2)
+apply(drule PMatch.intros(6))
+apply(rule PMatch.intros(7))
+apply (metis PMatch1(1) list.distinct(1) v4)
+apply (metis Nil_is_append_conv)
+apply(simp)
+apply(subst der_correctness)
+apply(simp add: Der_def)
+done
+
+
+
+lemma Sequ_single:
+ "(A ;; {t}) = {s @ t | s . s \<in> A}"
+apply(simp add: Sequ_def)
+done
+
+lemma Sequ_not:
+ assumes "\<forall>t. s \<notin> (L(der c r1) ;; {t})" "L r1 \<noteq> {}"
+ shows "\<forall>t. c # s \<notin> (L r1 ;; {t})"
+using assms
+apply(simp add: der_correctness)
+apply(simp add: Der_def)
+apply(simp add: Sequ_def)
+apply(rule allI)+
+apply(rule impI)
+apply(simp add: Cons_eq_append_conv)
+apply(auto)
+
+oops
+
+lemma PMatch_Roy2:
+ assumes "2\<rhd> v : (der c r)" "\<exists>s. c # s \<in> L r"
+ shows "2\<rhd> (injval r c v) : r"
+using assms
+apply(induct c r arbitrary: v rule: der.induct)
+apply(auto)
+apply(erule Roy2.cases)
+apply(simp_all)
+apply (metis Roy2.intros(2))
+(* alt case *)
+apply(erule Roy2.cases)
+apply(simp_all)
+apply(clarify)
+apply (metis Roy2.intros(3))
+apply(clarify)
+apply(rule Roy2.intros(4))
+apply (metis (full_types) Prf_flat_L Roy2_props v3 v4)
+apply(subgoal_tac "\<forall>t. c # flat va \<notin> L r1 ;; {t}")
+prefer 2
+apply(simp add: der_correctness)
+apply(simp add: Der_def)
+apply(simp add: Sequ_def)
+apply(rule allI)+
+apply(rule impI)
+apply(simp add: Cons_eq_append_conv)
+apply(erule disjE)
+apply(erule conjE)
+prefer 2
+apply metis
+apply(simp)
+apply(drule_tac x="[]" in spec)
+apply(drule_tac x="drop 1 t" in spec)
+apply(clarify)
+apply(simp)
+oops
+
+lemma lex_correct1:
+ assumes "s \<notin> L r"
+ shows "lex r s = None"
+using assms
+apply(induct s arbitrary: r)
+apply(simp)
+apply (metis nullable_correctness)
+apply(auto)
+apply(drule_tac x="der a r" in meta_spec)
+apply(drule meta_mp)
+apply(auto)
+apply(simp add: L_flat_Prf)
+by (metis v3 v4)
+
+
+lemma lex_correct2:
+ assumes "s \<in> L r"
+ shows "\<exists>v. lex r s = Some(v) \<and> \<turnstile> v : r \<and> flat v = s"
+using assms
+apply(induct s arbitrary: r)
+apply(simp)
+apply (metis mkeps_flat mkeps_nullable nullable_correctness)
+apply(drule_tac x="der a r" in meta_spec)
+apply(drule meta_mp)
+apply(simp add: L_flat_NPrf)
+apply(auto)
+apply (metis v3_proj v4_proj2)
+apply (metis v3)
+apply(rule v4)
+by metis
+
+lemma lex_correct3:
+ assumes "s \<in> L r"
+ shows "\<exists>v. lex r s = Some(v) \<and> s \<in> r \<rightarrow> v"
+using assms
+apply(induct s arbitrary: r)
+apply(simp)
+apply (metis PMatch_mkeps nullable_correctness)
+apply(drule_tac x="der a r" in meta_spec)
+apply(drule meta_mp)
+apply(simp add: L_flat_NPrf)
+apply(auto)
+apply (metis v3_proj v4_proj2)
+apply(rule PMatch2)
+apply(simp)
+done
+
+lemma lex_correct4:
+ assumes "s \<in> L r"
+ shows "\<exists>v. lex r s = Some(v) \<and> \<Turnstile> v : r \<and> flat v = s"
+using lex_correct3[OF assms]
+apply(auto)
+apply (metis PMatch1N)
+by (metis PMatch1(2))
+
+
+lemma lex_correct5:
+ assumes "s \<in> L r"
+ shows "s \<in> r \<rightarrow> (lex2 r s)"
+using assms
+apply(induct s arbitrary: r)
+apply(simp)
+apply (metis PMatch_mkeps nullable_correctness)
+apply(simp)
+apply(rule PMatch2)
+apply(drule_tac x="der a r" in meta_spec)
+apply(drule meta_mp)
+apply(simp add: L_flat_NPrf)
+apply(auto)
+apply (metis v3_proj v4_proj2)
+done
+
+lemma
+ "lex2 (ALT (CHAR a) (ALT (CHAR b) (SEQ (CHAR a) (CHAR b)))) [a,b] = Right (Right (Seq (Char a) (Char b)))"
+apply(simp)
+done
+
+
+(* NOT DONE YET *)
+
+section {* Sulzmann's Ordering of values *}
+
+inductive ValOrd :: "val \<Rightarrow> rexp \<Rightarrow> val \<Rightarrow> bool" ("_ \<succ>_ _" [100, 100, 100] 100)
+where
+ "v2 \<succ>r2 v2' \<Longrightarrow> (Seq v1 v2) \<succ>(SEQ r1 r2) (Seq v1 v2')"
+| "\<lbrakk>v1 \<succ>r1 v1'; v1 \<noteq> v1'\<rbrakk> \<Longrightarrow> (Seq v1 v2) \<succ>(SEQ r1 r2) (Seq v1' v2')"
+| "length (flat v1) \<ge> length (flat v2) \<Longrightarrow> (Left v1) \<succ>(ALT r1 r2) (Right v2)"
+| "length (flat v2) > length (flat v1) \<Longrightarrow> (Right v2) \<succ>(ALT r1 r2) (Left v1)"
+| "v2 \<succ>r2 v2' \<Longrightarrow> (Right v2) \<succ>(ALT r1 r2) (Right v2')"
+| "v1 \<succ>r1 v1' \<Longrightarrow> (Left v1) \<succ>(ALT r1 r2) (Left v1')"
+| "Void \<succ>EMPTY Void"
+| "(Char c) \<succ>(CHAR c) (Char c)"
+| "flat (Stars (v # vs)) = [] \<Longrightarrow> (Stars []) \<succ>(STAR r) (Stars (v # vs))"
+| "flat (Stars (v # vs)) \<noteq> [] \<Longrightarrow> (Stars (v # vs)) \<succ>(STAR r) (Stars [])"
+| "\<lbrakk>v1 \<succ>r v2; v1 \<noteq> v2\<rbrakk> \<Longrightarrow> (Stars (v1 # vs1)) \<succ>(STAR r) (Stars (v2 # vs2))"
+| "(Stars vs1) \<succ>(STAR r) (Stars vs2) \<Longrightarrow> (Stars (v # vs1)) \<succ>(STAR r) (Stars (v # vs2))"
+| "(Stars []) \<succ>(STAR r) (Stars [])"
+
+lemma PMatch_ValOrd:
+ assumes "s \<in> r \<rightarrow> v" "v' \<in> SValues r s"
+ shows "v \<succ>r v'"
+using assms
+apply(induct r arbitrary: v v' s rule: rexp.induct)
+apply(simp add: SValues_recs)
+apply(simp add: SValues_recs)
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply (metis ValOrd.intros(7))
+apply(simp add: SValues_recs)
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply (metis ValOrd.intros(8) empty_iff singletonD)
+apply(simp add: SValues_recs)
+apply(clarify)
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply(clarify)
+apply(case_tac "v1a = v1")
+apply(simp)
+apply(rule ValOrd.intros)
+apply(rotate_tac 1)
+apply(drule_tac x="v2a" in meta_spec)
+apply(rotate_tac 8)
+apply(drule_tac x="v2" in meta_spec)
+apply(drule_tac x="s2a" in meta_spec)
+apply(simp)
+apply(drule_tac meta_mp)
+apply(simp add: SValues_def)
+apply (metis PMatch1(2) same_append_eq)
+apply(simp)
+apply(rule ValOrd.intros)
+apply(drule_tac x="v1a" in meta_spec)
+apply(rotate_tac 8)
+apply(drule_tac x="v1" in meta_spec)
+apply(drule_tac x="s1a" in meta_spec)
+apply(simp)
+apply(drule_tac meta_mp)
+apply(simp add: append_eq_append_conv2)
+apply(auto)[1]
+apply(case_tac "us=[]")
+apply(simp)
+apply(drule_tac x="us" in spec)
+apply(drule mp)
+apply(simp add: SValues_def)
+apply (metis Prf_flat_L)
+apply(erule disjE)
+apply(simp)
+apply(simp)
+apply(simp add: SValues_def)
+apply (metis Prf_flat_L)
+
+apply(subst (asm) (2) Values_def)
+apply(simp)
+apply(clarify)
+apply(simp add: rest_def)
+apply(simp add: prefix_def)
+apply(auto)[1]
+apply(simp add: append_eq_append_conv2)
+apply(auto)[1]
+apply(case_tac "us = []")
+apply(simp)
+apply(simp add: Values_def)
+apply (metis append_Nil2 prefix_def)
+apply(drule_tac x="us" in spec)
+apply(simp)
+apply(drule_tac mp)
+
+
+oops
+(*HERE *)
+
+inductive ValOrd2 :: "val \<Rightarrow> string \<Rightarrow> val \<Rightarrow> bool" ("_ 2\<succ>_ _" [100, 100, 100] 100)
+where
+ "v2 2\<succ>s v2' \<Longrightarrow> (Seq v1 v2) 2\<succ>(flat v1 @ s) (Seq v1 v2')"
+| "\<lbrakk>v1 2\<succ>s v1'; v1 \<noteq> v1'\<rbrakk> \<Longrightarrow> (Seq v1 v2) 2\<succ>s (Seq v1' v2')"
+| "(flat v2) \<sqsubseteq> (flat v1) \<Longrightarrow> (Left v1) 2\<succ>(flat v1) (Right v2)"
+| "(flat v1) \<sqsubset> (flat v2) \<Longrightarrow> (Right v2) 2\<succ>(flat v2) (Left v1)"
+| "v2 2\<succ>s v2' \<Longrightarrow> (Right v2) 2\<succ>s (Right v2')"
+| "v1 2\<succ>s v1' \<Longrightarrow> (Left v1) 2\<succ>s (Left v1')"
+| "Void 2\<succ>[] Void"
+| "(Char c) 2\<succ>[c] (Char c)"
+| "flat (Stars (v # vs)) = [] \<Longrightarrow> (Stars []) 2\<succ>[] (Stars (v # vs))"
+| "flat (Stars (v # vs)) \<noteq> [] \<Longrightarrow> (Stars (v # vs)) 2\<succ>(flat (Stars (v # vs))) (Stars [])"
+| "\<lbrakk>v1 2\<succ>s v2; v1 \<noteq> v2\<rbrakk> \<Longrightarrow> (Stars (v1 # vs1)) 2\<succ>s (Stars (v2 # vs2))"
+| "(Stars vs1) 2\<succ>s (Stars vs2) \<Longrightarrow> (Stars (v # vs1)) 2\<succ>(flat v @ s) (Stars (v # vs2))"
+| "(Stars []) 2\<succ>[] (Stars [])"
+
+lemma ValOrd2_string1:
+ assumes "v1 2\<succ>s v2"
+ shows "s \<sqsubseteq> flat v1"
+using assms
+apply(induct)
+apply(auto simp add: prefix_def)
+apply (metis append_assoc)
+by (metis append_assoc)
+
+
+lemma admissibility:
+ assumes "s \<in> r \<rightarrow> v" "\<turnstile> v' : r"
+ shows "(\<forall>s'. (s' \<in> L(r) \<and> s' \<sqsubseteq> s) \<longrightarrow> v 2\<succ>s' v')"
+using assms
+apply(induct arbitrary: v')
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply (metis ValOrd2.intros(7))
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply (metis ValOrd2.intros(8) append_Nil2 prefix_Cons prefix_append prefix_def)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(auto)[1]
+apply (metis ValOrd2.intros(6))
+apply(rule ValOrd2.intros)
+apply(drule_tac x="v1" in meta_spec)
+apply(simp)
+
+apply(clarify)
+apply (metis PMatch1(2) ValOrd2.intros(3))
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(auto)
+
+apply(case_tac "v1 = v1a")
+apply(simp)
+apply(rotate_tac 3)
+apply(drule_tac x="v2a" in meta_spec)
+apply(drule meta_mp)
+apply(simp)
+apply(auto)
+apply(rule_tac x="flat v1a @ s'" in exI)
+apply (metis PMatch1(2) ValOrd2.intros(1) prefix_append)
+apply (metis PMatch1(2) ValOrd2.intros(2) ValOrd2_string1 flat.simps(5))
+prefer 4
+apply(erule Prf.cases)
+apply(simp_all)[7]
+prefer 2
+apply (metis ValOrd2.intros(5))
+
+
+apply (metis ValOrd.intros(6))
+oops
+
+
+lemma admissibility:
+ assumes "\<turnstile> s \<in> r \<rightarrow> v" "\<turnstile> v' : r"
+ shows "v \<succ>r v'"
+using assms
+apply(induct arbitrary: v')
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply (metis ValOrd.intros(7))
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply (metis ValOrd.intros(8))
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply (metis ValOrd.intros(6))
+oops
+
+lemma admissibility:
+ assumes "2\<rhd> v : r" "\<turnstile> v' : r" "flat v' \<sqsubseteq> flat v"
+ shows "v \<succ>r v'"
+using assms
+apply(induct arbitrary: v')
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply (metis ValOrd.intros(7))
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply (metis ValOrd.intros(8))
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply (metis ValOrd.intros(6))
+apply (metis ValOrd.intros(3) length_sprefix less_imp_le_nat order_refl sprefix_def)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply (metis Prf_flat_L ValOrd.intros(4) length_sprefix seq_empty(1) sprefix_def)
+apply (metis ValOrd.intros(5))
+oops
+
+
+lemma admisibility:
+ assumes "\<rhd> v : r" "\<turnstile> v' : r"
+ shows "v \<succ>r v'"
+using assms
+apply(induct arbitrary: v')
+prefer 5
+apply(drule royA)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(clarify)
+apply(case_tac "v1 = v1a")
+apply(simp)
+apply(rule ValOrd.intros)
+apply metis
+apply (metis ValOrd.intros(2))
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply (metis ValOrd.intros(7))
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply (metis ValOrd.intros(8))
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply (metis ValOrd.intros(6))
+apply(rule ValOrd.intros)
+defer
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(clarify)
+apply(rule ValOrd.intros)
+(* seq case goes through *)
+oops
+
+
+lemma admisibility:
+ assumes "\<rhd> v : r" "\<turnstile> v' : r" "flat v' \<sqsubseteq> flat v"
+ shows "v \<succ>r v'"
+using assms
+apply(induct arbitrary: v')
+prefer 5
+apply(drule royA)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(clarify)
+apply(case_tac "v1 = v1a")
+apply(simp)
+apply(rule ValOrd.intros)
+apply(subst (asm) (3) prefix_def)
+apply(erule exE)
+apply(simp)
+apply (metis prefix_def)
+(* the unequal case *)
+apply(subgoal_tac "flat v1 \<sqsubset> flat v1a \<or> flat v1a \<sqsubseteq> flat v1")
+prefer 2
+apply(simp add: prefix_def sprefix_def)
+apply (metis append_eq_append_conv2)
+apply(erule disjE)
+(* first case flat v1 \<sqsubset> flat v1a *)
+apply(subst (asm) sprefix_def)
+apply(subst (asm) (5) prefix_def)
+apply(clarify)
+apply(subgoal_tac "(s3 @ flat v2a) \<sqsubseteq> flat v2")
+prefer 2
+apply(simp)
+apply (metis append_assoc prefix_append)
+apply(subgoal_tac "s3 \<noteq> []")
+prefer 2
+apply (metis append_Nil2)
+(* HERE *)
+apply(subst (asm) (5) prefix_def)
+apply(erule exE)
+apply(simp add: ders_correctness Ders_def)
+apply(simp add: prefix_def)
+apply(clarify)
+apply(subst (asm) append_eq_append_conv2)
+apply(erule exE)
+apply(erule disjE)
+apply(clarify)
+oops
+
+
+
+lemma ValOrd_refl:
+ assumes "\<turnstile> v : r"
+ shows "v \<succ>r v"
+using assms
+apply(induct)
+apply(auto intro: ValOrd.intros)
+done
+
+lemma ValOrd_total:
+ shows "\<lbrakk>\<turnstile> v1 : r; \<turnstile> v2 : r\<rbrakk> \<Longrightarrow> v1 \<succ>r v2 \<or> v2 \<succ>r v1"
+apply(induct r arbitrary: v1 v2)
+apply(auto)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply (metis ValOrd.intros(7))
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply (metis ValOrd.intros(8))
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(clarify)
+apply(case_tac "v1a = v1b")
+apply(simp)
+apply(rule ValOrd.intros(1))
+apply (metis ValOrd.intros(1))
+apply(rule ValOrd.intros(2))
+apply(auto)[2]
+apply(erule contrapos_np)
+apply(rule ValOrd.intros(2))
+apply(auto)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(clarify)
+apply (metis ValOrd.intros(6))
+apply(rule ValOrd.intros)
+apply(erule contrapos_np)
+apply(rule ValOrd.intros)
+apply (metis le_eq_less_or_eq neq_iff)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(rule ValOrd.intros)
+apply(erule contrapos_np)
+apply(rule ValOrd.intros)
+apply (metis le_eq_less_or_eq neq_iff)
+apply(rule ValOrd.intros)
+apply(erule contrapos_np)
+apply(rule ValOrd.intros)
+apply(metis)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(auto)
+apply (metis ValOrd.intros(13))
+apply (metis ValOrd.intros(10) ValOrd.intros(9))
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(auto)
+apply (metis ValOrd.intros(10) ValOrd.intros(9))
+apply(case_tac "v = va")
+prefer 2
+apply (metis ValOrd.intros(11))
+apply(simp)
+apply(rule ValOrd.intros(12))
+apply(erule contrapos_np)
+apply(rule ValOrd.intros(12))
+oops
+
+lemma Roy_posix:
+ assumes "\<rhd> v : r" "\<turnstile> v' : r" "flat v' \<sqsubseteq> flat v"
+ shows "v \<succ>r v'"
+using assms
+apply(induct r arbitrary: v v' rule: rexp.induct)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(erule Roy.cases)
+apply(simp_all)
+apply (metis ValOrd.intros(7))
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(erule Roy.cases)
+apply(simp_all)
+apply (metis ValOrd.intros(8))
+prefer 2
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(erule Roy.cases)
+apply(simp_all)
+apply(clarify)
+apply (metis ValOrd.intros(6))
+apply(clarify)
+apply (metis Prf_flat_L ValOrd.intros(4) length_sprefix sprefix_def)
+apply(erule Roy.cases)
+apply(simp_all)
+apply (metis ValOrd.intros(3) length_sprefix less_imp_le_nat order_refl sprefix_def)
+apply(clarify)
+apply (metis ValOrd.intros(5))
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(erule Roy.cases)
+apply(simp_all)
+apply(clarify)
+apply(case_tac "v1a = v1")
+apply(simp)
+apply(rule ValOrd.intros)
+apply (metis prefix_append)
+apply(rule ValOrd.intros)
+prefer 2
+apply(simp)
+apply(simp add: prefix_def)
+apply(auto)[1]
+apply(simp add: append_eq_append_conv2)
+apply(auto)[1]
+apply(drule_tac x="v1a" in meta_spec)
+apply(rotate_tac 9)
+apply(drule_tac x="v1" in meta_spec)
+apply(drule_tac meta_mp)
+apply(simp)
+apply(drule_tac meta_mp)
+apply(simp)
+apply(drule_tac meta_mp)
+apply(simp)
+apply(drule_tac x="us" in spec)
+apply(drule_tac mp)
+apply (metis Prf_flat_L)
+apply(auto)[1]
+oops
+
+
+lemma ValOrd_anti:
+ shows "\<lbrakk>\<turnstile> v1 : r; \<turnstile> v2 : r; v1 \<succ>r v2; v2 \<succ>r v1\<rbrakk> \<Longrightarrow> v1 = v2"
+ and "\<lbrakk>\<turnstile> Stars vs1 : r; \<turnstile> Stars vs2 : r; Stars vs1 \<succ>r Stars vs2; Stars vs2 \<succ>r Stars vs1\<rbrakk> \<Longrightarrow> vs1 = vs2"
+apply(induct v1 and vs1 arbitrary: r v2 and r vs2 rule: val.inducts)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(auto)[1]
+prefer 2
+oops
+
+
+(*
+
+lemma ValOrd_PMatch:
+ assumes "s \<in> r \<rightarrow> v1" "\<turnstile> v2 : r" "flat v2 \<sqsubseteq> s"
+ shows "v1 \<succ>r v2"
+using assms
+apply(induct r arbitrary: s v1 v2 rule: rexp.induct)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply (metis ValOrd.intros(7))
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply (metis ValOrd.intros(8))
+defer
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply (metis ValOrd.intros(6))
+apply (metis PMatch1(2) Prf_flat_L ValOrd.intros(4) length_sprefix sprefix_def)
+apply(clarify)
+apply(erule PMatch.cases)
+apply(simp_all)[7]
+apply (metis PMatch1(2) ValOrd.intros(3) length_sprefix less_imp_le_nat order_refl sprefix_def)
+apply(clarify)
+apply (metis ValOrd.intros(5))
+(* Stars case *)
+apply(erule Prf.cases)
+apply(simp_all)[7]
+apply(erule PMatch.cases)
+apply(simp_all)
+apply (metis Nil_is_append_conv ValOrd.intros(10) flat.simps(7))
+apply (metis ValOrd.intros(13))
+apply(clarify)
+apply(erule PMatch.cases)
+apply(simp_all)
+prefer 2
+apply(rule ValOrd.intros)
+apply(simp add: prefix_def)
+apply(rule ValOrd.intros)
+apply(drule_tac x="s1" in meta_spec)
+apply(drule_tac x="va" in meta_spec)
+apply(drule_tac x="v" in meta_spec)
+apply(drule_tac meta_mp)
+apply(simp)
+apply(drule_tac meta_mp)
+apply(simp)
+apply(drule_tac meta_mp)
+apply(simp add: prefix_def)
+apply(auto)[1]
+prefer 3
+(* Seq case *)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)
+apply(erule PMatch.cases)
+apply(simp_all)[5]
+apply(auto)
+apply(case_tac "v1b = v1a")
+apply(auto)
+apply(simp add: prefix_def)
+apply(auto)[1]
+apply (metis PMatch1(2) ValOrd.intros(1) same_append_eq)
+apply(simp add: prefix_def)
+apply(auto)[1]
+apply(simp add: append_eq_append_conv2)
+apply(auto)
+prefer 2
+apply (metis ValOrd.intros(2))
+prefer 2
+apply (metis ValOrd.intros(2))
+apply(case_tac "us = []")
+apply(simp)
+apply (metis ValOrd.intros(2) append_Nil2)
+apply(drule_tac x="us" in spec)
+apply(simp)
+apply(drule_tac mp)
+apply (metis Prf_flat_L)
+apply(drule_tac x="s1 @ us" in meta_spec)
+apply(drule_tac x="v1b" in meta_spec)
+apply(drule_tac x="v1a" in meta_spec)
+apply(drule_tac meta_mp)
+
+apply(simp)
+apply(drule_tac meta_mp)
+apply(simp)
+apply(simp)
+apply(simp)
+apply(clarify)
+apply (metis ValOrd.intros(6))
+apply(clarify)
+apply (metis PMatch1(2) ValOrd.intros(3) length_sprefix less_imp_le_nat order_refl sprefix_def)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply (metis PMatch1(2) Prf_flat_L ValOrd.intros(4) length_sprefix sprefix_def)
+apply (metis ValOrd.intros(5))
+(* Seq case *)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)
+apply(case_tac "v1 = v1a")
+apply(auto)
+apply(simp add: prefix_def)
+apply(auto)[1]
+apply (metis PMatch1(2) ValOrd.intros(1) same_append_eq)
+apply(simp add: prefix_def)
+apply(auto)[1]
+apply(frule PMatch1)
+apply(frule PMatch1(2)[symmetric])
+apply(clarify)
+apply(simp add: append_eq_append_conv2)
+apply(auto)
+prefer 2
+apply (metis ValOrd.intros(2))
+prefer 2
+apply (metis ValOrd.intros(2))
+apply(case_tac "us = []")
+apply(simp)
+apply (metis ValOrd.intros(2) append_Nil2)
+apply(drule_tac x="us" in spec)
+apply(simp)
+apply(drule mp)
+apply (metis Prf_flat_L)
+apply(drule_tac x="v1a" in meta_spec)
+apply(drule_tac meta_mp)
+apply(simp)
+apply(drule_tac meta_mp)
+apply(simp)
+
+lemma ValOrd_PMatch:
+ assumes "s \<in> r \<rightarrow> v1" "\<turnstile> v2 : r" "flat v2 \<sqsubseteq> s"
+ shows "v1 \<succ>r v2"
+using assms
+apply(induct arbitrary: v2 rule: .induct)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(7))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(8))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply (metis ValOrd.intros(6))
+apply(clarify)
+apply (metis PMatch1(2) ValOrd.intros(3) length_sprefix less_imp_le_nat order_refl sprefix_def)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply (metis PMatch1(2) Prf_flat_L ValOrd.intros(4) length_sprefix sprefix_def)
+apply (metis ValOrd.intros(5))
+(* Seq case *)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)
+apply(case_tac "v1 = v1a")
+apply(auto)
+apply(simp add: prefix_def)
+apply(auto)[1]
+apply (metis PMatch1(2) ValOrd.intros(1) same_append_eq)
+apply(simp add: prefix_def)
+apply(auto)[1]
+apply(frule PMatch1)
+apply(frule PMatch1(2)[symmetric])
+apply(clarify)
+apply(simp add: append_eq_append_conv2)
+apply(auto)
+prefer 2
+apply (metis ValOrd.intros(2))
+prefer 2
+apply (metis ValOrd.intros(2))
+apply(case_tac "us = []")
+apply(simp)
+apply (metis ValOrd.intros(2) append_Nil2)
+apply(drule_tac x="us" in spec)
+apply(simp)
+apply(drule mp)
+apply (metis Prf_flat_L)
+apply(drule_tac x="v1a" in meta_spec)
+apply(drule_tac meta_mp)
+apply(simp)
+apply(drule_tac meta_mp)
+apply(simp)
+
+apply (metis PMatch1(2) ValOrd.intros(1) same_append_eq)
+apply(rule ValOrd.intros(2))
+apply(auto)
+apply(drule_tac x="v1a" in meta_spec)
+apply(drule_tac meta_mp)
+apply(simp)
+apply(drule_tac meta_mp)
+prefer 2
+apply(simp)
+thm append_eq_append_conv
+apply(simp add: append_eq_append_conv2)
+apply(auto)
+apply (metis Prf_flat_L)
+apply(case_tac "us = []")
+apply(simp)
+apply(drule_tac x="us" in spec)
+apply(drule mp)
+
+
+inductive ValOrd2 :: "val \<Rightarrow> val \<Rightarrow> bool" ("_ 2\<succ> _" [100, 100] 100)
+where
+ "v2 2\<succ> v2' \<Longrightarrow> (Seq v1 v2) 2\<succ> (Seq v1 v2')"
+| "\<lbrakk>v1 2\<succ> v1'; v1 \<noteq> v1'\<rbrakk> \<Longrightarrow> (Seq v1 v2) 2\<succ> (Seq v1' v2')"
+| "length (flat v1) \<ge> length (flat v2) \<Longrightarrow> (Left v1) 2\<succ> (Right v2)"
+| "length (flat v2) > length (flat v1) \<Longrightarrow> (Right v2) 2\<succ> (Left v1)"
+| "v2 2\<succ> v2' \<Longrightarrow> (Right v2) 2\<succ> (Right v2')"
+| "v1 2\<succ> v1' \<Longrightarrow> (Left v1) 2\<succ> (Left v1')"
+| "Void 2\<succ> Void"
+| "(Char c) 2\<succ> (Char c)"
+
+lemma Ord1:
+ "v1 \<succ>r v2 \<Longrightarrow> v1 2\<succ> v2"
+apply(induct rule: ValOrd.induct)
+apply(auto intro: ValOrd2.intros)
+done
+
+lemma Ord2:
+ "v1 2\<succ> v2 \<Longrightarrow> \<exists>r. v1 \<succ>r v2"
+apply(induct v1 v2 rule: ValOrd2.induct)
+apply(auto intro: ValOrd.intros)
+done
+
+lemma Ord3:
+ "\<lbrakk>v1 2\<succ> v2; \<turnstile> v1 : r\<rbrakk> \<Longrightarrow> v1 \<succ>r v2"
+apply(induct v1 v2 arbitrary: r rule: ValOrd2.induct)
+apply(auto intro: ValOrd.intros elim: Prf.cases)
+done
+
+section {* Posix definition *}
+
+definition POSIX :: "val \<Rightarrow> rexp \<Rightarrow> bool"
+where
+ "POSIX v r \<equiv> (\<turnstile> v : r \<and> (\<forall>v'. (\<turnstile> v' : r \<and> flat v' \<sqsubseteq> flat v) \<longrightarrow> v \<succ>r v'))"
+
+lemma ValOrd_refl:
+ assumes "\<turnstile> v : r"
+ shows "v \<succ>r v"
+using assms
+apply(induct)
+apply(auto intro: ValOrd.intros)
+done
+
+lemma ValOrd_total:
+ shows "\<lbrakk>\<turnstile> v1 : r; \<turnstile> v2 : r\<rbrakk> \<Longrightarrow> v1 \<succ>r v2 \<or> v2 \<succ>r v1"
+apply(induct r arbitrary: v1 v2)
+apply(auto)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(7))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(8))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(case_tac "v1a = v1b")
+apply(simp)
+apply(rule ValOrd.intros(1))
+apply (metis ValOrd.intros(1))
+apply(rule ValOrd.intros(2))
+apply(auto)[2]
+apply(erule contrapos_np)
+apply(rule ValOrd.intros(2))
+apply(auto)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis Ord1 Ord3 Prf.intros(2) ValOrd2.intros(6))
+apply(rule ValOrd.intros)
+apply(erule contrapos_np)
+apply(rule ValOrd.intros)
+apply (metis le_eq_less_or_eq neq_iff)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rule ValOrd.intros)
+apply(erule contrapos_np)
+apply(rule ValOrd.intros)
+apply (metis le_eq_less_or_eq neq_iff)
+apply(rule ValOrd.intros)
+apply(erule contrapos_np)
+apply(rule ValOrd.intros)
+by metis
+
+lemma ValOrd_anti:
+ shows "\<lbrakk>\<turnstile> v1 : r; \<turnstile> v2 : r; v1 \<succ>r v2; v2 \<succ>r v1\<rbrakk> \<Longrightarrow> v1 = v2"
+apply(induct r arbitrary: v1 v2)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+done
+
+lemma POSIX_ALT_I1:
+ assumes "POSIX v1 r1"
+ shows "POSIX (Left v1) (ALT r1 r2)"
+using assms
+unfolding POSIX_def
+apply(auto)
+apply (metis Prf.intros(2))
+apply(rotate_tac 2)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)
+apply(rule ValOrd.intros)
+apply(auto)
+apply(rule ValOrd.intros)
+by (metis le_eq_less_or_eq length_sprefix sprefix_def)
+
+lemma POSIX_ALT_I2:
+ assumes "POSIX v2 r2" "\<forall>v'. \<turnstile> v' : r1 \<longrightarrow> length (flat v2) > length (flat v')"
+ shows "POSIX (Right v2) (ALT r1 r2)"
+using assms
+unfolding POSIX_def
+apply(auto)
+apply (metis Prf.intros)
+apply(rotate_tac 3)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)
+apply(rule ValOrd.intros)
+apply metis
+apply(rule ValOrd.intros)
+apply metis
+done
+
+thm PMatch.intros[no_vars]
+
+lemma POSIX_PMatch:
+ assumes "s \<in> r \<rightarrow> v" "\<turnstile> v' : r"
+ shows "length (flat v') \<le> length (flat v)"
+using assms
+apply(induct arbitrary: s v v' rule: rexp.induct)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule PMatch.cases)
+apply(simp_all)[5]
+defer
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule PMatch.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(simp add: L_flat_Prf)
+
+apply(clarify)
+apply (metis ValOrd.intros(8))
+apply (metis POSIX_ALT_I1)
+apply(rule POSIX_ALT_I2)
+apply(simp)
+apply(auto)[1]
+apply(simp add: POSIX_def)
+apply(frule PMatch1(1))
+apply(frule PMatch1(2))
+apply(simp)
+
+
+lemma POSIX_PMatch:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "POSIX v r"
+using assms
+apply(induct arbitrary: rule: PMatch.induct)
+apply(auto)
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply (metis Prf.intros(4))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(7))
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply (metis Prf.intros(5))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(8))
+apply (metis POSIX_ALT_I1)
+apply(rule POSIX_ALT_I2)
+apply(simp)
+apply(auto)[1]
+apply(simp add: POSIX_def)
+apply(frule PMatch1(1))
+apply(frule PMatch1(2))
+apply(simp)
+
+
+
+lemma ValOrd_PMatch:
+ assumes "s \<in> r \<rightarrow> v1" "\<turnstile> v2 : r" "flat v2 = s"
+ shows "v1 \<succ>r v2"
+using assms
+apply(induct arbitrary: v2 rule: PMatch.induct)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(7))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(8))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply (metis ValOrd.intros(6))
+apply(clarify)
+apply (metis PMatch1(2) ValOrd.intros(3) order_refl)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply (metis Prf_flat_L)
+apply (metis ValOrd.intros(5))
+(* Seq case *)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)
+apply(case_tac "v1 = v1a")
+apply(auto)
+apply (metis PMatch1(2) ValOrd.intros(1) same_append_eq)
+apply(rule ValOrd.intros(2))
+apply(auto)
+apply(drule_tac x="v1a" in meta_spec)
+apply(drule_tac meta_mp)
+apply(simp)
+apply(drule_tac meta_mp)
+prefer 2
+apply(simp)
+apply(simp add: append_eq_append_conv2)
+apply(auto)
+apply (metis Prf_flat_L)
+apply(case_tac "us = []")
+apply(simp)
+apply(drule_tac x="us" in spec)
+apply(drule mp)
+
+thm L_flat_Prf
+apply(simp add: L_flat_Prf)
+thm append_eq_append_conv2
+apply(simp add: append_eq_append_conv2)
+apply(auto)
+apply(drule_tac x="us" in spec)
+apply(drule mp)
+apply metis
+apply (metis append_Nil2)
+apply(case_tac "us = []")
+apply(auto)
+apply(drule_tac x="s2" in spec)
+apply(drule mp)
+
+apply(auto)[1]
+apply(drule_tac x="v1a" in meta_spec)
+apply(simp)
+
+lemma refl_on_ValOrd:
+ "refl_on (Values r s) {(v1, v2). v1 \<succ>r v2 \<and> v1 \<in> Values r s \<and> v2 \<in> Values r s}"
+unfolding refl_on_def
+apply(auto)
+apply(rule ValOrd_refl)
+apply(simp add: Values_def)
+done
+
+
+section {* Posix definition *}
+
+definition POSIX :: "val \<Rightarrow> rexp \<Rightarrow> bool"
+where
+ "POSIX v r \<equiv> (\<turnstile> v : r \<and> (\<forall>v'. (\<turnstile> v' : r \<and> flat v = flat v') \<longrightarrow> v \<succ>r v'))"
+
+definition POSIX2 :: "val \<Rightarrow> rexp \<Rightarrow> bool"
+where
+ "POSIX2 v r \<equiv> (\<turnstile> v : r \<and> (\<forall>v'. (\<turnstile> v' : r \<and> flat v = flat v') \<longrightarrow> v 2\<succ> v'))"
+
+lemma "POSIX v r = POSIX2 v r"
+unfolding POSIX_def POSIX2_def
+apply(auto)
+apply(rule Ord1)
+apply(auto)
+apply(rule Ord3)
+apply(auto)
+done
+
+section {* POSIX for some constructors *}
+
+lemma POSIX_SEQ1:
+ assumes "POSIX (Seq v1 v2) (SEQ r1 r2)" "\<turnstile> v1 : r1" "\<turnstile> v2 : r2"
+ shows "POSIX v1 r1"
+using assms
+unfolding POSIX_def
+apply(auto)
+apply(drule_tac x="Seq v' v2" in spec)
+apply(simp)
+apply(erule impE)
+apply(rule Prf.intros)
+apply(simp)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)
+apply(clarify)
+by (metis ValOrd_refl)
+
+lemma POSIX_SEQ2:
+ assumes "POSIX (Seq v1 v2) (SEQ r1 r2)" "\<turnstile> v1 : r1" "\<turnstile> v2 : r2"
+ shows "POSIX v2 r2"
+using assms
+unfolding POSIX_def
+apply(auto)
+apply(drule_tac x="Seq v1 v'" in spec)
+apply(simp)
+apply(erule impE)
+apply(rule Prf.intros)
+apply(simp)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)
+done
+
+lemma POSIX_ALT2:
+ assumes "POSIX (Left v1) (ALT r1 r2)"
+ shows "POSIX v1 r1"
+using assms
+unfolding POSIX_def
+apply(auto)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(drule_tac x="Left v'" in spec)
+apply(simp)
+apply(drule mp)
+apply(rule Prf.intros)
+apply(auto)
+apply(erule ValOrd.cases)
+apply(simp_all)
+done
+
+lemma POSIX_ALT1a:
+ assumes "POSIX (Right v2) (ALT r1 r2)"
+ shows "POSIX v2 r2"
+using assms
+unfolding POSIX_def
+apply(auto)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(drule_tac x="Right v'" in spec)
+apply(simp)
+apply(drule mp)
+apply(rule Prf.intros)
+apply(auto)
+apply(erule ValOrd.cases)
+apply(simp_all)
+done
+
+lemma POSIX_ALT1b:
+ assumes "POSIX (Right v2) (ALT r1 r2)"
+ shows "(\<forall>v'. (\<turnstile> v' : r2 \<and> flat v' = flat v2) \<longrightarrow> v2 \<succ>r2 v')"
+using assms
+apply(drule_tac POSIX_ALT1a)
+unfolding POSIX_def
+apply(auto)
+done
+
+lemma POSIX_ALT_I1:
+ assumes "POSIX v1 r1"
+ shows "POSIX (Left v1) (ALT r1 r2)"
+using assms
+unfolding POSIX_def
+apply(auto)
+apply (metis Prf.intros(2))
+apply(rotate_tac 2)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)
+apply(rule ValOrd.intros)
+apply(auto)
+apply(rule ValOrd.intros)
+by simp
+
+lemma POSIX_ALT_I2:
+ assumes "POSIX v2 r2" "\<forall>v'. \<turnstile> v' : r1 \<longrightarrow> length (flat v2) > length (flat v')"
+ shows "POSIX (Right v2) (ALT r1 r2)"
+using assms
+unfolding POSIX_def
+apply(auto)
+apply (metis Prf.intros)
+apply(rotate_tac 3)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)
+apply(rule ValOrd.intros)
+apply metis
+done
+
+lemma mkeps_POSIX:
+ assumes "nullable r"
+ shows "POSIX (mkeps r) r"
+using assms
+apply(induct r)
+apply(auto)[1]
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply (metis Prf.intros(4))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros)
+apply(simp)
+apply(auto)[1]
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply (metis mkeps.simps(2) mkeps_nullable nullable.simps(5))
+apply(rotate_tac 6)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (simp add: mkeps_flat)
+apply(case_tac "mkeps r1a = v1")
+apply(simp)
+apply (metis ValOrd.intros(1))
+apply (rule ValOrd.intros(2))
+apply metis
+apply(simp)
+(* ALT case *)
+thm mkeps.simps
+apply(simp)
+apply(erule disjE)
+apply(simp)
+apply (metis POSIX_ALT_I1)
+(* *)
+apply(auto)[1]
+thm POSIX_ALT_I1
+apply (metis POSIX_ALT_I1)
+apply(simp (no_asm) add: POSIX_def)
+apply(auto)[1]
+apply(rule Prf.intros(3))
+apply(simp only: POSIX_def)
+apply(rotate_tac 4)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+thm mkeps_flat
+apply(simp add: mkeps_flat)
+apply(auto)[1]
+thm Prf_flat_L nullable_correctness
+apply (metis Prf_flat_L nullable_correctness)
+apply(rule ValOrd.intros)
+apply(subst (asm) POSIX_def)
+apply(clarify)
+apply(drule_tac x="v2" in spec)
+by simp
+
+
+
+text {*
+ Injection value is related to r
+*}
+
+
+
+text {*
+ The string behind the injection value is an added c
+*}
+
+
+lemma injval_inj: "inj_on (injval r c) {v. \<turnstile> v : der c r}"
+apply(induct c r rule: der.induct)
+unfolding inj_on_def
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply (metis list.distinct(1) mkeps_flat v4)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(rotate_tac 6)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis list.distinct(1) mkeps_flat v4)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+done
+
+lemma Values_nullable:
+ assumes "nullable r1"
+ shows "mkeps r1 \<in> Values r1 s"
+using assms
+apply(induct r1 arbitrary: s)
+apply(simp_all)
+apply(simp add: Values_recs)
+apply(simp add: Values_recs)
+apply(simp add: Values_recs)
+apply(auto)[1]
+done
+
+lemma Values_injval:
+ assumes "v \<in> Values (der c r) s"
+ shows "injval r c v \<in> Values r (c#s)"
+using assms
+apply(induct c r arbitrary: v s rule: der.induct)
+apply(simp add: Values_recs)
+apply(simp add: Values_recs)
+apply(case_tac "c = c'")
+apply(simp)
+apply(simp add: Values_recs)
+apply(simp add: prefix_def)
+apply(simp)
+apply(simp add: Values_recs)
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(case_tac "nullable r1")
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(simp add: rest_def)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(simp add: Values_def)
+apply(rule Values_nullable)
+apply(assumption)
+apply(simp add: rest_def)
+apply(subst mkeps_flat)
+apply(assumption)
+apply(simp)
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(simp add: rest_def)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(simp add: Values_def)
+done
+
+lemma Values_projval:
+ assumes "v \<in> Values r (c#s)" "\<exists>s. flat v = c # s"
+ shows "projval r c v \<in> Values (der c r) s"
+using assms
+apply(induct r arbitrary: v s c rule: rexp.induct)
+apply(simp add: Values_recs)
+apply(simp add: Values_recs)
+apply(case_tac "c = char")
+apply(simp)
+apply(simp add: Values_recs)
+apply(simp)
+apply(simp add: Values_recs)
+apply(simp add: prefix_def)
+apply(case_tac "nullable rexp1")
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(simp add: rest_def)
+apply (metis hd_Cons_tl hd_append2 list.sel(1))
+apply(simp add: rest_def)
+apply(simp add: append_eq_Cons_conv)
+apply(auto)[1]
+apply(subst v4_proj2)
+apply(simp add: Values_def)
+apply(assumption)
+apply(simp)
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(auto simp add: Values_def not_nullable_flat)[1]
+apply(simp add: append_eq_Cons_conv)
+apply(auto)[1]
+apply(simp add: append_eq_Cons_conv)
+apply(auto)[1]
+apply(simp add: rest_def)
+apply(subst v4_proj2)
+apply(simp add: Values_def)
+apply(assumption)
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+done
+
+
+definition "MValue v r s \<equiv> (v \<in> Values r s \<and> (\<forall>v' \<in> Values r s. v 2\<succ> v'))"
+
+lemma MValue_ALTE:
+ assumes "MValue v (ALT r1 r2) s"
+ shows "(\<exists>vl. v = Left vl \<and> MValue vl r1 s \<and> (\<forall>vr \<in> Values r2 s. length (flat vr) \<le> length (flat vl))) \<or>
+ (\<exists>vr. v = Right vr \<and> MValue vr r2 s \<and> (\<forall>vl \<in> Values r1 s. length (flat vl) < length (flat vr)))"
+using assms
+apply(simp add: MValue_def)
+apply(simp add: Values_recs)
+apply(auto)
+apply(drule_tac x="Left x" in bspec)
+apply(simp)
+apply(erule ValOrd2.cases)
+apply(simp_all)
+apply(drule_tac x="Right vr" in bspec)
+apply(simp)
+apply(erule ValOrd2.cases)
+apply(simp_all)
+apply(drule_tac x="Right x" in bspec)
+apply(simp)
+apply(erule ValOrd2.cases)
+apply(simp_all)
+apply(drule_tac x="Left vl" in bspec)
+apply(simp)
+apply(erule ValOrd2.cases)
+apply(simp_all)
+done
+
+lemma MValue_ALTI1:
+ assumes "MValue vl r1 s" "\<forall>vr \<in> Values r2 s. length (flat vr) \<le> length (flat vl)"
+ shows "MValue (Left vl) (ALT r1 r2) s"
+using assms
+apply(simp add: MValue_def)
+apply(simp add: Values_recs)
+apply(auto)
+apply(rule ValOrd2.intros)
+apply metis
+apply(rule ValOrd2.intros)
+apply metis
+done
+
+lemma MValue_ALTI2:
+ assumes "MValue vr r2 s" "\<forall>vl \<in> Values r1 s. length (flat vl) < length (flat vr)"
+ shows "MValue (Right vr) (ALT r1 r2) s"
+using assms
+apply(simp add: MValue_def)
+apply(simp add: Values_recs)
+apply(auto)
+apply(rule ValOrd2.intros)
+apply metis
+apply(rule ValOrd2.intros)
+apply metis
+done
+
+lemma t: "(c#xs = c#ys) \<Longrightarrow> xs = ys"
+by (metis list.sel(3))
+
+lemma t2: "(xs = ys) \<Longrightarrow> (c#xs) = (c#ys)"
+by (metis)
+
+lemma "\<not>(nullable r) \<Longrightarrow> \<not>(\<exists>v. \<turnstile> v : r \<and> flat v = [])"
+by (metis Prf_flat_L nullable_correctness)
+
+
+lemma LeftRight:
+ assumes "(Left v1) \<succ>(der c (ALT r1 r2)) (Right v2)"
+ and "\<turnstile> v1 : der c r1" "\<turnstile> v2 : der c r2"
+ shows "(injval (ALT r1 r2) c (Left v1)) \<succ>(ALT r1 r2) (injval (ALT r1 r2) c (Right v2))"
+using assms
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd.intros)
+apply(clarify)
+apply(subst v4)
+apply(simp)
+apply(subst v4)
+apply(simp)
+apply(simp)
+done
+
+lemma RightLeft:
+ assumes "(Right v1) \<succ>(der c (ALT r1 r2)) (Left v2)"
+ and "\<turnstile> v1 : der c r2" "\<turnstile> v2 : der c r1"
+ shows "(injval (ALT r1 r2) c (Right v1)) \<succ>(ALT r1 r2) (injval (ALT r1 r2) c (Left v2))"
+using assms
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd.intros)
+apply(clarify)
+apply(subst v4)
+apply(simp)
+apply(subst v4)
+apply(simp)
+apply(simp)
+done
+
+lemma h:
+ assumes "nullable r1" "\<turnstile> v1 : der c r1"
+ shows "injval r1 c v1 \<succ>r1 mkeps r1"
+using assms
+apply(induct r1 arbitrary: v1 rule: der.induct)
+apply(simp)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(auto)[1]
+apply (metis ValOrd.intros(6))
+apply (metis ValOrd.intros(6))
+apply (metis ValOrd.intros(3) le_add2 list.size(3) mkeps_flat monoid_add_class.add.right_neutral)
+apply(auto)[1]
+apply (metis ValOrd.intros(4) length_greater_0_conv list.distinct(1) list.size(3) mkeps_flat v4)
+apply (metis ValOrd.intros(4) length_greater_0_conv list.distinct(1) list.size(3) mkeps_flat v4)
+apply (metis ValOrd.intros(5))
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply (metis ValOrd.intros(2) list.distinct(1) mkeps_flat v4)
+apply(clarify)
+by (metis ValOrd.intros(1))
+
+lemma LeftRightSeq:
+ assumes "(Left (Seq v1 v2)) \<succ>(der c (SEQ r1 r2)) (Right v3)"
+ and "nullable r1" "\<turnstile> v1 : der c r1"
+ shows "(injval (SEQ r1 r2) c (Seq v1 v2)) \<succ>(SEQ r1 r2) (injval (SEQ r1 r2) c (Right v2))"
+using assms
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply(simp)
+apply(rule ValOrd.intros(2))
+prefer 2
+apply (metis list.distinct(1) mkeps_flat v4)
+by (metis h)
+
+lemma rr1:
+ assumes "\<turnstile> v : r" "\<not>nullable r"
+ shows "flat v \<noteq> []"
+using assms
+by (metis Prf_flat_L nullable_correctness)
+
+(* HERE *)
+
+lemma Prf_inj_test:
+ assumes "v1 \<succ>(der c r) v2"
+ "v1 \<in> Values (der c r) s"
+ "v2 \<in> Values (der c r) s"
+ "injval r c v1 \<in> Values r (c#s)"
+ "injval r c v2 \<in> Values r (c#s)"
+ shows "(injval r c v1) 2\<succ> (injval r c v2)"
+using assms
+apply(induct c r arbitrary: v1 v2 s rule: der.induct)
+(* NULL case *)
+apply(simp add: Values_recs)
+(* EMPTY case *)
+apply(simp add: Values_recs)
+(* CHAR case *)
+apply(case_tac "c = c'")
+apply(simp)
+apply(simp add: Values_recs)
+apply (metis ValOrd2.intros(8))
+apply(simp add: Values_recs)
+(* ALT case *)
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply (metis ValOrd2.intros(6))
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd2.intros)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd2.intros)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply (metis ValOrd2.intros(5))
+(* SEQ case*)
+apply(simp)
+apply(case_tac "nullable r1")
+apply(simp)
+defer
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply(rule ValOrd2.intros)
+apply(simp)
+apply (metis Ord1)
+apply(clarify)
+apply(rule ValOrd2.intros)
+apply(subgoal_tac "rest v1 (flat v1 @ flat v2) = flat v2")
+apply(simp)
+apply(subgoal_tac "rest (injval r1 c v1) (c # flat v1 @ flat v2) = flat v2")
+apply(simp)
+oops
+
+lemma Prf_inj_test:
+ assumes "v1 \<succ>(der c r) v2"
+ "v1 \<in> Values (der c r) s"
+ "v2 \<in> Values (der c r) s"
+ "injval r c v1 \<in> Values r (c#s)"
+ "injval r c v2 \<in> Values r (c#s)"
+ shows "(injval r c v1) 2\<succ> (injval r c v2)"
+using assms
+apply(induct c r arbitrary: v1 v2 s rule: der.induct)
+(* NULL case *)
+apply(simp add: Values_recs)
+(* EMPTY case *)
+apply(simp add: Values_recs)
+(* CHAR case *)
+apply(case_tac "c = c'")
+apply(simp)
+apply(simp add: Values_recs)
+apply (metis ValOrd2.intros(8))
+apply(simp add: Values_recs)
+(* ALT case *)
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply (metis ValOrd2.intros(6))
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd2.intros)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd2.intros)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(subst v4)
+apply(simp add: Values_def)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply (metis ValOrd2.intros(5))
+(* SEQ case*)
+apply(simp)
+apply(case_tac "nullable r1")
+apply(simp)
+defer
+apply(simp)
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply(rule ValOrd2.intros)
+apply(simp)
+apply (metis Ord1)
+apply(clarify)
+apply(rule ValOrd2.intros)
+apply metis
+using injval_inj
+apply(simp add: Values_def inj_on_def)
+apply metis
+apply(simp add: Values_recs)
+apply(auto)[1]
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply (metis Ord1 ValOrd2.intros(1))
+apply(clarify)
+apply(rule ValOrd2.intros(2))
+apply metis
+using injval_inj
+apply(simp add: Values_def inj_on_def)
+apply metis
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd2.intros(2))
+thm h
+apply(rule Ord1)
+apply(rule h)
+apply(simp)
+apply(simp add: Values_def)
+apply(simp add: Values_def)
+apply (metis list.distinct(1) mkeps_flat v4)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply(simp add: Values_def)
+defer
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply(rule ValOrd2.intros(1))
+apply(rotate_tac 1)
+apply(drule_tac x="v2" in meta_spec)
+apply(rotate_tac 8)
+apply(drule_tac x="v2'" in meta_spec)
+apply(rotate_tac 8)
+oops
+
+lemma POSIX_der:
+ assumes "POSIX v (der c r)" "\<turnstile> v : der c r"
+ shows "POSIX (injval r c v) r"
+using assms
+unfolding POSIX_def
+apply(auto)
+thm v3
+apply (erule v3)
+thm v4
+apply(subst (asm) v4)
+apply(assumption)
+apply(drule_tac x="projval r c v'" in spec)
+apply(drule mp)
+apply(rule conjI)
+thm v3_proj
+apply(rule v3_proj)
+apply(simp)
+apply(rule_tac x="flat v" in exI)
+apply(simp)
+thm t
+apply(rule_tac c="c" in t)
+apply(simp)
+thm v4_proj
+apply(subst v4_proj)
+apply(simp)
+apply(rule_tac x="flat v" in exI)
+apply(simp)
+apply(simp)
+oops
+
+lemma POSIX_der:
+ assumes "POSIX v (der c r)" "\<turnstile> v : der c r"
+ shows "POSIX (injval r c v) r"
+using assms
+apply(induct c r arbitrary: v rule: der.induct)
+(* null case*)
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+(* empty case *)
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+(* char case *)
+apply(simp add: POSIX_def)
+apply(case_tac "c = c'")
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis Prf.intros(5))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(8))
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+(* alt case *)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(simp (no_asm) add: POSIX_def)
+apply(auto)[1]
+apply (metis Prf.intros(2) v3)
+apply(rotate_tac 4)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis POSIX_ALT2 POSIX_def ValOrd.intros(6))
+apply (metis ValOrd.intros(3) order_refl)
+apply(simp (no_asm) add: POSIX_def)
+apply(auto)[1]
+apply (metis Prf.intros(3) v3)
+apply(rotate_tac 4)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+defer
+apply (metis POSIX_ALT1a POSIX_def ValOrd.intros(5))
+prefer 2
+apply(subst (asm) (5) POSIX_def)
+apply(auto)[1]
+apply(rotate_tac 5)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rule ValOrd.intros)
+apply(subst (asm) v4)
+apply(simp)
+apply(drule_tac x="Left (projval r1a c v1)" in spec)
+apply(clarify)
+apply(drule mp)
+apply(rule conjI)
+apply (metis Prf.intros(2) v3_proj)
+apply(simp)
+apply (metis v4_proj2)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply (metis less_not_refl v4_proj2)
+(* seq case *)
+apply(case_tac "nullable r1")
+defer
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis Prf.intros(1) v3)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(subst (asm) (3) v4)
+apply(simp)
+apply(simp)
+apply(subgoal_tac "flat v1a \<noteq> []")
+prefer 2
+apply (metis Prf_flat_L nullable_correctness)
+apply(subgoal_tac "\<exists>s. flat v1a = c # s")
+prefer 2
+apply (metis append_eq_Cons_conv)
+apply(auto)[1]
+oops
+
+
+lemma POSIX_ex: "\<turnstile> v : r \<Longrightarrow> \<exists>v. POSIX v r"
+apply(induct r arbitrary: v)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rule_tac x="Void" in exI)
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply (metis Prf.intros(4))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(7))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rule_tac x="Char c" in exI)
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply (metis Prf.intros(5))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply (metis ValOrd.intros(8))
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply(drule_tac x="v1" in meta_spec)
+apply(drule_tac x="v2" in meta_spec)
+apply(auto)[1]
+defer
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply (metis POSIX_ALT_I1)
+apply (metis POSIX_ALT_I1 POSIX_ALT_I2)
+apply(case_tac "nullable r1a")
+apply(rule_tac x="Seq (mkeps r1a) va" in exI)
+apply(auto simp add: POSIX_def)[1]
+apply (metis Prf.intros(1) mkeps_nullable)
+apply(simp add: mkeps_flat)
+apply(rotate_tac 7)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(case_tac "mkeps r1 = v1a")
+apply(simp)
+apply (rule ValOrd.intros(1))
+apply (metis append_Nil mkeps_flat)
+apply (rule ValOrd.intros(2))
+apply(drule mkeps_POSIX)
+apply(simp add: POSIX_def)
+oops
+
+lemma POSIX_ex2: "\<turnstile> v : r \<Longrightarrow> \<exists>v. POSIX v r \<and> \<turnstile> v : r"
+apply(induct r arbitrary: v)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rule_tac x="Void" in exI)
+apply(simp add: POSIX_def)
+apply(auto)[1]
+oops
+
+lemma POSIX_ALT_cases:
+ assumes "\<turnstile> v : (ALT r1 r2)" "POSIX v (ALT r1 r2)"
+ shows "(\<exists>v1. v = Left v1 \<and> POSIX v1 r1) \<or> (\<exists>v2. v = Right v2 \<and> POSIX v2 r2)"
+using assms
+apply(erule_tac Prf.cases)
+apply(simp_all)
+unfolding POSIX_def
+apply(auto)
+apply (metis POSIX_ALT2 POSIX_def assms(2))
+by (metis POSIX_ALT1b assms(2))
+
+lemma POSIX_ALT_cases2:
+ assumes "POSIX v (ALT r1 r2)" "\<turnstile> v : (ALT r1 r2)"
+ shows "(\<exists>v1. v = Left v1 \<and> POSIX v1 r1) \<or> (\<exists>v2. v = Right v2 \<and> POSIX v2 r2)"
+using assms POSIX_ALT_cases by auto
+
+lemma Prf_flat_empty:
+ assumes "\<turnstile> v : r" "flat v = []"
+ shows "nullable r"
+using assms
+apply(induct)
+apply(auto)
+done
+
+lemma POSIX_proj:
+ assumes "POSIX v r" "\<turnstile> v : r" "\<exists>s. flat v = c#s"
+ shows "POSIX (projval r c v) (der c r)"
+using assms
+apply(induct r c v arbitrary: rule: projval.induct)
+defer
+defer
+defer
+defer
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+oops
+
+lemma POSIX_proj:
+ assumes "POSIX v r" "\<turnstile> v : r" "\<exists>s. flat v = c#s"
+ shows "POSIX (projval r c v) (der c r)"
+using assms
+apply(induct r arbitrary: c v rule: rexp.induct)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+oops
+
+lemma POSIX_proj:
+ assumes "POSIX v r" "\<turnstile> v : r" "\<exists>s. flat v = c#s"
+ shows "POSIX (projval r c v) (der c r)"
+using assms
+apply(induct r c v arbitrary: rule: projval.induct)
+defer
+defer
+defer
+defer
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp add: POSIX_def)
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+oops
+
+lemma Prf_inj:
+ assumes "v1 \<succ>(der c r) v2" "\<turnstile> v1 : der c r" "\<turnstile> v2 : der c r" "flat v1 = flat v2"
+ shows "(injval r c v1) \<succ>r (injval r c v2)"
+using assms
+apply(induct arbitrary: v1 v2 rule: der.induct)
+(* NULL case *)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+(* EMPTY case *)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+(* CHAR case *)
+apply(case_tac "c = c'")
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd.intros)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+(* ALT case *)
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(rule ValOrd.intros)
+apply(subst v4)
+apply(clarify)
+apply(rotate_tac 3)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(subst v4)
+apply(clarify)
+apply(rotate_tac 2)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(rule ValOrd.intros)
+apply(clarify)
+apply(rotate_tac 3)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(rule ValOrd.intros)
+apply(clarify)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+(* SEQ case*)
+apply(simp)
+apply(case_tac "nullable r1")
+defer
+apply(simp)
+apply(erule ValOrd.cases)
+apply(simp_all)[8]
+apply(clarify)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(clarify)
+apply(rule ValOrd.intros)
+apply(simp)
+oops
+
+
+text {*
+ Injection followed by projection is the identity.
+*}
+
+lemma proj_inj_id:
+ assumes "\<turnstile> v : der c r"
+ shows "projval r c (injval r c v) = v"
+using assms
+apply(induct r arbitrary: c v rule: rexp.induct)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(case_tac "c = char")
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+defer
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(simp)
+apply(case_tac "nullable rexp1")
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply (metis list.distinct(1) v4)
+apply(auto)[1]
+apply (metis mkeps_flat)
+apply(auto)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+apply(auto)[1]
+apply(simp add: v4)
+done
+
+text {*
+
+ HERE: Crucial lemma that does not go through in the sequence case.
+
+*}
+lemma v5:
+ assumes "\<turnstile> v : der c r" "POSIX v (der c r)"
+ shows "POSIX (injval r c v) r"
+using assms
+apply(induct arbitrary: v rule: der.induct)
+(* NULL case *)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+(* EMPTY case *)
+apply(simp)
+apply(erule Prf.cases)
+apply(simp_all)[5]
+(* CHAR case *)
+apply(simp)
+apply(case_tac "c = c'")
+apply(auto simp add: POSIX_def)[1]
+apply(erule Prf.cases)
+apply(simp_all)[5]
+oops
+*)
+
+
+end
\ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys2/RegLangs.thy Sun Oct 10 18:35:21 2021 +0100
@@ -0,0 +1,236 @@
+theory RegLangs
+ imports Main "HOL-Library.Sublist"
+begin
+
+section \<open>Sequential Composition of Languages\<close>
+
+definition
+ Sequ :: "string set \<Rightarrow> string set \<Rightarrow> string set" ("_ ;; _" [100,100] 100)
+where
+ "A ;; B = {s1 @ s2 | s1 s2. s1 \<in> A \<and> s2 \<in> B}"
+
+text \<open>Two Simple Properties about Sequential Composition\<close>
+
+lemma Sequ_empty_string [simp]:
+ shows "A ;; {[]} = A"
+ and "{[]} ;; A = A"
+by (simp_all add: Sequ_def)
+
+lemma Sequ_empty [simp]:
+ shows "A ;; {} = {}"
+ and "{} ;; A = {}"
+ by (simp_all add: Sequ_def)
+
+
+section \<open>Semantic Derivative (Left Quotient) of Languages\<close>
+
+definition
+ Der :: "char \<Rightarrow> string set \<Rightarrow> string set"
+where
+ "Der c A \<equiv> {s. c # s \<in> A}"
+
+definition
+ Ders :: "string \<Rightarrow> string set \<Rightarrow> string set"
+where
+ "Ders s A \<equiv> {s'. s @ s' \<in> A}"
+
+lemma Der_null [simp]:
+ shows "Der c {} = {}"
+unfolding Der_def
+by auto
+
+lemma Der_empty [simp]:
+ shows "Der c {[]} = {}"
+unfolding Der_def
+by auto
+
+lemma Der_char [simp]:
+ shows "Der c {[d]} = (if c = d then {[]} else {})"
+unfolding Der_def
+by auto
+
+lemma Der_union [simp]:
+ shows "Der c (A \<union> B) = Der c A \<union> Der c B"
+unfolding Der_def
+by auto
+
+lemma Der_Sequ [simp]:
+ shows "Der c (A ;; B) = (Der c A) ;; B \<union> (if [] \<in> A then Der c B else {})"
+unfolding Der_def Sequ_def
+by (auto simp add: Cons_eq_append_conv)
+
+
+section \<open>Kleene Star for Languages\<close>
+
+inductive_set
+ Star :: "string set \<Rightarrow> string set" ("_\<star>" [101] 102)
+ for A :: "string set"
+where
+ start[intro]: "[] \<in> A\<star>"
+| step[intro]: "\<lbrakk>s1 \<in> A; s2 \<in> A\<star>\<rbrakk> \<Longrightarrow> s1 @ s2 \<in> A\<star>"
+
+(* Arden's lemma *)
+
+lemma Star_cases:
+ shows "A\<star> = {[]} \<union> A ;; A\<star>"
+unfolding Sequ_def
+by (auto) (metis Star.simps)
+
+lemma Star_decomp:
+ assumes "c # x \<in> A\<star>"
+ shows "\<exists>s1 s2. x = s1 @ s2 \<and> c # s1 \<in> A \<and> s2 \<in> A\<star>"
+using assms
+by (induct x\<equiv>"c # x" rule: Star.induct)
+ (auto simp add: append_eq_Cons_conv)
+
+lemma Star_Der_Sequ:
+ shows "Der c (A\<star>) \<subseteq> (Der c A) ;; A\<star>"
+unfolding Der_def Sequ_def
+by(auto simp add: Star_decomp)
+
+
+lemma Der_star[simp]:
+ shows "Der c (A\<star>) = (Der c A) ;; A\<star>"
+proof -
+ have "Der c (A\<star>) = Der c ({[]} \<union> A ;; A\<star>)"
+ by (simp only: Star_cases[symmetric])
+ also have "... = Der c (A ;; A\<star>)"
+ by (simp only: Der_union Der_empty) (simp)
+ also have "... = (Der c A) ;; A\<star> \<union> (if [] \<in> A then Der c (A\<star>) else {})"
+ by simp
+ also have "... = (Der c A) ;; A\<star>"
+ using Star_Der_Sequ by auto
+ finally show "Der c (A\<star>) = (Der c A) ;; A\<star>" .
+qed
+
+lemma Star_concat:
+ assumes "\<forall>s \<in> set ss. s \<in> A"
+ shows "concat ss \<in> A\<star>"
+using assms by (induct ss) (auto)
+
+lemma Star_split:
+ assumes "s \<in> A\<star>"
+ shows "\<exists>ss. concat ss = s \<and> (\<forall>s \<in> set ss. s \<in> A \<and> s \<noteq> [])"
+using assms
+ apply(induct rule: Star.induct)
+ using concat.simps(1) apply fastforce
+ apply(clarify)
+ by (metis append_Nil concat.simps(2) set_ConsD)
+
+
+
+section \<open>Regular Expressions\<close>
+
+datatype rexp =
+ ZERO
+| ONE
+| CH char
+| SEQ rexp rexp
+| ALT rexp rexp
+| STAR rexp
+
+section \<open>Semantics of Regular Expressions\<close>
+
+fun
+ L :: "rexp \<Rightarrow> string set"
+where
+ "L (ZERO) = {}"
+| "L (ONE) = {[]}"
+| "L (CH c) = {[c]}"
+| "L (SEQ r1 r2) = (L r1) ;; (L r2)"
+| "L (ALT r1 r2) = (L r1) \<union> (L r2)"
+| "L (STAR r) = (L r)\<star>"
+
+
+section \<open>Nullable, Derivatives\<close>
+
+fun
+ nullable :: "rexp \<Rightarrow> bool"
+where
+ "nullable (ZERO) = False"
+| "nullable (ONE) = True"
+| "nullable (CH c) = False"
+| "nullable (ALT r1 r2) = (nullable r1 \<or> nullable r2)"
+| "nullable (SEQ r1 r2) = (nullable r1 \<and> nullable r2)"
+| "nullable (STAR r) = True"
+
+
+fun
+ der :: "char \<Rightarrow> rexp \<Rightarrow> rexp"
+where
+ "der c (ZERO) = ZERO"
+| "der c (ONE) = ZERO"
+| "der c (CH d) = (if c = d then ONE else ZERO)"
+| "der c (ALT r1 r2) = ALT (der c r1) (der c r2)"
+| "der c (SEQ r1 r2) =
+ (if nullable r1
+ then ALT (SEQ (der c r1) r2) (der c r2)
+ else SEQ (der c r1) r2)"
+| "der c (STAR r) = SEQ (der c r) (STAR r)"
+
+fun
+ ders :: "string \<Rightarrow> rexp \<Rightarrow> rexp"
+where
+ "ders [] r = r"
+| "ders (c # s) r = ders s (der c r)"
+
+
+lemma nullable_correctness:
+ shows "nullable r \<longleftrightarrow> [] \<in> (L r)"
+by (induct r) (auto simp add: Sequ_def)
+
+lemma der_correctness:
+ shows "L (der c r) = Der c (L r)"
+by (induct r) (simp_all add: nullable_correctness)
+
+lemma ders_correctness:
+ shows "L (ders s r) = Ders s (L r)"
+ by (induct s arbitrary: r)
+ (simp_all add: Ders_def der_correctness Der_def)
+
+lemma ders_append:
+ shows "ders (s1 @ s2) r = ders s2 (ders s1 r)"
+ by (induct s1 arbitrary: s2 r) (auto)
+
+lemma ders_snoc:
+ shows "ders (s @ [c]) r = der c (ders s r)"
+ by (simp add: ders_append)
+
+
+(*
+datatype ctxt =
+ SeqC rexp bool
+ | AltCL rexp
+ | AltCH rexp
+ | StarC rexp
+
+function
+ down :: "char \<Rightarrow> rexp \<Rightarrow> ctxt list \<Rightarrow> rexp * ctxt list"
+and up :: "char \<Rightarrow> rexp \<Rightarrow> ctxt list \<Rightarrow> rexp * ctxt list"
+where
+ "down c (SEQ r1 r2) ctxts =
+ (if (nullable r1) then down c r1 (SeqC r2 True # ctxts)
+ else down c r1 (SeqC r2 False # ctxts))"
+| "down c (CH d) ctxts =
+ (if c = d then up c ONE ctxts else up c ZERO ctxts)"
+| "down c ONE ctxts = up c ZERO ctxts"
+| "down c ZERO ctxts = up c ZERO ctxts"
+| "down c (ALT r1 r2) ctxts = down c r1 (AltCH r2 # ctxts)"
+| "down c (STAR r1) ctxts = down c r1 (StarC r1 # ctxts)"
+| "up c r [] = (r, [])"
+| "up c r (SeqC r2 False # ctxts) = up c (SEQ r r2) ctxts"
+| "up c r (SeqC r2 True # ctxts) = down c r2 (AltCL (SEQ r r2) # ctxts)"
+| "up c r (AltCL r1 # ctxts) = up c (ALT r1 r) ctxts"
+| "up c r (AltCH r2 # ctxts) = down c r2 (AltCL r # ctxts)"
+| "up c r (StarC r1 # ctxts) = up c (SEQ r (STAR r1)) ctxts"
+ apply(pat_completeness)
+ apply(auto)
+ done
+
+termination
+ sorry
+
+*)
+
+
+end
\ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys2/Simplifying.thy Sun Oct 10 18:35:21 2021 +0100
@@ -0,0 +1,242 @@
+theory Simplifying
+ imports "Lexer"
+begin
+
+section {* Lexer including simplifications *}
+
+
+fun F_RIGHT where
+ "F_RIGHT f v = Right (f v)"
+
+fun F_LEFT where
+ "F_LEFT f v = Left (f v)"
+
+fun F_ALT where
+ "F_ALT f\<^sub>1 f\<^sub>2 (Right v) = Right (f\<^sub>2 v)"
+| "F_ALT f\<^sub>1 f\<^sub>2 (Left v) = Left (f\<^sub>1 v)"
+| "F_ALT f1 f2 v = v"
+
+
+fun F_SEQ1 where
+ "F_SEQ1 f\<^sub>1 f\<^sub>2 v = Seq (f\<^sub>1 Void) (f\<^sub>2 v)"
+
+fun F_SEQ2 where
+ "F_SEQ2 f\<^sub>1 f\<^sub>2 v = Seq (f\<^sub>1 v) (f\<^sub>2 Void)"
+
+fun F_SEQ where
+ "F_SEQ f\<^sub>1 f\<^sub>2 (Seq v\<^sub>1 v\<^sub>2) = Seq (f\<^sub>1 v\<^sub>1) (f\<^sub>2 v\<^sub>2)"
+| "F_SEQ f1 f2 v = v"
+
+fun simp_ALT where
+ "simp_ALT (ZERO, f\<^sub>1) (r\<^sub>2, f\<^sub>2) = (r\<^sub>2, F_RIGHT f\<^sub>2)"
+| "simp_ALT (r\<^sub>1, f\<^sub>1) (ZERO, f\<^sub>2) = (r\<^sub>1, F_LEFT f\<^sub>1)"
+| "simp_ALT (r\<^sub>1, f\<^sub>1) (r\<^sub>2, f\<^sub>2) = (ALT r\<^sub>1 r\<^sub>2, F_ALT f\<^sub>1 f\<^sub>2)"
+
+
+fun simp_SEQ where
+ "simp_SEQ (ONE, f\<^sub>1) (r\<^sub>2, f\<^sub>2) = (r\<^sub>2, F_SEQ1 f\<^sub>1 f\<^sub>2)"
+| "simp_SEQ (r\<^sub>1, f\<^sub>1) (ONE, f\<^sub>2) = (r\<^sub>1, F_SEQ2 f\<^sub>1 f\<^sub>2)"
+| "simp_SEQ (ZERO, f\<^sub>1) (r\<^sub>2, f\<^sub>2) = (ZERO, undefined)"
+| "simp_SEQ (r\<^sub>1, f\<^sub>1) (ZERO, f\<^sub>2) = (ZERO, undefined)"
+| "simp_SEQ (r\<^sub>1, f\<^sub>1) (r\<^sub>2, f\<^sub>2) = (SEQ r\<^sub>1 r\<^sub>2, F_SEQ f\<^sub>1 f\<^sub>2)"
+
+lemma simp_SEQ_simps[simp]:
+ "simp_SEQ p1 p2 = (if (fst p1 = ONE) then (fst p2, F_SEQ1 (snd p1) (snd p2))
+ else (if (fst p2 = ONE) then (fst p1, F_SEQ2 (snd p1) (snd p2))
+ else (if (fst p1 = ZERO) then (ZERO, undefined)
+ else (if (fst p2 = ZERO) then (ZERO, undefined)
+ else (SEQ (fst p1) (fst p2), F_SEQ (snd p1) (snd p2))))))"
+by (induct p1 p2 rule: simp_SEQ.induct) (auto)
+
+lemma simp_ALT_simps[simp]:
+ "simp_ALT p1 p2 = (if (fst p1 = ZERO) then (fst p2, F_RIGHT (snd p2))
+ else (if (fst p2 = ZERO) then (fst p1, F_LEFT (snd p1))
+ else (ALT (fst p1) (fst p2), F_ALT (snd p1) (snd p2))))"
+by (induct p1 p2 rule: simp_ALT.induct) (auto)
+
+fun
+ simp :: "rexp \<Rightarrow> rexp * (val \<Rightarrow> val)"
+where
+ "simp (ALT r1 r2) = simp_ALT (simp r1) (simp r2)"
+| "simp (SEQ r1 r2) = simp_SEQ (simp r1) (simp r2)"
+| "simp r = (r, id)"
+
+fun
+ slexer :: "rexp \<Rightarrow> string \<Rightarrow> val option"
+where
+ "slexer r [] = (if nullable r then Some(mkeps r) else None)"
+| "slexer r (c#s) = (let (rs, fr) = simp (der c r) in
+ (case (slexer rs s) of
+ None \<Rightarrow> None
+ | Some(v) \<Rightarrow> Some(injval r c (fr v))))"
+
+
+lemma slexer_better_simp:
+ "slexer r (c#s) = (case (slexer (fst (simp (der c r))) s) of
+ None \<Rightarrow> None
+ | Some(v) \<Rightarrow> Some(injval r c ((snd (simp (der c r))) v)))"
+by (auto split: prod.split option.split)
+
+
+lemma L_fst_simp:
+ shows "L(r) = L(fst (simp r))"
+by (induct r) (auto)
+
+lemma Posix_simp:
+ assumes "s \<in> (fst (simp r)) \<rightarrow> v"
+ shows "s \<in> r \<rightarrow> ((snd (simp r)) v)"
+using assms
+proof(induct r arbitrary: s v rule: rexp.induct)
+ case (ALT r1 r2 s v)
+ have IH1: "\<And>s v. s \<in> fst (simp r1) \<rightarrow> v \<Longrightarrow> s \<in> r1 \<rightarrow> snd (simp r1) v" by fact
+ have IH2: "\<And>s v. s \<in> fst (simp r2) \<rightarrow> v \<Longrightarrow> s \<in> r2 \<rightarrow> snd (simp r2) v" by fact
+ have as: "s \<in> fst (simp (ALT r1 r2)) \<rightarrow> v" by fact
+ consider (ZERO_ZERO) "fst (simp r1) = ZERO" "fst (simp r2) = ZERO"
+ | (ZERO_NZERO) "fst (simp r1) = ZERO" "fst (simp r2) \<noteq> ZERO"
+ | (NZERO_ZERO) "fst (simp r1) \<noteq> ZERO" "fst (simp r2) = ZERO"
+ | (NZERO_NZERO) "fst (simp r1) \<noteq> ZERO" "fst (simp r2) \<noteq> ZERO" by auto
+ then show "s \<in> ALT r1 r2 \<rightarrow> snd (simp (ALT r1 r2)) v"
+ proof(cases)
+ case (ZERO_ZERO)
+ with as have "s \<in> ZERO \<rightarrow> v" by simp
+ then show "s \<in> ALT r1 r2 \<rightarrow> snd (simp (ALT r1 r2)) v" by (rule Posix_elims(1))
+ next
+ case (ZERO_NZERO)
+ with as have "s \<in> fst (simp r2) \<rightarrow> v" by simp
+ with IH2 have "s \<in> r2 \<rightarrow> snd (simp r2) v" by simp
+ moreover
+ from ZERO_NZERO have "fst (simp r1) = ZERO" by simp
+ then have "L (fst (simp r1)) = {}" by simp
+ then have "L r1 = {}" using L_fst_simp by simp
+ then have "s \<notin> L r1" by simp
+ ultimately have "s \<in> ALT r1 r2 \<rightarrow> Right (snd (simp r2) v)" by (rule Posix_ALT2)
+ then show "s \<in> ALT r1 r2 \<rightarrow> snd (simp (ALT r1 r2)) v"
+ using ZERO_NZERO by simp
+ next
+ case (NZERO_ZERO)
+ with as have "s \<in> fst (simp r1) \<rightarrow> v" by simp
+ with IH1 have "s \<in> r1 \<rightarrow> snd (simp r1) v" by simp
+ then have "s \<in> ALT r1 r2 \<rightarrow> Left (snd (simp r1) v)" by (rule Posix_ALT1)
+ then show "s \<in> ALT r1 r2 \<rightarrow> snd (simp (ALT r1 r2)) v" using NZERO_ZERO by simp
+ next
+ case (NZERO_NZERO)
+ with as have "s \<in> ALT (fst (simp r1)) (fst (simp r2)) \<rightarrow> v" by simp
+ then consider (Left) v1 where "v = Left v1" "s \<in> (fst (simp r1)) \<rightarrow> v1"
+ | (Right) v2 where "v = Right v2" "s \<in> (fst (simp r2)) \<rightarrow> v2" "s \<notin> L (fst (simp r1))"
+ by (erule_tac Posix_elims(4))
+ then show "s \<in> ALT r1 r2 \<rightarrow> snd (simp (ALT r1 r2)) v"
+ proof(cases)
+ case (Left)
+ then have "v = Left v1" "s \<in> r1 \<rightarrow> (snd (simp r1) v1)" using IH1 by simp_all
+ then show "s \<in> ALT r1 r2 \<rightarrow> snd (simp (ALT r1 r2)) v" using NZERO_NZERO
+ by (simp_all add: Posix_ALT1)
+ next
+ case (Right)
+ then have "v = Right v2" "s \<in> r2 \<rightarrow> (snd (simp r2) v2)" "s \<notin> L r1" using IH2 L_fst_simp by simp_all
+ then show "s \<in> ALT r1 r2 \<rightarrow> snd (simp (ALT r1 r2)) v" using NZERO_NZERO
+ by (simp_all add: Posix_ALT2)
+ qed
+ qed
+next
+ case (SEQ r1 r2 s v)
+ have IH1: "\<And>s v. s \<in> fst (simp r1) \<rightarrow> v \<Longrightarrow> s \<in> r1 \<rightarrow> snd (simp r1) v" by fact
+ have IH2: "\<And>s v. s \<in> fst (simp r2) \<rightarrow> v \<Longrightarrow> s \<in> r2 \<rightarrow> snd (simp r2) v" by fact
+ have as: "s \<in> fst (simp (SEQ r1 r2)) \<rightarrow> v" by fact
+ consider (ONE_ONE) "fst (simp r1) = ONE" "fst (simp r2) = ONE"
+ | (ONE_NONE) "fst (simp r1) = ONE" "fst (simp r2) \<noteq> ONE"
+ | (NONE_ONE) "fst (simp r1) \<noteq> ONE" "fst (simp r2) = ONE"
+ | (NONE_NONE) "fst (simp r1) \<noteq> ONE" "fst (simp r2) \<noteq> ONE"
+ by auto
+ then show "s \<in> SEQ r1 r2 \<rightarrow> snd (simp (SEQ r1 r2)) v"
+ proof(cases)
+ case (ONE_ONE)
+ with as have b: "s \<in> ONE \<rightarrow> v" by simp
+ from b have "s \<in> r1 \<rightarrow> snd (simp r1) v" using IH1 ONE_ONE by simp
+ moreover
+ from b have c: "s = []" "v = Void" using Posix_elims(2) by auto
+ moreover
+ have "[] \<in> ONE \<rightarrow> Void" by (simp add: Posix_ONE)
+ then have "[] \<in> fst (simp r2) \<rightarrow> Void" using ONE_ONE by simp
+ then have "[] \<in> r2 \<rightarrow> snd (simp r2) Void" using IH2 by simp
+ ultimately have "([] @ []) \<in> SEQ r1 r2 \<rightarrow> Seq (snd (simp r1) Void) (snd (simp r2) Void)"
+ using Posix_SEQ by blast
+ then show "s \<in> SEQ r1 r2 \<rightarrow> snd (simp (SEQ r1 r2)) v" using c ONE_ONE by simp
+ next
+ case (ONE_NONE)
+ with as have b: "s \<in> fst (simp r2) \<rightarrow> v" by simp
+ from b have "s \<in> r2 \<rightarrow> snd (simp r2) v" using IH2 ONE_NONE by simp
+ moreover
+ have "[] \<in> ONE \<rightarrow> Void" by (simp add: Posix_ONE)
+ then have "[] \<in> fst (simp r1) \<rightarrow> Void" using ONE_NONE by simp
+ then have "[] \<in> r1 \<rightarrow> snd (simp r1) Void" using IH1 by simp
+ moreover
+ from ONE_NONE(1) have "L (fst (simp r1)) = {[]}" by simp
+ then have "L r1 = {[]}" by (simp add: L_fst_simp[symmetric])
+ ultimately have "([] @ s) \<in> SEQ r1 r2 \<rightarrow> Seq (snd (simp r1) Void) (snd (simp r2) v)"
+ by(rule_tac Posix_SEQ) auto
+ then show "s \<in> SEQ r1 r2 \<rightarrow> snd (simp (SEQ r1 r2)) v" using ONE_NONE by simp
+ next
+ case (NONE_ONE)
+ with as have "s \<in> fst (simp r1) \<rightarrow> v" by simp
+ with IH1 have "s \<in> r1 \<rightarrow> snd (simp r1) v" by simp
+ moreover
+ have "[] \<in> ONE \<rightarrow> Void" by (simp add: Posix_ONE)
+ then have "[] \<in> fst (simp r2) \<rightarrow> Void" using NONE_ONE by simp
+ then have "[] \<in> r2 \<rightarrow> snd (simp r2) Void" using IH2 by simp
+ ultimately have "(s @ []) \<in> SEQ r1 r2 \<rightarrow> Seq (snd (simp r1) v) (snd (simp r2) Void)"
+ by(rule_tac Posix_SEQ) auto
+ then show "s \<in> SEQ r1 r2 \<rightarrow> snd (simp (SEQ r1 r2)) v" using NONE_ONE by simp
+ next
+ case (NONE_NONE)
+ from as have 00: "fst (simp r1) \<noteq> ZERO" "fst (simp r2) \<noteq> ZERO"
+ apply(auto)
+ apply(smt Posix_elims(1) fst_conv)
+ by (smt NONE_NONE(2) Posix_elims(1) fstI)
+ with NONE_NONE as have "s \<in> SEQ (fst (simp r1)) (fst (simp r2)) \<rightarrow> v" by simp
+ then obtain s1 s2 v1 v2 where eqs: "s = s1 @ s2" "v = Seq v1 v2"
+ "s1 \<in> (fst (simp r1)) \<rightarrow> v1" "s2 \<in> (fst (simp r2)) \<rightarrow> v2"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L r1 \<and> s\<^sub>4 \<in> L r2)"
+ by (erule_tac Posix_elims(5)) (auto simp add: L_fst_simp[symmetric])
+ then have "s1 \<in> r1 \<rightarrow> (snd (simp r1) v1)" "s2 \<in> r2 \<rightarrow> (snd (simp r2) v2)"
+ using IH1 IH2 by auto
+ then show "s \<in> SEQ r1 r2 \<rightarrow> snd (simp (SEQ r1 r2)) v" using eqs NONE_NONE 00
+ by(auto intro: Posix_SEQ)
+ qed
+qed (simp_all)
+
+
+lemma slexer_correctness:
+ shows "slexer r s = lexer r s"
+proof(induct s arbitrary: r)
+ case Nil
+ show "slexer r [] = lexer r []" by simp
+next
+ case (Cons c s r)
+ have IH: "\<And>r. slexer r s = lexer r s" by fact
+ show "slexer r (c # s) = lexer r (c # s)"
+ proof (cases "s \<in> L (der c r)")
+ case True
+ assume a1: "s \<in> L (der c r)"
+ then obtain v1 where a2: "lexer (der c r) s = Some v1" "s \<in> der c r \<rightarrow> v1"
+ using lexer_correct_Some by auto
+ from a1 have "s \<in> L (fst (simp (der c r)))" using L_fst_simp[symmetric] by simp
+ then obtain v2 where a3: "lexer (fst (simp (der c r))) s = Some v2" "s \<in> (fst (simp (der c r))) \<rightarrow> v2"
+ using lexer_correct_Some by auto
+ then have a4: "slexer (fst (simp (der c r))) s = Some v2" using IH by simp
+ from a3(2) have "s \<in> der c r \<rightarrow> (snd (simp (der c r))) v2" using Posix_simp by simp
+ with a2(2) have "v1 = (snd (simp (der c r))) v2" using Posix_determ by simp
+ with a2(1) a4 show "slexer r (c # s) = lexer r (c # s)" by (auto split: prod.split)
+ next
+ case False
+ assume b1: "s \<notin> L (der c r)"
+ then have "lexer (der c r) s = None" using lexer_correct_None by simp
+ moreover
+ from b1 have "s \<notin> L (fst (simp (der c r)))" using L_fst_simp[symmetric] by simp
+ then have "lexer (fst (simp (der c r))) s = None" using lexer_correct_None by simp
+ then have "slexer (fst (simp (der c r))) s = None" using IH by simp
+ ultimately show "slexer r (c # s) = lexer r (c # s)"
+ by (simp del: slexer.simps add: slexer_better_simp)
+ qed
+ qed
+
+end
\ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys2/SizeBound.thy Sun Oct 10 18:35:21 2021 +0100
@@ -0,0 +1,1717 @@
+
+theory SizeBound
+ imports "Lexer"
+begin
+
+section \<open>Bit-Encodings\<close>
+
+datatype bit = Z | S
+
+fun code :: "val \<Rightarrow> bit list"
+where
+ "code Void = []"
+| "code (Char c) = []"
+| "code (Left v) = Z # (code v)"
+| "code (Right v) = S # (code v)"
+| "code (Seq v1 v2) = (code v1) @ (code v2)"
+| "code (Stars []) = [S]"
+| "code (Stars (v # vs)) = (Z # code v) @ code (Stars vs)"
+
+
+fun
+ Stars_add :: "val \<Rightarrow> val \<Rightarrow> val"
+where
+ "Stars_add v (Stars vs) = Stars (v # vs)"
+
+function
+ decode' :: "bit list \<Rightarrow> rexp \<Rightarrow> (val * bit list)"
+where
+ "decode' ds ZERO = (Void, [])"
+| "decode' ds ONE = (Void, ds)"
+| "decode' ds (CH d) = (Char d, ds)"
+| "decode' [] (ALT r1 r2) = (Void, [])"
+| "decode' (Z # ds) (ALT r1 r2) = (let (v, ds') = decode' ds r1 in (Left v, ds'))"
+| "decode' (S # ds) (ALT r1 r2) = (let (v, ds') = decode' ds r2 in (Right v, ds'))"
+| "decode' ds (SEQ r1 r2) = (let (v1, ds') = decode' ds r1 in
+ let (v2, ds'') = decode' ds' r2 in (Seq v1 v2, ds''))"
+| "decode' [] (STAR r) = (Void, [])"
+| "decode' (S # ds) (STAR r) = (Stars [], ds)"
+| "decode' (Z # ds) (STAR r) = (let (v, ds') = decode' ds r in
+ let (vs, ds'') = decode' ds' (STAR r)
+ in (Stars_add v vs, ds''))"
+by pat_completeness auto
+
+lemma decode'_smaller:
+ assumes "decode'_dom (ds, r)"
+ shows "length (snd (decode' ds r)) \<le> length ds"
+using assms
+apply(induct ds r)
+apply(auto simp add: decode'.psimps split: prod.split)
+using dual_order.trans apply blast
+by (meson dual_order.trans le_SucI)
+
+termination "decode'"
+apply(relation "inv_image (measure(%cs. size cs) <*lex*> measure(%s. size s)) (%(ds,r). (r,ds))")
+apply(auto dest!: decode'_smaller)
+by (metis less_Suc_eq_le snd_conv)
+
+definition
+ decode :: "bit list \<Rightarrow> rexp \<Rightarrow> val option"
+where
+ "decode ds r \<equiv> (let (v, ds') = decode' ds r
+ in (if ds' = [] then Some v else None))"
+
+lemma decode'_code_Stars:
+ assumes "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> (\<forall>x. decode' (code v @ x) r = (v, x)) \<and> flat v \<noteq> []"
+ shows "decode' (code (Stars vs) @ ds) (STAR r) = (Stars vs, ds)"
+ using assms
+ apply(induct vs)
+ apply(auto)
+ done
+
+lemma decode'_code:
+ assumes "\<Turnstile> v : r"
+ shows "decode' ((code v) @ ds) r = (v, ds)"
+using assms
+ apply(induct v r arbitrary: ds)
+ apply(auto)
+ using decode'_code_Stars by blast
+
+lemma decode_code:
+ assumes "\<Turnstile> v : r"
+ shows "decode (code v) r = Some v"
+ using assms unfolding decode_def
+ by (smt append_Nil2 decode'_code old.prod.case)
+
+
+section {* Annotated Regular Expressions *}
+
+datatype arexp =
+ AZERO
+| AONE "bit list"
+| ACHAR "bit list" char
+| ASEQ "bit list" arexp arexp
+| AALTs "bit list" "arexp list"
+| ASTAR "bit list" arexp
+
+abbreviation
+ "AALT bs r1 r2 \<equiv> AALTs bs [r1, r2]"
+
+fun asize :: "arexp \<Rightarrow> nat" where
+ "asize AZERO = 1"
+| "asize (AONE cs) = 1"
+| "asize (ACHAR cs c) = 1"
+| "asize (AALTs cs rs) = Suc (sum_list (map asize rs))"
+| "asize (ASEQ cs r1 r2) = Suc (asize r1 + asize r2)"
+| "asize (ASTAR cs r) = Suc (asize r)"
+
+fun
+ erase :: "arexp \<Rightarrow> rexp"
+where
+ "erase AZERO = ZERO"
+| "erase (AONE _) = ONE"
+| "erase (ACHAR _ c) = CH c"
+| "erase (AALTs _ []) = ZERO"
+| "erase (AALTs _ [r]) = (erase r)"
+| "erase (AALTs bs (r#rs)) = ALT (erase r) (erase (AALTs bs rs))"
+| "erase (ASEQ _ r1 r2) = SEQ (erase r1) (erase r2)"
+| "erase (ASTAR _ r) = STAR (erase r)"
+
+
+
+
+fun nonalt :: "arexp \<Rightarrow> bool"
+ where
+ "nonalt (AALTs bs2 rs) = False"
+| "nonalt r = True"
+
+
+fun good :: "arexp \<Rightarrow> bool" where
+ "good AZERO = False"
+| "good (AONE cs) = True"
+| "good (ACHAR cs c) = True"
+| "good (AALTs cs []) = False"
+| "good (AALTs cs [r]) = False"
+| "good (AALTs cs (r1#r2#rs)) = (\<forall>r' \<in> set (r1#r2#rs). good r' \<and> nonalt r')"
+| "good (ASEQ _ AZERO _) = False"
+| "good (ASEQ _ (AONE _) _) = False"
+| "good (ASEQ _ _ AZERO) = False"
+| "good (ASEQ cs r1 r2) = (good r1 \<and> good r2)"
+| "good (ASTAR cs r) = True"
+
+
+
+
+fun fuse :: "bit list \<Rightarrow> arexp \<Rightarrow> arexp" where
+ "fuse bs AZERO = AZERO"
+| "fuse bs (AONE cs) = AONE (bs @ cs)"
+| "fuse bs (ACHAR cs c) = ACHAR (bs @ cs) c"
+| "fuse bs (AALTs cs rs) = AALTs (bs @ cs) rs"
+| "fuse bs (ASEQ cs r1 r2) = ASEQ (bs @ cs) r1 r2"
+| "fuse bs (ASTAR cs r) = ASTAR (bs @ cs) r"
+
+lemma fuse_append:
+ shows "fuse (bs1 @ bs2) r = fuse bs1 (fuse bs2 r)"
+ apply(induct r)
+ apply(auto)
+ done
+
+
+fun intern :: "rexp \<Rightarrow> arexp" where
+ "intern ZERO = AZERO"
+| "intern ONE = AONE []"
+| "intern (CH c) = ACHAR [] c"
+| "intern (ALT r1 r2) = AALT [] (fuse [Z] (intern r1))
+ (fuse [S] (intern r2))"
+| "intern (SEQ r1 r2) = ASEQ [] (intern r1) (intern r2)"
+| "intern (STAR r) = ASTAR [] (intern r)"
+
+
+fun retrieve :: "arexp \<Rightarrow> val \<Rightarrow> bit list" where
+ "retrieve (AONE bs) Void = bs"
+| "retrieve (ACHAR bs c) (Char d) = bs"
+| "retrieve (AALTs bs [r]) v = bs @ retrieve r v"
+| "retrieve (AALTs bs (r#rs)) (Left v) = bs @ retrieve r v"
+| "retrieve (AALTs bs (r#rs)) (Right v) = bs @ retrieve (AALTs [] rs) v"
+| "retrieve (ASEQ bs r1 r2) (Seq v1 v2) = bs @ retrieve r1 v1 @ retrieve r2 v2"
+| "retrieve (ASTAR bs r) (Stars []) = bs @ [S]"
+| "retrieve (ASTAR bs r) (Stars (v#vs)) =
+ bs @ [Z] @ retrieve r v @ retrieve (ASTAR [] r) (Stars vs)"
+
+
+
+fun
+ bnullable :: "arexp \<Rightarrow> bool"
+where
+ "bnullable (AZERO) = False"
+| "bnullable (AONE bs) = True"
+| "bnullable (ACHAR bs c) = False"
+| "bnullable (AALTs bs rs) = (\<exists>r \<in> set rs. bnullable r)"
+| "bnullable (ASEQ bs r1 r2) = (bnullable r1 \<and> bnullable r2)"
+| "bnullable (ASTAR bs r) = True"
+
+fun
+ bmkeps :: "arexp \<Rightarrow> bit list"
+where
+ "bmkeps(AONE bs) = bs"
+| "bmkeps(ASEQ bs r1 r2) = bs @ (bmkeps r1) @ (bmkeps r2)"
+| "bmkeps(AALTs bs [r]) = bs @ (bmkeps r)"
+| "bmkeps(AALTs bs (r#rs)) = (if bnullable(r) then bs @ (bmkeps r) else (bmkeps (AALTs bs rs)))"
+| "bmkeps(ASTAR bs r) = bs @ [S]"
+
+
+fun
+ bder :: "char \<Rightarrow> arexp \<Rightarrow> arexp"
+where
+ "bder c (AZERO) = AZERO"
+| "bder c (AONE bs) = AZERO"
+| "bder c (ACHAR bs d) = (if c = d then AONE bs else AZERO)"
+| "bder c (AALTs bs rs) = AALTs bs (map (bder c) rs)"
+| "bder c (ASEQ bs r1 r2) =
+ (if bnullable r1
+ then AALT bs (ASEQ [] (bder c r1) r2) (fuse (bmkeps r1) (bder c r2))
+ else ASEQ bs (bder c r1) r2)"
+| "bder c (ASTAR bs r) = ASEQ bs (fuse [Z] (bder c r)) (ASTAR [] r)"
+
+
+fun
+ bders :: "arexp \<Rightarrow> string \<Rightarrow> arexp"
+where
+ "bders r [] = r"
+| "bders r (c#s) = bders (bder c r) s"
+
+lemma bders_append:
+ "bders r (s1 @ s2) = bders (bders r s1) s2"
+ apply(induct s1 arbitrary: r s2)
+ apply(simp_all)
+ done
+
+lemma bnullable_correctness:
+ shows "nullable (erase r) = bnullable r"
+ apply(induct r rule: erase.induct)
+ apply(simp_all)
+ done
+
+lemma erase_fuse:
+ shows "erase (fuse bs r) = erase r"
+ apply(induct r rule: erase.induct)
+ apply(simp_all)
+ done
+
+thm Posix.induct
+
+lemma erase_intern [simp]:
+ shows "erase (intern r) = r"
+ apply(induct r)
+ apply(simp_all add: erase_fuse)
+ done
+
+lemma erase_bder [simp]:
+ shows "erase (bder a r) = der a (erase r)"
+ apply(induct r rule: erase.induct)
+ apply(simp_all add: erase_fuse bnullable_correctness)
+ done
+
+lemma erase_bders [simp]:
+ shows "erase (bders r s) = ders s (erase r)"
+ apply(induct s arbitrary: r )
+ apply(simp_all)
+ done
+
+lemma retrieve_encode_STARS:
+ assumes "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> code v = retrieve (intern r) v"
+ shows "code (Stars vs) = retrieve (ASTAR [] (intern r)) (Stars vs)"
+ using assms
+ apply(induct vs)
+ apply(simp_all)
+ done
+
+
+lemma retrieve_fuse2:
+ assumes "\<Turnstile> v : (erase r)"
+ shows "retrieve (fuse bs r) v = bs @ retrieve r v"
+ using assms
+ apply(induct r arbitrary: v bs)
+ apply(auto elim: Prf_elims)[4]
+ defer
+ using retrieve_encode_STARS
+ apply(auto elim!: Prf_elims)[1]
+ apply(case_tac vs)
+ apply(simp)
+ apply(simp)
+ (* AALTs case *)
+ apply(simp)
+ apply(case_tac x2a)
+ apply(simp)
+ apply(auto elim!: Prf_elims)[1]
+ apply(simp)
+ apply(case_tac list)
+ apply(simp)
+ apply(auto)
+ apply(auto elim!: Prf_elims)[1]
+ done
+
+lemma retrieve_fuse:
+ assumes "\<Turnstile> v : r"
+ shows "retrieve (fuse bs (intern r)) v = bs @ retrieve (intern r) v"
+ using assms
+ by (simp_all add: retrieve_fuse2)
+
+
+lemma retrieve_code:
+ assumes "\<Turnstile> v : r"
+ shows "code v = retrieve (intern r) v"
+ using assms
+ apply(induct v r )
+ apply(simp_all add: retrieve_fuse retrieve_encode_STARS)
+ done
+
+
+lemma bnullable_Hdbmkeps_Hd:
+ assumes "bnullable a"
+ shows "bmkeps (AALTs bs (a # rs)) = bs @ (bmkeps a)"
+ using assms
+ by (metis bmkeps.simps(3) bmkeps.simps(4) list.exhaust)
+
+lemma r1:
+ assumes "\<not> bnullable a" "bnullable (AALTs bs rs)"
+ shows "bmkeps (AALTs bs (a # rs)) = bmkeps (AALTs bs rs)"
+ using assms
+ apply(induct rs)
+ apply(auto)
+ done
+
+lemma r2:
+ assumes "x \<in> set rs" "bnullable x"
+ shows "bnullable (AALTs bs rs)"
+ using assms
+ apply(induct rs)
+ apply(auto)
+ done
+
+lemma r3:
+ assumes "\<not> bnullable r"
+ " \<exists> x \<in> set rs. bnullable x"
+ shows "retrieve (AALTs bs rs) (mkeps (erase (AALTs bs rs))) =
+ retrieve (AALTs bs (r # rs)) (mkeps (erase (AALTs bs (r # rs))))"
+ using assms
+ apply(induct rs arbitrary: r bs)
+ apply(auto)[1]
+ apply(auto)
+ using bnullable_correctness apply blast
+ apply(auto simp add: bnullable_correctness mkeps_nullable retrieve_fuse2)
+ apply(subst retrieve_fuse2[symmetric])
+ apply (smt bnullable.simps(4) bnullable_correctness erase.simps(5) erase.simps(6) insert_iff list.exhaust list.set(2) mkeps.simps(3) mkeps_nullable)
+ apply(simp)
+ apply(case_tac "bnullable a")
+ apply (smt append_Nil2 bnullable.simps(4) bnullable_correctness erase.simps(5) erase.simps(6) fuse.simps(4) insert_iff list.exhaust list.set(2) mkeps.simps(3) mkeps_nullable retrieve_fuse2)
+ apply(drule_tac x="a" in meta_spec)
+ apply(drule_tac x="bs" in meta_spec)
+ apply(drule meta_mp)
+ apply(simp)
+ apply(drule meta_mp)
+ apply(auto)
+ apply(subst retrieve_fuse2[symmetric])
+ apply(case_tac rs)
+ apply(simp)
+ apply(auto)[1]
+ apply (simp add: bnullable_correctness)
+ apply (metis append_Nil2 bnullable_correctness erase_fuse fuse.simps(4) list.set_intros(1) mkeps.simps(3) mkeps_nullable nullable.simps(4) r2)
+ apply (simp add: bnullable_correctness)
+ apply (metis append_Nil2 bnullable_correctness erase.simps(6) erase_fuse fuse.simps(4) list.set_intros(2) mkeps.simps(3) mkeps_nullable r2)
+ apply(simp)
+ done
+
+
+lemma t:
+ assumes "\<forall>r \<in> set rs. nullable (erase r) \<longrightarrow> bmkeps r = retrieve r (mkeps (erase r))"
+ "nullable (erase (AALTs bs rs))"
+ shows " bmkeps (AALTs bs rs) = retrieve (AALTs bs rs) (mkeps (erase (AALTs bs rs)))"
+ using assms
+ apply(induct rs arbitrary: bs)
+ apply(simp)
+ apply(auto simp add: bnullable_correctness)
+ apply(case_tac rs)
+ apply(auto simp add: bnullable_correctness)[2]
+ apply(subst r1)
+ apply(simp)
+ apply(rule r2)
+ apply(assumption)
+ apply(simp)
+ apply(drule_tac x="bs" in meta_spec)
+ apply(drule meta_mp)
+ apply(auto)[1]
+ prefer 2
+ apply(case_tac "bnullable a")
+ apply(subst bnullable_Hdbmkeps_Hd)
+ apply blast
+ apply(subgoal_tac "nullable (erase a)")
+ prefer 2
+ using bnullable_correctness apply blast
+ apply (metis (no_types, lifting) erase.simps(5) erase.simps(6) list.exhaust mkeps.simps(3) retrieve.simps(3) retrieve.simps(4))
+ apply(subst r1)
+ apply(simp)
+ using r2 apply blast
+ apply(drule_tac x="bs" in meta_spec)
+ apply(drule meta_mp)
+ apply(auto)[1]
+ apply(simp)
+ using r3 apply blast
+ apply(auto)
+ using r3 by blast
+
+lemma bmkeps_retrieve:
+ assumes "nullable (erase r)"
+ shows "bmkeps r = retrieve r (mkeps (erase r))"
+ using assms
+ apply(induct r)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ defer
+ apply(simp)
+ apply(rule t)
+ apply(auto)
+ done
+
+lemma bder_retrieve:
+ assumes "\<Turnstile> v : der c (erase r)"
+ shows "retrieve (bder c r) v = retrieve r (injval (erase r) c v)"
+ using assms
+ apply(induct r arbitrary: v rule: erase.induct)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(case_tac "c = ca")
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(simp)
+ apply(rename_tac "r\<^sub>1" "r\<^sub>2" rs v)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(simp)
+ apply(case_tac rs)
+ apply(simp)
+ apply(simp)
+ apply (smt Prf_elims(3) injval.simps(2) injval.simps(3) retrieve.simps(4) retrieve.simps(5) same_append_eq)
+ apply(simp)
+ apply(case_tac "nullable (erase r1)")
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(subgoal_tac "bnullable r1")
+ prefer 2
+ using bnullable_correctness apply blast
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(subgoal_tac "bnullable r1")
+ prefer 2
+ using bnullable_correctness apply blast
+ apply(simp)
+ apply(simp add: retrieve_fuse2)
+ apply(simp add: bmkeps_retrieve)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ using bnullable_correctness apply blast
+ apply(rename_tac bs r v)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(clarify)
+ apply(erule Prf_elims)
+ apply(clarify)
+ apply(subst injval.simps)
+ apply(simp del: retrieve.simps)
+ apply(subst retrieve.simps)
+ apply(subst retrieve.simps)
+ apply(simp)
+ apply(simp add: retrieve_fuse2)
+ done
+
+
+
+lemma MAIN_decode:
+ assumes "\<Turnstile> v : ders s r"
+ shows "Some (flex r id s v) = decode (retrieve (bders (intern r) s) v) r"
+ using assms
+proof (induct s arbitrary: v rule: rev_induct)
+ case Nil
+ have "\<Turnstile> v : ders [] r" by fact
+ then have "\<Turnstile> v : r" by simp
+ then have "Some v = decode (retrieve (intern r) v) r"
+ using decode_code retrieve_code by auto
+ then show "Some (flex r id [] v) = decode (retrieve (bders (intern r) []) v) r"
+ by simp
+next
+ case (snoc c s v)
+ have IH: "\<And>v. \<Turnstile> v : ders s r \<Longrightarrow>
+ Some (flex r id s v) = decode (retrieve (bders (intern r) s) v) r" by fact
+ have asm: "\<Turnstile> v : ders (s @ [c]) r" by fact
+ then have asm2: "\<Turnstile> injval (ders s r) c v : ders s r"
+ by (simp add: Prf_injval ders_append)
+ have "Some (flex r id (s @ [c]) v) = Some (flex r id s (injval (ders s r) c v))"
+ by (simp add: flex_append)
+ also have "... = decode (retrieve (bders (intern r) s) (injval (ders s r) c v)) r"
+ using asm2 IH by simp
+ also have "... = decode (retrieve (bder c (bders (intern r) s)) v) r"
+ using asm by (simp_all add: bder_retrieve ders_append)
+ finally show "Some (flex r id (s @ [c]) v) =
+ decode (retrieve (bders (intern r) (s @ [c])) v) r" by (simp add: bders_append)
+qed
+
+
+definition blex where
+ "blex a s \<equiv> if bnullable (bders a s) then Some (bmkeps (bders a s)) else None"
+
+
+
+definition blexer where
+ "blexer r s \<equiv> if bnullable (bders (intern r) s) then
+ decode (bmkeps (bders (intern r) s)) r else None"
+
+lemma blexer_correctness:
+ shows "blexer r s = lexer r s"
+proof -
+ { define bds where "bds \<equiv> bders (intern r) s"
+ define ds where "ds \<equiv> ders s r"
+ assume asm: "nullable ds"
+ have era: "erase bds = ds"
+ unfolding ds_def bds_def by simp
+ have mke: "\<Turnstile> mkeps ds : ds"
+ using asm by (simp add: mkeps_nullable)
+ have "decode (bmkeps bds) r = decode (retrieve bds (mkeps ds)) r"
+ using bmkeps_retrieve
+ using asm era by (simp add: bmkeps_retrieve)
+ also have "... = Some (flex r id s (mkeps ds))"
+ using mke by (simp_all add: MAIN_decode ds_def bds_def)
+ finally have "decode (bmkeps bds) r = Some (flex r id s (mkeps ds))"
+ unfolding bds_def ds_def .
+ }
+ then show "blexer r s = lexer r s"
+ unfolding blexer_def lexer_flex
+ apply(subst bnullable_correctness[symmetric])
+ apply(simp)
+ done
+qed
+
+
+fun distinctBy :: "'a list \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'b set \<Rightarrow> 'a list"
+ where
+ "distinctBy [] f acc = []"
+| "distinctBy (x#xs) f acc =
+ (if (f x) \<in> acc then distinctBy xs f acc
+ else x # (distinctBy xs f ({f x} \<union> acc)))"
+
+
+
+
+fun flts :: "arexp list \<Rightarrow> arexp list"
+ where
+ "flts [] = []"
+| "flts (AZERO # rs) = flts rs"
+| "flts ((AALTs bs rs1) # rs) = (map (fuse bs) rs1) @ flts rs"
+| "flts (r1 # rs) = r1 # flts rs"
+
+
+
+
+fun li :: "bit list \<Rightarrow> arexp list \<Rightarrow> arexp"
+ where
+ "li _ [] = AZERO"
+| "li bs [a] = fuse bs a"
+| "li bs as = AALTs bs as"
+
+
+
+
+fun bsimp_ASEQ :: "bit list \<Rightarrow> arexp \<Rightarrow> arexp \<Rightarrow> arexp"
+ where
+ "bsimp_ASEQ _ AZERO _ = AZERO"
+| "bsimp_ASEQ _ _ AZERO = AZERO"
+| "bsimp_ASEQ bs1 (AONE bs2) r2 = fuse (bs1 @ bs2) r2"
+| "bsimp_ASEQ bs1 r1 r2 = ASEQ bs1 r1 r2"
+
+
+fun bsimp_AALTs :: "bit list \<Rightarrow> arexp list \<Rightarrow> arexp"
+ where
+ "bsimp_AALTs _ [] = AZERO"
+| "bsimp_AALTs bs1 [r] = fuse bs1 r"
+| "bsimp_AALTs bs1 rs = AALTs bs1 rs"
+
+
+fun bsimp :: "arexp \<Rightarrow> arexp"
+ where
+ "bsimp (ASEQ bs1 r1 r2) = bsimp_ASEQ bs1 (bsimp r1) (bsimp r2)"
+| "bsimp (AALTs bs1 rs) = bsimp_AALTs bs1 (distinctBy (flts (map bsimp rs)) erase {} ) "
+| "bsimp r = r"
+
+
+
+
+fun
+ bders_simp :: "arexp \<Rightarrow> string \<Rightarrow> arexp"
+where
+ "bders_simp r [] = r"
+| "bders_simp r (c # s) = bders_simp (bsimp (bder c r)) s"
+
+definition blexer_simp where
+ "blexer_simp r s \<equiv> if bnullable (bders_simp (intern r) s) then
+ decode (bmkeps (bders_simp (intern r) s)) r else None"
+
+export_code bders_simp in Scala module_name Example
+
+lemma bders_simp_append:
+ shows "bders_simp r (s1 @ s2) = bders_simp (bders_simp r s1) s2"
+ apply(induct s1 arbitrary: r s2)
+ apply(simp)
+ apply(simp)
+ done
+
+
+
+
+
+
+
+lemma L_bsimp_ASEQ:
+ "L (SEQ (erase r1) (erase r2)) = L (erase (bsimp_ASEQ bs r1 r2))"
+ apply(induct bs r1 r2 rule: bsimp_ASEQ.induct)
+ apply(simp_all)
+ by (metis erase_fuse fuse.simps(4))
+
+lemma L_bsimp_AALTs:
+ "L (erase (AALTs bs rs)) = L (erase (bsimp_AALTs bs rs))"
+ apply(induct bs rs rule: bsimp_AALTs.induct)
+ apply(simp_all add: erase_fuse)
+ done
+
+lemma L_erase_AALTs:
+ shows "L (erase (AALTs bs rs)) = \<Union> (L ` erase ` (set rs))"
+ apply(induct rs)
+ apply(simp)
+ apply(simp)
+ apply(case_tac rs)
+ apply(simp)
+ apply(simp)
+ done
+
+lemma L_erase_flts:
+ shows "\<Union> (L ` erase ` (set (flts rs))) = \<Union> (L ` erase ` (set rs))"
+ apply(induct rs rule: flts.induct)
+ apply(simp_all)
+ apply(auto)
+ using L_erase_AALTs erase_fuse apply auto[1]
+ by (simp add: L_erase_AALTs erase_fuse)
+
+lemma L_erase_dB_acc:
+ shows "( \<Union>(L ` acc) \<union> ( \<Union> (L ` erase ` (set (distinctBy rs erase acc) ) ) )) = \<Union>(L ` acc) \<union> \<Union> (L ` erase ` (set rs))"
+ apply(induction rs arbitrary: acc)
+ apply simp
+ apply simp
+ by (smt (z3) SUP_absorb UN_insert sup_assoc sup_commute)
+
+lemma L_erase_dB:
+ shows " ( \<Union> (L ` erase ` (set (distinctBy rs erase {}) ) ) ) = \<Union> (L ` erase ` (set rs))"
+ by (metis L_erase_dB_acc Un_commute Union_image_empty)
+
+lemma L_bsimp_erase:
+ shows "L (erase r) = L (erase (bsimp r))"
+ apply(induct r)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(auto simp add: Sequ_def)[1]
+ apply(subst L_bsimp_ASEQ[symmetric])
+ apply(auto simp add: Sequ_def)[1]
+ apply(subst (asm) L_bsimp_ASEQ[symmetric])
+ apply(auto simp add: Sequ_def)[1]
+ apply(simp)
+ apply(subst L_bsimp_AALTs[symmetric])
+ defer
+ apply(simp)
+ apply(subst (2)L_erase_AALTs)
+ apply(subst L_erase_dB)
+ apply(subst L_erase_flts)
+ apply(auto)
+ apply (simp add: L_erase_AALTs)
+ using L_erase_AALTs by blast
+
+lemma bsimp_ASEQ0:
+ shows "bsimp_ASEQ bs r1 AZERO = AZERO"
+ apply(induct r1)
+ apply(auto)
+ done
+
+
+
+lemma bsimp_ASEQ1:
+ assumes "r1 \<noteq> AZERO" "r2 \<noteq> AZERO" "\<forall>bs. r1 \<noteq> AONE bs"
+ shows "bsimp_ASEQ bs r1 r2 = ASEQ bs r1 r2"
+ using assms
+ apply(induct bs r1 r2 rule: bsimp_ASEQ.induct)
+ apply(auto)
+ done
+
+lemma bsimp_ASEQ2:
+ shows "bsimp_ASEQ bs (AONE bs1) r2 = fuse (bs @ bs1) r2"
+ apply(induct r2)
+ apply(auto)
+ done
+
+
+lemma L_bders_simp:
+ shows "L (erase (bders_simp r s)) = L (erase (bders r s))"
+ apply(induct s arbitrary: r rule: rev_induct)
+ apply(simp)
+ apply(simp)
+ apply(simp add: ders_append)
+ apply(simp add: bders_simp_append)
+ apply(simp add: L_bsimp_erase[symmetric])
+ by (simp add: der_correctness)
+
+
+lemma b2:
+ assumes "bnullable r"
+ shows "bmkeps (fuse bs r) = bs @ bmkeps r"
+ by (simp add: assms bmkeps_retrieve bnullable_correctness erase_fuse mkeps_nullable retrieve_fuse2)
+
+
+lemma b4:
+ shows "bnullable (bders_simp r s) = bnullable (bders r s)"
+ by (metis L_bders_simp bnullable_correctness lexer.simps(1) lexer_correct_None option.distinct(1))
+
+
+lemma qq1:
+ assumes "\<exists>r \<in> set rs. bnullable r"
+ shows "bmkeps (AALTs bs (rs @ rs1)) = bmkeps (AALTs bs rs)"
+ using assms
+ apply(induct rs arbitrary: rs1 bs)
+ apply(simp)
+ apply(simp)
+ by (metis Nil_is_append_conv bmkeps.simps(4) neq_Nil_conv bnullable_Hdbmkeps_Hd split_list_last)
+
+lemma qq2:
+ assumes "\<forall>r \<in> set rs. \<not> bnullable r" "\<exists>r \<in> set rs1. bnullable r"
+ shows "bmkeps (AALTs bs (rs @ rs1)) = bmkeps (AALTs bs rs1)"
+ using assms
+ apply(induct rs arbitrary: rs1 bs)
+ apply(simp)
+ apply(simp)
+ by (metis append_assoc in_set_conv_decomp r1 r2)
+
+lemma qq3:
+ shows "bnullable (AALTs bs rs) = (\<exists>r \<in> set rs. bnullable r)"
+ apply(induct rs arbitrary: bs)
+ apply(simp)
+ apply(simp)
+ done
+
+
+
+
+
+fun nonnested :: "arexp \<Rightarrow> bool"
+ where
+ "nonnested (AALTs bs2 []) = True"
+| "nonnested (AALTs bs2 ((AALTs bs1 rs1) # rs2)) = False"
+| "nonnested (AALTs bs2 (r # rs2)) = nonnested (AALTs bs2 rs2)"
+| "nonnested r = True"
+
+
+lemma k0:
+ shows "flts (r # rs1) = flts [r] @ flts rs1"
+ apply(induct r arbitrary: rs1)
+ apply(auto)
+ done
+
+lemma k00:
+ shows "flts (rs1 @ rs2) = flts rs1 @ flts rs2"
+ apply(induct rs1 arbitrary: rs2)
+ apply(auto)
+ by (metis append.assoc k0)
+
+lemma k0a:
+ shows "flts [AALTs bs rs] = map (fuse bs) rs"
+ apply(simp)
+ done
+
+
+
+
+
+
+
+
+lemma bsimp_AALTs_qq:
+ assumes "1 < length rs"
+ shows "bsimp_AALTs bs rs = AALTs bs rs"
+ using assms
+ apply(case_tac rs)
+ apply(simp)
+ apply(case_tac list)
+ apply(simp_all)
+ done
+
+
+
+lemma bbbbs1:
+ shows "nonalt r \<or> (\<exists>bs rs. r = AALTs bs rs)"
+ using nonalt.elims(3) by auto
+
+
+
+
+
+lemma flts_append:
+ "flts (xs1 @ xs2) = flts xs1 @ flts xs2"
+ apply(induct xs1 arbitrary: xs2 rule: rev_induct)
+ apply(auto)
+ apply(case_tac xs)
+ apply(auto)
+ apply(case_tac x)
+ apply(auto)
+ apply(case_tac x)
+ apply(auto)
+ done
+
+fun nonazero :: "arexp \<Rightarrow> bool"
+ where
+ "nonazero AZERO = False"
+| "nonazero r = True"
+
+
+lemma flts_single1:
+ assumes "nonalt r" "nonazero r"
+ shows "flts [r] = [r]"
+ using assms
+ apply(induct r)
+ apply(auto)
+ done
+
+
+
+lemma q3a:
+ assumes "\<exists>r \<in> set rs. bnullable r"
+ shows "bmkeps (AALTs bs (map (fuse bs1) rs)) = bmkeps (AALTs (bs@bs1) rs)"
+ using assms
+ apply(induct rs arbitrary: bs bs1)
+ apply(simp)
+ apply(simp)
+ apply(auto)
+ apply (metis append_assoc b2 bnullable_correctness erase_fuse bnullable_Hdbmkeps_Hd)
+ apply(case_tac "bnullable a")
+ apply (metis append.assoc b2 bnullable_correctness erase_fuse bnullable_Hdbmkeps_Hd)
+ apply(case_tac rs)
+ apply(simp)
+ apply(simp)
+ apply(auto)[1]
+ apply (metis bnullable_correctness erase_fuse)+
+ done
+
+lemma qq4:
+ assumes "\<exists>x\<in>set list. bnullable x"
+ shows "\<exists>x\<in>set (flts list). bnullable x"
+ using assms
+ apply(induct list rule: flts.induct)
+ apply(auto)
+ by (metis UnCI bnullable_correctness erase_fuse imageI)
+
+
+lemma qs3:
+ assumes "\<exists>r \<in> set rs. bnullable r"
+ shows "bmkeps (AALTs bs rs) = bmkeps (AALTs bs (flts rs))"
+ using assms
+ apply(induct rs arbitrary: bs taking: size rule: measure_induct)
+ apply(case_tac x)
+ apply(simp)
+ apply(simp)
+ apply(case_tac a)
+ apply(simp)
+ apply (simp add: r1)
+ apply(simp)
+ apply (simp add: bnullable_Hdbmkeps_Hd)
+ apply(simp)
+ apply(case_tac "flts list")
+ apply(simp)
+ apply (metis L_erase_AALTs L_erase_flts L_flat_Prf1 L_flat_Prf2 Prf_elims(1) bnullable_correctness erase.simps(4) mkeps_nullable r2)
+ apply(simp)
+ apply (simp add: r1)
+ prefer 3
+ apply(simp)
+ apply (simp add: bnullable_Hdbmkeps_Hd)
+ prefer 2
+ apply(simp)
+ apply(case_tac "\<exists>x\<in>set x52. bnullable x")
+ apply(case_tac "list")
+ apply(simp)
+ apply (metis b2 fuse.simps(4) q3a r2)
+ apply(erule disjE)
+ apply(subst qq1)
+ apply(auto)[1]
+ apply (metis bnullable_correctness erase_fuse)
+ apply(simp)
+ apply (metis b2 fuse.simps(4) q3a r2)
+ apply(simp)
+ apply(auto)[1]
+ apply(subst qq1)
+ apply (metis bnullable_correctness erase_fuse image_eqI set_map)
+ apply (metis b2 fuse.simps(4) q3a r2)
+ apply(subst qq1)
+ apply (metis bnullable_correctness erase_fuse image_eqI set_map)
+ apply (metis b2 fuse.simps(4) q3a r2)
+ apply(simp)
+ apply(subst qq2)
+ apply (metis bnullable_correctness erase_fuse imageE set_map)
+ prefer 2
+ apply(case_tac "list")
+ apply(simp)
+ apply(simp)
+ apply (simp add: qq4)
+ apply(simp)
+ apply(auto)
+ apply(case_tac list)
+ apply(simp)
+ apply(simp)
+ apply (simp add: bnullable_Hdbmkeps_Hd)
+ apply(case_tac "bnullable (ASEQ x41 x42 x43)")
+ apply(case_tac list)
+ apply(simp)
+ apply(simp)
+ apply (simp add: bnullable_Hdbmkeps_Hd)
+ apply(simp)
+ using qq4 r1 r2 by auto
+
+
+
+
+lemma bder_fuse:
+ shows "bder c (fuse bs a) = fuse bs (bder c a)"
+ apply(induct a arbitrary: bs c)
+ apply(simp_all)
+ done
+
+
+fun flts2 :: "char \<Rightarrow> arexp list \<Rightarrow> arexp list"
+ where
+ "flts2 _ [] = []"
+| "flts2 c (AZERO # rs) = flts2 c rs"
+| "flts2 c (AONE _ # rs) = flts2 c rs"
+| "flts2 c (ACHAR bs d # rs) = (if c = d then (ACHAR bs d # flts2 c rs) else flts2 c rs)"
+| "flts2 c ((AALTs bs rs1) # rs) = (map (fuse bs) rs1) @ flts2 c rs"
+| "flts2 c (ASEQ bs r1 r2 # rs) = (if (bnullable(r1) \<and> r2 = AZERO) then
+ flts2 c rs
+ else ASEQ bs r1 r2 # flts2 c rs)"
+| "flts2 c (r1 # rs) = r1 # flts2 c rs"
+
+
+
+
+
+
+
+
+
+
+
+
+
+lemma WQ1:
+ assumes "s \<in> L (der c r)"
+ shows "s \<in> der c r \<rightarrow> mkeps (ders s (der c r))"
+ using assms
+ oops
+
+
+
+lemma bder_bsimp_AALTs:
+ shows "bder c (bsimp_AALTs bs rs) = bsimp_AALTs bs (map (bder c) rs)"
+ apply(induct bs rs rule: bsimp_AALTs.induct)
+ apply(simp)
+ apply(simp)
+ apply (simp add: bder_fuse)
+ apply(simp)
+ done
+
+
+
+lemma
+ assumes "asize (bsimp a) = asize a" "a = AALTs bs [AALTs bs2 [], AZERO, AONE bs3]"
+ shows "bsimp a = a"
+ using assms
+ apply(simp)
+ oops
+
+
+
+
+
+
+
+
+inductive rrewrite:: "arexp \<Rightarrow> arexp \<Rightarrow> bool" ("_ \<leadsto> _" [99, 99] 99)
+ where
+ "ASEQ bs AZERO r2 \<leadsto> AZERO"
+| "ASEQ bs r1 AZERO \<leadsto> AZERO"
+| "ASEQ bs (AONE bs1) r \<leadsto> fuse (bs@bs1) r"
+| "r1 \<leadsto> r2 \<Longrightarrow> ASEQ bs r1 r3 \<leadsto> ASEQ bs r2 r3"
+| "r3 \<leadsto> r4 \<Longrightarrow> ASEQ bs r1 r3 \<leadsto> ASEQ bs r1 r4"
+| "r \<leadsto> r' \<Longrightarrow> (AALTs bs (rs1 @ [r] @ rs2)) \<leadsto> (AALTs bs (rs1 @ [r'] @ rs2))"
+(*context rule for eliminating 0, alts--corresponds to the recursive call flts r::rs = r::(flts rs)*)
+| "AALTs bs (rsa@AZERO # rsb) \<leadsto> AALTs bs (rsa@rsb)"
+| "AALTs bs (rsa@(AALTs bs1 rs1)# rsb) \<leadsto> AALTs bs (rsa@(map (fuse bs1) rs1)@rsb)"
+(*the below rule for extracting common prefixes between a list of rexp's bitcodes*)
+| "AALTs bs (map (fuse bs1) rs) \<leadsto> AALTs (bs@bs1) rs"
+(*opposite direction also allowed, which means bits are free to be moved around
+as long as they are on the right path*)
+| "AALTs (bs@bs1) rs \<leadsto> AALTs bs (map (fuse bs1) rs)"
+| "AALTs bs [] \<leadsto> AZERO"
+| "AALTs bs [r] \<leadsto> fuse bs r"
+| "erase a1 = erase a2 \<Longrightarrow> AALTs bs (rsa@[a1]@rsb@[a2]@rsc) \<leadsto> AALTs bs (rsa@[a1]@rsb@rsc)"
+
+
+inductive rrewrites:: "arexp \<Rightarrow> arexp \<Rightarrow> bool" ("_ \<leadsto>* _" [100, 100] 100)
+ where
+rs1[intro, simp]:"r \<leadsto>* r"
+| rs2[intro]: "\<lbrakk>r1 \<leadsto>* r2; r2 \<leadsto> r3\<rbrakk> \<Longrightarrow> r1 \<leadsto>* r3"
+
+inductive srewrites:: "arexp list \<Rightarrow> arexp list \<Rightarrow> bool" (" _ s\<leadsto>* _" [100, 100] 100)
+ where
+ss1: "[] s\<leadsto>* []"
+|ss2: "\<lbrakk>r \<leadsto>* r'; rs s\<leadsto>* rs'\<rbrakk> \<Longrightarrow> (r#rs) s\<leadsto>* (r'#rs')"
+(*rs1 = [r1, r2, ..., rn] rs2 = [r1', r2', ..., rn']
+[r1, r2, ..., rn] \<leadsto>* [r1', r2, ..., rn] \<leadsto>* [...r2',...] \<leadsto>* [r1', r2',... rn']
+*)
+
+
+
+lemma r_in_rstar : "r1 \<leadsto> r2 \<Longrightarrow> r1 \<leadsto>* r2"
+ using rrewrites.intros(1) rrewrites.intros(2) by blast
+
+lemma real_trans:
+ assumes a1: "r1 \<leadsto>* r2" and a2: "r2 \<leadsto>* r3"
+ shows "r1 \<leadsto>* r3"
+ using a2 a1
+ apply(induct r2 r3 arbitrary: r1 rule: rrewrites.induct)
+ apply(auto)
+ done
+
+
+lemma many_steps_later: "\<lbrakk>r1 \<leadsto> r2; r2 \<leadsto>* r3 \<rbrakk> \<Longrightarrow> r1 \<leadsto>* r3"
+ by (meson r_in_rstar real_trans)
+
+
+lemma contextrewrites1: "r \<leadsto>* r' \<Longrightarrow> (AALTs bs (r#rs)) \<leadsto>* (AALTs bs (r'#rs))"
+ apply(induct r r' rule: rrewrites.induct)
+ apply simp
+ by (metis append_Cons append_Nil rrewrite.intros(6) rs2)
+
+
+lemma contextrewrites2: "r \<leadsto>* r' \<Longrightarrow> (AALTs bs (rs1@[r]@rs)) \<leadsto>* (AALTs bs (rs1@[r']@rs))"
+ apply(induct r r' rule: rrewrites.induct)
+ apply simp
+ using rrewrite.intros(6) by blast
+
+
+
+lemma srewrites_alt: "rs1 s\<leadsto>* rs2 \<Longrightarrow> (AALTs bs (rs@rs1)) \<leadsto>* (AALTs bs (rs@rs2))"
+
+ apply(induct rs1 rs2 arbitrary: bs rs rule: srewrites.induct)
+ apply(rule rs1)
+ apply(drule_tac x = "bs" in meta_spec)
+ apply(drule_tac x = "rsa@[r']" in meta_spec)
+ apply simp
+ apply(rule real_trans)
+ prefer 2
+ apply(assumption)
+ apply(drule contextrewrites2)
+ apply auto
+ done
+
+
+corollary srewrites_alt1: "rs1 s\<leadsto>* rs2 \<Longrightarrow> AALTs bs rs1 \<leadsto>* AALTs bs rs2"
+ by (metis append.left_neutral srewrites_alt)
+
+
+lemma star_seq: "r1 \<leadsto>* r2 \<Longrightarrow> ASEQ bs r1 r3 \<leadsto>* ASEQ bs r2 r3"
+ apply(induct r1 r2 arbitrary: r3 rule: rrewrites.induct)
+ apply(rule rs1)
+ apply(erule rrewrites.cases)
+ apply(simp)
+ apply(rule r_in_rstar)
+ apply(rule rrewrite.intros(4))
+ apply simp
+ apply(rule rs2)
+ apply(assumption)
+ apply(rule rrewrite.intros(4))
+ by assumption
+
+lemma star_seq2: "r3 \<leadsto>* r4 \<Longrightarrow> ASEQ bs r1 r3 \<leadsto>* ASEQ bs r1 r4"
+ apply(induct r3 r4 arbitrary: r1 rule: rrewrites.induct)
+ apply auto
+ using rrewrite.intros(5) by blast
+
+
+lemma continuous_rewrite: "\<lbrakk>r1 \<leadsto>* AZERO\<rbrakk> \<Longrightarrow> ASEQ bs1 r1 r2 \<leadsto>* AZERO"
+ apply(induction ra\<equiv>"r1" rb\<equiv>"AZERO" arbitrary: bs1 r1 r2 rule: rrewrites.induct)
+ apply (simp add: r_in_rstar rrewrite.intros(1))
+
+ by (meson rrewrite.intros(1) rrewrites.intros(2) star_seq)
+
+
+
+lemma bsimp_aalts_simpcases: "AONE bs \<leadsto>* (bsimp (AONE bs))" "AZERO \<leadsto>* bsimp AZERO" "ACHAR bs c \<leadsto>* (bsimp (ACHAR bs c))"
+ apply (simp add: rrewrites.intros(1))
+ apply (simp add: rrewrites.intros(1))
+ by (simp add: rrewrites.intros(1))
+
+lemma trivialbsimpsrewrites: "\<lbrakk>\<And>x. x \<in> set rs \<Longrightarrow> x \<leadsto>* f x \<rbrakk> \<Longrightarrow> rs s\<leadsto>* (map f rs)"
+
+ apply(induction rs)
+ apply simp
+ apply(rule ss1)
+ by (metis insert_iff list.simps(15) list.simps(9) srewrites.simps)
+
+
+lemma bsimp_AALTsrewrites: "AALTs bs1 rs \<leadsto>* bsimp_AALTs bs1 rs"
+ apply(induction rs)
+ apply simp
+ apply(rule r_in_rstar)
+ apply(simp add: rrewrite.intros(11))
+ apply(case_tac "rs = Nil")
+ apply(simp)
+ using rrewrite.intros(12) apply auto[1]
+ apply(subgoal_tac "length (a#rs) > 1")
+ apply(simp add: bsimp_AALTs_qq)
+ apply(simp)
+ done
+
+inductive frewrites:: "arexp list \<Rightarrow> arexp list \<Rightarrow> bool" (" _ f\<leadsto>* _" [100, 100] 100)
+ where
+fs1: "[] f\<leadsto>* []"
+|fs2: "\<lbrakk>rs f\<leadsto>* rs'\<rbrakk> \<Longrightarrow> (AZERO#rs) f\<leadsto>* rs'"
+|fs3: "\<lbrakk>rs f\<leadsto>* rs'\<rbrakk> \<Longrightarrow> ((AALTs bs rs1) # rs) f\<leadsto>* ((map (fuse bs) rs1) @ rs')"
+|fs4: "\<lbrakk>rs f\<leadsto>* rs';nonalt r; nonazero r\<rbrakk> \<Longrightarrow> (r#rs) f\<leadsto>* (r#rs')"
+
+
+
+
+
+lemma flts_prepend: "\<lbrakk>nonalt a; nonazero a\<rbrakk> \<Longrightarrow> flts (a#rs) = a # (flts rs)"
+ by (metis append_Cons append_Nil flts_single1 k00)
+
+lemma fltsfrewrites: "rs f\<leadsto>* (flts rs)"
+ apply(induction rs)
+ apply simp
+ apply(rule fs1)
+
+ apply(case_tac "a = AZERO")
+
+
+ using fs2 apply auto[1]
+ apply(case_tac "\<exists>bs rs. a = AALTs bs rs")
+ apply(erule exE)+
+
+ apply (simp add: fs3)
+ apply(subst flts_prepend)
+ apply(rule nonalt.elims(2))
+ prefer 2
+ thm nonalt.elims
+
+ apply blast
+
+ using bbbbs1 apply blast
+ apply(simp add: nonalt.simps)+
+
+ apply (meson nonazero.elims(3))
+
+ by (meson fs4 nonalt.elims(3) nonazero.elims(3))
+
+
+lemma rrewrite0away: "AALTs bs ( AZERO # rsb) \<leadsto> AALTs bs rsb"
+ by (metis append_Nil rrewrite.intros(7))
+
+
+lemma frewritesaalts:"rs f\<leadsto>* rs' \<Longrightarrow> (AALTs bs (rs1@rs)) \<leadsto>* (AALTs bs (rs1@rs'))"
+ apply(induct rs rs' arbitrary: bs rs1 rule:frewrites.induct)
+ apply(rule rs1)
+ apply(drule_tac x = "bs" in meta_spec)
+ apply(drule_tac x = "rs1 @ [AZERO]" in meta_spec)
+ apply(rule real_trans)
+ apply simp
+ using r_in_rstar rrewrite.intros(7) apply presburger
+ apply(drule_tac x = "bsa" in meta_spec)
+ apply(drule_tac x = "rs1a @ [AALTs bs rs1]" in meta_spec)
+ apply(rule real_trans)
+ apply simp
+ using r_in_rstar rrewrite.intros(8) apply presburger
+ apply(drule_tac x = "bs" in meta_spec)
+ apply(drule_tac x = "rs1@[r]" in meta_spec)
+ apply(rule real_trans)
+ apply simp
+ apply auto
+ done
+
+lemma fltsrewrites: " AALTs bs1 rs \<leadsto>* AALTs bs1 (flts rs)"
+ apply(induction rs)
+ apply simp
+ apply(case_tac "a = AZERO")
+ apply (metis append_Nil flts.simps(2) many_steps_later rrewrite.intros(7))
+
+
+
+ apply(case_tac "\<exists>bs2 rs2. a = AALTs bs2 rs2")
+ apply(erule exE)+
+ apply(simp add: flts.simps)
+ prefer 2
+
+ apply(subst flts_prepend)
+
+ apply (meson nonalt.elims(3))
+
+ apply (meson nonazero.elims(3))
+ apply(subgoal_tac "(a#rs) f\<leadsto>* (a#flts rs)")
+ apply (metis append_Nil frewritesaalts)
+ apply (meson fltsfrewrites fs4 nonalt.elims(3) nonazero.elims(3))
+ by (metis append_Cons append_Nil fltsfrewrites frewritesaalts k00 k0a)
+
+lemma alts_simpalts: "\<And>bs1 rs. (\<And>x. x \<in> set rs \<Longrightarrow> x \<leadsto>* bsimp x) \<Longrightarrow>
+AALTs bs1 rs \<leadsto>* AALTs bs1 (map bsimp rs)"
+ apply(subgoal_tac " rs s\<leadsto>* (map bsimp rs)")
+ prefer 2
+ using trivialbsimpsrewrites apply auto[1]
+ using srewrites_alt1 by auto
+
+
+lemma threelistsappend: "rsa@a#rsb = (rsa@[a])@rsb"
+ apply auto
+ done
+
+fun distinctByAcc :: "'a list \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'b set \<Rightarrow> 'b set"
+ where
+ "distinctByAcc [] f acc = acc"
+| "distinctByAcc (x#xs) f acc =
+ (if (f x) \<in> acc then distinctByAcc xs f acc
+ else (distinctByAcc xs f ({f x} \<union> acc)))"
+
+lemma dB_single_step: "distinctBy (a#rs) f {} = a # distinctBy rs f {f a}"
+ apply simp
+ done
+
+lemma somewhereInside: "r \<in> set rs \<Longrightarrow> \<exists>rs1 rs2. rs = rs1@[r]@rs2"
+ using split_list by fastforce
+
+lemma somewhereMapInside: "f r \<in> f ` set rs \<Longrightarrow> \<exists>rs1 rs2 a. rs = rs1@[a]@rs2 \<and> f a = f r"
+ apply auto
+ by (metis split_list)
+
+lemma alts_dBrewrites_withFront: " AALTs bs (rsa @ rs) \<leadsto>* AALTs bs (rsa @ distinctBy rs erase (erase ` set rsa))"
+ apply(induction rs arbitrary: rsa)
+ apply simp
+ apply(drule_tac x = "rsa@[a]" in meta_spec)
+ apply(subst threelistsappend)
+ apply(rule real_trans)
+ apply simp
+ apply(case_tac "a \<in> set rsa")
+ apply simp
+ apply(drule somewhereInside)
+ apply(erule exE)+
+ apply simp
+ apply(subgoal_tac " AALTs bs
+ (rs1 @
+ a #
+ rs2 @
+ a #
+ distinctBy rs erase
+ (insert (erase a)
+ (erase `
+ (set rs1 \<union> set rs2)))) \<leadsto> AALTs bs (rs1@ a # rs2 @ distinctBy rs erase
+ (insert (erase a)
+ (erase `
+ (set rs1 \<union> set rs2)))) ")
+ prefer 2
+ using rrewrite.intros(13) apply force
+ using r_in_rstar apply force
+ apply(subgoal_tac "erase ` set (rsa @ [a]) = insert (erase a) (erase ` set rsa)")
+ prefer 2
+
+ apply auto[1]
+ apply(case_tac "erase a \<in> erase `set rsa")
+
+ apply simp
+ apply(subgoal_tac "AALTs bs (rsa @ a # distinctBy rs erase (insert (erase a) (erase ` set rsa))) \<leadsto>
+ AALTs bs (rsa @ distinctBy rs erase (insert (erase a) (erase ` set rsa)))")
+ apply force
+ apply (smt (verit, ccfv_threshold) append_Cons append_assoc append_self_conv2 r_in_rstar rrewrite.intros(13) same_append_eq somewhereMapInside)
+ by force
+
+
+
+lemma alts_dBrewrites: "AALTs bs rs \<leadsto>* AALTs bs (distinctBy rs erase {})"
+ apply(induction rs)
+ apply simp
+ apply simp
+ using alts_dBrewrites_withFront
+ by (metis append_Nil dB_single_step empty_set image_empty)
+
+
+
+
+
+
+lemma bsimp_rewrite: " (rrewrites r ( bsimp r))"
+ apply(induction r rule: bsimp.induct)
+ apply simp
+ apply(case_tac "bsimp r1 = AZERO")
+ apply simp
+ using continuous_rewrite apply blast
+ apply(case_tac "\<exists>bs. bsimp r1 = AONE bs")
+ apply(erule exE)
+ apply simp
+ apply(subst bsimp_ASEQ2)
+ apply (meson real_trans rrewrite.intros(3) rrewrites.intros(2) star_seq star_seq2)
+ apply (smt (verit, best) bsimp_ASEQ0 bsimp_ASEQ1 real_trans rrewrite.intros(2) rs2 star_seq star_seq2)
+ defer
+ using bsimp_aalts_simpcases(2) apply blast
+ apply simp
+ apply simp
+ apply simp
+
+ apply auto
+
+
+ apply(subgoal_tac "AALTs bs1 rs \<leadsto>* AALTs bs1 (map bsimp rs)")
+ apply(subgoal_tac "AALTs bs1 (map bsimp rs) \<leadsto>* AALTs bs1 (flts (map bsimp rs))")
+ apply(subgoal_tac "AALTs bs1 (flts (map bsimp rs)) \<leadsto>* AALTs bs1 (distinctBy (flts (map bsimp rs)) erase {})")
+ apply(subgoal_tac "AALTs bs1 (distinctBy (flts (map bsimp rs)) erase {}) \<leadsto>* bsimp_AALTs bs1 (distinctBy (flts (map bsimp rs)) erase {} )")
+
+
+ apply (meson real_trans)
+
+ apply (meson bsimp_AALTsrewrites)
+
+ apply (meson alts_dBrewrites)
+
+ using fltsrewrites apply auto[1]
+
+ using alts_simpalts by force
+
+
+lemma rewritenullable: "\<lbrakk>r1 \<leadsto> r2; bnullable r1 \<rbrakk> \<Longrightarrow> bnullable r2"
+ apply(induction r1 r2 rule: rrewrite.induct)
+ apply(simp)+
+ apply (metis bnullable_correctness erase_fuse)
+ apply simp
+ apply simp
+ apply auto[1]
+ apply auto[1]
+ apply auto[4]
+ apply (metis UnCI bnullable_correctness erase_fuse imageI)
+ apply (metis bnullable_correctness erase_fuse)
+ apply (metis bnullable_correctness erase_fuse)
+
+ apply (metis bnullable_correctness erase.simps(5) erase_fuse)
+
+
+ by (smt (z3) Un_iff bnullable_correctness insert_iff list.set(2) qq3 set_append)
+
+lemma rewrite_non_nullable: "\<lbrakk>r1 \<leadsto> r2; \<not>bnullable r1 \<rbrakk> \<Longrightarrow> \<not>bnullable r2"
+ apply(induction r1 r2 rule: rrewrite.induct)
+ apply auto
+ apply (metis bnullable_correctness erase_fuse)+
+ done
+
+
+lemma rewritesnullable: "\<lbrakk> r1 \<leadsto>* r2; bnullable r1 \<rbrakk> \<Longrightarrow> bnullable r2"
+ apply(induction r1 r2 rule: rrewrites.induct)
+ apply simp
+ apply(rule rewritenullable)
+ apply simp
+ apply simp
+ done
+
+lemma nonbnullable_lists_concat: " \<lbrakk> \<not> (\<exists>r0\<in>set rs1. bnullable r0); \<not> bnullable r; \<not> (\<exists>r0\<in>set rs2. bnullable r0)\<rbrakk> \<Longrightarrow>
+\<not>(\<exists>r0 \<in> (set (rs1@[r]@rs2)). bnullable r0 ) "
+ apply simp
+ apply blast
+ done
+
+
+
+lemma nomember_bnullable: "\<lbrakk> \<not> (\<exists>r0\<in>set rs1. bnullable r0); \<not> bnullable r; \<not> (\<exists>r0\<in>set rs2. bnullable r0)\<rbrakk>
+ \<Longrightarrow> \<not>bnullable (AALTs bs (rs1 @ [r] @ rs2))"
+ using nonbnullable_lists_concat qq3 by presburger
+
+lemma bnullable_segment: " bnullable (AALTs bs (rs1@[r]@rs2)) \<Longrightarrow> bnullable (AALTs bs rs1) \<or> bnullable (AALTs bs rs2) \<or> bnullable r"
+ apply(case_tac "\<exists>r0\<in>set rs1. bnullable r0")
+
+ using qq3 apply blast
+ apply(case_tac "bnullable r")
+
+ apply blast
+ apply(case_tac "\<exists>r0\<in>set rs2. bnullable r0")
+
+ using bnullable.simps(4) apply presburger
+ apply(subgoal_tac "False")
+
+ apply blast
+
+ using nomember_bnullable by blast
+
+
+
+lemma bnullablewhichbmkeps: "\<lbrakk>bnullable (AALTs bs (rs1@[r]@rs2)); \<not> bnullable (AALTs bs rs1); bnullable r \<rbrakk>
+ \<Longrightarrow> bmkeps (AALTs bs (rs1@[r]@rs2)) = bs @ (bmkeps r)"
+ using qq2 bnullable_Hdbmkeps_Hd by force
+
+lemma rrewrite_nbnullable: "\<lbrakk> r1 \<leadsto> r2 ; \<not> bnullable r1 \<rbrakk> \<Longrightarrow> \<not>bnullable r2"
+ apply(induction rule: rrewrite.induct)
+ apply auto[1]
+ apply auto[1]
+ apply auto[1]
+ apply (metis bnullable_correctness erase_fuse)
+ apply auto[1]
+ apply auto[1]
+ apply auto[1]
+ apply auto[1]
+ apply auto[1]
+ apply (metis bnullable_correctness erase_fuse)
+ apply auto[1]
+ apply (metis bnullable_correctness erase_fuse)
+ apply auto[1]
+ apply (metis bnullable_correctness erase_fuse)
+ apply auto[1]
+ apply auto[1]
+
+ apply (metis bnullable_correctness erase_fuse)
+
+ by (meson rewrite_non_nullable rrewrite.intros(13))
+
+
+
+
+lemma spillbmkepslistr: "bnullable (AALTs bs1 rs1)
+ \<Longrightarrow> bmkeps (AALTs bs (AALTs bs1 rs1 # rsb)) = bmkeps (AALTs bs ( map (fuse bs1) rs1 @ rsb))"
+ apply(subst bnullable_Hdbmkeps_Hd)
+
+ apply simp
+ by (metis bmkeps.simps(3) k0a list.set_intros(1) qq1 qq4 qs3)
+
+lemma third_segment_bnullable: "\<lbrakk>bnullable (AALTs bs (rs1@rs2@rs3)); \<not>bnullable (AALTs bs rs1); \<not>bnullable (AALTs bs rs2)\<rbrakk> \<Longrightarrow>
+bnullable (AALTs bs rs3)"
+
+ by (metis append.left_neutral append_Cons bnullable.simps(1) bnullable_segment rrewrite.intros(7) rrewrite_nbnullable)
+
+
+lemma third_segment_bmkeps: "\<lbrakk>bnullable (AALTs bs (rs1@rs2@rs3)); \<not>bnullable (AALTs bs rs1); \<not>bnullable (AALTs bs rs2)\<rbrakk> \<Longrightarrow>
+bmkeps (AALTs bs (rs1@rs2@rs3) ) = bmkeps (AALTs bs rs3)"
+ apply(subgoal_tac "bnullable (AALTs bs rs3)")
+ apply(subgoal_tac "\<forall>r \<in> set (rs1@rs2). \<not>bnullable r")
+ apply(subgoal_tac "bmkeps (AALTs bs (rs1@rs2@rs3)) = bmkeps (AALTs bs ((rs1@rs2)@rs3) )")
+ apply (metis qq2 qq3)
+
+ apply (metis append.assoc)
+
+ apply (metis append.assoc in_set_conv_decomp r2 third_segment_bnullable)
+
+ using third_segment_bnullable by blast
+
+
+lemma rewrite_bmkepsalt: " \<lbrakk>bnullable (AALTs bs (rsa @ AALTs bs1 rs1 # rsb)); bnullable (AALTs bs (rsa @ map (fuse bs1) rs1 @ rsb))\<rbrakk>
+ \<Longrightarrow> bmkeps (AALTs bs (rsa @ AALTs bs1 rs1 # rsb)) = bmkeps (AALTs bs (rsa @ map (fuse bs1) rs1 @ rsb))"
+ apply(case_tac "bnullable (AALTs bs rsa)")
+
+ using qq1 apply force
+ apply(case_tac "bnullable (AALTs bs1 rs1)")
+ apply(subst qq2)
+
+
+ using r2 apply blast
+
+ apply (metis list.set_intros(1))
+ apply (smt (verit, ccfv_threshold) append_eq_append_conv2 list.set_intros(1) qq2 qq3 rewritenullable rrewrite.intros(8) self_append_conv2 spillbmkepslistr)
+
+
+ thm qq1
+ apply(subgoal_tac "bmkeps (AALTs bs (rsa @ AALTs bs1 rs1 # rsb)) = bmkeps (AALTs bs rsb) ")
+ prefer 2
+
+ apply (metis append_Cons append_Nil bnullable.simps(1) bnullable_segment rewritenullable rrewrite.intros(11) third_segment_bmkeps)
+
+ by (metis bnullable.simps(4) rewrite_non_nullable rrewrite.intros(10) third_segment_bmkeps)
+
+
+
+lemma rewrite_bmkeps: "\<lbrakk> r1 \<leadsto> r2; (bnullable r1)\<rbrakk> \<Longrightarrow> bmkeps r1 = bmkeps r2"
+
+ apply(frule rewritenullable)
+ apply simp
+ apply(induction r1 r2 rule: rrewrite.induct)
+ apply simp
+ using bnullable.simps(1) bnullable.simps(5) apply blast
+ apply (simp add: b2)
+ apply simp
+ apply simp
+ apply(frule bnullable_segment)
+ apply(case_tac "bnullable (AALTs bs rs1)")
+ using qq1 apply force
+ apply(case_tac "bnullable r")
+ using bnullablewhichbmkeps rewritenullable apply presburger
+ apply(subgoal_tac "bnullable (AALTs bs rs2)")
+ apply(subgoal_tac "\<not> bnullable r'")
+ apply (simp add: qq2 r1)
+
+ using rrewrite_nbnullable apply blast
+
+ apply blast
+ apply (simp add: flts_append qs3)
+
+ apply (meson rewrite_bmkepsalt)
+
+ using bnullable.simps(4) q3a apply blast
+
+ apply (simp add: q3a)
+
+ using bnullable.simps(1) apply blast
+
+ apply (simp add: b2)
+
+ by (smt (z3) Un_iff bnullable_correctness erase.simps(5) qq1 qq2 qq3 set_append)
+
+
+
+lemma rewrites_bmkeps: "\<lbrakk> (r1 \<leadsto>* r2); (bnullable r1)\<rbrakk> \<Longrightarrow> bmkeps r1 = bmkeps r2"
+ apply(induction r1 r2 rule: rrewrites.induct)
+ apply simp
+ apply(subgoal_tac "bnullable r2")
+ prefer 2
+ apply(metis rewritesnullable)
+ apply(subgoal_tac "bmkeps r1 = bmkeps r2")
+ prefer 2
+ apply fastforce
+ using rewrite_bmkeps by presburger
+
+
+thm rrewrite.intros(12)
+lemma alts_rewrite_front: "r \<leadsto> r' \<Longrightarrow> AALTs bs (r # rs) \<leadsto> AALTs bs (r' # rs)"
+ by (metis append_Cons append_Nil rrewrite.intros(6))
+
+lemma alt_rewrite_front: "r \<leadsto> r' \<Longrightarrow> AALT bs r r2 \<leadsto> AALT bs r' r2"
+ using alts_rewrite_front by blast
+
+lemma to_zero_in_alt: " AALT bs (ASEQ [] AZERO r) r2 \<leadsto> AALT bs AZERO r2"
+ by (simp add: alts_rewrite_front rrewrite.intros(1))
+
+lemma alt_remove0_front: " AALT bs AZERO r \<leadsto> AALTs bs [r]"
+ by (simp add: rrewrite0away)
+
+lemma alt_rewrites_back: "r2 \<leadsto>* r2' \<Longrightarrow>AALT bs r1 r2 \<leadsto>* AALT bs r1 r2'"
+ apply(induction r2 r2' arbitrary: bs rule: rrewrites.induct)
+ apply simp
+ by (meson rs1 rs2 srewrites_alt1 ss1 ss2)
+
+lemma rewrite_fuse: " r2 \<leadsto> r3 \<Longrightarrow> fuse bs r2 \<leadsto>* fuse bs r3"
+ apply(induction r2 r3 arbitrary: bs rule: rrewrite.induct)
+ apply auto
+
+ apply (simp add: continuous_rewrite)
+
+ apply (simp add: r_in_rstar rrewrite.intros(2))
+
+ apply (metis fuse_append r_in_rstar rrewrite.intros(3))
+
+ using r_in_rstar star_seq apply blast
+
+ using r_in_rstar star_seq2 apply blast
+
+ using contextrewrites2 r_in_rstar apply auto[1]
+
+ apply (simp add: r_in_rstar rrewrite.intros(7))
+
+ using rrewrite.intros(8) apply auto[1]
+
+ apply (metis append_assoc r_in_rstar rrewrite.intros(9))
+
+ apply (metis append_assoc r_in_rstar rrewrite.intros(10))
+
+ apply (simp add: r_in_rstar rrewrite.intros(11))
+
+ apply (metis fuse_append r_in_rstar rrewrite.intros(12))
+
+ using rrewrite.intros(13) by auto
+
+
+
+lemma rewrites_fuse: "r2 \<leadsto>* r2' \<Longrightarrow> (fuse bs1 r2) \<leadsto>* (fuse bs1 r2')"
+ apply(induction r2 r2' arbitrary: bs1 rule: rrewrites.induct)
+ apply simp
+ by (meson real_trans rewrite_fuse)
+
+lemma bder_fuse_list: " map (bder c \<circ> fuse bs1) rs1 = map (fuse bs1 \<circ> bder c) rs1"
+ apply(induction rs1)
+ apply simp
+ by (simp add: bder_fuse)
+
+
+
+lemma rewrite_der_altmiddle: "bder c (AALTs bs (rsa @ AALTs bs1 rs1 # rsb)) \<leadsto>* bder c (AALTs bs (rsa @ map (fuse bs1) rs1 @ rsb))"
+ apply simp
+ apply(simp add: bder_fuse_list)
+ apply(rule many_steps_later)
+ apply(subst rrewrite.intros(8))
+ apply simp
+
+ by fastforce
+
+lemma lock_step_der_removal:
+ shows " erase a1 = erase a2 \<Longrightarrow>
+ bder c (AALTs bs (rsa @ [a1] @ rsb @ [a2] @ rsc)) \<leadsto>*
+ bder c (AALTs bs (rsa @ [a1] @ rsb @ rsc))"
+ apply(simp)
+
+ using rrewrite.intros(13) by auto
+
+lemma rewrite_after_der: "r1 \<leadsto> r2 \<Longrightarrow> (bder c r1) \<leadsto>* (bder c r2)"
+ apply(induction r1 r2 arbitrary: c rule: rrewrite.induct)
+
+ apply (simp add: r_in_rstar rrewrite.intros(1))
+ apply simp
+
+ apply (meson contextrewrites1 r_in_rstar rrewrite.intros(11) rrewrite.intros(2) rrewrite0away rs2)
+ apply(simp)
+ apply(rule many_steps_later)
+ apply(rule to_zero_in_alt)
+ apply(rule many_steps_later)
+ apply(rule alt_remove0_front)
+ apply(rule many_steps_later)
+ apply(rule rrewrite.intros(12))
+ using bder_fuse fuse_append rs1 apply presburger
+ apply(case_tac "bnullable r1")
+ prefer 2
+ apply(subgoal_tac "\<not>bnullable r2")
+ prefer 2
+ using rewrite_non_nullable apply presburger
+ apply simp+
+
+ using star_seq apply auto[1]
+ apply(subgoal_tac "bnullable r2")
+ apply simp+
+ apply(subgoal_tac "bmkeps r1 = bmkeps r2")
+ prefer 2
+ using rewrite_bmkeps apply auto[1]
+ using contextrewrites1 star_seq apply auto[1]
+ using rewritenullable apply auto[1]
+ apply(case_tac "bnullable r1")
+ apply simp
+ apply(subgoal_tac "ASEQ [] (bder c r1) r3 \<leadsto> ASEQ [] (bder c r1) r4")
+ prefer 2
+ using rrewrite.intros(5) apply blast
+ apply(rule many_steps_later)
+ apply(rule alt_rewrite_front)
+ apply assumption
+ apply (meson alt_rewrites_back rewrites_fuse)
+
+ apply (simp add: r_in_rstar rrewrite.intros(5))
+
+ using contextrewrites2 apply force
+
+ using rrewrite.intros(7) apply force
+
+ using rewrite_der_altmiddle apply auto[1]
+
+ apply (metis bder.simps(4) bder_fuse_list map_map r_in_rstar rrewrite.intros(9))
+
+ apply (metis List.map.compositionality bder.simps(4) bder_fuse_list r_in_rstar rrewrite.intros(10))
+
+ apply (simp add: r_in_rstar rrewrite.intros(11))
+
+ apply (metis bder.simps(4) bder_bsimp_AALTs bsimp_AALTs.simps(2) bsimp_AALTsrewrites)
+
+
+ using lock_step_der_removal by auto
+
+
+
+lemma rewrites_after_der: " r1 \<leadsto>* r2 \<Longrightarrow> (bder c r1) \<leadsto>* (bder c r2)"
+ apply(induction r1 r2 rule: rrewrites.induct)
+ apply(rule rs1)
+ by (meson real_trans rewrite_after_der)
+
+
+
+
+lemma central: " (bders r s) \<leadsto>* (bders_simp r s)"
+ apply(induct s arbitrary: r rule: rev_induct)
+
+ apply simp
+ apply(subst bders_append)
+ apply(subst bders_simp_append)
+ by (metis bders.simps(1) bders.simps(2) bders_simp.simps(1) bders_simp.simps(2) bsimp_rewrite real_trans rewrites_after_der)
+
+
+
+thm arexp.induct
+
+lemma quasi_main: "bnullable (bders r s) \<Longrightarrow> bmkeps (bders r s) = bmkeps (bders_simp r s)"
+ using central rewrites_bmkeps by blast
+
+theorem main_main: "blexer r s = blexer_simp r s"
+ by (simp add: b4 blexer_def blexer_simp_def quasi_main)
+
+
+theorem blexersimp_correctness: "blexer_simp r s= lexer r s"
+ using blexer_correctness main_main by auto
+
+
+unused_thms
+
+
+end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys2/Spec.thy Sun Oct 10 18:35:21 2021 +0100
@@ -0,0 +1,380 @@
+
+theory Spec
+ imports RegLangs
+begin
+
+section \<open>"Plain" Values\<close>
+
+datatype val =
+ Void
+| Char char
+| Seq val val
+| Right val
+| Left val
+| Stars "val list"
+
+
+section \<open>The string behind a value\<close>
+
+fun
+ flat :: "val \<Rightarrow> string"
+where
+ "flat (Void) = []"
+| "flat (Char c) = [c]"
+| "flat (Left v) = flat v"
+| "flat (Right v) = flat v"
+| "flat (Seq v1 v2) = (flat v1) @ (flat v2)"
+| "flat (Stars []) = []"
+| "flat (Stars (v#vs)) = (flat v) @ (flat (Stars vs))"
+
+abbreviation
+ "flats vs \<equiv> concat (map flat vs)"
+
+lemma flat_Stars [simp]:
+ "flat (Stars vs) = flats vs"
+by (induct vs) (auto)
+
+
+section \<open>Lexical Values\<close>
+
+inductive
+ Prf :: "val \<Rightarrow> rexp \<Rightarrow> bool" ("\<Turnstile> _ : _" [100, 100] 100)
+where
+ "\<lbrakk>\<Turnstile> v1 : r1; \<Turnstile> v2 : r2\<rbrakk> \<Longrightarrow> \<Turnstile> Seq v1 v2 : SEQ r1 r2"
+| "\<Turnstile> v1 : r1 \<Longrightarrow> \<Turnstile> Left v1 : ALT r1 r2"
+| "\<Turnstile> v2 : r2 \<Longrightarrow> \<Turnstile> Right v2 : ALT r1 r2"
+| "\<Turnstile> Void : ONE"
+| "\<Turnstile> Char c : CH c"
+| "\<forall>v \<in> set vs. \<Turnstile> v : r \<and> flat v \<noteq> [] \<Longrightarrow> \<Turnstile> Stars vs : STAR r"
+
+inductive_cases Prf_elims:
+ "\<Turnstile> v : ZERO"
+ "\<Turnstile> v : SEQ r1 r2"
+ "\<Turnstile> v : ALT r1 r2"
+ "\<Turnstile> v : ONE"
+ "\<Turnstile> v : CH c"
+ "\<Turnstile> vs : STAR r"
+
+lemma Prf_Stars_appendE:
+ assumes "\<Turnstile> Stars (vs1 @ vs2) : STAR r"
+ shows "\<Turnstile> Stars vs1 : STAR r \<and> \<Turnstile> Stars vs2 : STAR r"
+using assms
+by (auto intro: Prf.intros elim!: Prf_elims)
+
+
+lemma flats_Prf_value:
+ assumes "\<forall>s\<in>set ss. \<exists>v. s = flat v \<and> \<Turnstile> v : r"
+ shows "\<exists>vs. flats vs = concat ss \<and> (\<forall>v\<in>set vs. \<Turnstile> v : r \<and> flat v \<noteq> [])"
+using assms
+apply(induct ss)
+apply(auto)
+apply(rule_tac x="[]" in exI)
+apply(simp)
+apply(case_tac "flat v = []")
+apply(rule_tac x="vs" in exI)
+apply(simp)
+apply(rule_tac x="v#vs" in exI)
+apply(simp)
+done
+
+
+lemma L_flat_Prf1:
+ assumes "\<Turnstile> v : r"
+ shows "flat v \<in> L r"
+using assms
+by (induct) (auto simp add: Sequ_def Star_concat)
+
+lemma L_flat_Prf2:
+ assumes "s \<in> L r"
+ shows "\<exists>v. \<Turnstile> v : r \<and> flat v = s"
+using assms
+proof(induct r arbitrary: s)
+ case (STAR r s)
+ have IH: "\<And>s. s \<in> L r \<Longrightarrow> \<exists>v. \<Turnstile> v : r \<and> flat v = s" by fact
+ have "s \<in> L (STAR r)" by fact
+ then obtain ss where "concat ss = s" "\<forall>s \<in> set ss. s \<in> L r \<and> s \<noteq> []"
+ using Star_split by auto
+ then obtain vs where "flats vs = s" "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> flat v \<noteq> []"
+ using IH flats_Prf_value by metis
+ then show "\<exists>v. \<Turnstile> v : STAR r \<and> flat v = s"
+ using Prf.intros(6) flat_Stars by blast
+next
+ case (SEQ r1 r2 s)
+ then show "\<exists>v. \<Turnstile> v : SEQ r1 r2 \<and> flat v = s"
+ unfolding Sequ_def L.simps by (fastforce intro: Prf.intros)
+next
+ case (ALT r1 r2 s)
+ then show "\<exists>v. \<Turnstile> v : ALT r1 r2 \<and> flat v = s"
+ unfolding L.simps by (fastforce intro: Prf.intros)
+qed (auto intro: Prf.intros)
+
+
+lemma L_flat_Prf:
+ shows "L(r) = {flat v | v. \<Turnstile> v : r}"
+using L_flat_Prf1 L_flat_Prf2 by blast
+
+
+
+section \<open>Sets of Lexical Values\<close>
+
+text \<open>
+ Shows that lexical values are finite for a given regex and string.
+\<close>
+
+definition
+ LV :: "rexp \<Rightarrow> string \<Rightarrow> val set"
+where "LV r s \<equiv> {v. \<Turnstile> v : r \<and> flat v = s}"
+
+lemma LV_simps:
+ shows "LV ZERO s = {}"
+ and "LV ONE s = (if s = [] then {Void} else {})"
+ and "LV (CH c) s = (if s = [c] then {Char c} else {})"
+ and "LV (ALT r1 r2) s = Left ` LV r1 s \<union> Right ` LV r2 s"
+unfolding LV_def
+by (auto intro: Prf.intros elim: Prf.cases)
+
+
+abbreviation
+ "Prefixes s \<equiv> {s'. prefix s' s}"
+
+abbreviation
+ "Suffixes s \<equiv> {s'. suffix s' s}"
+
+abbreviation
+ "SSuffixes s \<equiv> {s'. strict_suffix s' s}"
+
+lemma Suffixes_cons [simp]:
+ shows "Suffixes (c # s) = Suffixes s \<union> {c # s}"
+by (auto simp add: suffix_def Cons_eq_append_conv)
+
+
+lemma finite_Suffixes:
+ shows "finite (Suffixes s)"
+by (induct s) (simp_all)
+
+lemma finite_SSuffixes:
+ shows "finite (SSuffixes s)"
+proof -
+ have "SSuffixes s \<subseteq> Suffixes s"
+ unfolding strict_suffix_def suffix_def by auto
+ then show "finite (SSuffixes s)"
+ using finite_Suffixes finite_subset by blast
+qed
+
+lemma finite_Prefixes:
+ shows "finite (Prefixes s)"
+proof -
+ have "finite (Suffixes (rev s))"
+ by (rule finite_Suffixes)
+ then have "finite (rev ` Suffixes (rev s))" by simp
+ moreover
+ have "rev ` (Suffixes (rev s)) = Prefixes s"
+ unfolding suffix_def prefix_def image_def
+ by (auto)(metis rev_append rev_rev_ident)+
+ ultimately show "finite (Prefixes s)" by simp
+qed
+
+lemma LV_STAR_finite:
+ assumes "\<forall>s. finite (LV r s)"
+ shows "finite (LV (STAR r) s)"
+proof(induct s rule: length_induct)
+ fix s::"char list"
+ assume "\<forall>s'. length s' < length s \<longrightarrow> finite (LV (STAR r) s')"
+ then have IH: "\<forall>s' \<in> SSuffixes s. finite (LV (STAR r) s')"
+ by (force simp add: strict_suffix_def suffix_def)
+ define f where "f \<equiv> \<lambda>(v, vs). Stars (v # vs)"
+ define S1 where "S1 \<equiv> \<Union>s' \<in> Prefixes s. LV r s'"
+ define S2 where "S2 \<equiv> \<Union>s2 \<in> SSuffixes s. Stars -` (LV (STAR r) s2)"
+ have "finite S1" using assms
+ unfolding S1_def by (simp_all add: finite_Prefixes)
+ moreover
+ with IH have "finite S2" unfolding S2_def
+ by (auto simp add: finite_SSuffixes inj_on_def finite_vimageI)
+ ultimately
+ have "finite ({Stars []} \<union> f ` (S1 \<times> S2))" by simp
+ moreover
+ have "LV (STAR r) s \<subseteq> {Stars []} \<union> f ` (S1 \<times> S2)"
+ unfolding S1_def S2_def f_def
+ unfolding LV_def image_def prefix_def strict_suffix_def
+ apply(auto)
+ apply(case_tac x)
+ apply(auto elim: Prf_elims)
+ apply(erule Prf_elims)
+ apply(auto)
+ apply(case_tac vs)
+ apply(auto intro: Prf.intros)
+ apply(rule exI)
+ apply(rule conjI)
+ apply(rule_tac x="flat a" in exI)
+ apply(rule conjI)
+ apply(rule_tac x="flats list" in exI)
+ apply(simp)
+ apply(blast)
+ apply(simp add: suffix_def)
+ using Prf.intros(6) by blast
+ ultimately
+ show "finite (LV (STAR r) s)" by (simp add: finite_subset)
+qed
+
+
+lemma LV_finite:
+ shows "finite (LV r s)"
+proof(induct r arbitrary: s)
+ case (ZERO s)
+ show "finite (LV ZERO s)" by (simp add: LV_simps)
+next
+ case (ONE s)
+ show "finite (LV ONE s)" by (simp add: LV_simps)
+next
+ case (CH c s)
+ show "finite (LV (CH c) s)" by (simp add: LV_simps)
+next
+ case (ALT r1 r2 s)
+ then show "finite (LV (ALT r1 r2) s)" by (simp add: LV_simps)
+next
+ case (SEQ r1 r2 s)
+ define f where "f \<equiv> \<lambda>(v1, v2). Seq v1 v2"
+ define S1 where "S1 \<equiv> \<Union>s' \<in> Prefixes s. LV r1 s'"
+ define S2 where "S2 \<equiv> \<Union>s' \<in> Suffixes s. LV r2 s'"
+ have IHs: "\<And>s. finite (LV r1 s)" "\<And>s. finite (LV r2 s)" by fact+
+ then have "finite S1" "finite S2" unfolding S1_def S2_def
+ by (simp_all add: finite_Prefixes finite_Suffixes)
+ moreover
+ have "LV (SEQ r1 r2) s \<subseteq> f ` (S1 \<times> S2)"
+ unfolding f_def S1_def S2_def
+ unfolding LV_def image_def prefix_def suffix_def
+ apply (auto elim!: Prf_elims)
+ by (metis (mono_tags, lifting) mem_Collect_eq)
+ ultimately
+ show "finite (LV (SEQ r1 r2) s)"
+ by (simp add: finite_subset)
+next
+ case (STAR r s)
+ then show "finite (LV (STAR r) s)" by (simp add: LV_STAR_finite)
+qed
+
+
+
+section \<open>Our inductive POSIX Definition\<close>
+
+inductive
+ Posix :: "string \<Rightarrow> rexp \<Rightarrow> val \<Rightarrow> bool" ("_ \<in> _ \<rightarrow> _" [100, 100, 100] 100)
+where
+ Posix_ONE: "[] \<in> ONE \<rightarrow> Void"
+| Posix_CH: "[c] \<in> (CH c) \<rightarrow> (Char c)"
+| Posix_ALT1: "s \<in> r1 \<rightarrow> v \<Longrightarrow> s \<in> (ALT r1 r2) \<rightarrow> (Left v)"
+| Posix_ALT2: "\<lbrakk>s \<in> r2 \<rightarrow> v; s \<notin> L(r1)\<rbrakk> \<Longrightarrow> s \<in> (ALT r1 r2) \<rightarrow> (Right v)"
+| Posix_SEQ: "\<lbrakk>s1 \<in> r1 \<rightarrow> v1; s2 \<in> r2 \<rightarrow> v2;
+ \<not>(\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (s1 @ s\<^sub>3) \<in> L r1 \<and> s\<^sub>4 \<in> L r2)\<rbrakk> \<Longrightarrow>
+ (s1 @ s2) \<in> (SEQ r1 r2) \<rightarrow> (Seq v1 v2)"
+| Posix_STAR1: "\<lbrakk>s1 \<in> r \<rightarrow> v; s2 \<in> STAR r \<rightarrow> Stars vs; flat v \<noteq> [];
+ \<not>(\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (s1 @ s\<^sub>3) \<in> L r \<and> s\<^sub>4 \<in> L (STAR r))\<rbrakk>
+ \<Longrightarrow> (s1 @ s2) \<in> STAR r \<rightarrow> Stars (v # vs)"
+| Posix_STAR2: "[] \<in> STAR r \<rightarrow> Stars []"
+
+inductive_cases Posix_elims:
+ "s \<in> ZERO \<rightarrow> v"
+ "s \<in> ONE \<rightarrow> v"
+ "s \<in> CH c \<rightarrow> v"
+ "s \<in> ALT r1 r2 \<rightarrow> v"
+ "s \<in> SEQ r1 r2 \<rightarrow> v"
+ "s \<in> STAR r \<rightarrow> v"
+
+lemma Posix1:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "s \<in> L r" "flat v = s"
+using assms
+ by(induct s r v rule: Posix.induct)
+ (auto simp add: Sequ_def)
+
+text \<open>
+ For a give value and string, our Posix definition
+ determines a unique value.
+\<close>
+
+lemma Posix_determ:
+ assumes "s \<in> r \<rightarrow> v1" "s \<in> r \<rightarrow> v2"
+ shows "v1 = v2"
+using assms
+proof (induct s r v1 arbitrary: v2 rule: Posix.induct)
+ case (Posix_ONE v2)
+ have "[] \<in> ONE \<rightarrow> v2" by fact
+ then show "Void = v2" by cases auto
+next
+ case (Posix_CH c v2)
+ have "[c] \<in> CH c \<rightarrow> v2" by fact
+ then show "Char c = v2" by cases auto
+next
+ case (Posix_ALT1 s r1 v r2 v2)
+ have "s \<in> ALT r1 r2 \<rightarrow> v2" by fact
+ moreover
+ have "s \<in> r1 \<rightarrow> v" by fact
+ then have "s \<in> L r1" by (simp add: Posix1)
+ ultimately obtain v' where eq: "v2 = Left v'" "s \<in> r1 \<rightarrow> v'" by cases auto
+ moreover
+ have IH: "\<And>v2. s \<in> r1 \<rightarrow> v2 \<Longrightarrow> v = v2" by fact
+ ultimately have "v = v'" by simp
+ then show "Left v = v2" using eq by simp
+next
+ case (Posix_ALT2 s r2 v r1 v2)
+ have "s \<in> ALT r1 r2 \<rightarrow> v2" by fact
+ moreover
+ have "s \<notin> L r1" by fact
+ ultimately obtain v' where eq: "v2 = Right v'" "s \<in> r2 \<rightarrow> v'"
+ by cases (auto simp add: Posix1)
+ moreover
+ have IH: "\<And>v2. s \<in> r2 \<rightarrow> v2 \<Longrightarrow> v = v2" by fact
+ ultimately have "v = v'" by simp
+ then show "Right v = v2" using eq by simp
+next
+ case (Posix_SEQ s1 r1 v1 s2 r2 v2 v')
+ have "(s1 @ s2) \<in> SEQ r1 r2 \<rightarrow> v'"
+ "s1 \<in> r1 \<rightarrow> v1" "s2 \<in> r2 \<rightarrow> v2"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L r1 \<and> s\<^sub>4 \<in> L r2)" by fact+
+ then obtain v1' v2' where "v' = Seq v1' v2'" "s1 \<in> r1 \<rightarrow> v1'" "s2 \<in> r2 \<rightarrow> v2'"
+ apply(cases) apply (auto simp add: append_eq_append_conv2)
+ using Posix1(1) by fastforce+
+ moreover
+ have IHs: "\<And>v1'. s1 \<in> r1 \<rightarrow> v1' \<Longrightarrow> v1 = v1'"
+ "\<And>v2'. s2 \<in> r2 \<rightarrow> v2' \<Longrightarrow> v2 = v2'" by fact+
+ ultimately show "Seq v1 v2 = v'" by simp
+next
+ case (Posix_STAR1 s1 r v s2 vs v2)
+ have "(s1 @ s2) \<in> STAR r \<rightarrow> v2"
+ "s1 \<in> r \<rightarrow> v" "s2 \<in> STAR r \<rightarrow> Stars vs" "flat v \<noteq> []"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L r \<and> s\<^sub>4 \<in> L (STAR r))" by fact+
+ then obtain v' vs' where "v2 = Stars (v' # vs')" "s1 \<in> r \<rightarrow> v'" "s2 \<in> (STAR r) \<rightarrow> (Stars vs')"
+ apply(cases) apply (auto simp add: append_eq_append_conv2)
+ using Posix1(1) apply fastforce
+ apply (metis Posix1(1) Posix_STAR1.hyps(6) append_Nil append_Nil2)
+ using Posix1(2) by blast
+ moreover
+ have IHs: "\<And>v2. s1 \<in> r \<rightarrow> v2 \<Longrightarrow> v = v2"
+ "\<And>v2. s2 \<in> STAR r \<rightarrow> v2 \<Longrightarrow> Stars vs = v2" by fact+
+ ultimately show "Stars (v # vs) = v2" by auto
+next
+ case (Posix_STAR2 r v2)
+ have "[] \<in> STAR r \<rightarrow> v2" by fact
+ then show "Stars [] = v2" by cases (auto simp add: Posix1)
+qed
+
+
+text \<open>
+ Our POSIX values are lexical values.
+\<close>
+
+lemma Posix_LV:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "v \<in> LV r s"
+ using assms unfolding LV_def
+ apply(induct rule: Posix.induct)
+ apply(auto simp add: intro!: Prf.intros elim!: Prf_elims)
+ done
+
+lemma Posix_Prf:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "\<Turnstile> v : r"
+ using assms Posix_LV LV_def
+ by simp
+
+end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys2/SpecAlts.thy Sun Oct 10 18:35:21 2021 +0100
@@ -0,0 +1,762 @@
+
+theory SpecAlts
+ imports Main "~~/src/HOL/Library/Sublist"
+begin
+
+section {* Sequential Composition of Languages *}
+
+definition
+ Sequ :: "string set \<Rightarrow> string set \<Rightarrow> string set" ("_ ;; _" [100,100] 100)
+where
+ "A ;; B = {s1 @ s2 | s1 s2. s1 \<in> A \<and> s2 \<in> B}"
+
+text {* Two Simple Properties about Sequential Composition *}
+
+lemma Sequ_empty_string [simp]:
+ shows "A ;; {[]} = A"
+ and "{[]} ;; A = A"
+by (simp_all add: Sequ_def)
+
+lemma Sequ_empty [simp]:
+ shows "A ;; {} = {}"
+ and "{} ;; A = {}"
+by (simp_all add: Sequ_def)
+
+
+section {* Semantic Derivative (Left Quotient) of Languages *}
+
+definition
+ Der :: "char \<Rightarrow> string set \<Rightarrow> string set"
+where
+ "Der c A \<equiv> {s. c # s \<in> A}"
+
+definition
+ Ders :: "string \<Rightarrow> string set \<Rightarrow> string set"
+where
+ "Ders s A \<equiv> {s'. s @ s' \<in> A}"
+
+lemma Der_null [simp]:
+ shows "Der c {} = {}"
+unfolding Der_def
+by auto
+
+lemma Der_empty [simp]:
+ shows "Der c {[]} = {}"
+unfolding Der_def
+by auto
+
+lemma Der_char [simp]:
+ shows "Der c {[d]} = (if c = d then {[]} else {})"
+unfolding Der_def
+by auto
+
+lemma Der_union [simp]:
+ shows "Der c (A \<union> B) = Der c A \<union> Der c B"
+unfolding Der_def
+ by auto
+
+lemma Der_Union [simp]:
+ shows "Der c (\<Union>B. A) = (\<Union>B. Der c A)"
+unfolding Der_def
+by auto
+
+lemma Der_Sequ [simp]:
+ shows "Der c (A ;; B) = (Der c A) ;; B \<union> (if [] \<in> A then Der c B else {})"
+unfolding Der_def Sequ_def
+by (auto simp add: Cons_eq_append_conv)
+
+
+section {* Kleene Star for Languages *}
+
+inductive_set
+ Star :: "string set \<Rightarrow> string set" ("_\<star>" [101] 102)
+ for A :: "string set"
+where
+ start[intro]: "[] \<in> A\<star>"
+| step[intro]: "\<lbrakk>s1 \<in> A; s2 \<in> A\<star>\<rbrakk> \<Longrightarrow> s1 @ s2 \<in> A\<star>"
+
+(* Arden's lemma *)
+
+lemma Star_cases:
+ shows "A\<star> = {[]} \<union> A ;; A\<star>"
+unfolding Sequ_def
+by (auto) (metis Star.simps)
+
+lemma Star_decomp:
+ assumes "c # x \<in> A\<star>"
+ shows "\<exists>s1 s2. x = s1 @ s2 \<and> c # s1 \<in> A \<and> s2 \<in> A\<star>"
+using assms
+by (induct x\<equiv>"c # x" rule: Star.induct)
+ (auto simp add: append_eq_Cons_conv)
+
+lemma Star_Der_Sequ:
+ shows "Der c (A\<star>) \<subseteq> (Der c A) ;; A\<star>"
+unfolding Der_def Sequ_def
+by(auto simp add: Star_decomp)
+
+
+lemma Der_star [simp]:
+ shows "Der c (A\<star>) = (Der c A) ;; A\<star>"
+proof -
+ have "Der c (A\<star>) = Der c ({[]} \<union> A ;; A\<star>)"
+ by (simp only: Star_cases[symmetric])
+ also have "... = Der c (A ;; A\<star>)"
+ by (simp only: Der_union Der_empty) (simp)
+ also have "... = (Der c A) ;; A\<star> \<union> (if [] \<in> A then Der c (A\<star>) else {})"
+ by simp
+ also have "... = (Der c A) ;; A\<star>"
+ using Star_Der_Sequ by auto
+ finally show "Der c (A\<star>) = (Der c A) ;; A\<star>" .
+qed
+
+
+section {* Regular Expressions *}
+
+datatype rexp =
+ ZERO
+| ONE
+| CHAR char
+| SEQ rexp rexp
+| ALTS "rexp list"
+| STAR rexp
+
+section {* Semantics of Regular Expressions *}
+
+fun
+ L :: "rexp \<Rightarrow> string set"
+where
+ "L (ZERO) = {}"
+| "L (ONE) = {[]}"
+| "L (CHAR c) = {[c]}"
+| "L (SEQ r1 r2) = (L r1) ;; (L r2)"
+| "L (ALTS rs) = (\<Union>r \<in> set rs. L r)"
+| "L (STAR r) = (L r)\<star>"
+
+
+section {* Nullable, Derivatives *}
+
+fun
+ nullable :: "rexp \<Rightarrow> bool"
+where
+ "nullable (ZERO) = False"
+| "nullable (ONE) = True"
+| "nullable (CHAR c) = False"
+| "nullable (ALTS rs) = (\<exists>r \<in> set rs. nullable r)"
+| "nullable (SEQ r1 r2) = (nullable r1 \<and> nullable r2)"
+| "nullable (STAR r) = True"
+
+
+fun
+ der :: "char \<Rightarrow> rexp \<Rightarrow> rexp"
+where
+ "der c (ZERO) = ZERO"
+| "der c (ONE) = ZERO"
+| "der c (CHAR d) = (if c = d then ONE else ZERO)"
+| "der c (ALTS rs) = ALTS (map (der c) rs)"
+| "der c (SEQ r1 r2) =
+ (if nullable r1
+ then ALTS [SEQ (der c r1) r2, der c r2]
+ else SEQ (der c r1) r2)"
+| "der c (STAR r) = SEQ (der c r) (STAR r)"
+
+fun
+ ders :: "string \<Rightarrow> rexp \<Rightarrow> rexp"
+where
+ "ders [] r = r"
+| "ders (c # s) r = ders s (der c r)"
+
+
+lemma nullable_correctness:
+ shows "nullable r \<longleftrightarrow> [] \<in> (L r)"
+by (induct r) (auto simp add: Sequ_def)
+
+lemma der_correctness:
+ shows "L (der c r) = Der c (L r)"
+ apply(induct r)
+ apply(simp_all add: nullable_correctness)
+ apply(auto simp add: Der_def)
+ done
+
+lemma ders_correctness:
+ shows "L (ders s r) = Ders s (L r)"
+by (induct s arbitrary: r)
+ (simp_all add: Ders_def der_correctness Der_def)
+
+fun flats :: "rexp list \<Rightarrow> rexp list"
+ where
+ "flats [] = []"
+| "flats (ZERO # rs1) = flats(rs1)"
+| "flats ((ALTS rs1) #rs2) = rs1 @ (flats rs2)"
+| "flats (r1 # rs2) = r1 # flats rs2"
+
+fun simp_SEQ where
+ "simp_SEQ ONE r\<^sub>2 = r\<^sub>2"
+| "simp_SEQ r\<^sub>1 ONE = r\<^sub>1"
+| "simp_SEQ r\<^sub>1 r\<^sub>2 = SEQ r\<^sub>1 r\<^sub>2"
+
+fun
+ simp :: "rexp \<Rightarrow> rexp"
+where
+ "simp (ALTS rs) = ALTS (remdups (flats (map simp rs)))"
+| "simp (SEQ r1 r2) = simp_SEQ (simp r1) (simp r2)"
+| "simp r = r"
+
+lemma simp_SEQ_correctness:
+ shows "L (simp_SEQ r1 r2) = L (SEQ r1 r2)"
+ apply(induct r1 r2 rule: simp_SEQ.induct)
+ apply(simp_all)
+ done
+
+lemma flats_correctness:
+ shows "(\<Union>r \<in> set (flats rs). L r) = L (ALTS rs)"
+ apply(induct rs rule: flats.induct)
+ apply(simp_all)
+ done
+
+
+lemma simp_correctness:
+ shows "L (simp r) = L r"
+ apply(induct r)
+ apply(simp_all)
+ apply(simp add: simp_SEQ_correctness)
+ apply(simp add: flats_correctness)
+ done
+
+fun
+ ders2 :: "string \<Rightarrow> rexp \<Rightarrow> rexp"
+where
+ "ders2 [] r = r"
+| "ders2 (c # s) r = ders2 s (simp (der c r))"
+
+lemma ders2_ZERO:
+ shows "ders2 s ZERO = ZERO"
+ apply(induct s)
+ apply(simp_all)
+ done
+
+lemma ders2_ONE:
+ shows "ders2 s ONE \<in> {ZERO, ONE}"
+ apply(induct s)
+ apply(simp_all)
+ apply(auto)
+ apply(case_tac s)
+ apply(auto)
+ apply(case_tac s)
+ apply(auto)
+ done
+
+lemma ders2_CHAR:
+ shows "ders2 s (CHAR c) \<in> {ZERO, ONE, CHAR c}"
+ apply(induct s)
+ apply(simp_all)
+ apply(auto simp add: ders2_ZERO)
+ apply(case_tac s)
+ apply(auto simp add: ders2_ZERO)
+ using ders2_ONE
+ apply(auto)[1]
+ using ders2_ONE
+ apply(auto)[1]
+ done
+
+lemma remdup_size:
+ shows "size_list f (remdups rs) \<le> size_list f rs"
+ apply(induct rs)
+ apply(simp_all)
+ done
+
+lemma flats_append:
+ shows "flats (rs1 @ rs2) = (flats rs1) @ (flats rs2)"
+ apply(induct rs1 arbitrary: rs2)
+ apply(auto)
+ apply(case_tac a)
+ apply(auto)
+ done
+
+lemma flats_Cons:
+ shows "flats (r # rs) = (flats [r]) @ (flats rs)"
+ apply(subst flats_append[symmetric])
+ apply(simp)
+ done
+
+lemma flats_size:
+ shows "size_list (\<lambda>x. size (ders2 s x)) (flats rs) \<le> size_list (\<lambda>x. size (ders2 s x)) rs"
+ apply(induct rs arbitrary: s rule: flats.induct)
+ apply(simp_all)
+ apply(simp add: ders2_ZERO)
+ apply (simp add: le_SucI)
+
+ apply(subst flats_Cons)
+ apply(simp)
+ apply(case_tac a)
+ apply(auto)
+ apply(simp add: ders2_ZERO)
+ apply (simp add: le_SucI)
+ sorry
+
+lemma ders2_ALTS:
+ shows "size (ders2 s (ALTS rs)) \<le> size (ALTS (map (ders2 s) rs))"
+ apply(induct s arbitrary: rs)
+ apply(simp_all)
+ thm size_list_pointwise
+ apply (simp add: size_list_pointwise)
+ apply(drule_tac x="remdups (flats (map (simp \<circ> der a) rs))" in meta_spec)
+ apply(rule le_trans)
+ apply(assumption)
+ apply(simp)
+ apply(rule le_trans)
+ apply(rule remdup_size)
+ apply(simp add: comp_def)
+ apply(rule le_trans)
+ apply(rule flats_size)
+ by (simp add: size_list_pointwise)
+
+definition
+ "derss2 A r = {ders2 s r | s. s \<in> A}"
+
+lemma
+ "\<forall>rd \<in> derss2 (UNIV) r. size rd \<le> Suc (size r)"
+ apply(induct r)
+ apply(auto simp add: derss2_def ders2_ZERO)[1]
+ apply(auto simp add: derss2_def ders2_ZERO)[1]
+ using ders2_ONE
+ apply(auto)[1]
+ apply (metis rexp.size(7) rexp.size(8) zero_le)
+ using ders2_CHAR
+ apply(auto)[1]
+ apply (smt derss2_def le_SucI le_zero_eq mem_Collect_eq rexp.size(7) rexp.size(8) rexp.size(9))
+ defer
+ apply(auto simp add: derss2_def)
+ apply(rule le_trans)
+ apply(rule ders2_ALTS)
+ apply(simp)
+ apply(simp add: comp_def)
+
+ apply(simp add: size_list_pointwise)
+ apply(case_tac s)
+ apply(simp)
+ apply(simp only:)
+ apply(auto)[1]
+
+ apply(case_tac s)
+ apply(simp)
+ apply(simp)
+
+section {* Values *}
+
+datatype val =
+ Void
+| Char char
+| Seq val val
+| Nth nat val
+| Stars "val list"
+
+
+section {* The string behind a value *}
+
+fun
+ flat :: "val \<Rightarrow> string"
+where
+ "flat (Void) = []"
+| "flat (Char c) = [c]"
+| "flat (Nth n v) = flat v"
+| "flat (Seq v1 v2) = (flat v1) @ (flat v2)"
+| "flat (Stars []) = []"
+| "flat (Stars (v#vs)) = (flat v) @ (flat (Stars vs))"
+
+abbreviation
+ "flats vs \<equiv> concat (map flat vs)"
+
+lemma flat_Stars [simp]:
+ "flat (Stars vs) = flats vs"
+by (induct vs) (auto)
+
+lemma Star_concat:
+ assumes "\<forall>s \<in> set ss. s \<in> A"
+ shows "concat ss \<in> A\<star>"
+using assms by (induct ss) (auto)
+
+lemma Star_cstring:
+ assumes "s \<in> A\<star>"
+ shows "\<exists>ss. concat ss = s \<and> (\<forall>s \<in> set ss. s \<in> A \<and> s \<noteq> [])"
+using assms
+apply(induct rule: Star.induct)
+apply(auto)[1]
+apply(rule_tac x="[]" in exI)
+apply(simp)
+apply(erule exE)
+apply(clarify)
+apply(case_tac "s1 = []")
+apply(rule_tac x="ss" in exI)
+apply(simp)
+apply(rule_tac x="s1#ss" in exI)
+apply(simp)
+done
+
+
+section {* Lexical Values *}
+
+inductive
+ Prf :: "val \<Rightarrow> rexp \<Rightarrow> bool" ("\<Turnstile> _ : _" [100, 100] 100)
+where
+ "\<lbrakk>\<Turnstile> v1 : r1; \<Turnstile> v2 : r2\<rbrakk> \<Longrightarrow> \<Turnstile> Seq v1 v2 : SEQ r1 r2"
+| "\<lbrakk>\<Turnstile> v1 : (nth rs n); n < length rs\<rbrakk> \<Longrightarrow> \<Turnstile> (Nth n v1) : ALTS rs"
+| "\<Turnstile> Void : ONE"
+| "\<Turnstile> Char c : CHAR c"
+| "\<forall>v \<in> set vs. \<Turnstile> v : r \<and> flat v \<noteq> [] \<Longrightarrow> \<Turnstile> Stars vs : STAR r"
+
+inductive_cases Prf_elims:
+ "\<Turnstile> v : ZERO"
+ "\<Turnstile> v : SEQ r1 r2"
+ "\<Turnstile> v : ALTS rs"
+ "\<Turnstile> v : ONE"
+ "\<Turnstile> v : CHAR c"
+ "\<Turnstile> vs : STAR r"
+
+lemma Prf_Stars_appendE:
+ assumes "\<Turnstile> Stars (vs1 @ vs2) : STAR r"
+ shows "\<Turnstile> Stars vs1 : STAR r \<and> \<Turnstile> Stars vs2 : STAR r"
+using assms
+by (auto intro: Prf.intros elim!: Prf_elims)
+
+
+lemma Star_cval:
+ assumes "\<forall>s\<in>set ss. \<exists>v. s = flat v \<and> \<Turnstile> v : r"
+ shows "\<exists>vs. flats vs = concat ss \<and> (\<forall>v\<in>set vs. \<Turnstile> v : r \<and> flat v \<noteq> [])"
+using assms
+apply(induct ss)
+apply(auto)
+apply(rule_tac x="[]" in exI)
+apply(simp)
+apply(case_tac "flat v = []")
+apply(rule_tac x="vs" in exI)
+apply(simp)
+apply(rule_tac x="v#vs" in exI)
+apply(simp)
+done
+
+
+lemma L_flat_Prf1:
+ assumes "\<Turnstile> v : r"
+ shows "flat v \<in> L r"
+using assms
+ apply(induct)
+ apply(auto simp add: Sequ_def Star_concat)
+ done
+
+lemma L_flat_Prf2:
+ assumes "s \<in> L r"
+ shows "\<exists>v. \<Turnstile> v : r \<and> flat v = s"
+using assms
+proof(induct r arbitrary: s)
+ case (STAR r s)
+ have IH: "\<And>s. s \<in> L r \<Longrightarrow> \<exists>v. \<Turnstile> v : r \<and> flat v = s" by fact
+ have "s \<in> L (STAR r)" by fact
+ then obtain ss where "concat ss = s" "\<forall>s \<in> set ss. s \<in> L r \<and> s \<noteq> []"
+ using Star_cstring by auto
+ then obtain vs where "flats vs = s" "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> flat v \<noteq> []"
+ using IH Star_cval by metis
+ then show "\<exists>v. \<Turnstile> v : STAR r \<and> flat v = s"
+ using Prf.intros(5) flat_Stars by blast
+next
+ case (SEQ r1 r2 s)
+ then show "\<exists>v. \<Turnstile> v : SEQ r1 r2 \<and> flat v = s"
+ unfolding Sequ_def L.simps by (fastforce intro: Prf.intros)
+next
+ case (ALTS rs s)
+ then show "\<exists>v. \<Turnstile> v : ALTS rs \<and> flat v = s"
+ unfolding L.simps
+ apply(auto)
+ apply(case_tac rs)
+ apply(simp)
+ apply(simp)
+ apply(auto)
+ apply(drule_tac x="a" in meta_spec)
+ apply(simp)
+ apply(drule_tac x="s" in meta_spec)
+ apply(simp)
+ apply(erule exE)
+ apply(rule_tac x="Nth 0 v" in exI)
+ apply(simp)
+ apply(rule Prf.intros)
+ apply(simp)
+ apply(simp)
+ apply(drule_tac x="x" in meta_spec)
+ apply(simp)
+ apply(drule_tac x="s" in meta_spec)
+ apply(simp)
+ apply(erule exE)
+ apply(subgoal_tac "\<exists>n. nth list n = x \<and> n < length list")
+ apply(erule exE)
+ apply(rule_tac x="Nth (Suc n) v" in exI)
+ apply(simp)
+ apply(rule Prf.intros)
+ apply(simp)
+ apply(simp)
+ by (meson in_set_conv_nth)
+qed (auto intro: Prf.intros)
+
+
+lemma L_flat_Prf:
+ shows "L(r) = {flat v | v. \<Turnstile> v : r}"
+using L_flat_Prf1 L_flat_Prf2 by blast
+
+
+
+section {* Sets of Lexical Values *}
+
+text {*
+ Shows that lexical values are finite for a given regex and string.
+*}
+
+definition
+ LV :: "rexp \<Rightarrow> string \<Rightarrow> val set"
+where "LV r s \<equiv> {v. \<Turnstile> v : r \<and> flat v = s}"
+
+lemma LV_simps:
+ shows "LV ZERO s = {}"
+ and "LV ONE s = (if s = [] then {Void} else {})"
+ and "LV (CHAR c) s = (if s = [c] then {Char c} else {})"
+unfolding LV_def
+by (auto intro: Prf.intros elim: Prf.cases)
+
+
+abbreviation
+ "Prefixes s \<equiv> {s'. prefix s' s}"
+
+abbreviation
+ "Suffixes s \<equiv> {s'. suffix s' s}"
+
+abbreviation
+ "SSuffixes s \<equiv> {s'. strict_suffix s' s}"
+
+lemma Suffixes_cons [simp]:
+ shows "Suffixes (c # s) = Suffixes s \<union> {c # s}"
+by (auto simp add: suffix_def Cons_eq_append_conv)
+
+
+lemma finite_Suffixes:
+ shows "finite (Suffixes s)"
+by (induct s) (simp_all)
+
+lemma finite_SSuffixes:
+ shows "finite (SSuffixes s)"
+proof -
+ have "SSuffixes s \<subseteq> Suffixes s"
+ unfolding strict_suffix_def suffix_def by auto
+ then show "finite (SSuffixes s)"
+ using finite_Suffixes finite_subset by blast
+qed
+
+lemma finite_Prefixes:
+ shows "finite (Prefixes s)"
+proof -
+ have "finite (Suffixes (rev s))"
+ by (rule finite_Suffixes)
+ then have "finite (rev ` Suffixes (rev s))" by simp
+ moreover
+ have "rev ` (Suffixes (rev s)) = Prefixes s"
+ unfolding suffix_def prefix_def image_def
+ by (auto)(metis rev_append rev_rev_ident)+
+ ultimately show "finite (Prefixes s)" by simp
+qed
+
+lemma LV_STAR_finite:
+ assumes "\<forall>s. finite (LV r s)"
+ shows "finite (LV (STAR r) s)"
+proof(induct s rule: length_induct)
+ fix s::"char list"
+ assume "\<forall>s'. length s' < length s \<longrightarrow> finite (LV (STAR r) s')"
+ then have IH: "\<forall>s' \<in> SSuffixes s. finite (LV (STAR r) s')"
+ by (force simp add: strict_suffix_def suffix_def)
+ define f where "f \<equiv> \<lambda>(v, vs). Stars (v # vs)"
+ define S1 where "S1 \<equiv> \<Union>s' \<in> Prefixes s. LV r s'"
+ define S2 where "S2 \<equiv> \<Union>s2 \<in> SSuffixes s. Stars -` (LV (STAR r) s2)"
+ have "finite S1" using assms
+ unfolding S1_def by (simp_all add: finite_Prefixes)
+ moreover
+ with IH have "finite S2" unfolding S2_def
+ by (auto simp add: finite_SSuffixes inj_on_def finite_vimageI)
+ ultimately
+ have "finite ({Stars []} \<union> f ` (S1 \<times> S2))" by simp
+ moreover
+ have "LV (STAR r) s \<subseteq> {Stars []} \<union> f ` (S1 \<times> S2)"
+ unfolding S1_def S2_def f_def
+ unfolding LV_def image_def prefix_def strict_suffix_def
+ apply(auto)
+ apply(case_tac x)
+ apply(auto elim: Prf_elims)
+ apply(erule Prf_elims)
+ apply(auto)
+ apply(case_tac vs)
+ apply(auto intro: Prf.intros)
+ apply(rule exI)
+ apply(rule conjI)
+ apply(rule_tac x="flat a" in exI)
+ apply(rule conjI)
+ apply(rule_tac x="flats list" in exI)
+ apply(simp)
+ apply(blast)
+ apply(simp add: suffix_def)
+ using Prf.intros(5) by blast
+ ultimately
+ show "finite (LV (STAR r) s)" by (simp add: finite_subset)
+qed
+
+
+lemma LV_finite:
+ shows "finite (LV r s)"
+proof(induct r arbitrary: s)
+ case (ZERO s)
+ show "finite (LV ZERO s)" by (simp add: LV_simps)
+next
+ case (ONE s)
+ show "finite (LV ONE s)" by (simp add: LV_simps)
+next
+ case (CHAR c s)
+ show "finite (LV (CHAR c) s)" by (simp add: LV_simps)
+next
+ case (ALTS rs s)
+ then show "finite (LV (ALTS rs) s)"
+ sorry
+next
+ case (SEQ r1 r2 s)
+ define f where "f \<equiv> \<lambda>(v1, v2). Seq v1 v2"
+ define S1 where "S1 \<equiv> \<Union>s' \<in> Prefixes s. LV r1 s'"
+ define S2 where "S2 \<equiv> \<Union>s' \<in> Suffixes s. LV r2 s'"
+ have IHs: "\<And>s. finite (LV r1 s)" "\<And>s. finite (LV r2 s)" by fact+
+ then have "finite S1" "finite S2" unfolding S1_def S2_def
+ by (simp_all add: finite_Prefixes finite_Suffixes)
+ moreover
+ have "LV (SEQ r1 r2) s \<subseteq> f ` (S1 \<times> S2)"
+ unfolding f_def S1_def S2_def
+ unfolding LV_def image_def prefix_def suffix_def
+ apply (auto elim!: Prf_elims)
+ by (metis (mono_tags, lifting) mem_Collect_eq)
+ ultimately
+ show "finite (LV (SEQ r1 r2) s)"
+ by (simp add: finite_subset)
+next
+ case (STAR r s)
+ then show "finite (LV (STAR r) s)" by (simp add: LV_STAR_finite)
+qed
+
+
+(*
+section {* Our POSIX Definition *}
+
+inductive
+ Posix :: "string \<Rightarrow> rexp \<Rightarrow> val \<Rightarrow> bool" ("_ \<in> _ \<rightarrow> _" [100, 100, 100] 100)
+where
+ Posix_ONE: "[] \<in> ONE \<rightarrow> Void"
+| Posix_CHAR: "[c] \<in> (CHAR c) \<rightarrow> (Char c)"
+| Posix_ALT1: "s \<in> r1 \<rightarrow> v \<Longrightarrow> s \<in> (ALT r1 r2) \<rightarrow> (Left v)"
+| Posix_ALT2: "\<lbrakk>s \<in> r2 \<rightarrow> v; s \<notin> L(r1)\<rbrakk> \<Longrightarrow> s \<in> (ALT r1 r2) \<rightarrow> (Right v)"
+| Posix_SEQ: "\<lbrakk>s1 \<in> r1 \<rightarrow> v1; s2 \<in> r2 \<rightarrow> v2;
+ \<not>(\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (s1 @ s\<^sub>3) \<in> L r1 \<and> s\<^sub>4 \<in> L r2)\<rbrakk> \<Longrightarrow>
+ (s1 @ s2) \<in> (SEQ r1 r2) \<rightarrow> (Seq v1 v2)"
+| Posix_STAR1: "\<lbrakk>s1 \<in> r \<rightarrow> v; s2 \<in> STAR r \<rightarrow> Stars vs; flat v \<noteq> [];
+ \<not>(\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (s1 @ s\<^sub>3) \<in> L r \<and> s\<^sub>4 \<in> L (STAR r))\<rbrakk>
+ \<Longrightarrow> (s1 @ s2) \<in> STAR r \<rightarrow> Stars (v # vs)"
+| Posix_STAR2: "[] \<in> STAR r \<rightarrow> Stars []"
+
+inductive_cases Posix_elims:
+ "s \<in> ZERO \<rightarrow> v"
+ "s \<in> ONE \<rightarrow> v"
+ "s \<in> CHAR c \<rightarrow> v"
+ "s \<in> ALT r1 r2 \<rightarrow> v"
+ "s \<in> SEQ r1 r2 \<rightarrow> v"
+ "s \<in> STAR r \<rightarrow> v"
+
+lemma Posix1:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "s \<in> L r" "flat v = s"
+using assms
+by (induct s r v rule: Posix.induct)
+ (auto simp add: Sequ_def)
+
+text {*
+ Our Posix definition determines a unique value.
+*}
+
+lemma Posix_determ:
+ assumes "s \<in> r \<rightarrow> v1" "s \<in> r \<rightarrow> v2"
+ shows "v1 = v2"
+using assms
+proof (induct s r v1 arbitrary: v2 rule: Posix.induct)
+ case (Posix_ONE v2)
+ have "[] \<in> ONE \<rightarrow> v2" by fact
+ then show "Void = v2" by cases auto
+next
+ case (Posix_CHAR c v2)
+ have "[c] \<in> CHAR c \<rightarrow> v2" by fact
+ then show "Char c = v2" by cases auto
+next
+ case (Posix_ALT1 s r1 v r2 v2)
+ have "s \<in> ALT r1 r2 \<rightarrow> v2" by fact
+ moreover
+ have "s \<in> r1 \<rightarrow> v" by fact
+ then have "s \<in> L r1" by (simp add: Posix1)
+ ultimately obtain v' where eq: "v2 = Left v'" "s \<in> r1 \<rightarrow> v'" by cases auto
+ moreover
+ have IH: "\<And>v2. s \<in> r1 \<rightarrow> v2 \<Longrightarrow> v = v2" by fact
+ ultimately have "v = v'" by simp
+ then show "Left v = v2" using eq by simp
+next
+ case (Posix_ALT2 s r2 v r1 v2)
+ have "s \<in> ALT r1 r2 \<rightarrow> v2" by fact
+ moreover
+ have "s \<notin> L r1" by fact
+ ultimately obtain v' where eq: "v2 = Right v'" "s \<in> r2 \<rightarrow> v'"
+ by cases (auto simp add: Posix1)
+ moreover
+ have IH: "\<And>v2. s \<in> r2 \<rightarrow> v2 \<Longrightarrow> v = v2" by fact
+ ultimately have "v = v'" by simp
+ then show "Right v = v2" using eq by simp
+next
+ case (Posix_SEQ s1 r1 v1 s2 r2 v2 v')
+ have "(s1 @ s2) \<in> SEQ r1 r2 \<rightarrow> v'"
+ "s1 \<in> r1 \<rightarrow> v1" "s2 \<in> r2 \<rightarrow> v2"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L r1 \<and> s\<^sub>4 \<in> L r2)" by fact+
+ then obtain v1' v2' where "v' = Seq v1' v2'" "s1 \<in> r1 \<rightarrow> v1'" "s2 \<in> r2 \<rightarrow> v2'"
+ apply(cases) apply (auto simp add: append_eq_append_conv2)
+ using Posix1(1) by fastforce+
+ moreover
+ have IHs: "\<And>v1'. s1 \<in> r1 \<rightarrow> v1' \<Longrightarrow> v1 = v1'"
+ "\<And>v2'. s2 \<in> r2 \<rightarrow> v2' \<Longrightarrow> v2 = v2'" by fact+
+ ultimately show "Seq v1 v2 = v'" by simp
+next
+ case (Posix_STAR1 s1 r v s2 vs v2)
+ have "(s1 @ s2) \<in> STAR r \<rightarrow> v2"
+ "s1 \<in> r \<rightarrow> v" "s2 \<in> STAR r \<rightarrow> Stars vs" "flat v \<noteq> []"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L r \<and> s\<^sub>4 \<in> L (STAR r))" by fact+
+ then obtain v' vs' where "v2 = Stars (v' # vs')" "s1 \<in> r \<rightarrow> v'" "s2 \<in> (STAR r) \<rightarrow> (Stars vs')"
+ apply(cases) apply (auto simp add: append_eq_append_conv2)
+ using Posix1(1) apply fastforce
+ apply (metis Posix1(1) Posix_STAR1.hyps(6) append_Nil append_Nil2)
+ using Posix1(2) by blast
+ moreover
+ have IHs: "\<And>v2. s1 \<in> r \<rightarrow> v2 \<Longrightarrow> v = v2"
+ "\<And>v2. s2 \<in> STAR r \<rightarrow> v2 \<Longrightarrow> Stars vs = v2" by fact+
+ ultimately show "Stars (v # vs) = v2" by auto
+next
+ case (Posix_STAR2 r v2)
+ have "[] \<in> STAR r \<rightarrow> v2" by fact
+ then show "Stars [] = v2" by cases (auto simp add: Posix1)
+qed
+
+
+text {*
+ Our POSIX value is a lexical value.
+*}
+
+lemma Posix_LV:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "v \<in> LV r s"
+using assms unfolding LV_def
+apply(induct rule: Posix.induct)
+apply(auto simp add: intro!: Prf.intros elim!: Prf_elims)
+done
+*)
+
+
+end
\ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys2/SpecExt.thy Sun Oct 10 18:35:21 2021 +0100
@@ -0,0 +1,1688 @@
+
+theory SpecExt
+ imports Main (*"~~/src/HOL/Library/Sublist"*)
+begin
+
+section {* Sequential Composition of Languages *}
+
+definition
+ Sequ :: "string set \<Rightarrow> string set \<Rightarrow> string set" ("_ ;; _" [100,100] 100)
+where
+ "A ;; B = {s1 @ s2 | s1 s2. s1 \<in> A \<and> s2 \<in> B}"
+
+text {* Two Simple Properties about Sequential Composition *}
+
+lemma Sequ_empty_string [simp]:
+ shows "A ;; {[]} = A"
+ and "{[]} ;; A = A"
+by (simp_all add: Sequ_def)
+
+lemma Sequ_empty [simp]:
+ shows "A ;; {} = {}"
+ and "{} ;; A = {}"
+by (simp_all add: Sequ_def)
+
+lemma Sequ_assoc:
+ shows "(A ;; B) ;; C = A ;; (B ;; C)"
+apply(auto simp add: Sequ_def)
+apply blast
+by (metis append_assoc)
+
+lemma Sequ_Union_in:
+ shows "(A ;; (\<Union>x\<in> B. C x)) = (\<Union>x\<in> B. A ;; C x)"
+by (auto simp add: Sequ_def)
+
+section {* Semantic Derivative (Left Quotient) of Languages *}
+
+definition
+ Der :: "char \<Rightarrow> string set \<Rightarrow> string set"
+where
+ "Der c A \<equiv> {s. c # s \<in> A}"
+
+definition
+ Ders :: "string \<Rightarrow> string set \<Rightarrow> string set"
+where
+ "Ders s A \<equiv> {s'. s @ s' \<in> A}"
+
+lemma Der_null [simp]:
+ shows "Der c {} = {}"
+unfolding Der_def
+by auto
+
+lemma Der_empty [simp]:
+ shows "Der c {[]} = {}"
+unfolding Der_def
+by auto
+
+lemma Der_char [simp]:
+ shows "Der c {[d]} = (if c = d then {[]} else {})"
+unfolding Der_def
+by auto
+
+lemma Der_union [simp]:
+ shows "Der c (A \<union> B) = Der c A \<union> Der c B"
+unfolding Der_def
+by auto
+
+lemma Der_UNION [simp]:
+ shows "Der c (\<Union>x\<in>A. B x) = (\<Union>x\<in>A. Der c (B x))"
+by (auto simp add: Der_def)
+
+lemma Der_Sequ [simp]:
+ shows "Der c (A ;; B) = (Der c A) ;; B \<union> (if [] \<in> A then Der c B else {})"
+unfolding Der_def Sequ_def
+ by (auto simp add: Cons_eq_append_conv)
+
+
+section {* Kleene Star for Languages *}
+
+inductive_set
+ Star :: "string set \<Rightarrow> string set" ("_\<star>" [101] 102)
+ for A :: "string set"
+where
+ start[intro]: "[] \<in> A\<star>"
+| step[intro]: "\<lbrakk>s1 \<in> A; s2 \<in> A\<star>\<rbrakk> \<Longrightarrow> s1 @ s2 \<in> A\<star>"
+
+(* Arden's lemma *)
+
+lemma Star_cases:
+ shows "A\<star> = {[]} \<union> A ;; A\<star>"
+unfolding Sequ_def
+by (auto) (metis Star.simps)
+
+lemma Star_decomp:
+ assumes "c # x \<in> A\<star>"
+ shows "\<exists>s1 s2. x = s1 @ s2 \<and> c # s1 \<in> A \<and> s2 \<in> A\<star>"
+using assms
+by (induct x\<equiv>"c # x" rule: Star.induct)
+ (auto simp add: append_eq_Cons_conv)
+
+lemma Star_Der_Sequ:
+ shows "Der c (A\<star>) \<subseteq> (Der c A) ;; A\<star>"
+unfolding Der_def Sequ_def
+by(auto simp add: Star_decomp)
+
+
+lemma Der_star [simp]:
+ shows "Der c (A\<star>) = (Der c A) ;; A\<star>"
+proof -
+ have "Der c (A\<star>) = Der c ({[]} \<union> A ;; A\<star>)"
+ by (simp only: Star_cases[symmetric])
+ also have "... = Der c (A ;; A\<star>)"
+ by (simp only: Der_union Der_empty) (simp)
+ also have "... = (Der c A) ;; A\<star> \<union> (if [] \<in> A then Der c (A\<star>) else {})"
+ by simp
+ also have "... = (Der c A) ;; A\<star>"
+ using Star_Der_Sequ by auto
+ finally show "Der c (A\<star>) = (Der c A) ;; A\<star>" .
+qed
+
+section {* Power operation for Sets *}
+
+fun
+ Pow :: "string set \<Rightarrow> nat \<Rightarrow> string set" ("_ \<up> _" [101, 102] 101)
+where
+ "A \<up> 0 = {[]}"
+| "A \<up> (Suc n) = A ;; (A \<up> n)"
+
+lemma Pow_empty [simp]:
+ shows "[] \<in> A \<up> n \<longleftrightarrow> (n = 0 \<or> [] \<in> A)"
+by(induct n) (auto simp add: Sequ_def)
+
+lemma Pow_Suc_rev:
+ "A \<up> (Suc n) = (A \<up> n) ;; A"
+apply(induct n arbitrary: A)
+apply(simp_all)
+by (metis Sequ_assoc)
+
+
+lemma Pow_decomp:
+ assumes "c # x \<in> A \<up> n"
+ shows "\<exists>s1 s2. x = s1 @ s2 \<and> c # s1 \<in> A \<and> s2 \<in> A \<up> (n - 1)"
+using assms
+apply(induct n)
+apply(auto simp add: Cons_eq_append_conv Sequ_def)
+apply(case_tac n)
+apply(auto simp add: Sequ_def)
+apply(blast)
+done
+
+lemma Star_Pow:
+ assumes "s \<in> A\<star>"
+ shows "\<exists>n. s \<in> A \<up> n"
+using assms
+apply(induct)
+apply(auto)
+apply(rule_tac x="Suc n" in exI)
+apply(auto simp add: Sequ_def)
+done
+
+lemma Pow_Star:
+ assumes "s \<in> A \<up> n"
+ shows "s \<in> A\<star>"
+using assms
+apply(induct n arbitrary: s)
+apply(auto simp add: Sequ_def)
+ done
+
+lemma
+ assumes "[] \<in> A" "n \<noteq> 0" "A \<noteq> {}"
+ shows "A \<up> (Suc n) = A \<up> n"
+
+lemma Der_Pow_0:
+ shows "Der c (A \<up> 0) = {}"
+by(simp add: Der_def)
+
+lemma Der_Pow_Suc:
+ shows "Der c (A \<up> (Suc n)) = (Der c A) ;; (A \<up> n)"
+unfolding Der_def Sequ_def
+apply(auto simp add: Cons_eq_append_conv Sequ_def dest!: Pow_decomp)
+apply(case_tac n)
+apply(force simp add: Sequ_def)+
+done
+
+lemma Der_Pow [simp]:
+ shows "Der c (A \<up> n) = (if n = 0 then {} else (Der c A) ;; (A \<up> (n - 1)))"
+apply(case_tac n)
+apply(simp_all del: Pow.simps add: Der_Pow_0 Der_Pow_Suc)
+done
+
+lemma Der_Pow_Sequ [simp]:
+ shows "Der c (A ;; A \<up> n) = (Der c A) ;; (A \<up> n)"
+by (simp only: Pow.simps[symmetric] Der_Pow) (simp)
+
+
+lemma Pow_Sequ_Un:
+ assumes "0 < x"
+ shows "(\<Union>n \<in> {..x}. (A \<up> n)) = ({[]} \<union> (\<Union>n \<in> {..x - Suc 0}. A ;; (A \<up> n)))"
+using assms
+apply(auto simp add: Sequ_def)
+apply(smt Pow.elims Sequ_def Suc_le_mono Suc_pred atMost_iff empty_iff insert_iff mem_Collect_eq)
+apply(rule_tac x="Suc xa" in bexI)
+apply(auto simp add: Sequ_def)
+done
+
+lemma Pow_Sequ_Un2:
+ assumes "0 < x"
+ shows "(\<Union>n \<in> {x..}. (A \<up> n)) = (\<Union>n \<in> {x - Suc 0..}. A ;; (A \<up> n))"
+using assms
+apply(auto simp add: Sequ_def)
+apply(case_tac n)
+apply(auto simp add: Sequ_def)
+apply fastforce
+apply(case_tac x)
+apply(auto)
+apply(rule_tac x="Suc xa" in bexI)
+apply(auto simp add: Sequ_def)
+done
+
+section {* Regular Expressions *}
+
+datatype rexp =
+ ZERO
+| ONE
+| CHAR char
+| SEQ rexp rexp
+| ALT rexp rexp
+| STAR rexp
+| UPNTIMES rexp nat
+| NTIMES rexp nat
+| FROMNTIMES rexp nat
+| NMTIMES rexp nat nat
+| NOT rexp
+
+section {* Semantics of Regular Expressions *}
+
+fun
+ L :: "rexp \<Rightarrow> string set"
+where
+ "L (ZERO) = {}"
+| "L (ONE) = {[]}"
+| "L (CHAR c) = {[c]}"
+| "L (SEQ r1 r2) = (L r1) ;; (L r2)"
+| "L (ALT r1 r2) = (L r1) \<union> (L r2)"
+| "L (STAR r) = (L r)\<star>"
+| "L (UPNTIMES r n) = (\<Union>i\<in>{..n} . (L r) \<up> i)"
+| "L (NTIMES r n) = (L r) \<up> n"
+| "L (FROMNTIMES r n) = (\<Union>i\<in>{n..} . (L r) \<up> i)"
+| "L (NMTIMES r n m) = (\<Union>i\<in>{n..m} . (L r) \<up> i)"
+| "L (NOT r) = ((UNIV:: string set) - L r)"
+
+section {* Nullable, Derivatives *}
+
+fun
+ nullable :: "rexp \<Rightarrow> bool"
+where
+ "nullable (ZERO) = False"
+| "nullable (ONE) = True"
+| "nullable (CHAR c) = False"
+| "nullable (ALT r1 r2) = (nullable r1 \<or> nullable r2)"
+| "nullable (SEQ r1 r2) = (nullable r1 \<and> nullable r2)"
+| "nullable (STAR r) = True"
+| "nullable (UPNTIMES r n) = True"
+| "nullable (NTIMES r n) = (if n = 0 then True else nullable r)"
+| "nullable (FROMNTIMES r n) = (if n = 0 then True else nullable r)"
+| "nullable (NMTIMES r n m) = (if m < n then False else (if n = 0 then True else nullable r))"
+| "nullable (NOT r) = (\<not> nullable r)"
+
+fun
+ der :: "char \<Rightarrow> rexp \<Rightarrow> rexp"
+where
+ "der c (ZERO) = ZERO"
+| "der c (ONE) = ZERO"
+| "der c (CHAR d) = (if c = d then ONE else ZERO)"
+| "der c (ALT r1 r2) = ALT (der c r1) (der c r2)"
+| "der c (SEQ r1 r2) =
+ (if nullable r1
+ then ALT (SEQ (der c r1) r2) (der c r2)
+ else SEQ (der c r1) r2)"
+| "der c (STAR r) = SEQ (der c r) (STAR r)"
+| "der c (UPNTIMES r n) = (if n = 0 then ZERO else SEQ (der c r) (UPNTIMES r (n - 1)))"
+| "der c (NTIMES r n) = (if n = 0 then ZERO else SEQ (der c r) (NTIMES r (n - 1)))"
+| "der c (FROMNTIMES r n) =
+ (if n = 0
+ then SEQ (der c r) (STAR r)
+ else SEQ (der c r) (FROMNTIMES r (n - 1)))"
+| "der c (NMTIMES r n m) =
+ (if m < n then ZERO
+ else (if n = 0 then (if m = 0 then ZERO else
+ SEQ (der c r) (UPNTIMES r (m - 1))) else
+ SEQ (der c r) (NMTIMES r (n - 1) (m - 1))))"
+| "der c (NOT r) = NOT (der c r)"
+
+lemma
+ "L(der c (UPNTIMES r m)) =
+ L(if (m = 0) then ZERO else ALT ONE (SEQ(der c r) (UPNTIMES r (m - 1))))"
+ apply(case_tac m)
+ apply(simp)
+ apply(simp del: der.simps)
+ apply(simp only: der.simps)
+ apply(simp add: Sequ_def)
+ apply(auto)
+ defer
+ apply blast
+ oops
+
+
+
+lemma
+ assumes "der c r = ONE \<or> der c r = ZERO"
+ shows "L (der c (NOT r)) \<noteq> L(if (der c r = ZERO) then ONE else
+ if (der c r = ONE) then ZERO
+ else NOT(der c r))"
+ using assms
+ apply(simp)
+ apply(auto)
+ done
+
+lemma
+ "L (der c (NOT r)) = L(if (der c r = ZERO) then ONE else
+ if (der c r = ONE) then ZERO
+ else NOT(der c r))"
+ apply(simp)
+ apply(auto)
+ oops
+
+lemma pow_add:
+ assumes "s1 \<in> A \<up> n" "s2 \<in> A \<up> m"
+ shows "s1 @ s2 \<in> A \<up> (n + m)"
+ using assms
+ apply(induct n arbitrary: m s1 s2)
+ apply(auto simp add: Sequ_def)
+ by blast
+
+lemma pow_add2:
+ assumes "x \<in> A \<up> (m + n)"
+ shows "x \<in> A \<up> m ;; A \<up> n"
+ using assms
+ apply(induct m arbitrary: n x)
+ apply(auto simp add: Sequ_def)
+ by (metis append.assoc)
+
+
+
+lemma
+ "L(FROMNTIMES r n) = L(SEQ (NTIMES r n) (STAR r))"
+ apply(auto simp add: Sequ_def)
+ defer
+ apply(subgoal_tac "\<exists>m. s2 \<in> (L r) \<up> m")
+ prefer 2
+ apply (simp add: Star_Pow)
+ apply(auto)
+ apply(rule_tac x="n + m" in bexI)
+ apply (simp add: pow_add)
+ apply simp
+ apply(subgoal_tac "\<exists>m. m + n = xa")
+ apply(auto)
+ prefer 2
+ using le_add_diff_inverse2 apply auto[1]
+ by (smt Pow_Star Sequ_def add.commute mem_Collect_eq pow_add2)
+
+lemma
+ "L (der c (FROMNTIMES r n)) =
+ L (SEQ (der c r) (FROMNTIMES r (n - 1)))"
+ apply(auto simp add: Sequ_def)
+ using Star_Pow apply blast
+ using Pow_Star by blast
+
+lemma
+ "L (der c (UPNTIMES r n)) =
+ L(if n = 0 then ZERO else
+ ALT (der c r) (SEQ (der c r) (UPNTIMES r (n - 1))))"
+ apply(auto simp add: Sequ_def)
+ using SpecExt.Pow_empty by blast
+
+abbreviation "FROM \<equiv> FROMNTIMES"
+
+lemma
+ shows "L (der c (FROM r n)) =
+ L (if n <= 0 then SEQ (der c r) (ALT ONE (FROM r 0))
+ else SEQ (der c r) (ALT ZERO (FROM r (n -1))))"
+ apply(auto simp add: Sequ_def)
+ oops
+
+
+fun
+ ders :: "string \<Rightarrow> rexp \<Rightarrow> rexp"
+where
+ "ders [] r = r"
+| "ders (c # s) r = ders s (der c r)"
+
+
+lemma nullable_correctness:
+ shows "nullable r \<longleftrightarrow> [] \<in> (L r)"
+by(induct r) (auto simp add: Sequ_def)
+
+
+lemma der_correctness:
+ shows "L (der c r) = Der c (L r)"
+apply(induct r)
+apply(simp add: nullable_correctness del: Der_UNION)
+apply(simp add: nullable_correctness del: Der_UNION)
+apply(simp add: nullable_correctness del: Der_UNION)
+apply(simp add: nullable_correctness del: Der_UNION)
+apply(simp add: nullable_correctness del: Der_UNION)
+apply(simp add: nullable_correctness del: Der_UNION)
+ prefer 2
+ apply(simp only: der.simps)
+ apply(case_tac "x2 = 0")
+ apply(simp)
+ apply(simp del: Der_Sequ L.simps)
+ apply(subst L.simps)
+ apply(subst (2) L.simps)
+ thm Der_UNION
+
+apply(simp add: nullable_correctness del: Der_UNION)
+apply(simp add: nullable_correctness del: Der_UNION)
+apply(rule impI)
+apply(subst Sequ_Union_in)
+apply(subst Der_Pow_Sequ[symmetric])
+apply(subst Pow.simps[symmetric])
+apply(subst Der_UNION[symmetric])
+apply(subst Pow_Sequ_Un)
+apply(simp)
+apply(simp only: Der_union Der_empty)
+ apply(simp)
+(* FROMNTIMES *)
+ apply(simp add: nullable_correctness del: Der_UNION)
+ apply(rule conjI)
+prefer 2
+apply(subst Sequ_Union_in)
+apply(subst Der_Pow_Sequ[symmetric])
+apply(subst Pow.simps[symmetric])
+apply(case_tac x2)
+prefer 2
+apply(subst Pow_Sequ_Un2)
+apply(simp)
+apply(simp)
+ apply(auto simp add: Sequ_def Der_def)[1]
+ apply(auto simp add: Sequ_def split: if_splits)[1]
+ using Star_Pow apply fastforce
+ using Pow_Star apply blast
+(* NMTIMES *)
+apply(simp add: nullable_correctness del: Der_UNION)
+apply(rule impI)
+apply(rule conjI)
+apply(rule impI)
+apply(subst Sequ_Union_in)
+apply(subst Der_Pow_Sequ[symmetric])
+apply(subst Pow.simps[symmetric])
+apply(subst Der_UNION[symmetric])
+apply(case_tac x3a)
+apply(simp)
+apply(clarify)
+apply(auto simp add: Sequ_def Der_def Cons_eq_append_conv)[1]
+apply(rule_tac x="Suc xa" in bexI)
+apply(auto simp add: Sequ_def)[2]
+apply (metis append_Cons)
+apply (metis (no_types, hide_lams) Pow_decomp atMost_iff diff_Suc_eq_diff_pred diff_is_0_eq)
+apply(rule impI)+
+apply(subst Sequ_Union_in)
+apply(subst Der_Pow_Sequ[symmetric])
+apply(subst Pow.simps[symmetric])
+apply(subst Der_UNION[symmetric])
+apply(case_tac x2)
+apply(simp)
+apply(simp del: Pow.simps)
+apply(auto simp add: Sequ_def Der_def)
+apply (metis One_nat_def Suc_le_D Suc_le_mono atLeastAtMost_iff diff_Suc_1 not_le)
+by fastforce
+
+
+
+lemma ders_correctness:
+ shows "L (ders s r) = Ders s (L r)"
+by (induct s arbitrary: r)
+ (simp_all add: Ders_def der_correctness Der_def)
+
+
+section {* Values *}
+
+datatype val =
+ Void
+| Char char
+| Seq val val
+| Right val
+| Left val
+| Stars "val list"
+
+
+section {* The string behind a value *}
+
+fun
+ flat :: "val \<Rightarrow> string"
+where
+ "flat (Void) = []"
+| "flat (Char c) = [c]"
+| "flat (Left v) = flat v"
+| "flat (Right v) = flat v"
+| "flat (Seq v1 v2) = (flat v1) @ (flat v2)"
+| "flat (Stars []) = []"
+| "flat (Stars (v#vs)) = (flat v) @ (flat (Stars vs))"
+
+abbreviation
+ "flats vs \<equiv> concat (map flat vs)"
+
+lemma flat_Stars [simp]:
+ "flat (Stars vs) = flats vs"
+by (induct vs) (auto)
+
+lemma Star_concat:
+ assumes "\<forall>s \<in> set ss. s \<in> A"
+ shows "concat ss \<in> A\<star>"
+using assms by (induct ss) (auto)
+
+lemma Star_cstring:
+ assumes "s \<in> A\<star>"
+ shows "\<exists>ss. concat ss = s \<and> (\<forall>s \<in> set ss. s \<in> A \<and> s \<noteq> [])"
+using assms
+apply(induct rule: Star.induct)
+apply(auto)[1]
+apply(rule_tac x="[]" in exI)
+apply(simp)
+apply(erule exE)
+apply(clarify)
+apply(case_tac "s1 = []")
+apply(rule_tac x="ss" in exI)
+apply(simp)
+apply(rule_tac x="s1#ss" in exI)
+apply(simp)
+done
+
+lemma Aux:
+ assumes "\<forall>s\<in>set ss. s = []"
+ shows "concat ss = []"
+using assms
+by (induct ss) (auto)
+
+lemma Pow_cstring_nonempty:
+ assumes "s \<in> A \<up> n"
+ shows "\<exists>ss. concat ss = s \<and> length ss \<le> n \<and> (\<forall>s \<in> set ss. s \<in> A \<and> s \<noteq> [])"
+using assms
+apply(induct n arbitrary: s)
+apply(auto)
+apply(simp add: Sequ_def)
+apply(erule exE)+
+apply(clarify)
+apply(drule_tac x="s2" in meta_spec)
+apply(simp)
+apply(clarify)
+apply(case_tac "s1 = []")
+apply(simp)
+apply(rule_tac x="ss" in exI)
+apply(simp)
+apply(rule_tac x="s1 # ss" in exI)
+apply(simp)
+done
+
+lemma Pow_cstring:
+ assumes "s \<in> A \<up> n"
+ shows "\<exists>ss1 ss2. concat (ss1 @ ss2) = s \<and> length (ss1 @ ss2) = n \<and>
+ (\<forall>s \<in> set ss1. s \<in> A \<and> s \<noteq> []) \<and> (\<forall>s \<in> set ss2. s \<in> A \<and> s = [])"
+using assms
+apply(induct n arbitrary: s)
+apply(auto)[1]
+apply(simp only: Pow_Suc_rev)
+apply(simp add: Sequ_def)
+apply(erule exE)+
+apply(clarify)
+apply(drule_tac x="s1" in meta_spec)
+apply(simp)
+apply(erule exE)+
+apply(clarify)
+apply(case_tac "s2 = []")
+apply(simp)
+apply(rule_tac x="ss1" in exI)
+apply(rule_tac x="s2#ss2" in exI)
+apply(simp)
+apply(rule_tac x="ss1 @ [s2]" in exI)
+apply(rule_tac x="ss2" in exI)
+apply(simp)
+apply(subst Aux)
+apply(auto)[1]
+apply(subst Aux)
+apply(auto)[1]
+apply(simp)
+done
+
+
+section {* Lexical Values *}
+
+
+
+inductive
+ Prf :: "val \<Rightarrow> rexp \<Rightarrow> bool" ("\<Turnstile> _ : _" [100, 100] 100)
+where
+ "\<lbrakk>\<Turnstile> v1 : r1; \<Turnstile> v2 : r2\<rbrakk> \<Longrightarrow> \<Turnstile> Seq v1 v2 : SEQ r1 r2"
+| "\<Turnstile> v1 : r1 \<Longrightarrow> \<Turnstile> Left v1 : ALT r1 r2"
+| "\<Turnstile> v2 : r2 \<Longrightarrow> \<Turnstile> Right v2 : ALT r1 r2"
+| "\<Turnstile> Void : ONE"
+| "\<Turnstile> Char c : CHAR c"
+| "\<lbrakk>\<forall>v \<in> set vs. \<Turnstile> v : r \<and> flat v \<noteq> []\<rbrakk> \<Longrightarrow> \<Turnstile> Stars vs : STAR r"
+| "\<lbrakk>\<forall>v \<in> set vs. \<Turnstile> v : r \<and> flat v \<noteq> []; length vs \<le> n\<rbrakk> \<Longrightarrow> \<Turnstile> Stars vs : UPNTIMES r n"
+| "\<lbrakk>\<forall>v \<in> set vs1. \<Turnstile> v : r \<and> flat v \<noteq> [];
+ \<forall>v \<in> set vs2. \<Turnstile> v : r \<and> flat v = [];
+ length (vs1 @ vs2) = n\<rbrakk> \<Longrightarrow> \<Turnstile> Stars (vs1 @ vs2) : NTIMES r n"
+| "\<lbrakk>\<forall>v \<in> set vs1. \<Turnstile> v : r \<and> flat v \<noteq> [];
+ \<forall>v \<in> set vs2. \<Turnstile> v : r \<and> flat v = [];
+ length (vs1 @ vs2) = n\<rbrakk> \<Longrightarrow> \<Turnstile> Stars (vs1 @ vs2) : FROMNTIMES r n"
+| "\<lbrakk>\<forall>v \<in> set vs. \<Turnstile> v : r \<and> flat v \<noteq> []; length vs > n\<rbrakk> \<Longrightarrow> \<Turnstile> Stars vs : FROMNTIMES r n"
+| "\<lbrakk>\<forall>v \<in> set vs1. \<Turnstile> v : r \<and> flat v \<noteq> [];
+ \<forall>v \<in> set vs2. \<Turnstile> v : r \<and> flat v = [];
+ length (vs1 @ vs2) = n; length (vs1 @ vs2) \<le> m\<rbrakk> \<Longrightarrow> \<Turnstile> Stars (vs1 @ vs2) : NMTIMES r n m"
+| "\<lbrakk>\<forall>v \<in> set vs. \<Turnstile> v : r \<and> flat v \<noteq> [];
+ length vs > n; length vs \<le> m\<rbrakk> \<Longrightarrow> \<Turnstile> Stars vs : NMTIMES r n m"
+
+
+
+
+
+inductive_cases Prf_elims:
+ "\<Turnstile> v : ZERO"
+ "\<Turnstile> v : SEQ r1 r2"
+ "\<Turnstile> v : ALT r1 r2"
+ "\<Turnstile> v : ONE"
+ "\<Turnstile> v : CHAR c"
+ "\<Turnstile> vs : STAR r"
+ "\<Turnstile> vs : UPNTIMES r n"
+ "\<Turnstile> vs : NTIMES r n"
+ "\<Turnstile> vs : FROMNTIMES r n"
+ "\<Turnstile> vs : NMTIMES r n m"
+
+lemma Prf_Stars_appendE:
+ assumes "\<Turnstile> Stars (vs1 @ vs2) : STAR r"
+ shows "\<Turnstile> Stars vs1 : STAR r \<and> \<Turnstile> Stars vs2 : STAR r"
+using assms
+by (auto intro: Prf.intros elim!: Prf_elims)
+
+
+
+lemma flats_empty:
+ assumes "(\<forall>v\<in>set vs. flat v = [])"
+ shows "flats vs = []"
+using assms
+by(induct vs) (simp_all)
+
+lemma Star_cval:
+ assumes "\<forall>s\<in>set ss. \<exists>v. s = flat v \<and> \<Turnstile> v : r"
+ shows "\<exists>vs. flats vs = concat ss \<and> (\<forall>v\<in>set vs. \<Turnstile> v : r \<and> flat v \<noteq> [])"
+using assms
+apply(induct ss)
+apply(auto)
+apply(rule_tac x="[]" in exI)
+apply(simp)
+apply(case_tac "flat v = []")
+apply(rule_tac x="vs" in exI)
+apply(simp)
+apply(rule_tac x="v#vs" in exI)
+apply(simp)
+done
+
+
+lemma flats_cval:
+ assumes "\<forall>s\<in>set ss. \<exists>v. s = flat v \<and> \<Turnstile> v : r"
+ shows "\<exists>vs1 vs2. flats (vs1 @ vs2) = concat ss \<and> length (vs1 @ vs2) = length ss \<and>
+ (\<forall>v\<in>set vs1. \<Turnstile> v : r \<and> flat v \<noteq> []) \<and>
+ (\<forall>v\<in>set vs2. \<Turnstile> v : r \<and> flat v = [])"
+using assms
+apply(induct ss rule: rev_induct)
+apply(rule_tac x="[]" in exI)+
+apply(simp)
+apply(simp)
+apply(clarify)
+apply(case_tac "flat v = []")
+apply(rule_tac x="vs1" in exI)
+apply(rule_tac x="v#vs2" in exI)
+apply(simp)
+apply(rule_tac x="vs1 @ [v]" in exI)
+apply(rule_tac x="vs2" in exI)
+apply(simp)
+apply(subst (asm) (2) flats_empty)
+apply(simp)
+apply(simp)
+done
+
+lemma flats_cval_nonempty:
+ assumes "\<forall>s\<in>set ss. \<exists>v. s = flat v \<and> \<Turnstile> v : r"
+ shows "\<exists>vs. flats vs = concat ss \<and> length vs \<le> length ss \<and>
+ (\<forall>v\<in>set vs. \<Turnstile> v : r \<and> flat v \<noteq> [])"
+using assms
+apply(induct ss)
+apply(rule_tac x="[]" in exI)
+apply(simp)
+apply(simp)
+apply(clarify)
+apply(case_tac "flat v = []")
+apply(rule_tac x="vs" in exI)
+apply(simp)
+apply(rule_tac x="v # vs" in exI)
+apply(simp)
+done
+
+lemma Pow_flats:
+ assumes "\<forall>v \<in> set vs. flat v \<in> A"
+ shows "flats vs \<in> A \<up> length vs"
+using assms
+by(induct vs)(auto simp add: Sequ_def)
+
+lemma Pow_flats_appends:
+ assumes "\<forall>v \<in> set vs1. flat v \<in> A" "\<forall>v \<in> set vs2. flat v \<in> A"
+ shows "flats vs1 @ flats vs2 \<in> A \<up> (length vs1 + length vs2)"
+using assms
+apply(induct vs1)
+apply(auto simp add: Sequ_def Pow_flats)
+done
+
+lemma L_flat_Prf1:
+ assumes "\<Turnstile> v : r"
+ shows "flat v \<in> L r"
+using assms
+apply(induct)
+apply(auto simp add: Sequ_def Star_concat Pow_flats)
+apply(meson Pow_flats atMost_iff)
+using Pow_flats_appends apply blast
+using Pow_flats_appends apply blast
+apply (meson Pow_flats atLeast_iff less_imp_le)
+apply(rule_tac x="length vs1 + length vs2" in bexI)
+apply(meson Pow_flats_appends atLeastAtMost_iff)
+apply(simp)
+apply(meson Pow_flats atLeastAtMost_iff less_or_eq_imp_le)
+done
+
+lemma L_flat_Prf2:
+ assumes "s \<in> L r"
+ shows "\<exists>v. \<Turnstile> v : r \<and> flat v = s"
+using assms
+proof(induct r arbitrary: s)
+ case (STAR r s)
+ have IH: "\<And>s. s \<in> L r \<Longrightarrow> \<exists>v. \<Turnstile> v : r \<and> flat v = s" by fact
+ have "s \<in> L (STAR r)" by fact
+ then obtain ss where "concat ss = s" "\<forall>s \<in> set ss. s \<in> L r \<and> s \<noteq> []"
+ using Star_cstring by auto
+ then obtain vs where "flats vs = s" "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> flat v \<noteq> []"
+ using IH Star_cval by metis
+ then show "\<exists>v. \<Turnstile> v : STAR r \<and> flat v = s"
+ using Prf.intros(6) flat_Stars by blast
+next
+ case (SEQ r1 r2 s)
+ then show "\<exists>v. \<Turnstile> v : SEQ r1 r2 \<and> flat v = s"
+ unfolding Sequ_def L.simps by (fastforce intro: Prf.intros)
+next
+ case (ALT r1 r2 s)
+ then show "\<exists>v. \<Turnstile> v : ALT r1 r2 \<and> flat v = s"
+ unfolding L.simps by (fastforce intro: Prf.intros)
+next
+ case (NTIMES r n)
+ have IH: "\<And>s. s \<in> L r \<Longrightarrow> \<exists>v. \<Turnstile> v : r \<and> flat v = s" by fact
+ have "s \<in> L (NTIMES r n)" by fact
+ then obtain ss1 ss2 where "concat (ss1 @ ss2) = s" "length (ss1 @ ss2) = n"
+ "\<forall>s \<in> set ss1. s \<in> L r \<and> s \<noteq> []" "\<forall>s \<in> set ss2. s \<in> L r \<and> s = []"
+ using Pow_cstring by force
+ then obtain vs1 vs2 where "flats (vs1 @ vs2) = s" "length (vs1 @ vs2) = n"
+ "\<forall>v\<in>set vs1. \<Turnstile> v : r \<and> flat v \<noteq> []" "\<forall>v\<in>set vs2. \<Turnstile> v : r \<and> flat v = []"
+ using IH flats_cval
+ apply -
+ apply(drule_tac x="ss1 @ ss2" in meta_spec)
+ apply(drule_tac x="r" in meta_spec)
+ apply(drule meta_mp)
+ apply(simp)
+ apply (metis Un_iff)
+ apply(clarify)
+ apply(drule_tac x="vs1" in meta_spec)
+ apply(drule_tac x="vs2" in meta_spec)
+ apply(simp)
+ done
+ then show "\<exists>v. \<Turnstile> v : NTIMES r n \<and> flat v = s"
+ using Prf.intros(8) flat_Stars by blast
+next
+ case (FROMNTIMES r n)
+ have IH: "\<And>s. s \<in> L r \<Longrightarrow> \<exists>v. \<Turnstile> v : r \<and> flat v = s" by fact
+ have "s \<in> L (FROMNTIMES r n)" by fact
+ then obtain ss1 ss2 k where "concat (ss1 @ ss2) = s" "length (ss1 @ ss2) = k" "n \<le> k"
+ "\<forall>s \<in> set ss1. s \<in> L r \<and> s \<noteq> []" "\<forall>s \<in> set ss2. s \<in> L r \<and> s = []"
+ using Pow_cstring by force
+ then obtain vs1 vs2 where "flats (vs1 @ vs2) = s" "length (vs1 @ vs2) = k" "n \<le> k"
+ "\<forall>v\<in>set vs1. \<Turnstile> v : r \<and> flat v \<noteq> []" "\<forall>v\<in>set vs2. \<Turnstile> v : r \<and> flat v = []"
+ using IH flats_cval
+ apply -
+ apply(drule_tac x="ss1 @ ss2" in meta_spec)
+ apply(drule_tac x="r" in meta_spec)
+ apply(drule meta_mp)
+ apply(simp)
+ apply (metis Un_iff)
+ apply(clarify)
+ apply(drule_tac x="vs1" in meta_spec)
+ apply(drule_tac x="vs2" in meta_spec)
+ apply(simp)
+ done
+ then show "\<exists>v. \<Turnstile> v : FROMNTIMES r n \<and> flat v = s"
+ apply(case_tac "length vs1 \<le> n")
+ apply(rule_tac x="Stars (vs1 @ take (n - length vs1) vs2)" in exI)
+ apply(simp)
+ apply(subgoal_tac "flats (take (n - length vs1) vs2) = []")
+ prefer 2
+ apply (meson flats_empty in_set_takeD)
+ apply(clarify)
+ apply(rule conjI)
+ apply(rule Prf.intros)
+ apply(simp)
+ apply (meson in_set_takeD)
+ apply(simp)
+ apply(simp)
+ apply (simp add: flats_empty)
+ apply(rule_tac x="Stars vs1" in exI)
+ apply(simp)
+ apply(rule conjI)
+ apply(rule Prf.intros(10))
+ apply(auto)
+ done
+next
+ case (NMTIMES r n m)
+ have IH: "\<And>s. s \<in> L r \<Longrightarrow> \<exists>v. \<Turnstile> v : r \<and> flat v = s" by fact
+ have "s \<in> L (NMTIMES r n m)" by fact
+ then obtain ss1 ss2 k where "concat (ss1 @ ss2) = s" "length (ss1 @ ss2) = k" "n \<le> k" "k \<le> m"
+ "\<forall>s \<in> set ss1. s \<in> L r \<and> s \<noteq> []" "\<forall>s \<in> set ss2. s \<in> L r \<and> s = []"
+ using Pow_cstring by (auto, blast)
+ then obtain vs1 vs2 where "flats (vs1 @ vs2) = s" "length (vs1 @ vs2) = k" "n \<le> k" "k \<le> m"
+ "\<forall>v\<in>set vs1. \<Turnstile> v : r \<and> flat v \<noteq> []" "\<forall>v\<in>set vs2. \<Turnstile> v : r \<and> flat v = []"
+ using IH flats_cval
+ apply -
+ apply(drule_tac x="ss1 @ ss2" in meta_spec)
+ apply(drule_tac x="r" in meta_spec)
+ apply(drule meta_mp)
+ apply(simp)
+ apply (metis Un_iff)
+ apply(clarify)
+ apply(drule_tac x="vs1" in meta_spec)
+ apply(drule_tac x="vs2" in meta_spec)
+ apply(simp)
+ done
+ then show "\<exists>v. \<Turnstile> v : NMTIMES r n m \<and> flat v = s"
+ apply(case_tac "length vs1 \<le> n")
+ apply(rule_tac x="Stars (vs1 @ take (n - length vs1) vs2)" in exI)
+ apply(simp)
+ apply(subgoal_tac "flats (take (n - length vs1) vs2) = []")
+ prefer 2
+ apply (meson flats_empty in_set_takeD)
+ apply(clarify)
+ apply(rule conjI)
+ apply(rule Prf.intros)
+ apply(simp)
+ apply (meson in_set_takeD)
+ apply(simp)
+ apply(simp)
+ apply (simp add: flats_empty)
+ apply(rule_tac x="Stars vs1" in exI)
+ apply(simp)
+ apply(rule conjI)
+ apply(rule Prf.intros)
+ apply(auto)
+ done
+next
+ case (UPNTIMES r n s)
+ have IH: "\<And>s. s \<in> L r \<Longrightarrow> \<exists>v. \<Turnstile> v : r \<and> flat v = s" by fact
+ have "s \<in> L (UPNTIMES r n)" by fact
+ then obtain ss where "concat ss = s" "\<forall>s \<in> set ss. s \<in> L r \<and> s \<noteq> []" "length ss \<le> n"
+ using Pow_cstring_nonempty by force
+ then obtain vs where "flats vs = s" "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> flat v \<noteq> []" "length vs \<le> n"
+ using IH flats_cval_nonempty by (smt order.trans)
+ then show "\<exists>v. \<Turnstile> v : UPNTIMES r n \<and> flat v = s"
+ using Prf.intros(7) flat_Stars by blast
+qed (auto intro: Prf.intros)
+
+
+lemma L_flat_Prf:
+ shows "L(r) = {flat v | v. \<Turnstile> v : r}"
+using L_flat_Prf1 L_flat_Prf2 by blast
+
+thm Prf.intros
+thm Prf.cases
+
+lemma
+ assumes "\<Turnstile> v : (STAR r)"
+ shows "\<Turnstile> v : (FROMNTIMES r 0)"
+ using assms
+ apply(erule_tac Prf.cases)
+ apply(simp_all)
+ apply(case_tac vs)
+ apply(auto)
+ apply(subst append_Nil[symmetric])
+ apply(rule Prf.intros)
+ apply(auto)
+ apply(simp add: Prf.intros)
+ done
+
+lemma
+ assumes "\<Turnstile> v : (FROMNTIMES r 0)"
+ shows "\<Turnstile> v : (STAR r)"
+ using assms
+ apply(erule_tac Prf.cases)
+ apply(simp_all)
+ apply(rule Prf.intros)
+ apply(simp)
+ apply(rule Prf.intros)
+ apply(simp)
+ done
+
+section {* Sets of Lexical Values *}
+
+text {*
+ Shows that lexical values are finite for a given regex and string.
+*}
+
+definition
+ LV :: "rexp \<Rightarrow> string \<Rightarrow> val set"
+where "LV r s \<equiv> {v. \<Turnstile> v : r \<and> flat v = s}"
+
+lemma LV_simps:
+ shows "LV ZERO s = {}"
+ and "LV ONE s = (if s = [] then {Void} else {})"
+ and "LV (CHAR c) s = (if s = [c] then {Char c} else {})"
+ and "LV (ALT r1 r2) s = Left ` LV r1 s \<union> Right ` LV r2 s"
+unfolding LV_def
+apply(auto intro: Prf.intros elim: Prf.cases)
+done
+
+abbreviation
+ "Prefixes s \<equiv> {s'. prefix s' s}"
+
+abbreviation
+ "Suffixes s \<equiv> {s'. suffix s' s}"
+
+abbreviation
+ "SSuffixes s \<equiv> {s'. strict_suffix s' s}"
+
+lemma Suffixes_cons [simp]:
+ shows "Suffixes (c # s) = Suffixes s \<union> {c # s}"
+by (auto simp add: suffix_def Cons_eq_append_conv)
+
+
+lemma finite_Suffixes:
+ shows "finite (Suffixes s)"
+by (induct s) (simp_all)
+
+lemma finite_SSuffixes:
+ shows "finite (SSuffixes s)"
+proof -
+ have "SSuffixes s \<subseteq> Suffixes s"
+ unfolding suffix_def strict_suffix_def by auto
+ then show "finite (SSuffixes s)"
+ using finite_Suffixes finite_subset by blast
+qed
+
+lemma finite_Prefixes:
+ shows "finite (Prefixes s)"
+proof -
+ have "finite (Suffixes (rev s))"
+ by (rule finite_Suffixes)
+ then have "finite (rev ` Suffixes (rev s))" by simp
+ moreover
+ have "rev ` (Suffixes (rev s)) = Prefixes s"
+ unfolding suffix_def prefix_def image_def
+ by (auto)(metis rev_append rev_rev_ident)+
+ ultimately show "finite (Prefixes s)" by simp
+qed
+
+definition
+ "Stars_Cons V Vs \<equiv> {Stars (v # vs) | v vs. v \<in> V \<and> Stars vs \<in> Vs}"
+
+definition
+ "Stars_Append Vs1 Vs2 \<equiv> {Stars (vs1 @ vs2) | vs1 vs2. Stars vs1 \<in> Vs1 \<and> Stars vs2 \<in> Vs2}"
+
+fun Stars_Pow :: "val set \<Rightarrow> nat \<Rightarrow> val set"
+where
+ "Stars_Pow Vs 0 = {Stars []}"
+| "Stars_Pow Vs (Suc n) = Stars_Cons Vs (Stars_Pow Vs n)"
+
+lemma finite_Stars_Cons:
+ assumes "finite V" "finite Vs"
+ shows "finite (Stars_Cons V Vs)"
+ using assms
+proof -
+ from assms(2) have "finite (Stars -` Vs)"
+ by(simp add: finite_vimageI inj_on_def)
+ with assms(1) have "finite (V \<times> (Stars -` Vs))"
+ by(simp)
+ then have "finite ((\<lambda>(v, vs). Stars (v # vs)) ` (V \<times> (Stars -` Vs)))"
+ by simp
+ moreover have "Stars_Cons V Vs = (\<lambda>(v, vs). Stars (v # vs)) ` (V \<times> (Stars -` Vs))"
+ unfolding Stars_Cons_def by auto
+ ultimately show "finite (Stars_Cons V Vs)"
+ by simp
+qed
+
+lemma finite_Stars_Append:
+ assumes "finite Vs1" "finite Vs2"
+ shows "finite (Stars_Append Vs1 Vs2)"
+ using assms
+proof -
+ define UVs1 where "UVs1 \<equiv> Stars -` Vs1"
+ define UVs2 where "UVs2 \<equiv> Stars -` Vs2"
+ from assms have "finite UVs1" "finite UVs2"
+ unfolding UVs1_def UVs2_def
+ by(simp_all add: finite_vimageI inj_on_def)
+ then have "finite ((\<lambda>(vs1, vs2). Stars (vs1 @ vs2)) ` (UVs1 \<times> UVs2))"
+ by simp
+ moreover
+ have "Stars_Append Vs1 Vs2 = (\<lambda>(vs1, vs2). Stars (vs1 @ vs2)) ` (UVs1 \<times> UVs2)"
+ unfolding Stars_Append_def UVs1_def UVs2_def by auto
+ ultimately show "finite (Stars_Append Vs1 Vs2)"
+ by simp
+qed
+
+lemma finite_Stars_Pow:
+ assumes "finite Vs"
+ shows "finite (Stars_Pow Vs n)"
+by (induct n) (simp_all add: finite_Stars_Cons assms)
+
+lemma LV_STAR_finite:
+ assumes "\<forall>s. finite (LV r s)"
+ shows "finite (LV (STAR r) s)"
+proof(induct s rule: length_induct)
+ fix s::"char list"
+ assume "\<forall>s'. length s' < length s \<longrightarrow> finite (LV (STAR r) s')"
+ then have IH: "\<forall>s' \<in> SSuffixes s. finite (LV (STAR r) s')"
+ apply(auto simp add: strict_suffix_def suffix_def)
+ by force
+ define f where "f \<equiv> \<lambda>(v, vs). Stars (v # vs)"
+ define S1 where "S1 \<equiv> \<Union>s' \<in> Prefixes s. LV r s'"
+ define S2 where "S2 \<equiv> \<Union>s2 \<in> SSuffixes s. LV (STAR r) s2"
+ have "finite S1" using assms
+ unfolding S1_def by (simp_all add: finite_Prefixes)
+ moreover
+ with IH have "finite S2" unfolding S2_def
+ by (auto simp add: finite_SSuffixes)
+ ultimately
+ have "finite ({Stars []} \<union> Stars_Cons S1 S2)"
+ by (simp add: finite_Stars_Cons)
+ moreover
+ have "LV (STAR r) s \<subseteq> {Stars []} \<union> (Stars_Cons S1 S2)"
+ unfolding S1_def S2_def f_def LV_def Stars_Cons_def
+ unfolding prefix_def strict_suffix_def
+ unfolding image_def
+ apply(auto)
+ apply(case_tac x)
+ apply(auto elim: Prf_elims)
+ apply(erule Prf_elims)
+ apply(auto)
+ apply(case_tac vs)
+ apply(auto intro: Prf.intros)
+ apply(rule exI)
+ apply(rule conjI)
+ apply(rule_tac x="flats list" in exI)
+ apply(rule conjI)
+ apply(simp add: suffix_def)
+ apply(blast)
+ using Prf.intros(6) flat_Stars by blast
+ ultimately
+ show "finite (LV (STAR r) s)" by (simp add: finite_subset)
+qed
+
+lemma LV_UPNTIMES_STAR:
+ "LV (UPNTIMES r n) s \<subseteq> LV (STAR r) s"
+by(auto simp add: LV_def intro: Prf.intros elim: Prf_elims)
+
+lemma LV_NTIMES_3:
+ shows "LV (NTIMES r (Suc n)) [] = (\<lambda>(v,vs). Stars (v#vs)) ` (LV r [] \<times> (Stars -` (LV (NTIMES r n) [])))"
+unfolding LV_def
+apply(auto elim!: Prf_elims simp add: image_def)
+apply(case_tac vs1)
+apply(auto)
+apply(case_tac vs2)
+apply(auto)
+apply(subst append.simps(1)[symmetric])
+apply(rule Prf.intros)
+apply(auto)
+apply(subst append.simps(1)[symmetric])
+apply(rule Prf.intros)
+apply(auto)
+ done
+
+lemma LV_FROMNTIMES_3:
+ shows "LV (FROMNTIMES r (Suc n)) [] =
+ (\<lambda>(v,vs). Stars (v#vs)) ` (LV r [] \<times> (Stars -` (LV (FROMNTIMES r n) [])))"
+unfolding LV_def
+apply(auto elim!: Prf_elims simp add: image_def)
+apply(case_tac vs1)
+apply(auto)
+apply(case_tac vs2)
+apply(auto)
+apply(subst append.simps(1)[symmetric])
+apply(rule Prf.intros)
+ apply(auto)
+ apply (metis le_imp_less_Suc length_greater_0_conv less_antisym list.exhaust list.set_intros(1) not_less_eq zero_le)
+ prefer 2
+ using nth_mem apply blast
+ apply(case_tac vs1)
+ apply (smt Groups.add_ac(2) Prf.intros(9) add.right_neutral add_Suc_right append.simps(1) insert_iff length_append list.set(2) list.size(3) list.size(4))
+ apply(auto)
+done
+
+lemma LV_NTIMES_4:
+ "LV (NTIMES r n) [] = Stars_Pow (LV r []) n"
+ apply(induct n)
+ apply(simp add: LV_def)
+ apply(auto elim!: Prf_elims simp add: image_def)[1]
+ apply(subst append.simps[symmetric])
+ apply(rule Prf.intros)
+ apply(simp_all)
+ apply(simp add: LV_NTIMES_3 image_def Stars_Cons_def)
+ apply blast
+ done
+
+lemma LV_NTIMES_5:
+ "LV (NTIMES r n) s \<subseteq> Stars_Append (LV (STAR r) s) (\<Union>i\<le>n. LV (NTIMES r i) [])"
+apply(auto simp add: LV_def)
+apply(auto elim!: Prf_elims)
+ apply(auto simp add: Stars_Append_def)
+ apply(rule_tac x="vs1" in exI)
+ apply(rule_tac x="vs2" in exI)
+ apply(auto)
+ using Prf.intros(6) apply(auto)
+ apply(rule_tac x="length vs2" in bexI)
+ thm Prf.intros
+ apply(subst append.simps(1)[symmetric])
+ apply(rule Prf.intros)
+ apply(auto)[1]
+ apply(auto)[1]
+ apply(simp)
+ apply(simp)
+ done
+
+lemma ttty:
+ "LV (FROMNTIMES r n) [] = Stars_Pow (LV r []) n"
+ apply(induct n)
+ apply(simp add: LV_def)
+ apply(auto elim: Prf_elims simp add: image_def)[1]
+ prefer 2
+ apply(subst append.simps[symmetric])
+ apply(rule Prf.intros)
+ apply(simp_all)
+ apply(erule Prf_elims)
+ apply(case_tac vs1)
+ apply(simp)
+ apply(simp)
+ apply(case_tac x)
+ apply(simp_all)
+ apply(simp add: LV_FROMNTIMES_3 image_def Stars_Cons_def)
+ apply blast
+ done
+
+lemma LV_FROMNTIMES_5:
+ "LV (FROMNTIMES r n) s \<subseteq> Stars_Append (LV (STAR r) s) (\<Union>i\<le>n. LV (FROMNTIMES r i) [])"
+apply(auto simp add: LV_def)
+apply(auto elim!: Prf_elims)
+ apply(auto simp add: Stars_Append_def)
+ apply(rule_tac x="vs1" in exI)
+ apply(rule_tac x="vs2" in exI)
+ apply(auto)
+ using Prf.intros(6) apply(auto)
+ apply(rule_tac x="length vs2" in bexI)
+ thm Prf.intros
+ apply(subst append.simps(1)[symmetric])
+ apply(rule Prf.intros)
+ apply(auto)[1]
+ apply(auto)[1]
+ apply(simp)
+ apply(simp)
+ apply(rule_tac x="vs" in exI)
+ apply(rule_tac x="[]" in exI)
+ apply(auto)
+ by (metis Prf.intros(9) append_Nil atMost_iff empty_iff le_imp_less_Suc less_antisym list.set(1) nth_mem zero_le)
+
+lemma LV_FROMNTIMES_6:
+ assumes "\<forall>s. finite (LV r s)"
+ shows "finite (LV (FROMNTIMES r n) s)"
+ apply(rule finite_subset)
+ apply(rule LV_FROMNTIMES_5)
+ apply(rule finite_Stars_Append)
+ apply(rule LV_STAR_finite)
+ apply(rule assms)
+ apply(rule finite_UN_I)
+ apply(auto)
+ by (simp add: assms finite_Stars_Pow ttty)
+
+lemma LV_NMTIMES_5:
+ "LV (NMTIMES r n m) s \<subseteq> Stars_Append (LV (STAR r) s) (\<Union>i\<le>n. LV (FROMNTIMES r i) [])"
+apply(auto simp add: LV_def)
+apply(auto elim!: Prf_elims)
+ apply(auto simp add: Stars_Append_def)
+ apply(rule_tac x="vs1" in exI)
+ apply(rule_tac x="vs2" in exI)
+ apply(auto)
+ using Prf.intros(6) apply(auto)
+ apply(rule_tac x="length vs2" in bexI)
+ thm Prf.intros
+ apply(subst append.simps(1)[symmetric])
+ apply(rule Prf.intros)
+ apply(auto)[1]
+ apply(auto)[1]
+ apply(simp)
+ apply(simp)
+ apply(rule_tac x="vs" in exI)
+ apply(rule_tac x="[]" in exI)
+ apply(auto)
+ by (metis Prf.intros(9) append_Nil atMost_iff empty_iff le_imp_less_Suc less_antisym list.set(1) nth_mem zero_le)
+
+lemma LV_NMTIMES_6:
+ assumes "\<forall>s. finite (LV r s)"
+ shows "finite (LV (NMTIMES r n m) s)"
+ apply(rule finite_subset)
+ apply(rule LV_NMTIMES_5)
+ apply(rule finite_Stars_Append)
+ apply(rule LV_STAR_finite)
+ apply(rule assms)
+ apply(rule finite_UN_I)
+ apply(auto)
+ by (simp add: assms finite_Stars_Pow ttty)
+
+
+lemma LV_finite:
+ shows "finite (LV r s)"
+proof(induct r arbitrary: s)
+ case (ZERO s)
+ show "finite (LV ZERO s)" by (simp add: LV_simps)
+next
+ case (ONE s)
+ show "finite (LV ONE s)" by (simp add: LV_simps)
+next
+ case (CHAR c s)
+ show "finite (LV (CHAR c) s)" by (simp add: LV_simps)
+next
+ case (ALT r1 r2 s)
+ then show "finite (LV (ALT r1 r2) s)" by (simp add: LV_simps)
+next
+ case (SEQ r1 r2 s)
+ define f where "f \<equiv> \<lambda>(v1, v2). Seq v1 v2"
+ define S1 where "S1 \<equiv> \<Union>s' \<in> Prefixes s. LV r1 s'"
+ define S2 where "S2 \<equiv> \<Union>s' \<in> Suffixes s. LV r2 s'"
+ have IHs: "\<And>s. finite (LV r1 s)" "\<And>s. finite (LV r2 s)" by fact+
+ then have "finite S1" "finite S2" unfolding S1_def S2_def
+ by (simp_all add: finite_Prefixes finite_Suffixes)
+ moreover
+ have "LV (SEQ r1 r2) s \<subseteq> f ` (S1 \<times> S2)"
+ unfolding f_def S1_def S2_def
+ unfolding LV_def image_def prefix_def suffix_def
+ apply (auto elim!: Prf_elims)
+ by (metis (mono_tags, lifting) mem_Collect_eq)
+ ultimately
+ show "finite (LV (SEQ r1 r2) s)"
+ by (simp add: finite_subset)
+next
+ case (STAR r s)
+ then show "finite (LV (STAR r) s)" by (simp add: LV_STAR_finite)
+next
+ case (UPNTIMES r n s)
+ have "\<And>s. finite (LV r s)" by fact
+ then show "finite (LV (UPNTIMES r n) s)"
+ by (meson LV_STAR_finite LV_UPNTIMES_STAR rev_finite_subset)
+next
+ case (FROMNTIMES r n s)
+ have "\<And>s. finite (LV r s)" by fact
+ then show "finite (LV (FROMNTIMES r n) s)"
+ by (simp add: LV_FROMNTIMES_6)
+next
+ case (NTIMES r n s)
+ have "\<And>s. finite (LV r s)" by fact
+ then show "finite (LV (NTIMES r n) s)"
+ by (metis (no_types, lifting) LV_NTIMES_4 LV_NTIMES_5 LV_STAR_finite finite_Stars_Append finite_Stars_Pow finite_UN_I finite_atMost finite_subset)
+next
+ case (NMTIMES r n m s)
+ have "\<And>s. finite (LV r s)" by fact
+ then show "finite (LV (NMTIMES r n m) s)"
+ by (simp add: LV_NMTIMES_6)
+qed
+
+
+
+section {* Our POSIX Definition *}
+
+inductive
+ Posix :: "string \<Rightarrow> rexp \<Rightarrow> val \<Rightarrow> bool" ("_ \<in> _ \<rightarrow> _" [100, 100, 100] 100)
+where
+ Posix_ONE: "[] \<in> ONE \<rightarrow> Void"
+| Posix_CHAR: "[c] \<in> (CHAR c) \<rightarrow> (Char c)"
+| Posix_ALT1: "s \<in> r1 \<rightarrow> v \<Longrightarrow> s \<in> (ALT r1 r2) \<rightarrow> (Left v)"
+| Posix_ALT2: "\<lbrakk>s \<in> r2 \<rightarrow> v; s \<notin> L(r1)\<rbrakk> \<Longrightarrow> s \<in> (ALT r1 r2) \<rightarrow> (Right v)"
+| Posix_SEQ: "\<lbrakk>s1 \<in> r1 \<rightarrow> v1; s2 \<in> r2 \<rightarrow> v2;
+ \<not>(\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (s1 @ s\<^sub>3) \<in> L r1 \<and> s\<^sub>4 \<in> L r2)\<rbrakk> \<Longrightarrow>
+ (s1 @ s2) \<in> (SEQ r1 r2) \<rightarrow> (Seq v1 v2)"
+| Posix_STAR1: "\<lbrakk>s1 \<in> r \<rightarrow> v; s2 \<in> STAR r \<rightarrow> Stars vs; flat v \<noteq> [];
+ \<not>(\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (s1 @ s\<^sub>3) \<in> L r \<and> s\<^sub>4 \<in> L (STAR r))\<rbrakk>
+ \<Longrightarrow> (s1 @ s2) \<in> STAR r \<rightarrow> Stars (v # vs)"
+| Posix_STAR2: "[] \<in> STAR r \<rightarrow> Stars []"
+| Posix_NTIMES1: "\<lbrakk>s1 \<in> r \<rightarrow> v; s2 \<in> NTIMES r (n - 1) \<rightarrow> Stars vs; flat v \<noteq> []; 0 < n;
+ \<not>(\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (s1 @ s\<^sub>3) \<in> L r \<and> s\<^sub>4 \<in> L (NTIMES r (n - 1)))\<rbrakk>
+ \<Longrightarrow> (s1 @ s2) \<in> NTIMES r n \<rightarrow> Stars (v # vs)"
+| Posix_NTIMES2: "\<lbrakk>\<forall>v \<in> set vs. [] \<in> r \<rightarrow> v; length vs = n\<rbrakk>
+ \<Longrightarrow> [] \<in> NTIMES r n \<rightarrow> Stars vs"
+| Posix_UPNTIMES1: "\<lbrakk>s1 \<in> r \<rightarrow> v; s2 \<in> UPNTIMES r (n - 1) \<rightarrow> Stars vs; flat v \<noteq> []; 0 < n;
+ \<not>(\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (s1 @ s\<^sub>3) \<in> L r \<and> s\<^sub>4 \<in> L (UPNTIMES r (n - 1)))\<rbrakk>
+ \<Longrightarrow> (s1 @ s2) \<in> UPNTIMES r n \<rightarrow> Stars (v # vs)"
+| Posix_UPNTIMES2: "[] \<in> UPNTIMES r n \<rightarrow> Stars []"
+| Posix_FROMNTIMES2: "\<lbrakk>\<forall>v \<in> set vs. [] \<in> r \<rightarrow> v; length vs = n\<rbrakk>
+ \<Longrightarrow> [] \<in> FROMNTIMES r n \<rightarrow> Stars vs"
+| Posix_FROMNTIMES1: "\<lbrakk>s1 \<in> r \<rightarrow> v; s2 \<in> FROMNTIMES r (n - 1) \<rightarrow> Stars vs; flat v \<noteq> []; 0 < n;
+ \<not>(\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (s1 @ s\<^sub>3) \<in> L r \<and> s\<^sub>4 \<in> L (FROMNTIMES r (n - 1)))\<rbrakk>
+ \<Longrightarrow> (s1 @ s2) \<in> FROMNTIMES r n \<rightarrow> Stars (v # vs)"
+| Posix_FROMNTIMES3: "\<lbrakk>s1 \<in> r \<rightarrow> v; s2 \<in> STAR r \<rightarrow> Stars vs; flat v \<noteq> [];
+ \<not>(\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (s1 @ s\<^sub>3) \<in> L r \<and> s\<^sub>4 \<in> L (STAR r))\<rbrakk>
+ \<Longrightarrow> (s1 @ s2) \<in> FROMNTIMES r 0 \<rightarrow> Stars (v # vs)"
+| Posix_NMTIMES2: "\<lbrakk>\<forall>v \<in> set vs. [] \<in> r \<rightarrow> v; length vs = n; n \<le> m\<rbrakk>
+ \<Longrightarrow> [] \<in> NMTIMES r n m \<rightarrow> Stars vs"
+| Posix_NMTIMES1: "\<lbrakk>s1 \<in> r \<rightarrow> v; s2 \<in> NMTIMES r (n - 1) (m - 1) \<rightarrow> Stars vs; flat v \<noteq> []; 0 < n; n \<le> m;
+ \<not>(\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (s1 @ s\<^sub>3) \<in> L r \<and> s\<^sub>4 \<in> L (NMTIMES r (n - 1) (m - 1)))\<rbrakk>
+ \<Longrightarrow> (s1 @ s2) \<in> NMTIMES r n m \<rightarrow> Stars (v # vs)"
+| Posix_NMTIMES3: "\<lbrakk>s1 \<in> r \<rightarrow> v; s2 \<in> UPNTIMES r (m - 1) \<rightarrow> Stars vs; flat v \<noteq> []; 0 < m;
+ \<not>(\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> (s1 @ s\<^sub>3) \<in> L r \<and> s\<^sub>4 \<in> L (UPNTIMES r (m - 1)))\<rbrakk>
+ \<Longrightarrow> (s1 @ s2) \<in> NMTIMES r 0 m \<rightarrow> Stars (v # vs)"
+
+inductive_cases Posix_elims:
+ "s \<in> ZERO \<rightarrow> v"
+ "s \<in> ONE \<rightarrow> v"
+ "s \<in> CHAR c \<rightarrow> v"
+ "s \<in> ALT r1 r2 \<rightarrow> v"
+ "s \<in> SEQ r1 r2 \<rightarrow> v"
+ "s \<in> STAR r \<rightarrow> v"
+ "s \<in> NTIMES r n \<rightarrow> v"
+ "s \<in> UPNTIMES r n \<rightarrow> v"
+ "s \<in> FROMNTIMES r n \<rightarrow> v"
+ "s \<in> NMTIMES r n m \<rightarrow> v"
+
+lemma Posix1:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "s \<in> L r" "flat v = s"
+using assms
+ apply(induct s r v rule: Posix.induct)
+ apply(auto simp add: Sequ_def)[18]
+ apply(case_tac n)
+ apply(simp)
+ apply(simp add: Sequ_def)
+ apply(auto)[1]
+ apply(simp)
+ apply(clarify)
+ apply(rule_tac x="Suc x" in bexI)
+ apply(simp add: Sequ_def)
+ apply(auto)[5]
+ using nth_mem nullable.simps(9) nullable_correctness apply auto[1]
+ apply simp
+ apply(simp)
+ apply(clarify)
+ apply(rule_tac x="Suc x" in bexI)
+ apply(simp add: Sequ_def)
+ apply(auto)[3]
+ defer
+ apply(simp)
+ apply fastforce
+ apply(simp)
+ apply(simp)
+ apply(clarify)
+ apply(rule_tac x="Suc x" in bexI)
+ apply(auto simp add: Sequ_def)[2]
+ apply(simp)
+ apply(simp)
+ apply(clarify)
+ apply(rule_tac x="Suc x" in bexI)
+ apply(auto simp add: Sequ_def)[2]
+ apply(simp)
+ apply(simp add: Star.step Star_Pow)
+done
+
+text {*
+ Our Posix definition determines a unique value.
+*}
+
+lemma List_eq_zipI:
+ assumes "\<forall>(v1, v2) \<in> set (zip vs1 vs2). v1 = v2"
+ and "length vs1 = length vs2"
+ shows "vs1 = vs2"
+ using assms
+ apply(induct vs1 arbitrary: vs2)
+ apply(case_tac vs2)
+ apply(simp)
+ apply(simp)
+ apply(case_tac vs2)
+ apply(simp)
+ apply(simp)
+done
+
+lemma Posix_determ:
+ assumes "s \<in> r \<rightarrow> v1" "s \<in> r \<rightarrow> v2"
+ shows "v1 = v2"
+using assms
+proof (induct s r v1 arbitrary: v2 rule: Posix.induct)
+ case (Posix_ONE v2)
+ have "[] \<in> ONE \<rightarrow> v2" by fact
+ then show "Void = v2" by cases auto
+next
+ case (Posix_CHAR c v2)
+ have "[c] \<in> CHAR c \<rightarrow> v2" by fact
+ then show "Char c = v2" by cases auto
+next
+ case (Posix_ALT1 s r1 v r2 v2)
+ have "s \<in> ALT r1 r2 \<rightarrow> v2" by fact
+ moreover
+ have "s \<in> r1 \<rightarrow> v" by fact
+ then have "s \<in> L r1" by (simp add: Posix1)
+ ultimately obtain v' where eq: "v2 = Left v'" "s \<in> r1 \<rightarrow> v'" by cases auto
+ moreover
+ have IH: "\<And>v2. s \<in> r1 \<rightarrow> v2 \<Longrightarrow> v = v2" by fact
+ ultimately have "v = v'" by simp
+ then show "Left v = v2" using eq by simp
+next
+ case (Posix_ALT2 s r2 v r1 v2)
+ have "s \<in> ALT r1 r2 \<rightarrow> v2" by fact
+ moreover
+ have "s \<notin> L r1" by fact
+ ultimately obtain v' where eq: "v2 = Right v'" "s \<in> r2 \<rightarrow> v'"
+ by cases (auto simp add: Posix1)
+ moreover
+ have IH: "\<And>v2. s \<in> r2 \<rightarrow> v2 \<Longrightarrow> v = v2" by fact
+ ultimately have "v = v'" by simp
+ then show "Right v = v2" using eq by simp
+next
+ case (Posix_SEQ s1 r1 v1 s2 r2 v2 v')
+ have "(s1 @ s2) \<in> SEQ r1 r2 \<rightarrow> v'"
+ "s1 \<in> r1 \<rightarrow> v1" "s2 \<in> r2 \<rightarrow> v2"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L r1 \<and> s\<^sub>4 \<in> L r2)" by fact+
+ then obtain v1' v2' where "v' = Seq v1' v2'" "s1 \<in> r1 \<rightarrow> v1'" "s2 \<in> r2 \<rightarrow> v2'"
+ apply(cases) apply (auto simp add: append_eq_append_conv2)
+ using Posix1(1) by fastforce+
+ moreover
+ have IHs: "\<And>v1'. s1 \<in> r1 \<rightarrow> v1' \<Longrightarrow> v1 = v1'"
+ "\<And>v2'. s2 \<in> r2 \<rightarrow> v2' \<Longrightarrow> v2 = v2'" by fact+
+ ultimately show "Seq v1 v2 = v'" by simp
+next
+ case (Posix_STAR1 s1 r v s2 vs v2)
+ have "(s1 @ s2) \<in> STAR r \<rightarrow> v2"
+ "s1 \<in> r \<rightarrow> v" "s2 \<in> STAR r \<rightarrow> Stars vs" "flat v \<noteq> []"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L r \<and> s\<^sub>4 \<in> L (STAR r))" by fact+
+ then obtain v' vs' where "v2 = Stars (v' # vs')" "s1 \<in> r \<rightarrow> v'" "s2 \<in> (STAR r) \<rightarrow> (Stars vs')"
+ apply(cases) apply (auto simp add: append_eq_append_conv2)
+ using Posix1(1) apply fastforce
+ apply (metis Posix1(1) Posix_STAR1.hyps(6) append_Nil append_Nil2)
+ using Posix1(2) by blast
+ moreover
+ have IHs: "\<And>v2. s1 \<in> r \<rightarrow> v2 \<Longrightarrow> v = v2"
+ "\<And>v2. s2 \<in> STAR r \<rightarrow> v2 \<Longrightarrow> Stars vs = v2" by fact+
+ ultimately show "Stars (v # vs) = v2" by auto
+next
+ case (Posix_STAR2 r v2)
+ have "[] \<in> STAR r \<rightarrow> v2" by fact
+ then show "Stars [] = v2" by cases (auto simp add: Posix1)
+next
+ case (Posix_NTIMES2 vs r n v2)
+ then show "Stars vs = v2"
+ apply(erule_tac Posix_elims)
+ apply(auto)
+ apply (simp add: Posix1(2))
+ apply(rule List_eq_zipI)
+ apply(auto)
+ by (meson in_set_zipE)
+next
+ case (Posix_NTIMES1 s1 r v s2 n vs v2)
+ have "(s1 @ s2) \<in> NTIMES r n \<rightarrow> v2"
+ "s1 \<in> r \<rightarrow> v" "s2 \<in> NTIMES r (n - 1) \<rightarrow> Stars vs" "flat v \<noteq> []"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L r \<and> s\<^sub>4 \<in> L (NTIMES r (n - 1 )))" by fact+
+ then obtain v' vs' where "v2 = Stars (v' # vs')" "s1 \<in> r \<rightarrow> v'" "s2 \<in> (NTIMES r (n - 1)) \<rightarrow> (Stars vs')"
+ apply(cases) apply (auto simp add: append_eq_append_conv2)
+ using Posix1(1) apply fastforce
+ apply (metis One_nat_def Posix1(1) Posix_NTIMES1.hyps(7) append.right_neutral append_self_conv2)
+ using Posix1(2) by blast
+ moreover
+ have IHs: "\<And>v2. s1 \<in> r \<rightarrow> v2 \<Longrightarrow> v = v2"
+ "\<And>v2. s2 \<in> NTIMES r (n - 1) \<rightarrow> v2 \<Longrightarrow> Stars vs = v2" by fact+
+ ultimately show "Stars (v # vs) = v2" by auto
+next
+ case (Posix_UPNTIMES1 s1 r v s2 n vs v2)
+ have "(s1 @ s2) \<in> UPNTIMES r n \<rightarrow> v2"
+ "s1 \<in> r \<rightarrow> v" "s2 \<in> UPNTIMES r (n - 1) \<rightarrow> Stars vs" "flat v \<noteq> []"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L r \<and> s\<^sub>4 \<in> L (UPNTIMES r (n - 1 )))" by fact+
+ then obtain v' vs' where "v2 = Stars (v' # vs')" "s1 \<in> r \<rightarrow> v'" "s2 \<in> (UPNTIMES r (n - 1)) \<rightarrow> (Stars vs')"
+ apply(cases) apply (auto simp add: append_eq_append_conv2)
+ using Posix1(1) apply fastforce
+ apply (metis One_nat_def Posix1(1) Posix_UPNTIMES1.hyps(7) append.right_neutral append_self_conv2)
+ using Posix1(2) by blast
+ moreover
+ have IHs: "\<And>v2. s1 \<in> r \<rightarrow> v2 \<Longrightarrow> v = v2"
+ "\<And>v2. s2 \<in> UPNTIMES r (n - 1) \<rightarrow> v2 \<Longrightarrow> Stars vs = v2" by fact+
+ ultimately show "Stars (v # vs) = v2" by auto
+next
+ case (Posix_UPNTIMES2 r n v2)
+ then show "Stars [] = v2"
+ apply(erule_tac Posix_elims)
+ apply(auto)
+ by (simp add: Posix1(2))
+next
+ case (Posix_FROMNTIMES1 s1 r v s2 n vs v2)
+ have "(s1 @ s2) \<in> FROMNTIMES r n \<rightarrow> v2"
+ "s1 \<in> r \<rightarrow> v" "s2 \<in> FROMNTIMES r (n - 1) \<rightarrow> Stars vs" "flat v \<noteq> []" "0 < n"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L r \<and> s\<^sub>4 \<in> L (FROMNTIMES r (n - 1 )))" by fact+
+ then obtain v' vs' where "v2 = Stars (v' # vs')" "s1 \<in> r \<rightarrow> v'" "s2 \<in> (FROMNTIMES r (n - 1)) \<rightarrow> (Stars vs')"
+ apply(cases) apply (auto simp add: append_eq_append_conv2)
+ using Posix1(1) Posix1(2) apply blast
+ apply(case_tac n)
+ apply(simp)
+ apply(simp)
+ apply(drule_tac x="va" in meta_spec)
+ apply(drule_tac x="vs" in meta_spec)
+ apply(simp)
+ apply(drule meta_mp)
+ apply (metis L.simps(9) Posix1(1) UN_E append.right_neutral append_Nil diff_Suc_1 local.Posix_FROMNTIMES1(4) val.inject(5))
+ apply (metis L.simps(9) Posix1(1) UN_E append.right_neutral append_Nil)
+ by (metis One_nat_def Posix1(1) Posix_FROMNTIMES1.hyps(7) self_append_conv self_append_conv2)
+ moreover
+ have IHs: "\<And>v2. s1 \<in> r \<rightarrow> v2 \<Longrightarrow> v = v2"
+ "\<And>v2. s2 \<in> FROMNTIMES r (n - 1) \<rightarrow> v2 \<Longrightarrow> Stars vs = v2" by fact+
+ ultimately show "Stars (v # vs) = v2" by auto
+next
+ case (Posix_FROMNTIMES2 vs r n v2)
+ then show "Stars vs = v2"
+ apply(erule_tac Posix_elims)
+ apply(auto)
+ apply(rule List_eq_zipI)
+ apply(auto)
+ apply(meson in_set_zipE)
+ apply (simp add: Posix1(2))
+ using Posix1(2) by blast
+next
+ case (Posix_FROMNTIMES3 s1 r v s2 vs v2)
+ have "(s1 @ s2) \<in> FROMNTIMES r 0 \<rightarrow> v2"
+ "s1 \<in> r \<rightarrow> v" "s2 \<in> STAR r \<rightarrow> Stars vs" "flat v \<noteq> []"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L r \<and> s\<^sub>4 \<in> L (STAR r))" by fact+
+ then obtain v' vs' where "v2 = Stars (v' # vs')" "s1 \<in> r \<rightarrow> v'" "s2 \<in> (STAR r) \<rightarrow> (Stars vs')"
+ apply(cases) apply (auto simp add: append_eq_append_conv2)
+ using Posix1(2) apply fastforce
+ using Posix1(1) apply fastforce
+ by (metis Posix1(1) Posix_FROMNTIMES3.hyps(6) append.right_neutral append_Nil)
+ moreover
+ have IHs: "\<And>v2. s1 \<in> r \<rightarrow> v2 \<Longrightarrow> v = v2"
+ "\<And>v2. s2 \<in> STAR r \<rightarrow> v2 \<Longrightarrow> Stars vs = v2" by fact+
+ ultimately show "Stars (v # vs) = v2" by auto
+next
+ case (Posix_NMTIMES1 s1 r v s2 n m vs v2)
+ have "(s1 @ s2) \<in> NMTIMES r n m \<rightarrow> v2"
+ "s1 \<in> r \<rightarrow> v" "s2 \<in> NMTIMES r (n - 1) (m - 1) \<rightarrow> Stars vs" "flat v \<noteq> []"
+ "0 < n" "n \<le> m"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L r \<and> s\<^sub>4 \<in> L (NMTIMES r (n - 1) (m - 1)))" by fact+
+ then obtain v' vs' where "v2 = Stars (v' # vs')" "s1 \<in> r \<rightarrow> v'"
+ "s2 \<in> (NMTIMES r (n - 1) (m - 1)) \<rightarrow> (Stars vs')"
+ apply(cases) apply (auto simp add: append_eq_append_conv2)
+ using Posix1(1) Posix1(2) apply blast
+ apply(case_tac n)
+ apply(simp)
+ apply(simp)
+ apply(case_tac m)
+ apply(simp)
+ apply(simp)
+ apply(drule_tac x="va" in meta_spec)
+ apply(drule_tac x="vs" in meta_spec)
+ apply(simp)
+ apply(drule meta_mp)
+ apply(drule Posix1(1))
+ apply(drule Posix1(1))
+ apply(drule Posix1(1))
+ apply(frule Posix1(1))
+ apply(simp)
+ using Posix_NMTIMES1.hyps(4) apply force
+ apply (metis L.simps(10) Posix1(1) UN_E append_Nil2 append_self_conv2)
+ by (metis One_nat_def Posix1(1) Posix_NMTIMES1.hyps(8) append.right_neutral append_Nil)
+ moreover
+ have IHs: "\<And>v2. s1 \<in> r \<rightarrow> v2 \<Longrightarrow> v = v2"
+ "\<And>v2. s2 \<in> NMTIMES r (n - 1) (m - 1) \<rightarrow> v2 \<Longrightarrow> Stars vs = v2" by fact+
+ ultimately show "Stars (v # vs) = v2" by auto
+next
+ case (Posix_NMTIMES2 vs r n m v2)
+ then show "Stars vs = v2"
+ apply(erule_tac Posix_elims)
+ apply(simp)
+ apply(rule List_eq_zipI)
+ apply(auto)
+ apply (meson in_set_zipE)
+ apply (simp add: Posix1(2))
+ apply(erule_tac Posix_elims)
+ apply(auto)
+ apply (simp add: Posix1(2))+
+ done
+next
+ case (Posix_NMTIMES3 s1 r v s2 m vs v2)
+ have "(s1 @ s2) \<in> NMTIMES r 0 m \<rightarrow> v2"
+ "s1 \<in> r \<rightarrow> v" "s2 \<in> UPNTIMES r (m - 1) \<rightarrow> Stars vs" "flat v \<noteq> []" "0 < m"
+ "\<not> (\<exists>s\<^sub>3 s\<^sub>4. s\<^sub>3 \<noteq> [] \<and> s\<^sub>3 @ s\<^sub>4 = s2 \<and> s1 @ s\<^sub>3 \<in> L r \<and> s\<^sub>4 \<in> L (UPNTIMES r (m - 1 )))" by fact+
+ then obtain v' vs' where "v2 = Stars (v' # vs')" "s1 \<in> r \<rightarrow> v'" "s2 \<in> (UPNTIMES r (m - 1)) \<rightarrow> (Stars vs')"
+ apply(cases) apply (auto simp add: append_eq_append_conv2)
+ using Posix1(2) apply blast
+ apply (smt L.simps(7) Posix1(1) UN_E append_eq_append_conv2)
+ by (metis One_nat_def Posix1(1) Posix_NMTIMES3.hyps(7) append.right_neutral append_Nil)
+ moreover
+ have IHs: "\<And>v2. s1 \<in> r \<rightarrow> v2 \<Longrightarrow> v = v2"
+ "\<And>v2. s2 \<in> UPNTIMES r (m - 1) \<rightarrow> v2 \<Longrightarrow> Stars vs = v2" by fact+
+ ultimately show "Stars (v # vs) = v2" by auto
+qed
+
+
+text {*
+ Our POSIX value is a lexical value.
+*}
+
+lemma Posix_LV:
+ assumes "s \<in> r \<rightarrow> v"
+ shows "v \<in> LV r s"
+using assms unfolding LV_def
+apply(induct rule: Posix.induct)
+ apply(auto simp add: intro!: Prf.intros elim!: Prf_elims)[7]
+ defer
+ defer
+ apply(auto simp add: intro!: Prf.intros elim!: Prf_elims)[2]
+ apply (metis (mono_tags, lifting) Prf.intros(9) append_Nil empty_iff flat_Stars flats_empty list.set(1) mem_Collect_eq)
+ apply(simp)
+ apply(clarify)
+ apply(case_tac n)
+ apply(simp)
+ apply(simp)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(subst append.simps(2)[symmetric])
+ apply(rule Prf.intros)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(rule Prf.intros)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(clarify)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(rule Prf.intros)
+ apply(simp)
+ apply(simp)
+ (* NTIMES *)
+ prefer 4
+ apply(simp)
+ apply(case_tac n)
+ apply(simp)
+ apply(simp)
+ apply(clarify)
+ apply(rotate_tac 5)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(subst append.simps(2)[symmetric])
+ apply(rule Prf.intros)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ prefer 4
+ apply(simp)
+ apply (metis Prf.intros(8) length_removeAll_less less_irrefl_nat removeAll.simps(1) self_append_conv2)
+ (* NMTIMES *)
+ apply(simp)
+ apply (metis Prf.intros(11) append_Nil empty_iff list.set(1))
+ apply(simp)
+ apply(clarify)
+ apply(rotate_tac 6)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(subst append.simps(2)[symmetric])
+ apply(rule Prf.intros)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(rule Prf.intros)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(clarify)
+ apply(rotate_tac 6)
+ apply(erule Prf_elims)
+ apply(simp)
+ apply(rule Prf.intros)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+done
+
+end
\ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thys2/Sulzmann.thy Sun Oct 10 18:35:21 2021 +0100
@@ -0,0 +1,328 @@
+
+theory Sulzmann
+ imports "Lexer"
+begin
+
+section {* Bit-Encodings *}
+
+datatype bit = Z | S
+
+fun
+ code :: "val \<Rightarrow> bit list"
+where
+ "code Void = []"
+| "code (Char c) = []"
+| "code (Left v) = Z # (code v)"
+| "code (Right v) = S # (code v)"
+| "code (Seq v1 v2) = (code v1) @ (code v2)"
+| "code (Stars []) = [S]"
+| "code (Stars (v # vs)) = (Z # code v) @ code (Stars vs)"
+
+
+fun
+ Stars_add :: "val \<Rightarrow> val \<Rightarrow> val"
+where
+ "Stars_add v (Stars vs) = Stars (v # vs)"
+
+function
+ decode' :: "bit list \<Rightarrow> rexp \<Rightarrow> (val * bit list)"
+where
+ "decode' ds ZERO = (Void, [])"
+| "decode' ds ONE = (Void, ds)"
+| "decode' ds (CH d) = (Char d, ds)"
+| "decode' [] (ALT r1 r2) = (Void, [])"
+| "decode' (Z # ds) (ALT r1 r2) = (let (v, ds') = decode' ds r1 in (Left v, ds'))"
+| "decode' (S # ds) (ALT r1 r2) = (let (v, ds') = decode' ds r2 in (Right v, ds'))"
+| "decode' ds (SEQ r1 r2) = (let (v1, ds') = decode' ds r1 in
+ let (v2, ds'') = decode' ds' r2 in (Seq v1 v2, ds''))"
+| "decode' [] (STAR r) = (Void, [])"
+| "decode' (S # ds) (STAR r) = (Stars [], ds)"
+| "decode' (Z # ds) (STAR r) = (let (v, ds') = decode' ds r in
+ let (vs, ds'') = decode' ds' (STAR r)
+ in (Stars_add v vs, ds''))"
+by pat_completeness auto
+
+lemma decode'_smaller:
+ assumes "decode'_dom (ds, r)"
+ shows "length (snd (decode' ds r)) \<le> length ds"
+using assms
+apply(induct ds r)
+apply(auto simp add: decode'.psimps split: prod.split)
+using dual_order.trans apply blast
+by (meson dual_order.trans le_SucI)
+
+termination "decode'"
+apply(relation "inv_image (measure(%cs. size cs) <*lex*> measure(%s. size s)) (%(ds,r). (r,ds))")
+apply(auto dest!: decode'_smaller)
+by (metis less_Suc_eq_le snd_conv)
+
+definition
+ decode :: "bit list \<Rightarrow> rexp \<Rightarrow> val option"
+where
+ "decode ds r \<equiv> (let (v, ds') = decode' ds r
+ in (if ds' = [] then Some v else None))"
+
+lemma decode'_code_Stars:
+ assumes "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> (\<forall>x. decode' (code v @ x) r = (v, x)) \<and> flat v \<noteq> []"
+ shows "decode' (code (Stars vs) @ ds) (STAR r) = (Stars vs, ds)"
+ using assms
+ apply(induct vs)
+ apply(auto)
+ done
+
+lemma decode'_code:
+ assumes "\<Turnstile> v : r"
+ shows "decode' ((code v) @ ds) r = (v, ds)"
+using assms
+ apply(induct v r arbitrary: ds)
+ apply(auto)
+ using decode'_code_Stars by blast
+
+lemma decode_code:
+ assumes "\<Turnstile> v : r"
+ shows "decode (code v) r = Some v"
+ using assms unfolding decode_def
+ by (smt append_Nil2 decode'_code old.prod.case)
+
+
+datatype arexp =
+ AZERO
+| AONE "bit list"
+| ACH "bit list" char
+| ASEQ "bit list" arexp arexp
+| AALT "bit list" arexp arexp
+| ASTAR "bit list" arexp
+
+fun fuse :: "bit list \<Rightarrow> arexp \<Rightarrow> arexp" where
+ "fuse bs AZERO = AZERO"
+| "fuse bs (AONE cs) = AONE (bs @ cs)"
+| "fuse bs (ACH cs c) = ACH (bs @ cs) c"
+| "fuse bs (AALT cs r1 r2) = AALT (bs @ cs) r1 r2"
+| "fuse bs (ASEQ cs r1 r2) = ASEQ (bs @ cs) r1 r2"
+| "fuse bs (ASTAR cs r) = ASTAR (bs @ cs) r"
+
+fun intern :: "rexp \<Rightarrow> arexp" where
+ "intern ZERO = AZERO"
+| "intern ONE = AONE []"
+| "intern (CH c) = ACH [] c"
+| "intern (ALT r1 r2) = AALT [] (fuse [Z] (intern r1))
+ (fuse [S] (intern r2))"
+| "intern (SEQ r1 r2) = ASEQ [] (intern r1) (intern r2)"
+| "intern (STAR r) = ASTAR [] (intern r)"
+
+
+fun retrieve :: "arexp \<Rightarrow> val \<Rightarrow> bit list" where
+ "retrieve (AONE bs) Void = bs"
+| "retrieve (ACH bs c) (Char d) = bs"
+| "retrieve (AALT bs r1 r2) (Left v) = bs @ retrieve r1 v"
+| "retrieve (AALT bs r1 r2) (Right v) = bs @ retrieve r2 v"
+| "retrieve (ASEQ bs r1 r2) (Seq v1 v2) = bs @ retrieve r1 v1 @ retrieve r2 v2"
+| "retrieve (ASTAR bs r) (Stars []) = bs @ [S]"
+| "retrieve (ASTAR bs r) (Stars (v#vs)) =
+ bs @ [Z] @ retrieve r v @ retrieve (ASTAR [] r) (Stars vs)"
+
+fun
+ erase :: "arexp \<Rightarrow> rexp"
+where
+ "erase AZERO = ZERO"
+| "erase (AONE _) = ONE"
+| "erase (ACH _ c) = CH c"
+| "erase (AALT _ r1 r2) = ALT (erase r1) (erase r2)"
+| "erase (ASEQ _ r1 r2) = SEQ (erase r1) (erase r2)"
+| "erase (ASTAR _ r) = STAR (erase r)"
+
+fun
+ bnullable :: "arexp \<Rightarrow> bool"
+where
+ "bnullable (AZERO) = False"
+| "bnullable (AONE bs) = True"
+| "bnullable (ACH bs c) = False"
+| "bnullable (AALT bs r1 r2) = (bnullable r1 \<or> bnullable r2)"
+| "bnullable (ASEQ bs r1 r2) = (bnullable r1 \<and> bnullable r2)"
+| "bnullable (ASTAR bs r) = True"
+
+fun
+ bmkeps :: "arexp \<Rightarrow> bit list"
+where
+ "bmkeps(AONE bs) = bs"
+| "bmkeps(ASEQ bs r1 r2) = bs @ (bmkeps r1) @ (bmkeps r2)"
+| "bmkeps(AALT bs r1 r2) = (if bnullable(r1) then bs @ (bmkeps r1) else bs @ (bmkeps r2))"
+| "bmkeps(ASTAR bs r) = bs @ [S]"
+
+
+fun
+ bder :: "char \<Rightarrow> arexp \<Rightarrow> arexp"
+where
+ "bder c (AZERO) = AZERO"
+| "bder c (AONE bs) = AZERO"
+| "bder c (ACH bs d) = (if c = d then AONE bs else AZERO)"
+| "bder c (AALT bs r1 r2) = AALT bs (bder c r1) (bder c r2)"
+| "bder c (ASEQ bs r1 r2) =
+ (if bnullable r1
+ then AALT bs (ASEQ [] (bder c r1) r2) (fuse (bmkeps r1) (bder c r2))
+ else ASEQ bs (bder c r1) r2)"
+| "bder c (ASTAR bs r) = ASEQ bs (fuse [Z] (bder c r)) (ASTAR [] r)"
+
+
+fun
+ bders :: "arexp \<Rightarrow> string \<Rightarrow> arexp"
+where
+ "bders r [] = r"
+| "bders r (c#s) = bders (bder c r) s"
+
+lemma bders_append:
+ "bders r (s1 @ s2) = bders (bders r s1) s2"
+ apply(induct s1 arbitrary: r s2)
+ apply(simp_all)
+ done
+
+lemma bnullable_correctness:
+ shows "nullable (erase r) = bnullable r"
+ apply(induct r)
+ apply(simp_all)
+ done
+
+lemma erase_fuse:
+ shows "erase (fuse bs r) = erase r"
+ apply(induct r)
+ apply(simp_all)
+ done
+
+lemma erase_intern[simp]:
+ shows "erase (intern r) = r"
+ apply(induct r)
+ apply(simp_all add: erase_fuse)
+ done
+
+lemma erase_bder[simp]:
+ shows "erase (bder a r) = der a (erase r)"
+ apply(induct r)
+ apply(simp_all add: erase_fuse bnullable_correctness)
+ done
+
+lemma erase_bders[simp]:
+ shows "erase (bders r s) = ders s (erase r)"
+ apply(induct s arbitrary: r )
+ apply(simp_all)
+ done
+
+lemma retrieve_encode_STARS:
+ assumes "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> code v = retrieve (intern r) v"
+ shows "code (Stars vs) = retrieve (ASTAR [] (intern r)) (Stars vs)"
+ using assms
+ apply(induct vs)
+ apply(simp_all)
+ done
+
+lemma retrieve_fuse2:
+ assumes "\<Turnstile> v : (erase r)"
+ shows "retrieve (fuse bs r) v = bs @ retrieve r v"
+ using assms
+ apply(induct r arbitrary: v bs)
+ using retrieve_encode_STARS
+ apply(auto elim!: Prf_elims)
+ apply(case_tac vs)
+ apply(simp)
+ apply(simp)
+ done
+
+lemma retrieve_fuse:
+ assumes "\<Turnstile> v : r"
+ shows "retrieve (fuse bs (intern r)) v = bs @ retrieve (intern r) v"
+ using assms
+ by (simp_all add: retrieve_fuse2)
+
+
+lemma retrieve_code:
+ assumes "\<Turnstile> v : r"
+ shows "code v = retrieve (intern r) v"
+ using assms
+ apply(induct v r)
+ apply(simp_all add: retrieve_fuse retrieve_encode_STARS)
+ done
+
+
+lemma bmkeps_retrieve:
+ assumes "nullable (erase r)"
+ shows "bmkeps r = retrieve r (mkeps (erase r))"
+ using assms
+ apply(induct r)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp)
+ apply(simp only: bmkeps.simps bnullable_correctness)
+ apply(auto simp only: split: if_split)
+ apply(auto simp add: bnullable_correctness)
+ done
+
+lemma bder_retrieve:
+ assumes "\<Turnstile> v : der c (erase r)"
+ shows "retrieve (bder c r) v = retrieve r (injval (erase r) c v)"
+ using assms
+ apply(induct r arbitrary: v)
+ apply(auto elim!: Prf_elims simp add: retrieve_fuse2 bnullable_correctness bmkeps_retrieve)
+ done
+
+lemma MAIN_decode:
+ assumes "\<Turnstile> v : ders s r"
+ shows "Some (flex r id s v) = decode (retrieve (bders (intern r) s) v) r"
+ using assms
+proof (induct s arbitrary: v rule: rev_induct)
+ case Nil
+ have "\<Turnstile> v : ders [] r" by fact
+ then have "\<Turnstile> v : r" by simp
+ then have "Some v = decode (retrieve (intern r) v) r"
+ using decode_code retrieve_code by auto
+ then show "Some (flex r id [] v) = decode (retrieve (bders (intern r) []) v) r"
+ by simp
+next
+ case (snoc c s v)
+ have IH: "\<And>v. \<Turnstile> v : ders s r \<Longrightarrow>
+ Some (flex r id s v) = decode (retrieve (bders (intern r) s) v) r" by fact
+ have asm: "\<Turnstile> v : ders (s @ [c]) r" by fact
+ then have asm2: "\<Turnstile> injval (ders s r) c v : ders s r"
+ by(simp add: Prf_injval ders_append)
+ have "Some (flex r id (s @ [c]) v) = Some (flex r id s (injval (ders s r) c v))"
+ by (simp add: flex_append)
+ also have "... = decode (retrieve (bders (intern r) s) (injval (ders s r) c v)) r"
+ using asm2 IH by simp
+ also have "... = decode (retrieve (bder c (bders (intern r) s)) v) r"
+ using asm by(simp_all add: bder_retrieve ders_append)
+ finally show "Some (flex r id (s @ [c]) v) =
+ decode (retrieve (bders (intern r) (s @ [c])) v) r" by (simp add: bders_append)
+qed
+
+
+definition blexer where
+ "blexer r s \<equiv> if bnullable (bders (intern r) s) then
+ decode (bmkeps (bders (intern r) s)) r else None"
+
+lemma blexer_correctness:
+ shows "blexer r s = lexer r s"
+proof -
+ { define bds where "bds \<equiv> bders (intern r) s"
+ define ds where "ds \<equiv> ders s r"
+ assume asm: "nullable ds"
+ have era: "erase bds = ds"
+ unfolding ds_def bds_def by simp
+ have mke: "\<Turnstile> mkeps ds : ds"
+ using asm by (simp add: mkeps_nullable)
+ have "decode (bmkeps bds) r = decode (retrieve bds (mkeps ds)) r"
+ using bmkeps_retrieve
+ using asm era by (simp add: bmkeps_retrieve)
+ also have "... = Some (flex r id s (mkeps ds))"
+ using mke by (simp_all add: MAIN_decode ds_def bds_def)
+ finally have "decode (bmkeps bds) r = Some (flex r id s (mkeps ds))"
+ unfolding bds_def ds_def .
+ }
+ then show "blexer r s = lexer r s"
+ unfolding blexer_def lexer_flex
+ apply(subst bnullable_correctness[symmetric])
+ apply(simp)
+ done
+qed
+
+
+
+end
\ No newline at end of file
Binary file thys2/journal.pdf has changed
Binary file thys2/notes.pdf has changed
Binary file thys2/paper.pdf has changed