# HG changeset patch # User Chengsong # Date 1633887321 -3600 # Node ID ec5e4fe4cc700e0dfaca1aaa1981dbdb0665a558 # Parent 232aa2f19a75575a4a8aaea66aa955197f678646 for new journal/conf paper! diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys/Journal/Paper.thy --- 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 \Bitcoded Lexing\ + + text \ 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)}\\ diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys/Journal/llncs.cls --- 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@ diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys/RegLangs.thy --- 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) diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys/Spec.thy --- 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 diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys2/BitCoded.thy --- /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 \Bit-Encodings\ + +datatype bit = Z | S + +fun + code :: "val \ 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 \ val \ val" +where + "Stars_add v (Stars vs) = Stars (v # vs)" + +function + decode' :: "bit list \ rexp \ (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)) \ 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 \ rexp \ val option" +where + "decode ds r \ (let (v, ds') = decode' ds r + in (if ds' = [] then Some v else None))" + +lemma decode'_code_Stars: + assumes "\v\set vs. \ v : r \ (\x. decode' (code v @ x) r = (v, x)) \ flat v \ []" + shows "decode' (code (Stars vs) @ ds) (STAR r) = (Stars vs, ds)" + using assms + apply(induct vs) + apply(auto) + done + +lemma decode'_code: + assumes "\ 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 "\ 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 \ AALTs bs [r1, r2]" + +fun asize :: "arexp \ 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 \ 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 "\ v : (erase a)" + shows "decode (code v) (erase a) = Some v" + using assms + by (simp add: decode_code) + + +fun nonalt :: "arexp \ bool" + where + "nonalt (AALTs bs2 rs) = False" +| "nonalt r = True" + + +fun good :: "arexp \ 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)) = (\r' \ set (r1#r2#rs). good r' \ nonalt r')" +| "good (ASEQ _ AZERO _) = False" +| "good (ASEQ _ (AONE _) _) = False" +| "good (ASEQ _ _ AZERO) = False" +| "good (ASEQ cs r1 r2) = (good r1 \ good r2)" +| "good (ASTAR cs r) = True" + + + + +fun fuse :: "bit list \ arexp \ 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 \ 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 \ val \ 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 \ bool" +where + "bnullable (AZERO) = False" +| "bnullable (AONE bs) = True" +| "bnullable (ACHAR bs c) = False" +| "bnullable (AALTs bs rs) = (\r \ set rs. bnullable r)" +| "bnullable (ASEQ bs r1 r2) = (bnullable r1 \ bnullable r2)" +| "bnullable (ASTAR bs r) = True" + +fun + bmkeps :: "arexp \ 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 \ arexp \ 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 \ string \ 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 "\v\set vs. \ v : r \ 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 "\ 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 "\ 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 "\ 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 \ (\ bnullable a \ 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 "\ 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 \ set rs" "bnullable x" + shows "bnullable (AALTs bs rs)" + using assms + apply(induct rs) + apply(auto) + done + +lemma r3: + assumes "\ bnullable r" + " \ x \ 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 "\r \ set rs. nullable (erase r) \ 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 "\ 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 "\ 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 "\ v : ders [] r" by fact + then have "\ 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: "\v. \ v : ders s r \ + Some (flex r id s v) = decode (retrieve (bders (intern r) s) v) r" by fact + have asm: "\ v : ders (s @ [c]) r" by fact + then have asm2: "\ 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 \ if bnullable (bders a s) then Some (bmkeps (bders a s)) else None" + + + +definition blexer where + "blexer r s \ 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 \ bders (intern r) s" + define ds where "ds \ ders s r" + assume asm: "nullable ds" + have era: "erase bds = ds" + unfolding ds_def bds_def by simp + have mke: "\ 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 \ ('a \ 'b) \ 'b set \ 'a list" + where + "distinctBy [] f acc = []" +| "distinctBy (x#xs) f acc = + (if (f x) \ acc then distinctBy xs f acc + else x # (distinctBy xs f ({f x} \ acc)))" + +fun flts :: "arexp list \ 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 \ arexp list \ arexp" + where + "li _ [] = AZERO" +| "li bs [a] = fuse bs a" +| "li bs as = AALTs bs as" + + + + +fun bsimp_ASEQ :: "bit list \ arexp \ arexp \ 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 \ arexp list \ arexp" + where + "bsimp_AALTs _ [] = AZERO" +| "bsimp_AALTs bs1 [r] = fuse bs1 r" +| "bsimp_AALTs bs1 rs = AALTs bs1 rs" + + +fun bsimp :: "arexp \ 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 \ string \ 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 \ 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) \ 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)) \ 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) \ 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) \ 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 "(\x\rs. asize (bsimp x)) \ sum_list (map asize rs)" + apply(induct rs) + apply(auto) + by (simp add: add_mono bsimp_size) + +lemma bsimp_AALTs_size2: + assumes "\r \ set rs. nonalt r" + shows "asize (bsimp_AALTs bs rs) \ 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 \ fuse bs) rs = map asize rs" + apply(induct rs) + apply(auto simp add: fuse_size) + done + +lemma flts_size2: + assumes "\bs rs'. AALTs bs rs' \ 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 "\r \ set (map bsimp rs). \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)) = \ (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 "\ (L ` erase ` (set (flts rs))) = \ (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 \ AZERO" "r2 \ AZERO" "\bs. r1 \ 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 "\r \ set rs. bmkeps(bsimp r) = bmkeps r" + shows "map (\r. bmkeps(bsimp r)) rs = map bmkeps rs" + using assms + apply(induct rs) + apply(simp) + apply(simp) + done + +lemma q3: + assumes "\r \ 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 "\r \ 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 "\r \ set rs. \ bnullable r" "\r \ 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) = (\r \ 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 "\r \ 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 "\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 \ 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 \ AZERO" + shows "flts [r] = [r]" + using assms + apply(case_tac r) + apply(simp_all) + done + +lemma nn1: + assumes "nonnested (AALTs bs rs)" + shows "\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 "\bs1 rs1. AALTs bs1 rs1 \ set (flts rs)" + using assms + apply(induct rs rule: flts.induct) + apply(auto) + done + +lemma nn1qq: + assumes "nonnested (AALTs bs rs)" + shows "\bs1 rs1. AALTs bs1 rs1 \ 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) \ (\r \ 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 "\r \ set rs. nonnested r" + shows "\r \ 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 "\r \ 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 "\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 "\r1 \ set rs. \ bs. r1 \ AALTs bs rs2" + using nn1b assms + by (metis nn1qq) + +lemma nn_flts: + assumes "nonnested (AALTs bs rs)" + shows "\r \ 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))) \ 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 \ (\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 \ Nil" "\r \ set rs. nonalt r" + shows "good (bsimp_AALTs bs rs) \ (\r \ 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) \ Nil" "\r \ set (flts (map bsimp rs)). nonalt r" + shows "good (bsimp (AALTs bs rs)) \ (\r \ 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 \ AZERO" "nonalt r" + shows "flts [r] \ []" + using assms + apply(induct r) + apply(simp_all) + done + +lemma flts1: + assumes "good r" + shows "flts [r] \ []" + using assms + apply(induct r) + apply(simp_all) + apply(case_tac x2a) + apply(simp) + apply(simp) + done + +lemma flts2: + assumes "good r" + shows "\r' \ set (flts [r]). good r' \ 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 "\r \ set rs. good r \ r = AZERO" + shows "\r \ 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 "\r\set rs. good r" + shows "flts rs \ []" + 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 "\r \ set rs. \ 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 "\y. asize y < Suc (sum_list (map asize rs)) \ + good (bsimp y) \ bsimp y = AZERO" + and "\r\set rs. \ 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 "\y. asize y < Suc (sum_list (map asize rs)) \ + good (bsimp y) \ 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 \ AZERO" "r2 \ AZERO" "\bs. r1 \ AONE bs" + shows "good (ASEQ bs r1 r2) = (good r1 \ 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) \ 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 "\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) \ {}" + 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 \ (\r. rs = [r] \ 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 "\r \ set (flts rs). r \ 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 \ set (flts rs)" + using assms + using flts_0 by blast + +lemma qqq1: + shows "AZERO \ set (flts (map bsimp rs))" + by (metis ex_map_conv flts3 good.simps(1) good1) + + +fun nonazero :: "arexp \ bool" + where + "nonazero AZERO = False" +| "nonazero r = True" + +lemma flts_concat: + shows "flts rs = concat (map (\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 "\y. asize y < Suc (sum_list (map asize rs)) \ good y \ bsimp y = y" + "\r'\set rs. good r' \ 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 "\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 "\r \ 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 "\x\set list. bnullable x" + shows "\x\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 "\r \ 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 "\x\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 "\x2aa. \x2aa \ set x2a; bnullable x2aa\ \ bmkeps x2aa = bmkeps (bsimp x2aa)" + "\x\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 "\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 "\r \ 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 \ None | Some v \ 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 \ arexp list \ 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) \ 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 "\y. asize y < Suc (sum_list (map asize rs)) \ good y \ bsimp y = y" + "\r'\set rs. good r' \ nonalt r'" + shows "flts (map (bsimp \ bder c) (flts (map bsimp rs))) = flts (map (bsimp \ 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) \ {}" + 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) \ 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) \ 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 \ []" + shows "good (bders_simp a s) \ 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)) \ {}" + 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)) = {} \ L (erase (bder a aa)) \ {}") + 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 "\ 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 \ (erase r) \ 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 \ (erase r) \ 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 \ (erase r) \ 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 \ 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 \ L (erase a)" + shows "[] \ erase (bsimp (bders a s)) \ 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] \ L (erase a)" + shows "[c] \ (erase a) \ 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] \ L (erase a)" + shows "[c] \ (erase a) \ 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 \ 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 \ (erase r) \ v" "s \ (erase (bsimp r)) \ 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 \ 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 \ 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. \ v: (erase a)}" + and "L (erase a) = {flat v | v. \ 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 \ L (erase a)" + shows "s \ erase a \ 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 \ 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 \ L (der c r)" + shows "s \ der c r \ 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 \ r \ 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 \ (der c r) \ 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) ((\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 \ (ders s1 r) \ 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 "\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 "\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 "\r \ set rs. r \ AZERO" "\r \ set rs. nonalt r" + shows "flts rs = rs" + using assms + apply(induct rs rule: flts.induct) + apply(auto) + done + +lemma flts_flts: + assumes "\r \ set rs. good r" + shows "flts (flts rs) = flts rs" + using assms + apply(induct rs taking: "\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 "\r \ set x52. r \ 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 "\r \ 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 \ AZERO" + shows "rs \ []" + 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 "\r \ set as. nonalt r \ r \ 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 "\r \ set as1. nonalt r \ r \ 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 \ a \ AZERO \ nonalt aa \ aa \ AZERO \ (\r\set list. nonalt r \ r \ AZERO)" + assume a2: "\as. \r\set as. nonalt r \ r \ AZERO \ 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 "\r \ set as1. nonalt r \ r \ AZERO" "\r \ set as2. nonalt r \ r \ 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 "\a \ 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 \ 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: "\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 "\y \ 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 \ 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 \ 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 \ AZERO) " + "\(\ a01 a02 x02. ( (a1 = ASEQ x02 a01 a02) \ 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] \ 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 " \ 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 \ AZERO) " + "\(\ a01 a02 x02. ( (a1 = ASEQ x02 a01 a02) \ bnullable(a01) ) )" +" (bder c a2 \ AZERO)" + "\(\ a11 a12 x12. ( (a2 = ASEQ x12 a11 a12) \ 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: "\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 "\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(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 "\bs1 as1. bsimp a1 = AALTs bs1 as1") + apply(case_tac "\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: "\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 "_ < _ \ _ \ _ \_ < _" + 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 "\r \ set (map bsimp x52). \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 \ 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 "\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 "\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 "\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 "(\bs1 rs1. 1 < length rs1 \ bsimp (bder c x43) = AALTs bs1 rs1 ) \ + (\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 "\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) \ 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 "(\i \ {0..n}. i) = n * (n + 1) div 2" + apply(induct n) + apply(simp) + apply(simp) + done + + + + + +end \ No newline at end of file diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys2/BitCoded2.thy --- /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 \Bit-Encodings\ + +datatype bit = Z | S + +fun + code :: "val \ 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 \ val \ val" +where + "Stars_add v (Stars vs) = Stars (v # vs)" +| "Stars_add v _ = Stars [v]" + +function + decode' :: "bit list \ rexp \ (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)) \ 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 \ rexp \ val option" +where + "decode ds r \ (let (v, ds') = decode' ds r + in (if ds' = [] then Some v else None))" + +lemma decode'_code_Stars: + assumes "\v\set vs. \ v : r \ (\x. decode' (code v @ x) r = (v, x)) \ flat v \ []" + shows "decode' (code (Stars vs) @ ds) (STAR r) = (Stars vs, ds)" + using assms + apply(induct vs) + apply(auto) + done + +lemma decode'_code: + assumes "\ 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 "\ 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 \ AALTs bs [r1, r2]" + +fun asize :: "arexp \ 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 \ 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 "\ v : (erase a)" + shows "decode (code v) (erase a) = Some v" + using assms + by (simp add: decode_code) + + +fun nonalt :: "arexp \ bool" + where + "nonalt (AALTs bs2 rs) = False" +| "nonalt r = True" + + +fun good :: "arexp \ 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)) = (\r' \ set (r1#r2#rs). good r' \ nonalt r')" +| "good (ASEQ _ AZERO _) = False" +| "good (ASEQ _ (AONE _) _) = False" +| "good (ASEQ _ _ AZERO) = False" +| "good (ASEQ cs r1 r2) = (good r1 \ good r2)" +| "good (ASTAR cs r) = True" + + + + +fun fuse :: "bit list \ arexp \ 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 \ 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 \ val \ 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 \ bool" +where + "bnullable (AZERO) = False" +| "bnullable (AONE bs) = True" +| "bnullable (ACHAR bs c) = False" +| "bnullable (AALTs bs rs) = (\r \ set rs. bnullable r)" +| "bnullable (ASEQ bs r1 r2) = (bnullable r1 \ bnullable r2)" +| "bnullable (ASTAR bs r) = True" + +fun + bmkeps :: "arexp \ 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 \ arexp \ 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 \ string \ 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 "\v\set vs. \ v : r \ 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 "\ 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 "\ 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 \ (\ bnullable a \ 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 "\ 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 \ set rs" "bnullable x" + shows "bnullable (AALTs bs rs)" + using assms + apply(induct rs) + apply(auto) + done + +lemma r3: + assumes "\ bnullable r" + " \ x \ 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 "\r \ set rs. nullable (erase r) \ 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 \ 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 \ ('a \ 'b) \ 'b set \ 'a list" + where + "distinctBy [] f acc = []" +| "distinctBy (x#xs) f acc = + (if (f x) \ acc then distinctBy xs f acc + else x # (distinctBy xs f ({f x} \ acc)))" + +fun flts :: "arexp list \ 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 \ 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 \ arexp \ arexp \ 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 \ arexp list \ arexp" + where + "bsimp_AALTs _ [] = AZERO" +| "bsimp_AALTs bs1 [r] = fuse bs1 r" +| "bsimp_AALTs bs1 rs = AALTs bs1 rs" + + +fun bsimp :: "arexp \ 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 \ bit list \ bool" ("_ >>2 _" [51, 50] 50) + where + "AONE bs >>2 bs" +| "ACHAR bs c >>2 bs" +| "\a1 >>2 bs1; a2 >>2 bs2\ \ ASEQ bs a1 a2 >>2 bs @ bs1 @ bs2" +| "r >>2 bs1 \ AALTs bs (r#rs) >>2 bs @ bs1" +| "AALTs bs rs >>2 bs @ bs1 \ AALTs bs (r#rs) >>2 bs @ bs1" +| "ASTAR bs r >>2 bs @ [S]" +| "\r >>2 bs1; ASTAR [] r >>2 bs2\ \ ASTAR bs r >>2 bs @ Z # bs1 @ bs2" +| "r >>2 bs \ (bsimp r) >>2 bs" + + +inductive contains :: "arexp \ bit list \ bool" ("_ >> _" [51, 50] 50) + where + "AONE bs >> bs" +| "ACHAR bs c >> bs" +| "\a1 >> bs1; a2 >> bs2\ \ ASEQ bs a1 a2 >> bs @ bs1 @ bs2" +| "r >> bs1 \ AALTs bs (r#rs) >> bs @ bs1" +| "AALTs bs rs >> bs @ bs1 \ AALTs bs (r#rs) >> bs @ bs1" +| "ASTAR bs r >> bs @ [S]" +| "\r >> bs1; ASTAR [] r >> bs2\ \ 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 "\v\set vs. \ v : r \ 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 "\ 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 "\r \ 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 "\r \ set rs. \ bnullable r" "\r \ 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 "\ bnullable r" "\r \ 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) = (\r \ 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 "\x. \x \ set rs; bnullable x\ \ x >> bmkeps x" "x \ 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 "\v. \ v : erase r \ r >> retrieve r v" + "\v\set vs. \ v : erase r \ flat v \ []" + 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 "\ v : r" + shows "(intern r) >> retrieve (intern r) v" + using contains2[OF assms] retrieve_code[OF assms] + by (simp) + + +lemma contains6: + assumes "\ 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 "\ 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 "\ 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 "\ 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 "\ v : der c (erase r)" + shows "(bder c r) >> retrieve r (injval (erase r) c v) \ + r >> retrieve r (injval (erase r) c v)" + by (simp add: assms contains7 contains7a) + +lemma contains8_iff: + assumes "\ v : ders s (erase r)" + shows "(bders r s) >> retrieve r (flex (erase r) id s v) \ + r >> retrieve r (flex (erase r) id s v)" + using Prf_flex assms contains6 contains7b by blast + + + + +fun + bders_simp :: "arexp \ string \ 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 \ 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) \ 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)) \ 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) \ 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) \ 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 "(\x\rs. asize (bsimp x)) \ sum_list (map asize rs)" + apply(induct rs) + apply(auto) + by (simp add: add_mono bsimp_size) + +lemma bsimp_AALTs_size2: + assumes "\r \ set rs. nonalt r" + shows "asize (bsimp_AALTs bs rs) \ 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 \ fuse bs) rs = map asize rs" + apply(induct rs) + apply(auto simp add: asize_fuse) + done + +lemma flts_size2: + assumes "\bs rs'. AALTs bs rs' \ 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 "\r \ set (map bsimp rs). \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)) = \ (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 "\ (L ` erase ` (set (flts rs))) = \ (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 \ AZERO" "r2 \ AZERO" "\bs. r1 \ 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 "\r \ set rs. bmkeps(bsimp r) = bmkeps r" + shows "map (\r. bmkeps(bsimp r)) rs = map bmkeps rs" + using assms + apply(induct rs) + apply(simp) + apply(simp) + done + +lemma q3: + assumes "\r \ 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 "\r \ 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 "\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 \ AZERO" + shows "flts [r] = [r]" + using assms + apply(case_tac r) + apply(simp_all) + done + +lemma nn1: + assumes "nonnested (AALTs bs rs)" + shows "\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 "\bs1 rs1. AALTs bs1 rs1 \ set (flts rs)" + using assms + apply(induct rs rule: flts.induct) + apply(auto) + done + +lemma nn1qq: + assumes "nonnested (AALTs bs rs)" + shows "\bs1 rs1. AALTs bs1 rs1 \ 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) \ (\r \ 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 "\r \ set rs. nonnested r" + shows "\r \ 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 "\r \ 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 "\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 "\r1 \ set rs. \ bs. r1 \ AALTs bs rs2" + using nn1b assms + by (metis nn1qq) + +lemma nn_flts: + assumes "nonnested (AALTs bs rs)" + shows "\r \ 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))) \ 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 \ (\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 \ Nil" "\r \ set rs. nonalt r" + shows "good (bsimp_AALTs bs rs) \ (\r \ 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) \ Nil" "\r \ set (flts (map bsimp rs)). nonalt r" + shows "good (bsimp (AALTs bs rs)) \ (\r \ 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 \ AZERO" "nonalt r" + shows "flts [r] \ []" + using assms + apply(induct r) + apply(simp_all) + done + +lemma flts1: + assumes "good r" + shows "flts [r] \ []" + using assms + apply(induct r) + apply(simp_all) + apply(case_tac x2a) + apply(simp) + apply(simp) + done + +lemma flts2: + assumes "good r" + shows "\r' \ set (flts [r]). good r' \ 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 "\r \ set rs. good r \ r = AZERO" + shows "\r \ 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 "\r\set rs. good r" + shows "flts rs \ []" + 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 "\r \ set rs. \ 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 "\y. asize y < Suc (sum_list (map asize rs)) \ + good (bsimp y) \ bsimp y = AZERO" + and "\r\set rs. \ 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 "\y. asize y < Suc (sum_list (map asize rs)) \ + good (bsimp y) \ 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 \ AZERO" "r2 \ AZERO" "\bs. r1 \ AONE bs" + shows "good (ASEQ bs r1 r2) = (good r1 \ 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) \ 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 "\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) \ {}" + 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 \ (\r. rs = [r] \ 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 "\r \ set (flts rs). r \ 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 \ set (flts rs)" + using assms + using flts_0 by blast + +lemma qqq1: + shows "AZERO \ set (flts (map bsimp rs))" + by (metis ex_map_conv flts3 good.simps(1) good1) + + +fun nonazero :: "arexp \ bool" + where + "nonazero AZERO = False" +| "nonazero r = True" + +lemma flts_concat: + shows "flts rs = concat (map (\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 "\y. asize y < Suc (sum_list (map asize rs)) \ good y \ bsimp y = y" + "\r'\set rs. good r' \ 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 "\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 "\x2aa bs bs1. \x2aa \ set x2a; fuse bs x2aa >> bs @ bs1\ \ 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 \ fuse bs a >> bs @ bs1" + by simp + +lemma contains50_IFF3: + shows "bsimp_AALTs bs as >> bs @ bs1 \ (\a \ 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 \ (\a \ 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 "\r \ 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 "\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 "\r \ 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 "\x\set list. bnullable x" + shows "\x\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 "\r \ 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 "\x\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 "\x2aa. \x2aa \ set x2a; bnullable x2aa\ \ bmkeps x2aa = bmkeps (bsimp x2aa)" + "\x\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 "\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 "\r \ 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 \ None | Some v \ Some (injval r c v)) = blexer r (c # s)" + apply(simp add: blexer_correctness) + done + +lemma XXX2_helper: + assumes "\y. asize y < Suc (sum_list (map asize rs)) \ good y \ bsimp y = y" + "\r'\set rs. good r' \ nonalt r'" + shows "flts (map (bsimp \ bder c) (flts (map bsimp rs))) = flts (map (bsimp \ 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) \ {}" + 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) \ 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) \ 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 \ []" + shows "good (bders_simp a s) \ 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)) \ {}" + 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)) = {} \ L (erase (bder a aa)) \ {}") + 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 "\ 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 \ (erase r) \ 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 \ (erase r) \ 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 \ (erase r) \ 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 \ 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 \ L (erase a)" + shows "[] \ erase (bsimp (bders a s)) \ 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] \ L (erase a)" + shows "[c] \ (erase a) \ 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] \ L (erase a)" + shows "[c] \ (erase a) \ 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 \ 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. \ v: (erase a)}" + and "L (erase a) = {flat v | v. \ 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 \ L (erase a)" + shows "s \ erase a \ 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 \ 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 \ r \ 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 \ (der c r) \ 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) ((\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 \ (ders s1 r) \ 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 "\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 "\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 (\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 "\r \ set rs. r \ AZERO" "\r \ set rs. nonalt r" + shows "flts rs = rs" + using assms + apply(induct rs rule: flts.induct) + apply(auto) + done + +lemma flts_flts: + assumes "\r \ set rs. good r" + shows "flts (flts rs) = flts rs" + using assms + apply(induct rs taking: "\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 "\r \ set x52. r \ 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 "\r \ set x52. nonalt r") + prefer 2 + apply (metis n0 nn1b test2) + by (metis flts_fuse flts_nothing) + + +lemma iii: + assumes "bsimp_AALTs bs rs \ AZERO" + shows "rs \ []" + 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 "\r \ set as. nonalt r \ r \ 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 "\r \ set as1. nonalt r \ r \ 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 \ a \ AZERO \ nonalt aa \ aa \ AZERO \ (\r\set list. nonalt r \ r \ AZERO)" + assume a2: "\as. \r\set as. nonalt r \ r \ AZERO \ 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 "\r \ set as1. nonalt r \ r \ AZERO" "\r \ set as2. nonalt r \ r \ 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 "\a \ 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 \ 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 \ r \ 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 \ r \ v" + shows "(bders (intern r) s) >> code v" +proof - + from assms have a1: "\ v : r" using Posix_Prf by simp + + from assms have "s \ L r" using Posix1(1) by auto + then have "[] \ L (ders s r)" by (simp add: ders_correctness Ders_def) + then have a2: "\ 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 "\ 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 \ r \ v" + shows "(intern r) >> code v" + using assms + using Posix_Prf contains2 by auto + +lemma PPP0_eq: + assumes "s \ r \ 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 "\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 "\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 "\bs1 bs2. r1 >> bs1 \ r2 >> bs2 \ 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 "\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 "\r \ 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 "\r \ 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 "\r \ 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 "\r \ 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 "\r \ 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 \ 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" "\r \ set rs2. \ 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 "\r \ set rs. (fuse bs r) >> bs2" + using assms + apply(induct rs arbitrary: bs bs2 taking: "\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 \ r >> bs" + using contains55 contains55a by blast + + +definition "SET a \ {bs . a >> bs}" + +lemma "SET(bsimp a) \ SET(a)" + unfolding SET_def + apply(auto simp add: PPP1_eq) + done + +lemma retrieve_code_bder: + assumes "\ 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 "\ 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 \ 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 "\ 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 \ 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 "\ v : ders s r" + shows "\ 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 \ L r" + shows "\ PX r s : r" + using assms unfolding PX_def PV_def + using L1 LX0 Posix_Prf lexer_correct_Some by fastforce + +lemma PV1: + assumes "\ v : ders s r" + shows "(intern r) >> code (PV r s v)" + using assms + by (simp add: Prf_PV contains2) + +lemma PX1: + assumes "s \ L r" + shows "(intern r) >> code (PX r s)" + using assms + by (simp add: Prf_PX contains2) + +lemma PX2: + assumes "s \ 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 \ 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 \ 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 "\ 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 \ 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 "\ v : ders s r" + shows "bders (intern r) s >> code (PV r s v) \ (intern r) >> code (PV r s v)" + by (simp add: PV1 PV3 assms) + +lemma PX_bders_iff: + assumes "s \ L r" + shows "bders (intern r) s >> code (PX r s) \ (intern r) >> code (PX r s)" + by (simp add: PX1 PX3 assms) + +lemma PX4: + assumes "(s1 @ s2) \ 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) \ L r" + shows "bders (intern r) (s1 @ s2) >> code (PX r (s1 @ s2)) \ + (intern r) >> code (PX r (s1 @ s2))" + by (simp add: PX1 PX3 assms) + +lemma PV_bders_iff3: + assumes "\ v : ders (s1 @ s2) r" + shows "bders (intern r) (s1 @ s2) >> code (PV r (s1 @ s2) v) \ + 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) \ L r" + shows "bders (intern r) (s1 @ s2) >> code (PX r (s1 @ s2)) \ + 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 "\ v : ders (s1 @ [c]) r" + shows "bder c (bders (intern r) s1) >> code (PV r (s1 @ [c]) v) \ + bders (intern r) s1 >> code (PV r (s1 @ [c]) v)" + by (simp add: PV_bders_iff3 assms bders_snoc) + +lemma PV_bder_IFF: + assumes "\ v : ders (s1 @ c # s2) r" + shows "bder c (bders (intern r) s1) >> code (PV r (s1 @ c # s2) v) \ + 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]) \ L r" + shows "bder c (bders (intern r) s1) >> code (PX r (s1 @ [c])) \ + bders (intern r) s1 >> code (PX r (s1 @ [c]))" + by (simp add: PX_bders_iff3 assms bders_snoc) + +lemma PV_bder_iff2: + assumes "\ v : ders (c # s1) r" + shows "bders (bder c (intern r)) s1 >> code (PV r (c # s1) v) \ + 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) \ L r" + shows "bders (bder c (intern r)) s1 >> code (PX r (c # s1)) \ + 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 "\ 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 "\ v : ders s (erase r)" + shows "bders r s >> FC r s v \ r >> FC r s v" + unfolding FC_def + by (simp add: assms contains8_iff) + + +lemma FC_bder_iff: + assumes "\ v : der c (erase r)" + shows "bder c r >> FC r [c] v \ r >> FC r [c] v" + apply(subst FC_bders_iff[symmetric]) + apply(simp add: assms) + apply(simp) + done + +lemma FC_bders_iff2: + assumes "\ v : ders (c # s) (erase r)" + shows "bders r (c # s) >> FC r (c # s) v \ 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 "\ 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 \ set rs" + shows "\r \ set rsX. fuse bsX r \ 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)" "\nonalt(bsimp r)" + shows "(\bsX rsX. r = AALTs bsX rsX) \ (\bsX rX1 rX2. r = ASEQ bsX rX1 rX2 \ 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) \ AALTs_subs (AALTs bs rs)" + +lemma nonalt_10: + assumes "nonalt r" "r \ AZERO" + shows "r \ 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 "\r\AALTs_subs (AALTs bs rs). r >> bs2" + using assms + apply(induct rs arbitrary: bs bs2 taking: "\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 "\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 "\r \ 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 \ 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 "\r \ 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) \ AALTs_subs (AALTs bs (rs1 @ rs2))" + apply(induct rs1) + apply(auto) + done + +lemma H5: + shows "AALTs_subs (AALTs bs rs2) \ 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) \ AALTs_subs (AALTs bs rs2)" + apply(induct rs1) + apply(auto) + done + +lemma H10: + shows "AALTs_subs (AALTs bs rs) = (\r \ 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 \ AALTs_subs (AALTs bs rs)" + shows "r \ 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 \ AALTs_subs (fuse bs a)" "r >> bs2" + shows "\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 \ AALTs_subs (fuse bs1 a)" + shows "fuse bs r \ 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 \ AALTs_subs a" + shows "fuse bs r \ AALTs_subs (fuse bs a)" + using AALTs_subs_fuse assms by blast + +lemma HH13: + assumes "r \ (\r \ set rs. AALTs_subs r)" + shows "fuse bs r \ AALTs_subs (AALTs bs rs)" + using assms + using H10 HH12 by blast + + +lemma contains61a_2: + assumes "\r\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) \ (\a\(\ (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) \ (\a\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 (\a. bders a s) (map (fuse bs) as) = map (fuse bs) (map (\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 (\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 \ + AALTs bs2 (map (\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 \ + 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 \ + 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 \ + 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 \ set as" + shows "bder c (bsimp_AALTs bs2 (flts (map bsimp as))) >> bs2 @ bs" + using assms + apply(subgoal_tac "\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 \ set as" + shows "bders (bsimp_AALTs bs2 (flts (map bsimp as))) s >> bs2 @ bs" + using assms + apply(subgoal_tac "\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 "\a \ set as. ((bder c a >> bs) \ (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 "\a \ set as. ((bders a s >> bs) \ (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 "\bsX. (bsimp a1) = AONE bsX") + apply(auto)[1] + using b3 apply fastforce + apply(subst bsimp_ASEQ1) + apply(auto)[3] + apply(simp) + apply(subgoal_tac "\ 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 "\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 "\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 "\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 \ 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 "\s bs. bders a1 s >> bs \ bders (bsimp a1) s >> bs" + "\s bs. bders a2 s >> bs \ 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 "\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 "\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 \ 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 "\ v : ders s (erase r)" "\ v : ders s (erase (bsimp r))" + shows "bders r s >> FC r s v \ bders (bsimp r) s >> FC (bsimp r) s v" + using FC_def contains7b + using assms by metis + +lemma mkeps1: + assumes "s \ L (erase r)" + shows "\ mkeps (ders s (erase r)) : ders s (erase r)" + using assms + by (meson lexer_correct_None lexer_flex mkeps_nullable) + +lemma mkeps2: + assumes "s \ L (erase r)" + shows "\ 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 \ L (erase r)" + shows "bders r s >> FE r s \ bders (bsimp r) s >> FE (bsimp r) s" + using assms + by (simp add: FE_def contains7b mkeps1 mkeps2) + +lemma TX3: + assumes "s \ L (erase r)" + shows "bders r s >> FE r s \ 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 \ 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)) \ (bders_simp a (aa # list) = AZERO)") + apply(auto) + apply(subst (asm) bder_simp_contains_IFF) + apply(simp) + +(* TOBE PROVED *) +lemma + assumes "s \ L (erase r)" + shows "bders_simp r s >> bs \ 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 \ L r" + shows "(bders_simp (intern r) s >> code (PX r s)) \ ((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) \ 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 \ (ders s1 r) \ 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 \ (ders s1 r) \ 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 \ L r" + shows "bders (intern r) s >> code (PX r s)" + using assms + by (simp add: PX3) + + +lemma OO1: + assumes "[c] \ r \ v" + shows "bder c (intern r) >> code v" + using assms + using PPP0_isar by force + +lemma OO1a: + assumes "[c] \ 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] \ 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] \ 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 "\ 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 "(\i \ {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 diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys2/BitCoded2CT.thy --- /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 \Bit-Encodings\ + +datatype bit = Z | S + +fun + code :: "val \ 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 \ val \ val" +where + "Stars_add v (Stars vs) = Stars (v # vs)" +| "Stars_add v _ = Stars [v]" + +function + decode' :: "bit list \ rexp \ (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)) \ 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 \ rexp \ val option" +where + "decode ds r \ (let (v, ds') = decode' ds r + in (if ds' = [] then Some v else None))" + +lemma decode'_code_Stars: + assumes "\v\set vs. \ v : r \ (\x. decode' (code v @ x) r = (v, x)) \ flat v \ []" + shows "decode' (code (Stars vs) @ ds) (STAR r) = (Stars vs, ds)" + using assms + apply(induct vs) + apply(auto) + done + +lemma decode'_code: + assumes "\ 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 "\ 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 \ AALTs bs [r1, r2]" + +fun asize :: "arexp \ 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 \ 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 "\ v : (erase a)" + shows "decode (code v) (erase a) = Some v" + using assms + by (simp add: decode_code) + + +fun nonalt :: "arexp \ bool" + where + "nonalt (AALTs bs2 rs) = False" +| "nonalt r = True" + + +fun good :: "arexp \ 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)) = (\r' \ set (r1#r2#rs). good r' \ nonalt r')" +| "good (ASEQ _ AZERO _) = False" +| "good (ASEQ _ (AONE _) _) = False" +| "good (ASEQ _ _ AZERO) = False" +| "good (ASEQ cs r1 r2) = (good r1 \ good r2)" +| "good (ASTAR cs r) = True" + + + + +fun fuse :: "bit list \ arexp \ 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 \ 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 \ val \ 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 \ bool" +where + "bnullable (AZERO) = False" +| "bnullable (AONE bs) = True" +| "bnullable (ACHAR bs c) = False" +| "bnullable (AALTs bs rs) = (\r \ set rs. bnullable r)" +| "bnullable (ASEQ bs r1 r2) = (bnullable r1 \ bnullable r2)" +| "bnullable (ASTAR bs r) = True" + +fun + bmkeps :: "arexp \ 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 \ arexp \ 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 \ string \ 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 "\v\set vs. \ v : r \ 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 "\ 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 "\ 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 "\ 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 \ (\ bnullable a \ 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 "\ 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 \ set rs" "bnullable x" + shows "bnullable (AALTs bs rs)" + using assms + apply(induct rs) + apply(auto) + done + +lemma r3: + assumes "\ bnullable r" + " \ x \ 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 "\r \ set rs. nullable (erase r) \ 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 "\ 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 "\ 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 "\ v : ders [] r" by fact + then have "\ 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: "\v. \ v : ders s r \ + Some (flex r id s v) = decode (retrieve (bders (intern r) s) v) r" by fact + have asm: "\ v : ders (s @ [c]) r" by fact + then have asm2: "\ 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 \ if bnullable (bders a s) then Some (bmkeps (bders a s)) else None" + + + +definition blexer where + "blexer r s \ 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 \ bders (intern r) s" + define ds where "ds \ ders s r" + assume asm: "nullable ds" + have era: "erase bds = ds" + unfolding ds_def bds_def by simp + have mke: "\ 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 \ fuse bs1) as1 = map (fuse bs1) (map (bder c) as1)" + apply(induct as1) + apply(auto simp add: bder_fuse) + done + + +fun nonnested :: "arexp \ 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 \ ('a \ 'b) \ 'b set \ 'a list" + where + "distinctBy [] f acc = []" +| "distinctBy (x#xs) f acc = + (if (f x) \ acc then distinctBy xs f acc + else x # (distinctBy xs f ({f x} \ acc)))" + +fun flts :: "arexp list \ 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 \ 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 \ arexp \ arexp \ 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 \ arexp list \ arexp" + where + "bsimp_AALTs _ [] = AZERO" +| "bsimp_AALTs bs1 [r] = fuse bs1 r" +| "bsimp_AALTs bs1 rs = AALTs bs1 rs" + + +fun bsimp :: "arexp \ 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 \ bit list \ bool" ("_ >>2 _" [51, 50] 50) + where + "AONE bs >>2 bs" +| "ACHAR bs c >>2 bs" +| "\a1 >>2 bs1; a2 >>2 bs2\ \ ASEQ bs a1 a2 >>2 bs @ bs1 @ bs2" +| "r >>2 bs1 \ AALTs bs (r#rs) >>2 bs @ bs1" +| "AALTs bs rs >>2 bs @ bs1 \ AALTs bs (r#rs) >>2 bs @ bs1" +| "ASTAR bs r >>2 bs @ [S]" +| "\r >>2 bs1; ASTAR [] r >>2 bs2\ \ ASTAR bs r >>2 bs @ Z # bs1 @ bs2" +| "r >>2 bs \ (bsimp r) >>2 bs" + + +inductive contains :: "arexp \ bit list \ bool" ("_ >> _" [51, 50] 50) + where + "AONE bs >> bs" +| "ACHAR bs c >> bs" +| "\a1 >> bs1; a2 >> bs2\ \ ASEQ bs a1 a2 >> bs @ bs1 @ bs2" +| "r >> bs1 \ AALTs bs (r#rs) >> bs @ bs1" +| "AALTs bs rs >> bs @ bs1 \ AALTs bs (r#rs) >> bs @ bs1" +| "ASTAR bs r >> bs @ [S]" +| "\r >> bs1; ASTAR [] r >> bs2\ \ 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 "\v\set vs. \ v : r \ 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 "\ 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 "\r \ 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 "\r \ set rs. \ bnullable r" "\r \ 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 "\ bnullable r" "\r \ 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) = (\r \ 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 "\x. \x \ set rs; bnullable x\ \ x >> bmkeps x" "x \ 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 "\v. \ v : erase r \ r >> retrieve r v" + "\v\set vs. \ v : erase r \ flat v \ []" + 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 "\ v : r" + shows "(intern r) >> retrieve (intern r) v" + using contains2[OF assms] retrieve_code[OF assms] + by (simp) + + +lemma contains6: + assumes "\ 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 "\ 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 "\ 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 "\ 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 "\ v : der c (erase r)" + shows "(bder c r) >> retrieve r (injval (erase r) c v) \ + r >> retrieve r (injval (erase r) c v)" + by (simp add: assms contains7 contains7a) + +lemma contains8_iff: + assumes "\ v : ders s (erase r)" + shows "(bders r s) >> retrieve r (flex (erase r) id s v) \ + r >> retrieve r (flex (erase r) id s v)" + using Prf_flex assms contains6 contains7b by blast + + +fun + bders_simp :: "arexp \ string \ 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 \ 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) \ 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)) \ 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) \ 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) \ 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 "(\x\rs. asize (bsimp x)) \ sum_list (map asize rs)" + apply(induct rs) + apply(auto) + by (simp add: add_mono bsimp_size) + +lemma bsimp_AALTs_size2: + assumes "\r \ set rs. nonalt r" + shows "asize (bsimp_AALTs bs rs) \ 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 \ fuse bs) rs = map asize rs" + apply(induct rs) + apply(auto simp add: asize_fuse) + done + +lemma flts_size2: + assumes "\bs rs'. AALTs bs rs' \ 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 "\r \ set (map bsimp rs). \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)) = \ (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 "\ (L ` erase ` (set (flts rs))) = \ (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 \ AZERO" "r2 \ AZERO" "\bs. r1 \ 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 "\r \ set rs. bmkeps(bsimp r) = bmkeps r" + shows "map (\r. bmkeps(bsimp r)) rs = map bmkeps rs" + using assms + apply(induct rs) + apply(simp) + apply(simp) + done + +lemma q3: + assumes "\r \ 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 "\r \ 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 "\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 \ AZERO" + shows "flts [r] = [r]" + using assms + apply(case_tac r) + apply(simp_all) + done + +lemma nn1: + assumes "nonnested (AALTs bs rs)" + shows "\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 "\bs1 rs1. AALTs bs1 rs1 \ set (flts rs)" + using assms + apply(induct rs rule: flts.induct) + apply(auto) + done + +lemma nn1qq: + assumes "nonnested (AALTs bs rs)" + shows "\bs1 rs1. AALTs bs1 rs1 \ 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) \ (\r \ 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 "\r \ set rs. nonnested r" + shows "\r \ 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 "\r \ 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 "\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 "\r1 \ set rs. \ bs. r1 \ AALTs bs rs2" + using nn1b assms + by (metis nn1qq) + +lemma nn_flts: + assumes "nonnested (AALTs bs rs)" + shows "\r \ 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))) \ 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 \ (\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 \ Nil" "\r \ set rs. nonalt r" + shows "good (bsimp_AALTs bs rs) \ (\r \ 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) \ Nil" "\r \ set (flts (map bsimp rs)). nonalt r" + shows "good (bsimp (AALTs bs rs)) \ (\r \ 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 \ AZERO" "nonalt r" + shows "flts [r] \ []" + using assms + apply(induct r) + apply(simp_all) + done + +lemma flts1: + assumes "good r" + shows "flts [r] \ []" + using assms + apply(induct r) + apply(simp_all) + apply(case_tac x2a) + apply(simp) + apply(simp) + done + +lemma flts2: + assumes "good r" + shows "\r' \ set (flts [r]). good r' \ 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 "\r \ set rs. good r \ r = AZERO" + shows "\r \ 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 "\r\set rs. good r" + shows "flts rs \ []" + 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 "\r \ set rs. \ 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 "\y. asize y < Suc (sum_list (map asize rs)) \ + good (bsimp y) \ bsimp y = AZERO" + and "\r\set rs. \ 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 "\y. asize y < Suc (sum_list (map asize rs)) \ + good (bsimp y) \ 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 \ AZERO" "r2 \ AZERO" "\bs. r1 \ AONE bs" + shows "good (ASEQ bs r1 r2) = (good r1 \ 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) \ 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 "\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) \ {}" + 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 \ (\r. rs = [r] \ 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 "\r \ set (flts rs). r \ 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 \ set (flts rs)" + using assms + using flts_0 by blast + +lemma qqq1: + shows "AZERO \ set (flts (map bsimp rs))" + by (metis ex_map_conv flts3 good.simps(1) good1) + + +fun nonazero :: "arexp \ bool" + where + "nonazero AZERO = False" +| "nonazero r = True" + +lemma flts_concat: + shows "flts rs = concat (map (\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 "\y. asize y < Suc (sum_list (map asize rs)) \ good y \ bsimp y = y" + "\r'\set rs. good r' \ 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 "\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 "\x2aa bs bs1. \x2aa \ set x2a; fuse bs x2aa >> bs @ bs1\ \ 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 "\r \ 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 "\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 "\r \ 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 "\x\set list. bnullable x" + shows "\x\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 "\r \ 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 "\x\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 "\x2aa. \x2aa \ set x2a; bnullable x2aa\ \ bmkeps x2aa = bmkeps (bsimp x2aa)" + "\x\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 "\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 "\r \ 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 \ None | Some v \ Some (injval r c v)) = blexer r (c # s)" + apply(simp add: blexer_correctness) + done + +lemma XXX2_helper: + assumes "\y. asize y < Suc (sum_list (map asize rs)) \ good y \ bsimp y = y" + "\r'\set rs. good r' \ nonalt r'" + shows "flts (map (bsimp \ bder c) (flts (map bsimp rs))) = flts (map (bsimp \ 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) \ {}" + 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) \ 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) \ 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 \ []" + shows "good (bders_simp a s) \ 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)) \ {}" + 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)) = {} \ L (erase (bder a aa)) \ {}") + 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 "\ 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 \ (erase r) \ 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 \ (erase r) \ 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 \ (erase r) \ 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 \ 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 \ L (erase a)" + shows "[] \ erase (bsimp (bders a s)) \ 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] \ L (erase a)" + shows "[c] \ (erase a) \ 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] \ L (erase a)" + shows "[c] \ (erase a) \ 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 \ 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. \ v: (erase a)}" + and "L (erase a) = {flat v | v. \ 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 \ L (erase a)" + shows "s \ erase a \ 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 \ 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 \ r \ 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 \ (der c r) \ 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) ((\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 \ (ders s1 r) \ 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 "\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 "\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 "\r \ set rs. r \ AZERO" "\r \ set rs. nonalt r" + shows "flts rs = rs" + using assms + apply(induct rs rule: flts.induct) + apply(auto) + done + +lemma flts_flts: + assumes "\r \ set rs. good r" + shows "flts (flts rs) = flts rs" + using assms + apply(induct rs taking: "\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 "\r \ set x52. r \ 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 "\r \ set x52. nonalt r") + prefer 2 + apply (metis n0 nn1b test2) + by (metis flts_fuse flts_nothing) + + +lemma iii: + assumes "bsimp_AALTs bs rs \ AZERO" + shows "rs \ []" + 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 "\r \ set as. nonalt r \ r \ 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 "\r \ set as1. nonalt r \ r \ 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 \ a \ AZERO \ nonalt aa \ aa \ AZERO \ (\r\set list. nonalt r \ r \ AZERO)" + assume a2: "\as. \r\set as. nonalt r \ r \ AZERO \ 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 "\r \ set as1. nonalt r \ r \ AZERO" "\r \ set as2. nonalt r \ r \ 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 "\a \ 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 \ 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 \ r \ 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 \ r \ v" + shows "(bders (intern r) s) >> code v" +proof - + from assms have a1: "\ v : r" using Posix_Prf by simp + + from assms have "s \ L r" using Posix1(1) by auto + then have "[] \ L (ders s r)" by (simp add: ders_correctness Ders_def) + then have a2: "\ 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 "\ 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 \ r \ v" + shows "(intern r) >> code v" + using assms + using Posix_Prf contains2 by auto + +lemma PPP0_eq: + assumes "s \ r \ 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 "\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 "\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 "\bs1 bs2. r1 >> bs1 \ r2 >> bs2 \ 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 "\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 "\r \ 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 "\r \ 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 "\r \ 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 "\r \ 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 "\r \ 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 \ 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" "\r \ set rs2. \ 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 "\r \ set rs. (fuse bs r) >> bs2" + using assms + apply(induct rs arbitrary: bs bs2 taking: "\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 \ r >> bs" + using contains55 contains55a by blast + +lemma retrieve_code_bder: + assumes "\ 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 "\ 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 \ 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) \ (\a\set as. a >> bs1)" + by (meson contains0 contains49 contains59 contains60) + +lemma i_know_it_must_be_a_theorem_but_dunno_its_name: + assumes "a \ (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 "\a list1 list2. + \ bder c (bsimp a) >> bs ; + bder c a >> bs; as = [a] @ list2; flts (map bsimp list1) = []; + flts (map bsimp list2) \ []\ + \ 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 "\a list1 list2. + \ a \ set as; bder c (bsimp a) >> bs; + bder c a >> bs; as = list1 @ [a] @ list2; flts (map bsimp list1) \ []; +flts(map bsimp list2) = []\ + \ 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 "\a \ set as. ((bder c a >> bs) \ (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 "\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 \ c) \ (c \ b)" + shows "a \ 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 \ 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 "\ v : ders s r" + shows "\ 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 \ L r" + shows "\ PX r s : r" + using assms unfolding PX_def PV_def + using L1 LX0 Posix_Prf lexer_correct_Some by fastforce + +lemma PV1: + assumes "\ v : ders s r" + shows "(intern r) >> code (PV r s v)" + using assms + by (simp add: Prf_PV contains2) + +lemma PX1: + assumes "s \ L r" + shows "(intern r) >> code (PX r s)" + using assms + by (simp add: Prf_PX contains2) + +lemma PX2: + assumes "s \ 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 \ 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 \ 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 "\ 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 \ 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 "\ v : ders s r" + shows "bders (intern r) s >> code (PV r s v) \ (intern r) >> code (PV r s v)" + by (simp add: PV1 PV3 assms) + +lemma PX_bders_iff: + assumes "s \ L r" + shows "bders (intern r) s >> code (PX r s) \ (intern r) >> code (PX r s)" + by (simp add: PX1 PX3 assms) + +lemma PX4: + assumes "(s1 @ s2) \ 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) \ L r" + shows "bders (intern r) (s1 @ s2) >> code (PX r (s1 @ s2)) \ + (intern r) >> code (PX r (s1 @ s2))" + by (simp add: PX1 PX3 assms) + +lemma PV_bders_iff3: + assumes "\ v : ders (s1 @ s2) r" + shows "bders (intern r) (s1 @ s2) >> code (PV r (s1 @ s2) v) \ + 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) \ L r" + shows "bders (intern r) (s1 @ s2) >> code (PX r (s1 @ s2)) \ + 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 "\ v : ders (s1 @ [c]) r" + shows "bder c (bders (intern r) s1) >> code (PV r (s1 @ [c]) v) \ + bders (intern r) s1 >> code (PV r (s1 @ [c]) v)" + by (simp add: PV_bders_iff3 assms bders_snoc) + +lemma PV_bder_IFF: + assumes "\ v : ders (s1 @ c # s2) r" + shows "bder c (bders (intern r) s1) >> code (PV r (s1 @ c # s2) v) \ + 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]) \ L r" + shows "bder c (bders (intern r) s1) >> code (PX r (s1 @ [c])) \ + bders (intern r) s1 >> code (PX r (s1 @ [c]))" + by (simp add: PX_bders_iff3 assms bders_snoc) + +lemma PV_bder_iff2: + assumes "\ v : ders (c # s1) r" + shows "bders (bder c (intern r)) s1 >> code (PV r (c # s1) v) \ + 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) \ L r" + shows "bders (bder c (intern r)) s1 >> code (PX r (c # s1)) \ + 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 "\ 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 "\ v : ders s (erase r)" + shows "bders r s >> FC r s v \ r >> FC r s v" + unfolding FC_def + by (simp add: assms contains8_iff) + + +lemma FC_bder_iff: + assumes "\ v : der c (erase r)" + shows "bder c r >> FC r [c] v \ 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 "\ 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 "\ v : der c (erase r)" "\ 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 "\ v: ders (s1 @ s2) r" + shows "bders (bsimp (bders (intern r) s1)) s2 >> code (PV r (s1 @ s2) v) \ + 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 \ set rs" + shows "\r \ set rsX. fuse bsX r \ 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)" "\nonalt(bsimp r)" + shows "(\bsX rsX. r = AALTs bsX rsX) \ (\bsX rX1 rX2. r = ASEQ bsX rX1 rX2 \ 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 \ 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 "\bsX. (bsimp a1) = AONE bsX") + apply(auto)[1] + using b3 apply fastforce + apply(subst bsimp_ASEQ1) + apply(auto)[3] + apply(simp) + apply(subgoal_tac "\ 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 "\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 "\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 \ 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 "\rsX bsX. (bsimp r) = AALTs bsX rsX \ (\r \ set rsX. nonalt r)") + prefer 2 + apply (metis n0 nonalt.elims(3)) + apply(auto) + apply(subgoal_tac "bsimp r \ 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 \ set (map bsimp x2a)") + prefer 2 + apply simp + apply(drule in1) + apply(subgoal_tac "rsX \ []") + 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 \ 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 \ L r" + shows "(bders_simp (intern r) s >> code (PX r s)) \ ((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) \ 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 \ (ders s1 r) \ 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 \ (ders s1 r) \ 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 \ L r" + shows "bders (intern r) s >> code (PX r s)" + using assms + by (simp add: PX3) + + +lemma OO1: + assumes "[c] \ r \ v" + shows "bder c (intern r) >> code v" + using assms + using PPP0_isar by force + +lemma OO1a: + assumes "[c] \ 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] \ 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] \ 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] \ 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 \ 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 "\ 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 "(\i \ {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 diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys2/BitCodedCT.thy --- /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 \Bit-Encodings\ + +datatype bit = Z | S + +fun + code :: "val \ 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 \ val \ val" +where + "Stars_add v (Stars vs) = Stars (v # vs)" + +function + decode' :: "bit list \ rexp \ (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)) \ 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 \ rexp \ val option" +where + "decode ds r \ (let (v, ds') = decode' ds r + in (if ds' = [] then Some v else None))" + +lemma decode'_code_Stars: + assumes "\v\set vs. \ v : r \ (\x. decode' (code v @ x) r = (v, x)) \ flat v \ []" + shows "decode' (code (Stars vs) @ ds) (STAR r) = (Stars vs, ds)" + using assms + apply(induct vs) + apply(auto) + done + +lemma decode'_code: + assumes "\ 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 "\ 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 \ AALTs bs [r1, r2]" + +fun asize :: "arexp \ 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 \ 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 "\ v : (erase a)" + shows "decode (code v) (erase a) = Some v" + using assms + by (simp add: decode_code) + + +fun nonalt :: "arexp \ bool" + where + "nonalt (AALTs bs2 rs) = False" +| "nonalt r = True" + + +fun good :: "arexp \ 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)) = (\r' \ set (r1#r2#rs). good r' \ nonalt r')" +| "good (ASEQ _ AZERO _) = False" +| "good (ASEQ _ (AONE _) _) = False" +| "good (ASEQ _ _ AZERO) = False" +| "good (ASEQ cs r1 r2) = (good r1 \ good r2)" +| "good (ASTAR cs r) = True" + + + + +fun fuse :: "bit list \ arexp \ 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 \ 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 \ val \ 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 \ bool" +where + "bnullable (AZERO) = False" +| "bnullable (AONE bs) = True" +| "bnullable (ACHAR bs c) = False" +| "bnullable (AALTs bs rs) = (\r \ set rs. bnullable r)" +| "bnullable (ASEQ bs r1 r2) = (bnullable r1 \ bnullable r2)" +| "bnullable (ASTAR bs r) = True" + +fun + bmkeps :: "arexp \ 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 \ arexp \ 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 \ string \ 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 "\v\set vs. \ v : r \ 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 "\ 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 "\ 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 "\ 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 \ (\ bnullable a \ 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 "\ 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 \ set rs" "bnullable x" + shows "bnullable (AALTs bs rs)" + using assms + apply(induct rs) + apply(auto) + done + +lemma r3: + assumes "\ bnullable r" + " \ x \ 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 "\r \ set rs. nullable (erase r) \ 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 "\ 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 "\ 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 "\ v : ders [] r" by fact + then have "\ 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: "\v. \ v : ders s r \ + Some (flex r id s v) = decode (retrieve (bders (intern r) s) v) r" by fact + have asm: "\ v : ders (s @ [c]) r" by fact + then have asm2: "\ 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 \ if bnullable (bders a s) then Some (bmkeps (bders a s)) else None" + + + +definition blexer where + "blexer r s \ 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 \ bders (intern r) s" + define ds where "ds \ ders s r" + assume asm: "nullable ds" + have era: "erase bds = ds" + unfolding ds_def bds_def by simp + have mke: "\ 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 \ ('a \ 'b) \ 'b set \ 'a list" + where + "distinctBy [] f acc = []" +| "distinctBy (x#xs) f acc = + (if (f x) \ acc then distinctBy xs f acc + else x # (distinctBy xs f ({f x} \ acc)))" + +fun flts :: "arexp list \ 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 \ arexp list \ arexp" + where + "li _ [] = AZERO" +| "li bs [a] = fuse bs a" +| "li bs as = AALTs bs as" + + +fun bsimp_ASEQ :: "bit list \ arexp \ arexp \ 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 \ arexp list \ arexp" + where + "bsimp_AALTs _ [] = AZERO" +| "bsimp_AALTs bs1 [r] = fuse bs1 r" +| "bsimp_AALTs bs1 rs = AALTs bs1 rs" + + +fun bsimp :: "arexp \ 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 \ string \ 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 \ 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) \ 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)) \ 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) \ 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) \ 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 "(\x\rs. asize (bsimp x)) \ sum_list (map asize rs)" + apply(induct rs) + apply(auto) + by (simp add: add_mono bsimp_size) + +lemma bsimp_AALTs_size2: + assumes "\r \ set rs. nonalt r" + shows "asize (bsimp_AALTs bs rs) \ 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 \ fuse bs) rs = map asize rs" + apply(induct rs) + apply(auto simp add: fuse_size) + done + +lemma flts_size2: + assumes "\bs rs'. AALTs bs rs' \ 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 "\r \ set (map bsimp rs). \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)) = \ (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 "\ (L ` erase ` (set (flts rs))) = \ (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 \ AZERO" "r2 \ AZERO" "\bs. r1 \ 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 "\r \ set rs. bmkeps(bsimp r) = bmkeps r" + shows "map (\r. bmkeps(bsimp r)) rs = map bmkeps rs" + using assms + apply(induct rs) + apply(simp) + apply(simp) + done + +lemma q3: + assumes "\r \ 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 "\r \ 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 "\r \ set rs. \ bnullable r" "\r \ 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) = (\r \ 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 "\r \ 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 "\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 \ 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 \ AZERO" + shows "flts [r] = [r]" + using assms + apply(case_tac r) + apply(simp_all) + done + +lemma nn1: + assumes "nonnested (AALTs bs rs)" + shows "\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 "\bs1 rs1. AALTs bs1 rs1 \ set (flts rs)" + using assms + apply(induct rs rule: flts.induct) + apply(auto) + done + +lemma nn1qq: + assumes "nonnested (AALTs bs rs)" + shows "\bs1 rs1. AALTs bs1 rs1 \ 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) \ (\r \ 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 "\r \ set rs. nonnested r" + shows "\r \ 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 "\r \ 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 "\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 "\r1 \ set rs. \ bs. r1 \ AALTs bs rs2" + using nn1b assms + by (metis nn1qq) + +lemma nn_flts: + assumes "nonnested (AALTs bs rs)" + shows "\r \ 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))) \ 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 \ (\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 \ Nil" "\r \ set rs. nonalt r" + shows "good (bsimp_AALTs bs rs) \ (\r \ 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) \ Nil" "\r \ set (flts (map bsimp rs)). nonalt r" + shows "good (bsimp (AALTs bs rs)) \ (\r \ 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 \ AZERO" "nonalt r" + shows "flts [r] \ []" + using assms + apply(induct r) + apply(simp_all) + done + +lemma flts1: + assumes "good r" + shows "flts [r] \ []" + using assms + apply(induct r) + apply(simp_all) + apply(case_tac x2a) + apply(simp) + apply(simp) + done + +lemma flts2: + assumes "good r" + shows "\r' \ set (flts [r]). good r' \ 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 "\r \ set rs. good r \ r = AZERO" + shows "\r \ 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 "\r\set rs. good r" + shows "flts rs \ []" + 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 "\r \ set rs. \ 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 "\y. asize y < Suc (sum_list (map asize rs)) \ + good (bsimp y) \ bsimp y = AZERO" + and "\r\set rs. \ 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 "\y. asize y < Suc (sum_list (map asize rs)) \ + good (bsimp y) \ 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 \ AZERO" "r2 \ AZERO" "\bs. r1 \ AONE bs" + shows "good (ASEQ bs r1 r2) = (good r1 \ 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) \ 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 "\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) \ {}" + 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 \ (\r. rs = [r] \ 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 "\r \ set (flts rs). r \ 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 \ set (flts rs)" + using assms + using flts_0 by blast + +lemma qqq1: + shows "AZERO \ set (flts (map bsimp rs))" + by (metis ex_map_conv flts3 good.simps(1) good1) + + +fun nonazero :: "arexp \ bool" + where + "nonazero AZERO = False" +| "nonazero r = True" + +lemma flts_concat: + shows "flts rs = concat (map (\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 "\y. asize y < Suc (sum_list (map asize rs)) \ good y \ bsimp y = y" + "\r'\set rs. good r' \ 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 "\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 "\r \ 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 "\x\set list. bnullable x" + shows "\x\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 "\r \ 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 "\x\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 "\x2aa. \x2aa \ set x2a; bnullable x2aa\ \ bmkeps x2aa = bmkeps (bsimp x2aa)" + "\x\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 "\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 "\r \ 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 \ None | Some v \ 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 "\y. asize y < Suc (sum_list (map asize rs)) \ good y \ bsimp y = y" + "\r'\set rs. good r' \ nonalt r'" + shows "flts (map (bsimp \ bder c) (flts (map bsimp rs))) = flts (map (bsimp \ 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) \ {}" + 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) \ 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) \ 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 \ []" + shows "good (bders_simp a s) \ 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)) \ {}" + 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)) = {} \ L (erase (bder a aa)) \ {}") + 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 "\ 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 \ (erase r) \ 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 \ (erase r) \ 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 \ (erase r) \ 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 \ 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 \ L (erase a)" + shows "[] \ erase (bsimp (bders a s)) \ 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] \ L (erase a)" + shows "[c] \ (erase a) \ 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] \ L (erase a)" + shows "[c] \ (erase a) \ 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 \ 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 \ (erase r) \ v" "s \ (erase (bsimp r)) \ 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 \ 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 \ 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. \ v: (erase a)}" + and "L (erase a) = {flat v | v. \ 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 \ L (erase a)" + shows "s \ erase a \ 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 \ 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 \ L (der c r)" + shows "s \ der c r \ 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 \ r \ 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 \ (der c r) \ 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) ((\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 \ (ders s1 r) \ 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 "\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 "\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 "\r \ set rs. r \ AZERO" "\r \ set rs. nonalt r" + shows "flts rs = rs" + using assms + apply(induct rs rule: flts.induct) + apply(auto) + done + +lemma flts_flts: + assumes "\r \ set rs. good r" + shows "flts (flts rs) = flts rs" + using assms + apply(induct rs taking: "\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 "\r \ set x52. r \ 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 "\r \ 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 \ AZERO" + shows "rs \ []" + using assms + apply(induct bs rs rule: bsimp_AALTs.induct) + apply(auto) + done + +lemma + assumes "\y. asize y < Suc (sum_list (map asize x52)) \ asize (bsimp y) = asize y \ bsimp y \ AZERO \ bsimp y = y" + "asize (bsimp_AALTs x51 (flts (map bsimp x52))) = Suc (sum_list (map asize x52))" + "bsimp_AALTs x51 (flts (map bsimp x52)) \ 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 \ 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 "\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: "\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 \ 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 "\bs rs. bsimp a = AALTs bs rs \ rs \ Nil \ 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 "\r \ set as. nonalt r \ r \ 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 "\r \ set as1. nonalt r \ r \ 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 \ a \ AZERO \ nonalt aa \ aa \ AZERO \ (\r\set list. nonalt r \ r \ AZERO)" + assume a2: "\as. \r\set as. nonalt r \ r \ AZERO \ 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 "\r \ set as1. nonalt r \ r \ AZERO" "\r \ set as2. nonalt r \ r \ 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 "\a \ 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 \ 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: "\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 "\y \ 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 \ 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 \ 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 \ AZERO) " + "\(\ a01 a02 x02. ( (a1 = ASEQ x02 a01 a02) \ 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] \ 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 " \ 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 \ AZERO) " + "\(\ a01 a02 x02. ( (a1 = ASEQ x02 a01 a02) \ bnullable(a01) ) )" +" (bder c a2 \ AZERO)" + "\(\ a11 a12 x12. ( (a2 = ASEQ x12 a11 a12) \ 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: "\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 "\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 "\bs1 as1. bsimp a1 = AALTs bs1 as1") + apply(case_tac "\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: "\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 "_ < _ \ _ \ _ \_ < _" + 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 "\r \ set (map bsimp x52). \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 \ 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 "\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 "\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 "\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 "(\bs1 rs1. 1 < length rs1 \ bsimp (bder c x43) = AALTs bs1 rs1 ) \ + (\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 "\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) \ 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 "(\i \ {0..n}. i) = n * (n + 1) div 2" + apply(induct n) + apply(simp) + apply(simp) + done + + + + + +end \ No newline at end of file diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys2/Bounds.thy --- /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 \ nat" +where "Size r == Max {size (ders s r) | s. True }" + +fun bar :: "rexp \ string \ 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)) \ 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) \ 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)) \ 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) \ Suc (Size r1 + Size r2)" +unfolding Size_def +apply(auto) +apply(simp add: size_ALT) +apply(subgoal_tac "Max {n. \s. n = Suc (size (ders s r1) + size (ders s r2))} \ + Suc (Max {n. \s. n = size (ders s r1) + size (ders s r2)})") +prefer 2 +oops + + + +end \ No newline at end of file diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys2/Exercises.thy --- /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 \ bool" +where + "zeroable (ZERO) \ True" +| "zeroable (ONE) \ False" +| "zeroable (CH c) \ False" +| "zeroable (ALT r1 r2) \ zeroable r1 \ zeroable r2" +| "zeroable (SEQ r1 r2) \ zeroable r1 \ zeroable r2" +| "zeroable (STAR r) \ False" + +lemma zeroable_correctness: + shows "zeroable r \ L r = {}" +by(induct r)(auto simp add: Sequ_def) + + +fun + atmostempty :: "rexp \ bool" +where + "atmostempty (ZERO) \ True" +| "atmostempty (ONE) \ True" +| "atmostempty (CH c) \ False" +| "atmostempty (ALT r1 r2) \ atmostempty r1 \ atmostempty r2" +| "atmostempty (SEQ r1 r2) \ + zeroable r1 \ zeroable r2 \ (atmostempty r1 \ atmostempty r2)" +| "atmostempty (STAR r) = atmostempty r" + + + +fun + somechars :: "rexp \ bool" +where + "somechars (ZERO) \ False" +| "somechars (ONE) \ False" +| "somechars (CH c) \ True" +| "somechars (ALT r1 r2) \ somechars r1 \ somechars r2" +| "somechars (SEQ r1 r2) \ + (\ zeroable r1 \ somechars r2) \ (\ zeroable r2 \ somechars r1) \ + (somechars r1 \ nullable r2) \ (somechars r2 \ nullable r1)" +| "somechars (STAR r) \ somechars r" + +lemma somechars_correctness: + shows "somechars r \ (\s. s \ [] \ s \ 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 \ \ 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 \ L r \ {[]}" +by(auto simp add: atmostempty_correctness_aux somechars_correctness) + +fun + leastsinglechar :: "rexp \ bool" +where + "leastsinglechar (ZERO) \ False" +| "leastsinglechar (ONE) \ False" +| "leastsinglechar (CH c) \ True" +| "leastsinglechar (ALT r1 r2) \ leastsinglechar r1 \ leastsinglechar r2" +| "leastsinglechar (SEQ r1 r2) \ + (if (zeroable r1 \ zeroable r2) then False + else ((nullable r1 \ leastsinglechar r2) \ (nullable r2 \ leastsinglechar r1)))" +| "leastsinglechar (STAR r) \ leastsinglechar r" + +lemma leastsinglechar_correctness: + "leastsinglechar r \ (\c. [c] \ 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 \ bool" +where + "infinitestrings (ZERO) = False" +| "infinitestrings (ONE) = False" +| "infinitestrings (CH c) = False" +| "infinitestrings (ALT r1 r2) = (infinitestrings r1 \ infinitestrings r2)" +| "infinitestrings (SEQ r1 r2) \ + (\ zeroable r1 \ infinitestrings r2) \ (\ zeroable r2 \ infinitestrings r1)" +| "infinitestrings (STAR r) = (\ atmostempty r)" + + + + + +lemma Star_atmostempty: + assumes "A \ {[]}" + shows "A\ \ {[]}" + 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 \ A\" + assume "\c x A. c # x \ A\ \ \s1 s2. x = s1 @ s2 \ c # s1 \ A \ s2 \ A\" + then have f2: "\cs C c. \csa. c # csa \ C \ c # cs \ C\" + by auto + obtain cc :: "char list \ char" and ccs :: "char list \ char list" where + "\cs. cs = [] \ 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 ({[]}\)" +using Star_atmostempty infinite_super by auto + +lemma Star_empty_finite: + shows "finite ({}\)" +using Star_atmostempty infinite_super by auto + +lemma Star_concat_replicate: + assumes "s \ A" + shows "concat (replicate n s) \ A\" +using assms +by (induct n) (auto) + + +lemma concat_replicate_inj: + assumes "concat (replicate n s) = concat (replicate m s)" "s \ []" + 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 \ {}" + shows "finite A" +apply(subgoal_tac "\s. s \ B") +apply(erule exE) +apply(subgoal_tac "finite {s1 @ s |s1. s1 \ A}") +apply(rule_tac f="\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 \ {}" + shows "finite B" +apply(subgoal_tac "\s. s \ A") +apply(erule exE) +apply(subgoal_tac "finite {s @ s1 |s1. s1 \ B}") +apply(rule_tac f="\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 \ {}" "B \ {}" + shows "finite (A ;; B) \ (finite (A \ 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 \ A" " s \ []" + shows "infinite (A\)" +proof - + have "inj (\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 ((\n. concat (replicate n s)) ` UNIV)" + by (simp add: range_inj_infinite) + moreover + have "((\n. concat (replicate n s)) ` UNIV) \ (A\)" + using Star_concat_replicate assms(1) by auto + ultimately show "infinite (A\)" + using infinite_super by auto +qed + +lemma infinitestrings_correctness: + shows "infinitestrings r \ 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 \ {} \ L r2 \ {}") +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 diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys2/Lexer.thy --- /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 \ 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 \ char \ val \ 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 \ string \ 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 \ None + | Some(v) \ Some(injval r c v))" + + + +section {* Mkeps, Injval Properties *} + +lemma mkeps_nullable: + assumes "nullable(r)" + shows "\ 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 "\ 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 "\ v : der c r" + shows "\ (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 "[] \ r \ 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 \ (der c r) \ v" + shows "(c # s) \ r \ (injval r c v)" +using assms +proof(induct r arbitrary: s v rule: rexp.induct) + case ZERO + have "s \ der c ZERO \ v" by fact + then have "s \ ZERO \ v" by simp + then have "False" by cases + then show "(c # s) \ ZERO \ (injval ZERO c v)" by simp +next + case ONE + have "s \ der c ONE \ v" by fact + then have "s \ ZERO \ v" by simp + then have "False" by cases + then show "(c # s) \ ONE \ (injval ONE c v)" by simp +next + case (CH d) + consider (eq) "c = d" | (ineq) "c \ d" by blast + then show "(c # s) \ (CH d) \ (injval (CH d) c v)" + proof (cases) + case eq + have "s \ der c (CH d) \ v" by fact + then have "s \ ONE \ v" using eq by simp + then have eqs: "s = [] \ v = Void" by cases simp + show "(c # s) \ CH d \ injval (CH d) c v" using eq eqs + by (auto intro: Posix.intros) + next + case ineq + have "s \ der c (CH d) \ v" by fact + then have "s \ ZERO \ v" using ineq by simp + then have "False" by cases + then show "(c # s) \ CH d \ injval (CH d) c v" by simp + qed +next + case (ALT r1 r2) + have IH1: "\s v. s \ der c r1 \ v \ (c # s) \ r1 \ injval r1 c v" by fact + have IH2: "\s v. s \ der c r2 \ v \ (c # s) \ r2 \ injval r2 c v" by fact + have "s \ der c (ALT r1 r2) \ v" by fact + then have "s \ ALT (der c r1) (der c r2) \ v" by simp + then consider (left) v' where "v = Left v'" "s \ der c r1 \ v'" + | (right) v' where "v = Right v'" "s \ L (der c r1)" "s \ der c r2 \ v'" + by cases auto + then show "(c # s) \ ALT r1 r2 \ injval (ALT r1 r2) c v" + proof (cases) + case left + have "s \ der c r1 \ v'" by fact + then have "(c # s) \ r1 \ injval r1 c v'" using IH1 by simp + then have "(c # s) \ ALT r1 r2 \ injval (ALT r1 r2) c (Left v')" by (auto intro: Posix.intros) + then show "(c # s) \ ALT r1 r2 \ injval (ALT r1 r2) c v" using left by simp + next + case right + have "s \ L (der c r1)" by fact + then have "c # s \ L r1" by (simp add: der_correctness Der_def) + moreover + have "s \ der c r2 \ v'" by fact + then have "(c # s) \ r2 \ injval r2 c v'" using IH2 by simp + ultimately have "(c # s) \ ALT r1 r2 \ injval (ALT r1 r2) c (Right v')" + by (auto intro: Posix.intros) + then show "(c # s) \ ALT r1 r2 \ injval (ALT r1 r2) c v" using right by simp + qed +next + case (SEQ r1 r2) + have IH1: "\s v. s \ der c r1 \ v \ (c # s) \ r1 \ injval r1 c v" by fact + have IH2: "\s v. s \ der c r2 \ v \ (c # s) \ r2 \ injval r2 c v" by fact + have "s \ der c (SEQ r1 r2) \ v" by fact + then consider + (left_nullable) v1 v2 s1 s2 where + "v = Left (Seq v1 v2)" "s = s1 @ s2" + "s1 \ der c r1 \ v1" "s2 \ r2 \ v2" "nullable r1" + "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L (der c r1) \ s\<^sub>4 \ L r2)" + | (right_nullable) v1 s1 s2 where + "v = Right v1" "s = s1 @ s2" + "s \ der c r2 \ v1" "nullable r1" "s1 @ s2 \ L (SEQ (der c r1) r2)" + | (not_nullable) v1 v2 s1 s2 where + "v = Seq v1 v2" "s = s1 @ s2" + "s1 \ der c r1 \ v1" "s2 \ r2 \ v2" "\nullable r1" + "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L (der c r1) \ s\<^sub>4 \ L r2)" + by (force split: if_splits elim!: Posix_elims simp add: Sequ_def der_correctness Der_def) + then show "(c # s) \ SEQ r1 r2 \ injval (SEQ r1 r2) c v" + proof (cases) + case left_nullable + have "s1 \ der c r1 \ v1" by fact + then have "(c # s1) \ r1 \ injval r1 c v1" using IH1 by simp + moreover + have "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L (der c r1) \ s\<^sub>4 \ L r2)" by fact + then have "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ (c # s1) @ s\<^sub>3 \ L r1 \ s\<^sub>4 \ L r2)" by (simp add: der_correctness Der_def) + ultimately have "((c # s1) @ s2) \ SEQ r1 r2 \ Seq (injval r1 c v1) v2" using left_nullable by (rule_tac Posix.intros) + then show "(c # s) \ SEQ r1 r2 \ injval (SEQ r1 r2) c v" using left_nullable by simp + next + case right_nullable + have "nullable r1" by fact + then have "[] \ r1 \ (mkeps r1)" by (rule Posix_mkeps) + moreover + have "s \ der c r2 \ v1" by fact + then have "(c # s) \ r2 \ (injval r2 c v1)" using IH2 by simp + moreover + have "s1 @ s2 \ L (SEQ (der c r1) r2)" by fact + then have "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = c # s \ [] @ s\<^sub>3 \ L r1 \ s\<^sub>4 \ L r2)" using right_nullable + by(auto simp add: der_correctness Der_def append_eq_Cons_conv Sequ_def) + ultimately have "([] @ (c # s)) \ SEQ r1 r2 \ Seq (mkeps r1) (injval r2 c v1)" + by(rule Posix.intros) + then show "(c # s) \ SEQ r1 r2 \ injval (SEQ r1 r2) c v" using right_nullable by simp + next + case not_nullable + have "s1 \ der c r1 \ v1" by fact + then have "(c # s1) \ r1 \ injval r1 c v1" using IH1 by simp + moreover + have "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L (der c r1) \ s\<^sub>4 \ L r2)" by fact + then have "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ (c # s1) @ s\<^sub>3 \ L r1 \ s\<^sub>4 \ L r2)" by (simp add: der_correctness Der_def) + ultimately have "((c # s1) @ s2) \ SEQ r1 r2 \ Seq (injval r1 c v1) v2" using not_nullable + by (rule_tac Posix.intros) (simp_all) + then show "(c # s) \ SEQ r1 r2 \ injval (SEQ r1 r2) c v" using not_nullable by simp + qed +next + case (STAR r) + have IH: "\s v. s \ der c r \ v \ (c # s) \ r \ injval r c v" by fact + have "s \ der c (STAR r) \ v" by fact + then consider + (cons) v1 vs s1 s2 where + "v = Seq v1 (Stars vs)" "s = s1 @ s2" + "s1 \ der c r \ v1" "s2 \ (STAR r) \ (Stars vs)" + "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L (der c r) \ s\<^sub>4 \ 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) \ STAR r \ injval (STAR r) c v" + proof (cases) + case cons + have "s1 \ der c r \ v1" by fact + then have "(c # s1) \ r \ injval r c v1" using IH by simp + moreover + have "s2 \ STAR r \ Stars vs" by fact + moreover + have "(c # s1) \ r \ 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) \ []" by simp + moreover + have "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L (der c r) \ s\<^sub>4 \ L (STAR r))" by fact + then have "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ (c # s1) @ s\<^sub>3 \ L r \ s\<^sub>4 \ L (STAR r))" + by (simp add: der_correctness Der_def) + ultimately + have "((c # s1) @ s2) \ STAR r \ Stars (injval r c v1 # vs)" by (rule Posix.intros) + then show "(c # s) \ STAR r \ injval (STAR r) c v" using cons by(simp) + qed +qed + + +section {* Lexer Correctness *} + + +lemma lexer_correct_None: + shows "s \ L r \ 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 \ L r \ (\v. lexer r s = Some(v) \ s \ r \ 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) \ s \ r \ v" + and "(lexer r s = None) \ \(\v. s \ r \ 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 \ (val \ val) => string \ (val \ val)" + where + "flex r f [] = f" +| "flex r f (c#s) = flex (der c r) (\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 \ (ders s1 r) \ v" + shows "(s1 @ s2) \ r \ 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 "\ a : (der c r)" "\ 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) \ r \ injval r c v" "\ v : (der c r)" + shows "s \ der c r \ 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 \ der c r \ a") + prefer 2 + apply (simp add: lexer_correctness(1)) + apply(subgoal_tac "\ a : (der c r)") + prefer 2 + using Posix_Prf apply blast + using injval_inj by blast + + +lemma Posix_flex2: + assumes "(s1 @ s2) \ r \ flex r id s1 v" "\ v : ders s1 r" + shows "s2 \ (ders s1 r) \ 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 \ r \ flex r id s1 v" "\ v : ders s1 r" + shows "[] \ (ders s1 r) \ 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 "\ v : ders s r" + shows "\ 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 diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys2/LexerExt.thy --- /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 \ 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 \ char \ val \ 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 \ string \ 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 \ None + | Some(v) \ 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 "\ 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 "\ 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 "\ v : der c r" + shows "\ (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 "[] \ r \ 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 \ (der c r) \ v" + shows "(c # s) \ r \ (injval r c v)" +using assms +proof(induct r arbitrary: s v rule: rexp.induct) + case ZERO + have "s \ der c ZERO \ v" by fact + then have "s \ ZERO \ v" by simp + then have "False" by cases + then show "(c # s) \ ZERO \ (injval ZERO c v)" by simp +next + case ONE + have "s \ der c ONE \ v" by fact + then have "s \ ZERO \ v" by simp + then have "False" by cases + then show "(c # s) \ ONE \ (injval ONE c v)" by simp +next + case (CHAR d) + consider (eq) "c = d" | (ineq) "c \ d" by blast + then show "(c # s) \ (CHAR d) \ (injval (CHAR d) c v)" + proof (cases) + case eq + have "s \ der c (CHAR d) \ v" by fact + then have "s \ ONE \ v" using eq by simp + then have eqs: "s = [] \ v = Void" by cases simp + show "(c # s) \ CHAR d \ injval (CHAR d) c v" using eq eqs + by (auto intro: Posix.intros) + next + case ineq + have "s \ der c (CHAR d) \ v" by fact + then have "s \ ZERO \ v" using ineq by simp + then have "False" by cases + then show "(c # s) \ CHAR d \ injval (CHAR d) c v" by simp + qed +next + case (ALT r1 r2) + have IH1: "\s v. s \ der c r1 \ v \ (c # s) \ r1 \ injval r1 c v" by fact + have IH2: "\s v. s \ der c r2 \ v \ (c # s) \ r2 \ injval r2 c v" by fact + have "s \ der c (ALT r1 r2) \ v" by fact + then have "s \ ALT (der c r1) (der c r2) \ v" by simp + then consider (left) v' where "v = Left v'" "s \ der c r1 \ v'" + | (right) v' where "v = Right v'" "s \ L (der c r1)" "s \ der c r2 \ v'" + by cases auto + then show "(c # s) \ ALT r1 r2 \ injval (ALT r1 r2) c v" + proof (cases) + case left + have "s \ der c r1 \ v'" by fact + then have "(c # s) \ r1 \ injval r1 c v'" using IH1 by simp + then have "(c # s) \ ALT r1 r2 \ injval (ALT r1 r2) c (Left v')" by (auto intro: Posix.intros) + then show "(c # s) \ ALT r1 r2 \ injval (ALT r1 r2) c v" using left by simp + next + case right + have "s \ L (der c r1)" by fact + then have "c # s \ L r1" by (simp add: der_correctness Der_def) + moreover + have "s \ der c r2 \ v'" by fact + then have "(c # s) \ r2 \ injval r2 c v'" using IH2 by simp + ultimately have "(c # s) \ ALT r1 r2 \ injval (ALT r1 r2) c (Right v')" + by (auto intro: Posix.intros) + then show "(c # s) \ ALT r1 r2 \ injval (ALT r1 r2) c v" using right by simp + qed +next + case (SEQ r1 r2) + have IH1: "\s v. s \ der c r1 \ v \ (c # s) \ r1 \ injval r1 c v" by fact + have IH2: "\s v. s \ der c r2 \ v \ (c # s) \ r2 \ injval r2 c v" by fact + have "s \ der c (SEQ r1 r2) \ v" by fact + then consider + (left_nullable) v1 v2 s1 s2 where + "v = Left (Seq v1 v2)" "s = s1 @ s2" + "s1 \ der c r1 \ v1" "s2 \ r2 \ v2" "nullable r1" + "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L (der c r1) \ s\<^sub>4 \ L r2)" + | (right_nullable) v1 s1 s2 where + "v = Right v1" "s = s1 @ s2" + "s \ der c r2 \ v1" "nullable r1" "s1 @ s2 \ L (SEQ (der c r1) r2)" + | (not_nullable) v1 v2 s1 s2 where + "v = Seq v1 v2" "s = s1 @ s2" + "s1 \ der c r1 \ v1" "s2 \ r2 \ v2" "\nullable r1" + "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L (der c r1) \ s\<^sub>4 \ L r2)" + by (force split: if_splits elim!: Posix_elims simp add: Sequ_def der_correctness Der_def) + then show "(c # s) \ SEQ r1 r2 \ injval (SEQ r1 r2) c v" + proof (cases) + case left_nullable + have "s1 \ der c r1 \ v1" by fact + then have "(c # s1) \ r1 \ injval r1 c v1" using IH1 by simp + moreover + have "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L (der c r1) \ s\<^sub>4 \ L r2)" by fact + then have "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ (c # s1) @ s\<^sub>3 \ L r1 \ s\<^sub>4 \ L r2)" by (simp add: der_correctness Der_def) + ultimately have "((c # s1) @ s2) \ SEQ r1 r2 \ Seq (injval r1 c v1) v2" using left_nullable by (rule_tac Posix.intros) + then show "(c # s) \ SEQ r1 r2 \ injval (SEQ r1 r2) c v" using left_nullable by simp + next + case right_nullable + have "nullable r1" by fact + then have "[] \ r1 \ (mkeps r1)" by (rule Posix_mkeps) + moreover + have "s \ der c r2 \ v1" by fact + then have "(c # s) \ r2 \ (injval r2 c v1)" using IH2 by simp + moreover + have "s1 @ s2 \ L (SEQ (der c r1) r2)" by fact + then have "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = c # s \ [] @ s\<^sub>3 \ L r1 \ s\<^sub>4 \ L r2)" using right_nullable + by(auto simp add: der_correctness Der_def append_eq_Cons_conv Sequ_def) + ultimately have "([] @ (c # s)) \ SEQ r1 r2 \ Seq (mkeps r1) (injval r2 c v1)" + by(rule Posix.intros) + then show "(c # s) \ SEQ r1 r2 \ injval (SEQ r1 r2) c v" using right_nullable by simp + next + case not_nullable + have "s1 \ der c r1 \ v1" by fact + then have "(c # s1) \ r1 \ injval r1 c v1" using IH1 by simp + moreover + have "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L (der c r1) \ s\<^sub>4 \ L r2)" by fact + then have "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ (c # s1) @ s\<^sub>3 \ L r1 \ s\<^sub>4 \ L r2)" by (simp add: der_correctness Der_def) + ultimately have "((c # s1) @ s2) \ SEQ r1 r2 \ Seq (injval r1 c v1) v2" using not_nullable + by (rule_tac Posix.intros) (simp_all) + then show "(c # s) \ SEQ r1 r2 \ injval (SEQ r1 r2) c v" using not_nullable by simp + qed +next +case (UPNTIMES r n s v) + have IH: "\s v. s \ der c r \ v \ (c # s) \ r \ injval r c v" by fact + have "s \ der c (UPNTIMES r n) \ v" by fact + then consider + (cons) v1 vs s1 s2 where + "v = Seq v1 (Stars vs)" "s = s1 @ s2" + "s1 \ der c r \ v1" "s2 \ (UPNTIMES r (n - 1)) \ (Stars vs)" "0 < n" + "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L (der c r) \ s\<^sub>4 \ 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 "\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) \ (UPNTIMES r n) \ injval (UPNTIMES r n) c v" + proof (cases) + case cons + have "s1 \ der c r \ v1" by fact + then have "(c # s1) \ r \ injval r c v1" using IH by simp + moreover + have "s2 \ (UPNTIMES r (n - 1)) \ Stars vs" by fact + moreover + have "(c # s1) \ r \ 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) \ []" by simp + moreover + have "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L (der c r) \ s\<^sub>4 \ L (UPNTIMES r (n - 1)))" by fact + then have "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ (c # s1) @ s\<^sub>3 \ L r \ s\<^sub>4 \ L (UPNTIMES r (n - 1)))" + by (simp add: der_correctness Der_def) + ultimately + have "((c # s1) @ s2) \ UPNTIMES r n \ 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) \ UPNTIMES r n \ injval (UPNTIMES r n) c v" using cons by(simp) + qed + next + case (STAR r) + have IH: "\s v. s \ der c r \ v \ (c # s) \ r \ injval r c v" by fact + have "s \ der c (STAR r) \ v" by fact + then consider + (cons) v1 vs s1 s2 where + "v = Seq v1 (Stars vs)" "s = s1 @ s2" + "s1 \ der c r \ v1" "s2 \ (STAR r) \ (Stars vs)" + "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L (der c r) \ s\<^sub>4 \ 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) \ STAR r \ injval (STAR r) c v" + proof (cases) + case cons + have "s1 \ der c r \ v1" by fact + then have "(c # s1) \ r \ injval r c v1" using IH by simp + moreover + have "s2 \ STAR r \ Stars vs" by fact + moreover + have "(c # s1) \ r \ 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) \ []" by simp + moreover + have "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L (der c r) \ s\<^sub>4 \ L (STAR r))" by fact + then have "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ (c # s1) @ s\<^sub>3 \ L r \ s\<^sub>4 \ L (STAR r))" + by (simp add: der_correctness Der_def) + ultimately + have "((c # s1) @ s2) \ STAR r \ Stars (injval r c v1 # vs)" by (rule Posix.intros) + then show "(c # s) \ STAR r \ injval (STAR r) c v" using cons by(simp) + qed + next + case (NTIMES r n s v) + have IH: "\s v. s \ der c r \ v \ (c # s) \ r \ injval r c v" by fact + have "s \ der c (NTIMES r n) \ v" by fact + then consider + (cons) v1 vs s1 s2 where + "v = Seq v1 (Stars vs)" "s = s1 @ s2" + "s1 \ der c r \ v1" "s2 \ (NTIMES r (n - 1)) \ (Stars vs)" "0 < n" + "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L (der c r) \ s\<^sub>4 \ 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 "\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) \ (NTIMES r n) \ injval (NTIMES r n) c v" + proof (cases) + case cons + have "s1 \ der c r \ v1" by fact + then have "(c # s1) \ r \ injval r c v1" using IH by simp + moreover + have "s2 \ (NTIMES r (n - 1)) \ Stars vs" by fact + moreover + have "(c # s1) \ r \ 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) \ []" by simp + moreover + have "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L (der c r) \ s\<^sub>4 \ L (NTIMES r (n - 1)))" by fact + then have "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ (c # s1) @ s\<^sub>3 \ L r \ s\<^sub>4 \ L (NTIMES r (n - 1)))" + by (simp add: der_correctness Der_def) + ultimately + have "((c # s1) @ s2) \ NTIMES r n \ 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) \ NTIMES r n \ injval (NTIMES r n) c v" using cons by(simp) + qed + next + case (FROMNTIMES r n s v) + have IH: "\s v. s \ der c r \ v \ (c # s) \ r \ injval r c v" by fact + have "s \ der c (FROMNTIMES r n) \ v" by fact + then consider + (cons) v1 vs s1 s2 where + "v = Seq v1 (Stars vs)" "s = s1 @ s2" + "s1 \ der c r \ v1" "s2 \ (FROMNTIMES r (n - 1)) \ (Stars vs)" "0 < n" + "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L (der c r) \ s\<^sub>4 \ L (FROMNTIMES r (n - 1)))" + | (null) v1 vs s1 s2 where + "v = Seq v1 (Stars vs)" "s = s1 @ s2" "s2 \ (STAR r) \ (Stars vs)" + "s1 \ der c r \ v1" "n = 0" + "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L (der c r) \ s\<^sub>4 \ 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 "\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 "\vss. v2 = Stars vss") + apply(clarify) + apply simp + apply(rotate_tac 6) + apply(erule Posix_elims) + apply(auto)[2] + done + then show "(c # s) \ (FROMNTIMES r n) \ injval (FROMNTIMES r n) c v" + proof (cases) + case cons + have "s1 \ der c r \ v1" by fact + then have "(c # s1) \ r \ injval r c v1" using IH by simp + moreover + have "s2 \ (FROMNTIMES r (n - 1)) \ Stars vs" by fact + moreover + have "(c # s1) \ r \ 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) \ []" by simp + moreover + have "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L (der c r) \ s\<^sub>4 \ L (FROMNTIMES r (n - 1)))" by fact + then have "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ (c # s1) @ s\<^sub>3 \ L r \ s\<^sub>4 \ L (FROMNTIMES r (n - 1)))" + by (simp add: der_correctness Der_def) + ultimately + have "((c # s1) @ s2) \ FROMNTIMES r n \ 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) \ FROMNTIMES r n \ injval (FROMNTIMES r n) c v" using cons by(simp) + next + case null + have "s1 \ der c r \ v1" by fact + then have "(c # s1) \ r \ injval r c v1" using IH by simp + moreover + have "s2 \ STAR r \ Stars vs" by fact + moreover + have "(c # s1) \ r \ 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) \ []" by simp + moreover + moreover + have "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L (der c r) \ s\<^sub>4 \ L (STAR r))" by fact + then have "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ (c # s1) @ s\<^sub>3 \ L r \ s\<^sub>4 \ L (STAR r))" + by (simp add: der_correctness Der_def) + ultimately + have "((c # s1) @ s2) \ FROMNTIMES r 0 \ Stars (injval r c v1 # vs)" + apply (rule_tac Posix.intros) back + apply(simp_all) + done + then show "(c # s) \ FROMNTIMES r n \ injval (FROMNTIMES r n) c v" using null + apply(simp) + done + qed + next + case (NMTIMES r n m s v) + have IH: "\s v. s \ der c r \ v \ (c # s) \ r \ injval r c v" by fact + have "s \ der c (NMTIMES r n m) \ v" by fact + then consider + (cons) v1 vs s1 s2 where + "v = Seq v1 (Stars vs)" "s = s1 @ s2" + "s1 \ der c r \ v1" "s2 \ (NMTIMES r (n - 1) (m - 1)) \ (Stars vs)" "0 < n" "n \ m" + "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L (der c r) \ s\<^sub>4 \ L (NMTIMES r (n - 1) (m - 1)))" + | (null) v1 vs s1 s2 where + "v = Seq v1 (Stars vs)" "s = s1 @ s2" "s2 \ (UPNTIMES r (m - 1)) \ (Stars vs)" + "s1 \ der c r \ v1" "n = 0" "0 < m" + "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L (der c r) \ s\<^sub>4 \ 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 "\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 "\vss. v2 = Stars vss") + apply(clarify) + apply simp + apply(rotate_tac 6) + apply(erule Posix_elims) + apply(auto)[2] + done + then show "(c # s) \ (NMTIMES r n m) \ injval (NMTIMES r n m) c v" + proof (cases) + case cons + have "s1 \ der c r \ v1" by fact + then have "(c # s1) \ r \ injval r c v1" using IH by simp + moreover + have "s2 \ (NMTIMES r (n - 1) (m - 1)) \ Stars vs" by fact + moreover + have "(c # s1) \ r \ 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) \ []" by simp + moreover + have "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L (der c r) \ s\<^sub>4 \ L (NMTIMES r (n - 1) (m - 1)))" by fact + then have "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ (c # s1) @ s\<^sub>3 \ L r \ s\<^sub>4 \ L (NMTIMES r (n - 1) (m - 1)))" + by (simp add: der_correctness Der_def) + ultimately + have "((c # s1) @ s2) \ NMTIMES r n m \ 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) \ NMTIMES r n m \ injval (NMTIMES r n m) c v" using cons by(simp) + next + case null + have "s1 \ der c r \ v1" by fact + then have "(c # s1) \ r \ injval r c v1" using IH by simp + moreover + have "s2 \ UPNTIMES r (m - 1) \ Stars vs" by fact + moreover + have "(c # s1) \ r \ 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) \ []" by simp + moreover + moreover + have "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L (der c r) \ s\<^sub>4 \ L (UPNTIMES r (m - 1)))" by fact + then have "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ (c # s1) @ s\<^sub>3 \ L r \ s\<^sub>4 \ L (UPNTIMES r (m - 1)))" + by (simp add: der_correctness Der_def) + ultimately + have "((c # s1) @ s2) \ NMTIMES r 0 m \ Stars (injval r c v1 # vs)" + apply (rule_tac Posix.intros) back + apply(simp_all) + apply(rule null) + done + then show "(c # s) \ NMTIMES r n m \ injval (NMTIMES r n m) c v" using null + apply(simp) + done + qed +qed + +section {* Lexer Correctness *} + +lemma lexer_correct_None: + shows "s \ L r \ 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 \ L r \ (\v. lexer r s = Some(v) \ s \ r \ 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) \ s \ r \ v" + and "(lexer r s = None) \ \(\v. s \ r \ 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 diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys2/PDerivs.thy --- /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 \ (\r' \ rs. {SEQ r' r})" + +lemma SEQs_eq_image: + "SEQs rs r = (\r'. SEQ r' r) ` rs" + by auto + +primrec + pder :: "char \ rexp \ 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) \ (pder c r2)" +| "pder c (SEQ r1 r2) = + (if nullable r1 then SEQs (pder c r1) r2 \ pder c r2 else SEQs (pder c r1) r2)" +| "pder c (STAR r) = SEQs (pder c r) (STAR r)" + +primrec + pders :: "char list \ rexp \ rexp set" +where + "pders [] r = {r}" +| "pders (c # s) r = \ (pders s ` pder c r)" + +abbreviation + pder_set :: "char \ rexp set \ rexp set" +where + "pder_set c rs \ \ (pder c ` rs)" + +abbreviation + pders_set :: "char list \ rexp set \ rexp set" +where + "pders_set s rs \ \ (pders s ` rs)" + +lemma pders_append: + "pders (s1 @ s2) r = \ (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) \ (pders s r2))" +by (induct s) (simp_all) + +lemma pders_CHAR: + shows "pders s (CHAR c) \ {CHAR c, ONE}" +by (induct s) (simp_all) + +subsection \Relating left-quotients and partial derivatives\ + +lemma Sequ_UNION_distrib: +shows "A ;; \(M ` I) = \((\i. A ;; M i) ` I)" +and "\(M ` I) ;; A = \((\i. M i ;; A) ` I)" +by (auto simp add: Sequ_def) + + +lemma Der_pder: + shows "Der c (L r) = \ (L ` pder c r)" +by (induct r) (simp_all add: nullable_correctness Sequ_UNION_distrib) + +lemma Ders_pders: + shows "Ders s (L r) = \ (L ` pders s r)" +proof (induct s arbitrary: r) + case (Cons c s) + have ih: "\r. Ders s (L r) = \ (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 "\ = Ders s (\ (L ` pder c r))" by (simp add: Der_pder) + also have "\ = (\A\(L ` (pder c r)). (Ders s A))" + by (auto simp add: Ders_def) + also have "\ = \ (L ` (pders_set s (pder c r)))" + using ih by auto + also have "\ = \ (L ` (pders (c # s) r))" by simp + finally show "Ders (c # s) (L r) = \ (L ` pders (c # s) r)" . +qed (simp add: Ders_def) + +subsection \Relating derivatives and partial derivatives\ + +lemma der_pder: + shows "\ (L ` (pder c r)) = L (der c r)" +unfolding der_correctness Der_pder by simp + +lemma ders_pders: + shows "\ (L ` (pders s r)) = L (ders s r)" +unfolding der_correctness ders_correctness Ders_pders by simp + + +subsection \Finiteness property of partial derivatives\ + +definition + pders_Set :: "string set \ rexp \ rexp set" +where + "pders_Set A r \ \x \ A. pders x r" + +lemma pders_Set_subsetI: + assumes "\s. s \ A \ pders s r \ C" + shows "pders_Set A r \ C" +using assms unfolding pders_Set_def by (rule UN_least) + +lemma pders_Set_union: + shows "pders_Set (A \ B) r = (pders_Set A r \ pders_Set B r)" +by (simp add: pders_Set_def) + +lemma pders_Set_subset: + shows "A \ B \ pders_Set A r \ pders_Set B r" +by (auto simp add: pders_Set_def) + +definition + "UNIV1 \ 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 \ pders_Set UNIV1 r2" +unfolding UNIV1_def pders_Set_def by auto + + +text \Non-empty suffixes of a string (needed for the cases of @{const SEQ} and @{const STAR} below)\ + +definition + "PSuf s \ {v. v \ [] \ (\u. u @ v = s)}" + +lemma PSuf_snoc: + shows "PSuf (s @ [c]) = (PSuf s) ;; {[c]} \ {[c]}" +unfolding PSuf_def Sequ_def +by (auto simp add: append_eq_append_conv2 append_eq_Cons_conv) + +lemma PSuf_Union: + shows "(\v \ PSuf s ;; {[c]}. f v) = (\v \ 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) \ SEQs (pders s r1) r2 \ (pders_Set (PSuf s) r2)" +proof (induct s rule: rev_induct) + case (snoc c s) + have ih: "pders s (SEQ r1 r2) \ SEQs (pders s r1) r2 \ (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 "\ \ pder_set c (SEQs (pders s r1) r2 \ (pders_Set (PSuf s) r2))" + using ih by fastforce + also have "\ = pder_set c (SEQs (pders s r1) r2) \ pder_set c (pders_Set (PSuf s) r2)" + by (simp) + also have "\ = pder_set c (SEQs (pders s r1) r2) \ pders_Set (PSuf s ;; {[c]}) r2" + by (simp add: pders_Set_snoc) + also + have "\ \ pder_set c (SEQs (pders s r1) r2) \ pder c r2 \ pders_Set (PSuf s ;; {[c]}) r2" + by auto + also + have "\ \ SEQs (pder_set c (pders s r1)) r2 \ pder c r2 \ pders_Set (PSuf s ;; {[c]}) r2" + by (auto simp add: if_splits) + also have "\ = SEQs (pders (s @ [c]) r1) r2 \ pder c r2 \ pders_Set (PSuf s ;; {[c]}) r2" + by (simp add: pders_snoc) + also have "\ \ SEQs (pders (s @ [c]) r1) r2 \ 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 \ UNIV1" + shows "pders_Set (PSuf s) r \ pders_Set UNIV1 r" +using a unfolding UNIV1_def PSuf_def pders_Set_def by auto + +lemma pders_Set_SEQ_aux2: + assumes a: "s \ UNIV1" + shows "SEQs (pders s r1) r2 \ 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) \ SEQs (pders_Set UNIV1 r1) r2 \ 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 \ []" + shows "pders s (STAR r) \ SEQs (pders_Set (PSuf s) r) (STAR r)" +using a +proof (induct s rule: rev_induct) + case (snoc c s) + have ih: "s \ [] \ pders s (STAR r) \ SEQs (pders_Set (PSuf s) r) (STAR r)" by fact + { assume asm: "s \ []" + have "pders (s @ [c]) (STAR r) = pder_set c (pders s (STAR r))" by (simp add: pders_snoc) + also have "\ \ pder_set c (SEQs (pders_Set (PSuf s) r) (STAR r))" + using ih[OF asm] by fast + also have "\ \ SEQs (pder_set c (pders_Set (PSuf s) r)) (STAR r) \ pder c (STAR r)" + by (auto split: if_splits) + also have "\ \ SEQs (pders_Set (PSuf (s @ [c])) r) (STAR r) \ (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 "\ = 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) \ 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 \ 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 \The following relationship between the alphabetic width of regular expressions +(called \awidth\ below) and the number of partial derivatives was proved +by Antimirov~\cite{Antimirov95} and formalized by Max Haslbeck.\ + +fun awidth :: "rexp \ 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) \ 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) \ awidth r" +proof (induction r) + case (ALT r1 r2) + have "card (pders_Set UNIV1 (ALT r1 r2)) = card (pders_Set UNIV1 r1 \ pders_Set UNIV1 r2)" by simp + also have "\ \ card (pders_Set UNIV1 r1) + card (pders_Set UNIV1 r2)" + by(simp add: card_Un_le) + also have "\ \ 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)) \ card (SEQs (pders_Set UNIV1 r1) r2 \ pders_Set UNIV1 r2)" + by (simp add: card_mono finite_pders_set pders_Set_SEQ) + also have "\ \ card (SEQs (pders_Set UNIV1 r1) r2) + card (pders_Set UNIV1 r2)" + by (simp add: card_Un_le) + also have "\ \ card (pders_Set UNIV1 r1) + card (pders_Set UNIV1 r2)" + by (simp add: card_SEQs_pders_Set_le) + also have "\ \ awidth (SEQ r1 r2)" using SEQ.IH by simp + finally show ?case . +next + case (STAR r) + have "card (pders_Set UNIV1 (STAR r)) \ card (SEQs (pders_Set UNIV1 r) (STAR r))" + by (simp add: card_mono finite_pders_set pders_Set_STAR) + also have "\ \ card (pders_Set UNIV1 r)" by (rule card_SEQs_pders_Set_le) + also have "\ \ awidth (STAR r)" by (simp add: STAR.IH) + finally show ?case . +qed (auto) + +text\Antimirov's Theorem 3.4:\ + +theorem card_pders_set_UNIV_le_awidth: + shows "card (pders_Set UNIV r) \ awidth r + 1" +proof - + have "card (insert r (pders_Set UNIV1 r)) \ Suc (card (pders_Set UNIV1 r))" + by(auto simp: card_insert_if[OF finite_pders_Set_UNIV1]) + also have "\ \ Suc (awidth r)" by(simp add: card_pders_set_UNIV1_le_awidth) + finally show ?thesis by(simp add: pders_Set_UNIV) +qed + +text\Antimirov's Corollary 3.5:\ + +corollary card_pders_set_le_awidth: + shows "card (pders_Set A r) \ awidth r + 1" +proof - + have "card (pders_Set A r) \ card (pders_Set UNIV r)" + by (simp add: card_mono finite_pders_set pders_Set_subset) + also have "... \ awidth r + 1" + by (rule card_pders_set_UNIV_le_awidth) + finally show "card (pders_Set A r) \ awidth r + 1" by simp +qed + +(* other result by antimirov *) + +lemma card_pders_awidth: + shows "card (pders s r) \ awidth r + 1" +proof - + have "pders s r \ pders_Set UNIV r" + using pders_Set_def by auto + then have "card (pders s r) \ card (pders_Set UNIV r)" + by (simp add: card_mono finite_pders_set) + then show "card (pders s r) \ awidth r + 1" + using card_pders_set_le_awidth order_trans by blast +qed + + + + + +fun subs :: "rexp \ rexp set" where +"subs ZERO = {ZERO}" | +"subs ONE = {ONE}" | +"subs (CHAR a) = {CHAR a, ONE}" | +"subs (ALT r1 r2) = (subs r1 \ subs r2 \ {ALT r1 r2})" | +"subs (SEQ r1 r2) = (subs r1 \ subs r2 \ {SEQ r1 r2} \ SEQs (subs r1) r2)" | +"subs (STAR r1) = (subs r1 \ {STAR r1} \ 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 \ 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 \ 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 \ size2 r" + apply(induct r) + apply(simp) + apply(simp_all) + done + +lemma subs_card: + shows "card (subs r) \ 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 "\r1 \ subs r. size2 r1 \ 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 \ size2 r" + apply(induct r) + apply(simp_all) + done + +lemma Sum1: + fixes A B :: "nat set" + assumes "A \ B" "finite A" "finite B" + shows "\A \ \B" + using assms + by (simp add: sum_mono2) + +lemma Sum2: + fixes A :: "rexp set" + and f g :: "rexp \ nat" + assumes "finite A" "\x \ A. f x \ g x" + shows "sum f A \ sum g A" + using assms + apply(induct A) + apply(auto) + done + + + + + +lemma pders_max_size: + shows "(sum size2 (pders s r)) \ (Suc (size2 r)) ^ 3" +proof - + have "(sum size2 (pders s r)) \ sum (\_. 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 "... \ (Suc (size2 r * size2 r)) * (sum (\_. 1) (pders s r))" + by simp + also have "... \ (Suc (size2 r * size2 r)) * card (pders s r)" + by simp + also have "... \ (Suc (size2 r * size2 r)) * (Suc (awidth r))" + using Suc_eq_plus1 card_pders_awidth mult_le_mono2 by presburger + also have "... \ (Suc (size2 r * size2 r)) * (Suc (size2 r))" + using Suc_le_mono awidth_size mult_le_mono2 by presburger + also have "... \ (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)) \ (Suc (size2 r)) ^ 3" +proof - + have "(sum size2 (pders_Set A r)) \ sum (\_. 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 "... \ (Suc (size2 r * size2 r)) * (sum (\_. 1) (pders_Set A r))" + by simp + also have "... \ (Suc (size2 r * size2 r)) * card (pders_Set A r)" + by simp + also have "... \ (Suc (size2 r * size2 r)) * (Suc (awidth r))" + using Suc_eq_plus1 card_pders_set_le_awidth mult_le_mono2 by presburger + also have "... \ (Suc (size2 r * size2 r)) * (Suc (size2 r))" + using Suc_le_mono awidth_size mult_le_mono2 by presburger + also have "... \ (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 \ 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 \ size2 r" + apply(induct r) + apply(simp_all) + done + +lemma height_rexp: + fixes r :: rexp + shows "1 \ height r" + apply(induct r) + apply(simp_all) + done + +lemma subs_height: + shows "\r1 \ subs r. height r1 \ Suc (height r)" + apply(induct r) + apply(auto)+ + done + + + +end \ No newline at end of file diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys2/Positions.thy --- /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 \An alternative definition for POSIX values\ + +section \Positions in Values\ + +fun + at :: "val \ nat list \ 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 \ (nat list) set" +where + "Pos (Void) = {[]}" +| "Pos (Char c) = {[]}" +| "Pos (Left v) = {[]} \ {0#ps | ps. ps \ Pos v}" +| "Pos (Right v) = {[]} \ {1#ps | ps. ps \ Pos v}" +| "Pos (Seq v1 v2) = {[]} \ {0#ps | ps. ps \ Pos v1} \ {1#ps | ps. ps \ Pos v2}" +| "Pos (Stars []) = {[]}" +| "Pos (Stars (v#vs)) = {[]} \ {0#ps | ps. ps \ Pos v} \ {Suc n#ps | n ps. n#ps \ Pos (Stars vs)}" + + +lemma Pos_stars: + "Pos (Stars vs) = {[]} \ (\n < length vs. {n#ps | ps. ps \ Pos (vs ! n)})" +apply(induct vs) +apply(auto simp add: insert_ident less_Suc_eq_0_disj) +done + +lemma Pos_empty: + shows "[] \ Pos v" +by (induct v rule: Pos.induct)(auto) + + +abbreviation + "intlen vs \ int (length vs)" + + +definition pflat_len :: "val \ nat list => int" +where + "pflat_len v p \ (if p \ 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 \ Pos v1" + shows "pflat_len v1 p = -1 " +using assms by (simp add: pflat_len_def) + + + +section \Orderings\ + + +definition prefix_list:: "'a list \ 'a list \ bool" ("_ \pre _" [60,59] 60) +where + "ps1 \pre ps2 \ \ps'. ps1 @ps' = ps2" + +definition sprefix_list:: "'a list \ 'a list \ bool" ("_ \spre _" [60,59] 60) +where + "ps1 \spre ps2 \ ps1 \pre ps2 \ ps1 \ ps2" + +inductive lex_list :: "nat list \ nat list \ bool" ("_ \lex _" [60,59] 60) +where + "[] \lex (p#ps)" +| "ps1 \lex ps2 \ (p#ps1) \lex (p#ps2)" +| "p1 < p2 \ (p1#ps1) \lex (p2#ps2)" + +lemma lex_irrfl: + fixes ps1 ps2 :: "nat list" + assumes "ps1 \lex ps2" + shows "ps1 \ ps2" +using assms +by(induct rule: lex_list.induct)(auto) + +lemma lex_simps [simp]: + fixes xs ys :: "nat list" + shows "[] \lex ys \ ys \ []" + and "xs \lex [] \ False" + and "(x # xs) \lex (y # ys) \ (x < y \ (x = y \ xs \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 \lex ps2" "ps2 \lex ps3" + shows "ps1 \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 \ p \lex q \ q \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 \ nat list \ val \ bool" ("_ \val _ _" [60, 60, 59] 60) +where + "v1 \val p v2 \ pflat_len v1 p > pflat_len v2 p \ + (\q \ Pos v1 \ Pos v2. q \lex p \ pflat_len v1 q = pflat_len v2 q)" + +lemma PosOrd_def2: + shows "v1 \val p v2 \ + pflat_len v1 p > pflat_len v2 p \ + (\q \ Pos v1. q \lex p \ pflat_len v1 q = pflat_len v2 q) \ + (\q \ Pos v2. q \lex p \ pflat_len v1 q = pflat_len v2 q)" +unfolding PosOrd_def +apply(auto) +done + + +definition PosOrd_ex:: "val \ val \ bool" ("_ :\val _" [60, 59] 60) +where + "v1 :\val v2 \ \p. v1 \val p v2" + +definition PosOrd_ex_eq:: "val \ val \ bool" ("_ :\val _" [60, 59] 60) +where + "v1 :\val v2 \ v1 :\val v2 \ v1 = v2" + + +lemma PosOrd_trans: + assumes "v1 :\val v2" "v2 :\val v3" + shows "v1 :\val v3" +proof - + from assms obtain p p' + where as: "v1 \val p v2" "v2 \val p' v3" unfolding PosOrd_ex_def by blast + then have pos: "p \ Pos v1" "p' \ Pos v2" unfolding PosOrd_def pflat_len_def + by (smt not_int_zless_negative)+ + have "p = p' \ p \lex p' \ p' \lex p" + by (rule lex_trichotomous) + moreover + { assume "p = p'" + with as have "v1 \val p v3" unfolding PosOrd_def pflat_len_def + by (smt Un_iff) + then have " v1 :\val v3" unfolding PosOrd_ex_def by blast + } + moreover + { assume "p \lex p'" + with as have "v1 \val p v3" unfolding PosOrd_def pflat_len_def + by (smt Un_iff lex_trans) + then have " v1 :\val v3" unfolding PosOrd_ex_def by blast + } + moreover + { assume "p' \lex p" + with as have "v1 \val p' v3" unfolding PosOrd_def + by (smt Un_iff lex_trans pflat_len_def) + then have "v1 :\val v3" unfolding PosOrd_ex_def by blast + } + ultimately show "v1 :\val v3" by blast +qed + +lemma PosOrd_irrefl: + assumes "v :\val v" + shows "False" +using assms unfolding PosOrd_ex_def PosOrd_def +by auto + +lemma PosOrd_assym: + assumes "v1 :\val v2" + shows "\(v2 :\val v1)" +using assms +using PosOrd_irrefl PosOrd_trans by blast + +(* + :\val and :\val are partial orders. +*) + +lemma PosOrd_ordering: + shows "ordering (\v1 v2. v1 :\val v2) (\ v1 v2. v1 :\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 (\v1 v2. v1 :\val v2) (\ v1 v2. v1 :\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 :\val v2 \ (v1 :\val v2 \ v1 \ v2)" +using PosOrd_ordering +unfolding ordering_def +by auto + +lemma PosOrdeq_trans: + assumes "v1 :\val v2" "v2 :\val v3" + shows "v1 :\val v3" +using assms PosOrd_ordering +unfolding ordering_def +by blast + +lemma PosOrdeq_antisym: + assumes "v1 :\val v2" "v2 :\val v1" + shows "v1 = v2" +using assms PosOrd_ordering +unfolding ordering_def +by blast + +lemma PosOrdeq_refl: + shows "v :\val v" +unfolding PosOrd_ex_eq_def +by auto + + +lemma PosOrd_shorterE: + assumes "v1 :\val v2" + shows "length (flat v2) \ 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 :\val v2" +unfolding PosOrd_ex_def PosOrd_def pflat_len_def +using assms Pos_empty by force + +lemma PosOrd_spreI: + assumes "flat v' \spre flat v" + shows "v :\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 \ 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 :\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 :\val Left v2" "flat v1 = flat v2" + shows "v1 :\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 :\val v2" "flat v1 = flat v2" + shows "Left v1 :\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 :\val Left v2 \ v1 :\val v2" +using assms PosOrd_LeftE PosOrd_LeftI +by blast + + +lemma PosOrd_RightE: + assumes "Right v1 :\val Right v2" "flat v1 = flat v2" + shows "v1 :\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 :\val v2" "flat v1 = flat v2" + shows "Right v1 :\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 :\val Right v2 \ v1 :\val v2" +using assms PosOrd_RightE PosOrd_RightI +by blast + + +lemma PosOrd_SeqI1: + assumes "v1 :\val w1" "flat (Seq v1 v2) = flat (Seq w1 w2)" + shows "Seq v1 v2 :\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 :\val w2" "flat v2 = flat w2" + shows "Seq v v2 :\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) :\val (Seq v w2) \ v2 :\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 :\val v2" "flats (v1#vs1) = flats (v2#vs2)" + shows "Stars (v1#vs1) :\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 :\val Stars vs2" "flats vs1 = flats vs2" + shows "Stars (v#vs1) :\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 :\val Stars vs2" "flat (Stars vs1) = flat (Stars vs2)" + shows "Stars (vs @ vs1) :\val Stars (vs @ vs2)" +using assms +apply(induct vs) +apply(simp) +apply(simp add: PosOrd_StarsI2) +done + +lemma PosOrd_StarsE2: + assumes "Stars (v # vs1) :\val Stars (v # vs2)" + shows "Stars vs1 :\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) :\val Stars (vs @ vs2)" + shows "Stars vs1 :\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) :\val Stars (vs @ vs2) \ Stars vs1 :\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 :\val v2 \ v2 :\val v1 \ (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 \ r \ v1" "v2 \ LV r s" + shows "v1 :\val v2" +using assms +proof (induct arbitrary: v2 rule: Posix.induct) + case (Posix_ONE v) + have "v \ LV ONE []" by fact + then have "v = Void" + by (simp add: LV_simps) + then show "Void :\val v" + by (simp add: PosOrd_ex_eq_def) +next + case (Posix_CH c v) + have "v \ LV (CH c) [c]" by fact + then have "v = Char c" + by (simp add: LV_simps) + then show "Char c :\val v" + by (simp add: PosOrd_ex_eq_def) +next + case (Posix_ALT1 s r1 v r2 v2) + have as1: "s \ r1 \ v" by fact + have IH: "\v2. v2 \ LV r1 s \ v :\val v2" by fact + have "v2 \ LV (ALT r1 r2) s" by fact + then have "\ v2 : ALT r1 r2" "flat v2 = s" + by(auto simp add: LV_def prefix_list_def) + then consider + (Left) v3 where "v2 = Left v3" "\ v3 : r1" "flat v3 = s" + | (Right) v3 where "v2 = Right v3" "\ v3 : r2" "flat v3 = s" + by (auto elim: Prf.cases) + then show "Left v :\val v2" + proof(cases) + case (Left v3) + have "v3 \ LV r1 s" using Left(2,3) + by (auto simp add: LV_def prefix_list_def) + with IH have "v :\val v3" by simp + moreover + have "flat v3 = flat v" using as1 Left(3) + by (simp add: Posix1(2)) + ultimately have "Left v :\val Left v3" + by (simp add: PosOrd_ex_eq_def PosOrd_Left_eq) + then show "Left v :\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 :\val Right v3" + unfolding PosOrd_ex_eq_def + by (simp add: PosOrd_Left_Right) + then show "Left v :\val v2" unfolding Right . + qed +next + case (Posix_ALT2 s r2 v r1 v2) + have as1: "s \ r2 \ v" by fact + have as2: "s \ L r1" by fact + have IH: "\v2. v2 \ LV r2 s \ v :\val v2" by fact + have "v2 \ LV (ALT r1 r2) s" by fact + then have "\ v2 : ALT r1 r2" "flat v2 = s" + by(auto simp add: LV_def prefix_list_def) + then consider + (Left) v3 where "v2 = Left v3" "\ v3 : r1" "flat v3 = s" + | (Right) v3 where "v2 = Right v3" "\ v3 : r2" "flat v3 = s" + by (auto elim: Prf.cases) + then show "Right v :\val v2" + proof (cases) + case (Right v3) + have "v3 \ LV r2 s" using Right(2,3) + by (auto simp add: LV_def prefix_list_def) + with IH have "v :\val v3" by simp + moreover + have "flat v3 = flat v" using as1 Right(3) + by (simp add: Posix1(2)) + ultimately have "Right v :\val Right v3" + by (auto simp add: PosOrd_ex_eq_def PosOrd_RightI) + then show "Right v :\val v2" unfolding Right . + next + case (Left v3) + have "v3 \ LV r1 s" using Left(2,3) as2 + by (auto simp add: LV_def prefix_list_def) + then have "flat v3 = flat v \ \ 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 :\val v2" by simp + qed +next + case (Posix_SEQ s1 r1 v1 s2 r2 v2 v3) + have "s1 \ r1 \ v1" "s2 \ r2 \ v2" by fact+ + then have as1: "s1 = flat v1" "s2 = flat v2" by (simp_all add: Posix1(2)) + have IH1: "\v3. v3 \ LV r1 s1 \ v1 :\val v3" by fact + have IH2: "\v3. v3 \ LV r2 s2 \ v2 :\val v3" by fact + have cond: "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L r1 \ s\<^sub>4 \ L r2)" by fact + have "v3 \ LV (SEQ r1 r2) (s1 @ s2)" by fact + then obtain v3a v3b where eqs: + "v3 = Seq v3a v3b" "\ v3a : r1" "\ 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 \pre s1" unfolding prefix_list_def + by (smt L_flat_Prf1 append_eq_append_conv2 append_self_conv) + then have "flat v3a \spre s1 \ (flat v3a = s1 \ flat v3b = s2)" using eqs + by (simp add: sprefix_list_def append_eq_conv_conj) + then have q2: "v1 :\val v3a \ (flat v3a = s1 \ flat v3b = s2)" + using PosOrd_spreI as1(1) eqs by blast + then have "v1 :\val v3a \ (v3a \ LV r1 s1 \ v3b \ LV r2 s2)" using eqs(2,3) + by (auto simp add: LV_def) + then have "v1 :\val v3a \ (v1 :\val v3a \ v2 :\val v3b)" using IH1 IH2 by blast + then have "Seq v1 v2 :\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 :\val v3" unfolding eqs by blast +next + case (Posix_STAR1 s1 r v s2 vs v3) + have "s1 \ r \ v" "s2 \ STAR r \ Stars vs" by fact+ + then have as1: "s1 = flat v" "s2 = flat (Stars vs)" by (auto dest: Posix1(2)) + have IH1: "\v3. v3 \ LV r s1 \ v :\val v3" by fact + have IH2: "\v3. v3 \ LV (STAR r) s2 \ Stars vs :\val v3" by fact + have cond: "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L r \ s\<^sub>4 \ L (STAR r))" by fact + have cond2: "flat v \ []" by fact + have "v3 \ LV (STAR r) (s1 @ s2)" by fact + then consider + (NonEmpty) v3a vs3 where "v3 = Stars (v3a # vs3)" + "\ v3a : r" "\ 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) :\val v3" + proof (cases) + case (NonEmpty v3a vs3) + have "flat (Stars (v3a # vs3)) = s1 @ s2" using NonEmpty(4) . + with cond have "flat v3a \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 \spre s1 \ (flat v3a = s1 \ flat (Stars vs3) = s2)" using NonEmpty(4) + by (simp add: sprefix_list_def append_eq_conv_conj) + then have q2: "v :\val v3a \ (flat v3a = s1 \ flat (Stars vs3) = s2)" + using PosOrd_spreI as1(1) NonEmpty(4) by blast + then have "v :\val v3a \ (v3a \ LV r s1 \ Stars vs3 \ LV (STAR r) s2)" + using NonEmpty(2,3) by (auto simp add: LV_def) + then have "v :\val v3a \ (v :\val v3a \ Stars vs :\val Stars vs3)" using IH1 IH2 by blast + then have "v :\val v3a \ (v = v3a \ Stars vs :\val Stars vs3)" + unfolding PosOrd_ex_eq_def by auto + then have "Stars (v # vs) :\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) :\val v3" unfolding NonEmpty by blast + next + case Empty + have "v3 = Stars []" by fact + then show "Stars (v # vs) :\val v3" + unfolding PosOrd_ex_eq_def using cond2 + by (simp add: PosOrd_shorterI) + qed +next + case (Posix_STAR2 r v2) + have "v2 \ LV (STAR r) []" by fact + then have "v2 = Stars []" + unfolding LV_def by (auto elim: Prf.cases) + then show "Stars [] :\val v2" + by (simp add: PosOrd_ex_eq_def) +qed + + +lemma Posix_PosOrd_reverse: + assumes "s \ r \ v1" + shows "\(\v2 \ LV r s. v2 :\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 \ LV r s" "\v\<^sub>2 \ LV r s. \ v\<^sub>2 :\val v1" + shows "s \ r \ v1" +proof - + have "s \ L r" using assms(1) unfolding LV_def + using L_flat_Prf1 by blast + then obtain vposix where vp: "s \ r \ vposix" + using lexer_correct_Some by blast + with assms(1) have "vposix :\val v1" by (simp add: Posix_PosOrd) + then have "vposix = v1 \ vposix :\val v1" unfolding PosOrd_ex_eq2 by auto + moreover + { assume "vposix :\val v1" + moreover + have "vposix \ LV r s" using vp + using Posix_LV by blast + ultimately have "False" using assms(2) by blast + } + ultimately show "s \ r \ v1" using vp by blast +qed + +lemma Least_existence: + assumes "LV r s \ {}" + shows " \vmin \ LV r s. \v \ LV r s. vmin :\val v" +proof - + from assms + obtain vposix where "s \ r \ vposix" + unfolding LV_def + using L_flat_Prf1 lexer_correct_Some by blast + then have "\v \ LV r s. vposix :\val v" + by (simp add: Posix_PosOrd) + then show "\vmin \ LV r s. \v \ LV r s. vmin :\val v" + using Posix_LV \s \ r \ vposix\ by blast +qed + +lemma Least_existence1: + assumes "LV r s \ {}" + shows " \!vmin \ LV r s. \v \ LV r s. vmin :\val v" +using Least_existence[OF assms] assms +using PosOrdeq_antisym by blast + +lemma Least_existence2: + assumes "LV r s \ {}" + shows " \!vmin \ LV r s. lexer r s = Some vmin \ (\v \ LV r s. vmin :\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 \ {}" + shows " \!vmin \ LV r s. \v \ (LV r s \ {v'. flat v' \spre s}). vmin :\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 :\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 :\val v2 \ v1 \ LV r s \ v2 \ 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 diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys2/PositionsExt.thy --- /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 \ nat list \ 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 \ (nat list) set" +where + "Pos (Void) = {[]}" +| "Pos (Char c) = {[]}" +| "Pos (Left v) = {[]} \ {0#ps | ps. ps \ Pos v}" +| "Pos (Right v) = {[]} \ {1#ps | ps. ps \ Pos v}" +| "Pos (Seq v1 v2) = {[]} \ {0#ps | ps. ps \ Pos v1} \ {1#ps | ps. ps \ Pos v2}" +| "Pos (Stars []) = {[]}" +| "Pos (Stars (v#vs)) = {[]} \ {0#ps | ps. ps \ Pos v} \ {Suc n#ps | n ps. n#ps \ Pos (Stars vs)}" + + +lemma Pos_stars: + "Pos (Stars vs) = {[]} \ (\n < length vs. {n#ps | ps. ps \ Pos (vs ! n)})" +apply(induct vs) +apply(auto simp add: insert_ident less_Suc_eq_0_disj) +done + +lemma Pos_empty: + shows "[] \ Pos v" +by (induct v rule: Pos.induct)(auto) + + +abbreviation + "intlen vs \ int (length vs)" + + +definition pflat_len :: "val \ nat list => int" +where + "pflat_len v p \ (if p \ 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 \ Pos v1" + shows "pflat_len v1 p = -1 " +using assms by (simp add: pflat_len_def) + + + +section {* Orderings *} + + +definition prefix_list:: "'a list \ 'a list \ bool" ("_ \pre _" [60,59] 60) +where + "ps1 \pre ps2 \ \ps'. ps1 @ps' = ps2" + +definition sprefix_list:: "'a list \ 'a list \ bool" ("_ \spre _" [60,59] 60) +where + "ps1 \spre ps2 \ ps1 \pre ps2 \ ps1 \ ps2" + +inductive lex_list :: "nat list \ nat list \ bool" ("_ \lex _" [60,59] 60) +where + "[] \lex (p#ps)" +| "ps1 \lex ps2 \ (p#ps1) \lex (p#ps2)" +| "p1 < p2 \ (p1#ps1) \lex (p2#ps2)" + +lemma lex_irrfl: + fixes ps1 ps2 :: "nat list" + assumes "ps1 \lex ps2" + shows "ps1 \ ps2" +using assms +by(induct rule: lex_list.induct)(auto) + +lemma lex_simps [simp]: + fixes xs ys :: "nat list" + shows "[] \lex ys \ ys \ []" + and "xs \lex [] \ False" + and "(x # xs) \lex (y # ys) \ (x < y \ (x = y \ xs \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 \lex ps2" "ps2 \lex ps3" + shows "ps1 \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 \ p \lex q \ q \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 \ nat list \ val \ bool" ("_ \val _ _" [60, 60, 59] 60) +where + "v1 \val p v2 \ pflat_len v1 p > pflat_len v2 p \ + (\q \ Pos v1 \ Pos v2. q \lex p \ pflat_len v1 q = pflat_len v2 q)" + +lemma PosOrd_def2: + shows "v1 \val p v2 \ + pflat_len v1 p > pflat_len v2 p \ + (\q \ Pos v1. q \lex p \ pflat_len v1 q = pflat_len v2 q) \ + (\q \ Pos v2. q \lex p \ pflat_len v1 q = pflat_len v2 q)" +unfolding PosOrd_def +apply(auto) +done + + +definition PosOrd_ex:: "val \ val \ bool" ("_ :\val _" [60, 59] 60) +where + "v1 :\val v2 \ \p. v1 \val p v2" + +definition PosOrd_ex_eq:: "val \ val \ bool" ("_ :\val _" [60, 59] 60) +where + "v1 :\val v2 \ v1 :\val v2 \ v1 = v2" + + +lemma PosOrd_trans: + assumes "v1 :\val v2" "v2 :\val v3" + shows "v1 :\val v3" +proof - + from assms obtain p p' + where as: "v1 \val p v2" "v2 \val p' v3" unfolding PosOrd_ex_def by blast + then have pos: "p \ Pos v1" "p' \ Pos v2" unfolding PosOrd_def pflat_len_def + by (smt not_int_zless_negative)+ + have "p = p' \ p \lex p' \ p' \lex p" + by (rule lex_trichotomous) + moreover + { assume "p = p'" + with as have "v1 \val p v3" unfolding PosOrd_def pflat_len_def + by (smt Un_iff) + then have " v1 :\val v3" unfolding PosOrd_ex_def by blast + } + moreover + { assume "p \lex p'" + with as have "v1 \val p v3" unfolding PosOrd_def pflat_len_def + by (smt Un_iff lex_trans) + then have " v1 :\val v3" unfolding PosOrd_ex_def by blast + } + moreover + { assume "p' \lex p" + with as have "v1 \val p' v3" unfolding PosOrd_def + by (smt Un_iff lex_trans pflat_len_def) + then have "v1 :\val v3" unfolding PosOrd_ex_def by blast + } + ultimately show "v1 :\val v3" by blast +qed + +lemma PosOrd_irrefl: + assumes "v :\val v" + shows "False" +using assms unfolding PosOrd_ex_def PosOrd_def +by auto + +lemma PosOrd_assym: + assumes "v1 :\val v2" + shows "\(v2 :\val v1)" +using assms +using PosOrd_irrefl PosOrd_trans by blast + +(* + :\val and :\val are partial orders. +*) + +lemma PosOrd_ordering: + shows "ordering (\v1 v2. v1 :\val v2) (\ v1 v2. v1 :\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 (\v1 v2. v1 :\val v2) (\ v1 v2. v1 :\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 :\val v2 \ (v1 :\val v2 \ v1 \ v2)" +using PosOrd_ordering +unfolding ordering_def +by auto + +lemma PosOrdeq_trans: + assumes "v1 :\val v2" "v2 :\val v3" + shows "v1 :\val v3" +using assms PosOrd_ordering +unfolding ordering_def +by blast + +lemma PosOrdeq_antisym: + assumes "v1 :\val v2" "v2 :\val v1" + shows "v1 = v2" +using assms PosOrd_ordering +unfolding ordering_def +by blast + +lemma PosOrdeq_refl: + shows "v :\val v" +unfolding PosOrd_ex_eq_def +by auto + + +lemma PosOrd_shorterE: + assumes "v1 :\val v2" + shows "length (flat v2) \ 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 :\val v2" +unfolding PosOrd_ex_def PosOrd_def pflat_len_def +using assms Pos_empty by force + +lemma PosOrd_spreI: + assumes "flat v' \spre flat v" + shows "v :\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 \ 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 :\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 :\val Left v2" "flat v1 = flat v2" + shows "v1 :\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 :\val v2" "flat v1 = flat v2" + shows "Left v1 :\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 :\val Left v2 \ v1 :\val v2" +using assms PosOrd_LeftE PosOrd_LeftI +by blast + + +lemma PosOrd_RightE: + assumes "Right v1 :\val Right v2" "flat v1 = flat v2" + shows "v1 :\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 :\val v2" "flat v1 = flat v2" + shows "Right v1 :\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 :\val Right v2 \ v1 :\val v2" +using assms PosOrd_RightE PosOrd_RightI +by blast + + +lemma PosOrd_SeqI1: + assumes "v1 :\val w1" "flat (Seq v1 v2) = flat (Seq w1 w2)" + shows "Seq v1 v2 :\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 :\val w2" "flat v2 = flat w2" + shows "Seq v v2 :\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) :\val (Seq v w2) \ v2 :\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 :\val v2" "flats (v1#vs1) = flats (v2#vs2)" + shows "Stars (v1#vs1) :\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 :\val Stars vs2" "flats vs1 = flats vs2" + shows "Stars (v#vs1) :\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 :\val Stars vs2" "flat (Stars vs1) = flat (Stars vs2)" + shows "Stars (vs @ vs1) :\val Stars (vs @ vs2)" +using assms +apply(induct vs) +apply(simp) +apply(simp add: PosOrd_StarsI2) +done + +lemma PosOrd_eq_Stars_zipI: + assumes "\(v1, v2) \ set (zip vs1 vs2). v1 :\val v2" + "length vs1 = length vs2" "flats vs1 = flats vs2" + shows "Stars vs1 :\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) :\val Stars (v # vs2)" + shows "Stars vs1 :\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) :\val Stars (vs @ vs2)" + shows "Stars vs1 :\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) :\val Stars (vs @ vs2) \ Stars vs1 :\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 :\val v2 \ v2 :\val v1 \ (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 \ r \ v1" "v2 \ LV r s" + shows "v1 :\val v2" +using assms +proof (induct arbitrary: v2 rule: Posix.induct) + case (Posix_ONE v) + have "v \ LV ONE []" by fact + then have "v = Void" + by (simp add: LV_simps) + then show "Void :\val v" + by (simp add: PosOrd_ex_eq_def) +next + case (Posix_CHAR c v) + have "v \ LV (CHAR c) [c]" by fact + then have "v = Char c" + by (simp add: LV_simps) + then show "Char c :\val v" + by (simp add: PosOrd_ex_eq_def) +next + case (Posix_ALT1 s r1 v r2 v2) + have as1: "s \ r1 \ v" by fact + have IH: "\v2. v2 \ LV r1 s \ v :\val v2" by fact + have "v2 \ LV (ALT r1 r2) s" by fact + then have "\ v2 : ALT r1 r2" "flat v2 = s" + by(auto simp add: LV_def prefix_list_def) + then consider + (Left) v3 where "v2 = Left v3" "\ v3 : r1" "flat v3 = s" + | (Right) v3 where "v2 = Right v3" "\ v3 : r2" "flat v3 = s" + by (auto elim: Prf.cases) + then show "Left v :\val v2" + proof(cases) + case (Left v3) + have "v3 \ LV r1 s" using Left(2,3) + by (auto simp add: LV_def prefix_list_def) + with IH have "v :\val v3" by simp + moreover + have "flat v3 = flat v" using as1 Left(3) + by (simp add: Posix1(2)) + ultimately have "Left v :\val Left v3" + by (simp add: PosOrd_ex_eq_def PosOrd_Left_eq) + then show "Left v :\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 :\val Right v3" + unfolding PosOrd_ex_eq_def + by (simp add: PosOrd_Left_Right) + then show "Left v :\val v2" unfolding Right . + qed +next + case (Posix_ALT2 s r2 v r1 v2) + have as1: "s \ r2 \ v" by fact + have as2: "s \ L r1" by fact + have IH: "\v2. v2 \ LV r2 s \ v :\val v2" by fact + have "v2 \ LV (ALT r1 r2) s" by fact + then have "\ v2 : ALT r1 r2" "flat v2 = s" + by(auto simp add: LV_def prefix_list_def) + then consider + (Left) v3 where "v2 = Left v3" "\ v3 : r1" "flat v3 = s" + | (Right) v3 where "v2 = Right v3" "\ v3 : r2" "flat v3 = s" + by (auto elim: Prf.cases) + then show "Right v :\val v2" + proof (cases) + case (Right v3) + have "v3 \ LV r2 s" using Right(2,3) + by (auto simp add: LV_def prefix_list_def) + with IH have "v :\val v3" by simp + moreover + have "flat v3 = flat v" using as1 Right(3) + by (simp add: Posix1(2)) + ultimately have "Right v :\val Right v3" + by (auto simp add: PosOrd_ex_eq_def PosOrd_RightI) + then show "Right v :\val v2" unfolding Right . + next + case (Left v3) + have "v3 \ LV r1 s" using Left(2,3) as2 + by (auto simp add: LV_def prefix_list_def) + then have "flat v3 = flat v \ \ 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 :\val v2" by simp + qed +next + case (Posix_SEQ s1 r1 v1 s2 r2 v2 v3) + have "s1 \ r1 \ v1" "s2 \ r2 \ v2" by fact+ + then have as1: "s1 = flat v1" "s2 = flat v2" by (simp_all add: Posix1(2)) + have IH1: "\v3. v3 \ LV r1 s1 \ v1 :\val v3" by fact + have IH2: "\v3. v3 \ LV r2 s2 \ v2 :\val v3" by fact + have cond: "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L r1 \ s\<^sub>4 \ L r2)" by fact + have "v3 \ LV (SEQ r1 r2) (s1 @ s2)" by fact + then obtain v3a v3b where eqs: + "v3 = Seq v3a v3b" "\ v3a : r1" "\ 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 \pre s1" unfolding prefix_list_def + by (smt L_flat_Prf1 append_eq_append_conv2 append_self_conv) + then have "flat v3a \spre s1 \ (flat v3a = s1 \ flat v3b = s2)" using eqs + by (simp add: sprefix_list_def append_eq_conv_conj) + then have q2: "v1 :\val v3a \ (flat v3a = s1 \ flat v3b = s2)" + using PosOrd_spreI as1(1) eqs by blast + then have "v1 :\val v3a \ (v3a \ LV r1 s1 \ v3b \ LV r2 s2)" using eqs(2,3) + by (auto simp add: LV_def) + then have "v1 :\val v3a \ (v1 :\val v3a \ v2 :\val v3b)" using IH1 IH2 by blast + then have "Seq v1 v2 :\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 :\val v3" unfolding eqs by blast +next + case (Posix_STAR1 s1 r v s2 vs v3) + have "s1 \ r \ v" "s2 \ STAR r \ Stars vs" by fact+ + then have as1: "s1 = flat v" "s2 = flat (Stars vs)" by (auto dest: Posix1(2)) + have IH1: "\v3. v3 \ LV r s1 \ v :\val v3" by fact + have IH2: "\v3. v3 \ LV (STAR r) s2 \ Stars vs :\val v3" by fact + have cond: "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L r \ s\<^sub>4 \ L (STAR r))" by fact + have cond2: "flat v \ []" by fact + have "v3 \ LV (STAR r) (s1 @ s2)" by fact + then consider + (NonEmpty) v3a vs3 where "v3 = Stars (v3a # vs3)" + "\ v3a : r" "\ 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) :\val v3" + proof (cases) + case (NonEmpty v3a vs3) + have "flat (Stars (v3a # vs3)) = s1 @ s2" using NonEmpty(4) . + with cond have "flat v3a \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 \spre s1 \ (flat v3a = s1 \ flat (Stars vs3) = s2)" using NonEmpty(4) + by (simp add: sprefix_list_def append_eq_conv_conj) + then have q2: "v :\val v3a \ (flat v3a = s1 \ flat (Stars vs3) = s2)" + using PosOrd_spreI as1(1) NonEmpty(4) by blast + then have "v :\val v3a \ (v3a \ LV r s1 \ Stars vs3 \ LV (STAR r) s2)" + using NonEmpty(2,3) by (auto simp add: LV_def) + then have "v :\val v3a \ (v :\val v3a \ Stars vs :\val Stars vs3)" using IH1 IH2 by blast + then have "v :\val v3a \ (v = v3a \ Stars vs :\val Stars vs3)" + unfolding PosOrd_ex_eq_def by auto + then have "Stars (v # vs) :\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) :\val v3" unfolding NonEmpty by blast + next + case Empty + have "v3 = Stars []" by fact + then show "Stars (v # vs) :\val v3" + unfolding PosOrd_ex_eq_def using cond2 + by (simp add: PosOrd_shorterI) + qed +next + case (Posix_STAR2 r v2) + have "v2 \ LV (STAR r) []" by fact + then have "v2 = Stars []" + unfolding LV_def by (auto elim: Prf.cases) + then show "Stars [] :\val v2" + by (simp add: PosOrd_ex_eq_def) +next + case (Posix_NTIMES1 s1 r v s2 n vs v3) + have "s1 \ r \ v" "s2 \ NTIMES r (n - 1) \ Stars vs" by fact+ + then have as1: "s1 = flat v" "s2 = flats vs" by (auto dest: Posix1(2)) + have IH1: "\v3. v3 \ LV r s1 \ v :\val v3" by fact + have IH2: "\v3. v3 \ LV (NTIMES r (n - 1)) s2 \ Stars vs :\val v3" by fact + have cond: "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L r \ s\<^sub>4 \ L (NTIMES r (n - 1)))" by fact + have cond2: "flat v \ []" by fact + have "v3 \ LV (NTIMES r n) (s1 @ s2)" by fact + then consider + (NonEmpty) v3a vs3 where "v3 = Stars (v3a # vs3)" + "\ v3a : r" "\ 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) :\val v3" + proof (cases) + case (NonEmpty v3a vs3) + have "flats (v3a # vs3) = s1 @ s2" using NonEmpty(4) . + with cond have "flat v3a \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 \spre s1 \ (flat v3a = s1 \ flat (Stars vs3) = s2)" using NonEmpty(4) + by (simp add: sprefix_list_def append_eq_conv_conj) + then have q2: "v :\val v3a \ (flat v3a = s1 \ flat (Stars vs3) = s2)" + using PosOrd_spreI as1(1) NonEmpty(4) by blast + then have "v :\val v3a \ (v3a \ LV r s1 \ Stars vs3 \ LV (NTIMES r (n - 1)) s2)" + using NonEmpty(2,3) by (auto simp add: LV_def) + then have "v :\val v3a \ (v :\val v3a \ Stars vs :\val Stars vs3)" using IH1 IH2 by blast + then have "v :\val v3a \ (v = v3a \ Stars vs :\val Stars vs3)" + unfolding PosOrd_ex_eq_def by auto + then have "Stars (v # vs) :\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) :\val v3" unfolding NonEmpty by blast + next + case Empty + have "v3 = Stars []" by fact + then show "Stars (v # vs) :\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 :\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 [] :\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 \ r \ v" "s2 \ UPNTIMES r (n - 1) \ Stars vs" by fact+ + then have as1: "s1 = flat v" "s2 = flat (Stars vs)" by (auto dest: Posix1(2)) + have IH1: "\v3. v3 \ LV r s1 \ v :\val v3" by fact + have IH2: "\v3. v3 \ LV (UPNTIMES r (n - 1)) s2 \ Stars vs :\val v3" by fact + have cond: "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L r \ s\<^sub>4 \ L (UPNTIMES r (n - 1)))" by fact + have cond2: "flat v \ []" by fact + have "v3 \ LV (UPNTIMES r n) (s1 @ s2)" by fact + then consider + (NonEmpty) v3a vs3 where "v3 = Stars (v3a # vs3)" + "\ v3a : r" "\ 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) :\val v3" + proof (cases) + case (NonEmpty v3a vs3) + have "flats (v3a # vs3) = s1 @ s2" using NonEmpty(4) . + with cond have "flat v3a \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 \spre s1 \ (flat v3a = s1 \ flat (Stars vs3) = s2)" using NonEmpty(4) + by (simp add: sprefix_list_def append_eq_conv_conj) + then have q2: "v :\val v3a \ (flat v3a = s1 \ flat (Stars vs3) = s2)" + using PosOrd_spreI as1(1) NonEmpty(4) by blast + then have "v :\val v3a \ (v3a \ LV r s1 \ Stars vs3 \ LV (UPNTIMES r (n - 1)) s2)" + using NonEmpty(2,3) by (auto simp add: LV_def) + then have "v :\val v3a \ (v :\val v3a \ Stars vs :\val Stars vs3)" using IH1 IH2 by blast + then have "v :\val v3a \ (v = v3a \ Stars vs :\val Stars vs3)" + unfolding PosOrd_ex_eq_def by auto + then have "Stars (v # vs) :\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) :\val v3" unfolding NonEmpty by blast + next + case Empty + have "v3 = Stars []" by fact + then show "Stars (v # vs) :\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 :\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 \ r \ v" "s2 \ FROMNTIMES r (n - 1) \ Stars vs" by fact+ + then have as1: "s1 = flat v" "s2 = flats vs" by (auto dest: Posix1(2)) + have IH1: "\v3. v3 \ LV r s1 \ v :\val v3" by fact + have IH2: "\v3. v3 \ LV (FROMNTIMES r (n - 1)) s2 \ Stars vs :\val v3" by fact + have cond: "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L r \ s\<^sub>4 \ L (FROMNTIMES r (n - 1)))" by fact + have cond2: "flat v \ []" by fact + have "v3 \ LV (FROMNTIMES r n) (s1 @ s2)" by fact + then consider + (NonEmpty) v3a vs3 where "v3 = Stars (v3a # vs3)" + "\ v3a : r" "\ 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) :\val v3" + proof (cases) + case (NonEmpty v3a vs3) + have "flats (v3a # vs3) = s1 @ s2" using NonEmpty(4) . + with cond have "flat v3a \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 \spre s1 \ (flat v3a = s1 \ flat (Stars vs3) = s2)" using NonEmpty(4) + by (simp add: sprefix_list_def append_eq_conv_conj) + then have q2: "v :\val v3a \ (flat v3a = s1 \ flat (Stars vs3) = s2)" + using PosOrd_spreI as1(1) NonEmpty(4) by blast + then have "v :\val v3a \ (v3a \ LV r s1 \ Stars vs3 \ LV (FROMNTIMES r (n - 1)) s2)" + using NonEmpty(2,3) by (auto simp add: LV_def) + then have "v :\val v3a \ (v :\val v3a \ Stars vs :\val Stars vs3)" using IH1 IH2 by blast + then have "v :\val v3a \ (v = v3a \ Stars vs :\val Stars vs3)" + unfolding PosOrd_ex_eq_def by auto + then have "Stars (v # vs) :\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) :\val v3" unfolding NonEmpty by blast + next + case Empty + have "v3 = Stars []" by fact + then show "Stars (v # vs) :\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 \ r \ v" "s2 \ STAR r \ Stars vs" by fact+ + then have as1: "s1 = flat v" "s2 = flat (Stars vs)" by (auto dest: Posix1(2)) + have IH1: "\v3. v3 \ LV r s1 \ v :\val v3" by fact + have IH2: "\v3. v3 \ LV (STAR r) s2 \ Stars vs :\val v3" by fact + have cond: "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L r \ s\<^sub>4 \ L (STAR r))" by fact + have cond2: "flat v \ []" by fact + have "v3 \ LV (FROMNTIMES r 0) (s1 @ s2)" by fact + then consider + (NonEmpty) v3a vs3 where "v3 = Stars (v3a # vs3)" + "\ v3a : r" "\ 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) :\val v3" + proof (cases) + case (NonEmpty v3a vs3) + have "flat (Stars (v3a # vs3)) = s1 @ s2" using NonEmpty(4) . + with cond have "flat v3a \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 \spre s1 \ (flat v3a = s1 \ flat (Stars vs3) = s2)" using NonEmpty(4) + by (simp add: sprefix_list_def append_eq_conv_conj) + then have q2: "v :\val v3a \ (flat v3a = s1 \ flat (Stars vs3) = s2)" + using PosOrd_spreI as1(1) NonEmpty(4) by blast + then have "v :\val v3a \ (v3a \ LV r s1 \ Stars vs3 \ LV (STAR r) s2)" + using NonEmpty(2,3) by (auto simp add: LV_def) + then have "v :\val v3a \ (v :\val v3a \ Stars vs :\val Stars vs3)" using IH1 IH2 by blast + then have "v :\val v3a \ (v = v3a \ Stars vs :\val Stars vs3)" + unfolding PosOrd_ex_eq_def by auto + then have "Stars (v # vs) :\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) :\val v3" unfolding NonEmpty by blast + next + case Empty + have "v3 = Stars []" by fact + then show "Stars (v # vs) :\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 :\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 \ r \ v" "s2 \ NMTIMES r (n - 1) (m - 1) \ Stars vs" by fact+ + then have as1: "s1 = flat v" "s2 = flats vs" by (auto dest: Posix1(2)) + have IH1: "\v3. v3 \ LV r s1 \ v :\val v3" by fact + have IH2: "\v3. v3 \ LV (NMTIMES r (n - 1) (m - 1)) s2 \ Stars vs :\val v3" by fact + have cond: "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L r \ s\<^sub>4 \ L (NMTIMES r (n - 1) (m - 1)))" by fact + have cond2: "flat v \ []" by fact + have "v3 \ LV (NMTIMES r n m) (s1 @ s2)" by fact + then consider + (NonEmpty) v3a vs3 where "v3 = Stars (v3a # vs3)" + "\ v3a : r" "\ 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) :\val v3" + proof (cases) + case (NonEmpty v3a vs3) + have "flats (v3a # vs3) = s1 @ s2" using NonEmpty(4) . + with cond have "flat v3a \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 \spre s1 \ (flat v3a = s1 \ flat (Stars vs3) = s2)" using NonEmpty(4) + by (simp add: sprefix_list_def append_eq_conv_conj) + then have q2: "v :\val v3a \ (flat v3a = s1 \ flat (Stars vs3) = s2)" + using PosOrd_spreI as1(1) NonEmpty(4) by blast + then have "v :\val v3a \ (v3a \ LV r s1 \ Stars vs3 \ LV (NMTIMES r (n - 1) (m - 1)) s2)" + using NonEmpty(2,3) by (auto simp add: LV_def) + then have "v :\val v3a \ (v :\val v3a \ Stars vs :\val Stars vs3)" using IH1 IH2 by blast + then have "v :\val v3a \ (v = v3a \ Stars vs :\val Stars vs3)" + unfolding PosOrd_ex_eq_def by auto + then have "Stars (v # vs) :\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) :\val v3" unfolding NonEmpty by blast + next + case Empty + have "v3 = Stars []" by fact + then show "Stars (v # vs) :\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 \ r \ v" "s2 \ UPNTIMES r (m - 1) \ Stars vs" by fact+ + then have as1: "s1 = flat v" "s2 = flat (Stars vs)" by (auto dest: Posix1(2)) + have IH1: "\v3. v3 \ LV r s1 \ v :\val v3" by fact + have IH2: "\v3. v3 \ LV (UPNTIMES r (m - 1)) s2 \ Stars vs :\val v3" by fact + have cond: "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L r \ s\<^sub>4 \ L (UPNTIMES r (m - 1)))" by fact + have cond2: "flat v \ []" by fact + have "v3 \ LV (NMTIMES r 0 m) (s1 @ s2)" by fact + then consider + (NonEmpty) v3a vs3 where "v3 = Stars (v3a # vs3)" + "\ v3a : r" "\ 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) :\val v3" + proof (cases) + case (NonEmpty v3a vs3) + have "flats (v3a # vs3) = s1 @ s2" using NonEmpty(4) . + with cond have "flat v3a \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 \spre s1 \ (flat v3a = s1 \ flat (Stars vs3) = s2)" using NonEmpty(4) + by (simp add: sprefix_list_def append_eq_conv_conj) + then have q2: "v :\val v3a \ (flat v3a = s1 \ flat (Stars vs3) = s2)" + using PosOrd_spreI as1(1) NonEmpty(4) by blast + then have "v :\val v3a \ (v3a \ LV r s1 \ Stars vs3 \ LV (UPNTIMES r (m - 1)) s2)" + using NonEmpty(2,3) by (auto simp add: LV_def) + then have "v :\val v3a \ (v :\val v3a \ Stars vs :\val Stars vs3)" using IH1 IH2 by blast + then have "v :\val v3a \ (v = v3a \ Stars vs :\val Stars vs3)" + unfolding PosOrd_ex_eq_def by auto + then have "Stars (v # vs) :\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) :\val v3" unfolding NonEmpty by blast + next + case Empty + have "v3 = Stars []" by fact + then show "Stars (v # vs) :\val v3" + unfolding PosOrd_ex_eq_def using cond2 + by (simp add: PosOrd_shorterI) + qed +qed + + +lemma Posix_PosOrd_reverse: + assumes "s \ r \ v1" + shows "\(\v2 \ LV r s. v2 :\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 \ LV r s" "\v\<^sub>2 \ LV r s. \ v\<^sub>2 :\val v1" + shows "s \ r \ v1" +proof - + have "s \ L r" using assms(1) unfolding LV_def + using L_flat_Prf1 by blast + then obtain vposix where vp: "s \ r \ vposix" + using lexer_correct_Some by blast + with assms(1) have "vposix :\val v1" by (simp add: Posix_PosOrd) + then have "vposix = v1 \ vposix :\val v1" unfolding PosOrd_ex_eq2 by auto + moreover + { assume "vposix :\val v1" + moreover + have "vposix \ LV r s" using vp + using Posix_LV by blast + ultimately have "False" using assms(2) by blast + } + ultimately show "s \ r \ v1" using vp by blast +qed + +lemma Least_existence: + assumes "LV r s \ {}" + shows " \vmin \ LV r s. \v \ LV r s. vmin :\val v" +proof - + from assms + obtain vposix where "s \ r \ vposix" + unfolding LV_def + using L_flat_Prf1 lexer_correct_Some by blast + then have "\v \ LV r s. vposix :\val v" + by (simp add: Posix_PosOrd) + then show "\vmin \ LV r s. \v \ LV r s. vmin :\val v" + using Posix_LV \s \ r \ vposix\ by blast +qed + +lemma Least_existence1: + assumes "LV r s \ {}" + shows " \!vmin \ LV r s. \v \ LV r s. vmin :\val v" +using Least_existence[OF assms] assms + using PosOrdeq_antisym by blast + + + + + +lemma Least_existence1_pre: + assumes "LV r s \ {}" + shows " \!vmin \ LV r s. \v \ (LV r s \ {v'. flat v' \spre s}). vmin :\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 :\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 :\val v2 \ v1 \ LV r s \ v2 \ 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 diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys2/README --- /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 + + + + + + + diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys2/ROOT --- /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" diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys2/Re.thy --- /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 \ string set \ string set" ("_ ;; _" [100,100] 100) +where + "A ;; B = {s1 @ s2 | s1 s2. s1 \ A \ s2 \ 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 \ 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) \ (L r2)" + +fun + nullable :: "rexp \ bool" +where + "nullable (NULL) = False" +| "nullable (EMPTY) = True" +| "nullable (CHAR c) = False" +| "nullable (ALT r1 r2) = (nullable r1 \ nullable r2)" +| "nullable (SEQ r1 r2) = (nullable r1 \ nullable r2)" + +lemma nullable_correctness: + shows "nullable r \ [] \ (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 \ 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 \ rexp \ bool" ("\ _ : _" [100, 100] 100) +where + "\\ v1 : r1; \ v2 : r2\ \ \ Seq v1 v2 : SEQ r1 r2" +| "\ v1 : r1 \ \ Left v1 : ALT r1 r2" +| "\ v2 : r2 \ \ Right v2 : ALT r1 r2" +| "\ Void : EMPTY" +| "\ Char c : CHAR c" + +lemma not_nullable_flat: + assumes "\ v : r" "\nullable r" + shows "flat v \ []" +using assms +apply(induct) +apply(auto) +done + +lemma Prf_flat_L: + assumes "\ v : r" shows "flat v \ 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. \ 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 \ val \ bool" ("_ gr\ _") +where + "v1 gr\ v1' \ (Seq v1 v2) gr\ (Seq v1' v2')" +| "v2 gr\ v2' \ (Seq v1 v2) gr\ (Seq v1 v2')" +| "v1 gr\ v2 \ (Left v1) gr\ (Left v2)" +| "v1 gr\ v2 \ (Right v1) gr\ (Right v2)" +| "(Left v2) gr\(Right v1)" +| "(Char c) gr\ (Char c)" +| "(Void) gr\ (Void)" + +lemma Gr_refl: + assumes "\ v : r" + shows "v gr\ v" +using assms +apply(induct) +apply(auto intro: GrOrd.intros) +done + +lemma Gr_total: + assumes "\ v1 : r" "\ v2 : r" + shows "v1 gr\ v2 \ v2 gr\ 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\ v2" "v2 gr\ v3" + and "\ v1 : r" "\ v2 : r" "\ v3 : r" + shows "v1 gr\ 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 \ string \ bool" ("_ \ _" [100, 100] 100) +where + "s1 \ s2 \ \s3. s1 @ s3 = s2" + +definition sprefix :: "string \ string \ bool" ("_ \ _" [100, 100] 100) +where + "s1 \ s2 \ (s1 \ s2 \ s1 \ s2)" + +lemma length_sprefix: + "s1 \ s2 \ length s1 < length s2" +unfolding sprefix_def prefix_def +by (auto) + +definition Prefixes :: "string \ string set" where + "Prefixes s \ {sp. sp \ s}" + +definition Suffixes :: "string \ string set" where + "Suffixes s \ rev ` (Prefixes (rev s))" + +lemma Suffixes_in: + "\s1. s1 @ s2 = s3 \ s2 \ Suffixes s3" +unfolding Suffixes_def Prefixes_def prefix_def image_def +apply(auto) +by (metis rev_rev_ident) + +lemma Prefixes_Cons: + "Prefixes (c # s) = {[]} \ {c # sp | sp. sp \ 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) \ (c # s2)) = (s1 \ s2)" +apply(auto simp add: prefix_def) +done + +lemma prefix_append: + "((s @ s1) \ (s @ s2)) = (s1 \ s2)" +apply(induct s) +apply(simp) +apply(simp add: prefix_Cons) +done + + +definition Values :: "rexp \ string \ val set" where + "Values r s \ {v. \ v : r \ flat v \ s}" + +definition rest :: "val \ string \ string" where + "rest v s \ drop (length (flat v)) s" + +lemma rest_flat: + assumes "flat v1 \ 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 \ 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] \ s then {Char c} else {})" + "Values (ALT r1 r2) s = {Left v | v. v \ Values r1 s} \ {Right v | v. v \ Values r2 s}" + "Values (SEQ r1 r2) s = {Seq v1 v2 | v1 v2. v1 \ Values r1 s \ v2 \ 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="\(x, y). Seq x y" and + A="{(v1, v2) | v1 v2. v1 \ Values r1 s \ v2 \ Values r2 (rest v1 s)}" in finite_surj) +prefer 2 +apply(auto)[1] +apply(rule_tac B="\sp \ Suffixes s. {(v1, v2). v1 \ Values r1 s \ v2 \ 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 \ 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 \ rexp \ 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 \ rexp \ rexp" +where + "ders [] r = r" +| "ders (c # s) r = ders s (der c r)" + + +section {* Injection function *} + +fun injval :: "rexp \ char \ val \ 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 \ string \ 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 \ None + | Some(v) \ Some(injval r c v))" + +fun + lex2 :: "rexp \ string \ val" +where + "lex2 r [] = mkeps r" +| "lex2 r (c#s) = injval r c (lex2 (der c r) s)" + + +section {* Projection function *} + +fun projval :: "rexp \ char \ val \ 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 "\ 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 "\ v : der c r" + shows "\ (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 "\ v : r" and "\s. (flat v) = c # s" + shows "\ (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 "\ 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 "\ v : r" and "\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 "\ 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 \ rexp \ val \ bool" ("_ \ _ \ _" [100, 100, 100] 100) +where + "[] \ EMPTY \ Void" +| "[c] \ (CHAR c) \ (Char c)" +| "s \ r1 \ v \ s \ (ALT r1 r2) \ (Left v)" +| "\s \ r2 \ v; s \ L(r1)\ \ s \ (ALT r1 r2) \ (Right v)" +| "\s1 \ r1 \ v1; s2 \ r2 \ v2; + \(\s3 s4. s3 \ [] \ s3 @ s4 = s2 \ (s1 @ s3) \ L r1 \ s4 \ L r2)\ \ + (s1 @ s2) \ (SEQ r1 r2) \ (Seq v1 v2)" + + +lemma PMatch_mkeps: + assumes "nullable r" + shows "[] \ r \ 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 \ r \ v" + shows "\ 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 \ r \ v" + shows "v \ Values r s" +using assms +apply(simp add: Values_def PMatch1) +by (metis append_Nil2 prefix_def) + +lemma PMatch2: + assumes "s \ (der c r) \ v" + shows "(c#s) \ r \ (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 "\ 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 \ 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 \ L r" + shows "\v. lex r s = Some(v) \ \ v : r \ 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 \ L r" + shows "\v. lex r s = Some(v) \ s \ r \ 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 \ L r" + shows "s \ r \ (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 \ rexp \ val \ bool" ("_ \_ _" [100, 100, 100] 100) +where + "v2 \r2 v2' \ (Seq v1 v2) \(SEQ r1 r2) (Seq v1 v2')" +| "\v1 \r1 v1'; v1 \ v1'\ \ (Seq v1 v2) \(SEQ r1 r2) (Seq v1' v2')" +| "length (flat v1) \ length (flat v2) \ (Left v1) \(ALT r1 r2) (Right v2)" +| "length (flat v2) > length (flat v1) \ (Right v2) \(ALT r1 r2) (Left v1)" +| "v2 \r2 v2' \ (Right v2) \(ALT r1 r2) (Right v2')" +| "v1 \r1 v1' \ (Left v1) \(ALT r1 r2) (Left v1')" +| "Void \EMPTY Void" +| "(Char c) \(CHAR c) (Char c)" + +inductive ValOrd2 :: "val \ val \ bool" ("_ 2\ _" [100, 100] 100) +where + "v2 2\ v2' \ (Seq v1 v2) 2\ (Seq v1 v2')" +| "\v1 2\ v1'; v1 \ v1'\ \ (Seq v1 v2) 2\ (Seq v1' v2')" +| "length (flat v1) \ length (flat v2) \ (Left v1) 2\ (Right v2)" +| "length (flat v2) > length (flat v1) \ (Right v2) 2\ (Left v1)" +| "v2 2\ v2' \ (Right v2) 2\ (Right v2')" +| "v1 2\ v1' \ (Left v1) 2\ (Left v1')" +| "Void 2\ Void" +| "(Char c) 2\ (Char c)" + +lemma Ord1: + "v1 \r v2 \ v1 2\ v2" +apply(induct rule: ValOrd.induct) +apply(auto intro: ValOrd2.intros) +done + +lemma Ord2: + "v1 2\ v2 \ \r. v1 \r v2" +apply(induct v1 v2 rule: ValOrd2.induct) +apply(auto intro: ValOrd.intros) +done + +lemma Ord3: + "\v1 2\ v2; \ v1 : r\ \ v1 \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 \ rexp \ bool" +where + "POSIX v r \ (\ v : r \ (\v'. (\ v' : r \ flat v' \ flat v) \ v \r v'))" + +lemma ValOrd_refl: + assumes "\ v : r" + shows "v \r v" +using assms +apply(induct) +apply(auto intro: ValOrd.intros) +done + +lemma ValOrd_total: + shows "\\ v1 : r; \ v2 : r\ \ v1 \r v2 \ v2 \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 "\\ v1 : r; \ v2 : r; v1 \r v2; v2 \r v1\ \ 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" "\v'. \ v' : r1 \ 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 \ val set" +where + "alleps(NULL) = {}" +| "alleps(EMPTY) = {Void}" +| "alleps(CHAR c) = {}" +| "alleps(SEQ r1 r2) = {Seq v1 v2 | v1 v2. v1 \ alleps r1 \ v2 \ alleps r2}" +| "alleps(ALT r1 r2) = {Left v1 | v1. v1 \ alleps r1} \ {Right v2 | v2. v2 \ alleps r2}" + +fun injall :: "rexp \ char \ val \ 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 \ injall r1 c v1}" +| "injall (ALT r1 r2) c (Right v2) = {Right v | v. v \ injall r2 c v2}" +| "injall (SEQ r1 r2) c (Seq v1 v2) = {Seq v v2 | v. v \ injall r1 c v1}" +| "injall (SEQ r1 r2) c (Left (Seq v1 v2)) = {Seq v v2 | v. v \ injall r1 c v1}" +| "injall (SEQ r1 r2) c (Right v2) = {Seq v v' | v v'. v \ alleps r1 \ v' \ injall r2 c v2}" + +fun + allvals :: "rexp \ string \ val set" +where + "allvals r [] = alleps r" +| "allvals r (c#s) = {v | v v'. v \ injall r c v' \ v' \ allvals (der c r) s}" + +lemma q1: + assumes "v \ alleps r" + shows "\ v : r \ 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 \ [] \ 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 \ [c] \ 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 \ allvals r1 s} \ + {Right v2 | v2. v2 \ 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 \ allvals r1 [] \ v2 \ allvals r2 []}" +by simp + +lemma allvals_SEQ: + shows "allvals (SEQ r1 r2) s = {Seq v1 v2 | v1 v2 s1 s2. + s = s1 @ s2 \ v1 \ allvals r1 s1 \ v2 \ 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" "\ v : r" "flat v = []" + shows "v \ 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. \ v : r \ flat v = []}" +using assms +apply(auto) +apply (simp_all add: q1) +by (simp add: q11) + + +lemma k0: + assumes "\ v : der a r" "v' \ 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 "\ v' : der a r" "v \ injall r a v'" + shows "\ 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 \ allvals r s" + shows "\ v : r \ s \ L (r) \ 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 \ allvals r1 s" + shows "Left v \ 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 \ allvals r2 s" + shows "Right v \ 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 \ alleps r1" "v2 \ allvals r2 s2" + shows "Seq v1 v2 \ 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 \ allvals r1 s1" "v2 \ allvals r2 s2" + shows "Seq v1 v2 \ 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 \ L (r)" + shows "\v. v \ allvals r s \ 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 \ L (r)" "\ v : r" "flat v = s" + shows "v \ 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 \ L(r)" + shows "allvals r s = {v. \ v : r \ s \ L (r) \ flat v = s}" +using assms +apply(auto) +apply (simp add: q22) +apply (simp add: q22) +by (simp add: q22b) + +lemma r3a: + assumes "v' \ allvals (SEQ r1 r2) (s1 @ s2)" + "(s1 @ s2) \ L (SEQ r1 r2)" + shows "\v1 v2. v' = Seq v1 v2 \ v1 \ allvals r1 s1 \ v2 \ 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 \ allvals (SEQ r1 r2) (s1 @ s2)" + "flat v1 = s1" "flat v2 = s2" + "(s1 @ s2) \ L (SEQ r1 r2)" + shows "v1 \ allvals r1 s1" "v2 \ 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 \ rexp \ string \ bool" +where + "POSIX2 v r s \ (\ v : r \ flat v = s \ (\v'\allvals r s. v \r v'))" + + + + +lemma k1: + assumes "nullable r" + shows "POSIX2 v r [] \ \v' \ alleps r. v \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 \ L r" + shows "POSIX2 v r s \ \v' \ allvals r s. v \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 \ r \ v" + shows "v \ 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 \ alleps r" +using assms +apply(induct r) +apply(auto) +done + +lemma injval_injall: + assumes "\ v : der a r" + shows "injval r a v \ 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 \r mkeps r" "flat v = []" "\ 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 \ alleps r" "nullable r" + shows "mkeps r \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 "\s3. s1 @ s3 \ L r1 \ s3 = [] \ (\s4. s3 @ s4 = s2 \ s4 \ L r2)" + and "s1 \ L r1" "s2 \ L r2" "(s1' @ s2') \ (s1 @ s2)" + and "s1'@ s2' \ L (SEQ r1 r2)" "s1' \ L r1" + shows "s1' \ 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 \(der a r) v2" "s \ (der a r) \ v1" "s' \ L (der a r)" + "v1 \ allvals (der a r) s" "v2 \ allvals (der a r) s'" "s' \ s" + shows "injval r a v1 \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 "\v' \ allvals r s. v \r v'" "s \ L r" "\ v : r" "flat v = s" + shows "s \ r \ 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 \ r \ v" "v' \ allvals r s" + shows "v \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 \ r \ 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 "(\x1. x = Left x1) \ (\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 "(\x1. x = Left x1) \ (\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 "(\x1 x2. x = Seq x1 x2 \ 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 \ L(r) \ \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 \ r \ v" "v' \ Values r s" + shows "v \r v' \ 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 \ r \ 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 \ r \ v1" "\ v2 : r" "flat v2 = s" + shows "v1 \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 \r v2 \ v1 \ Values r s \ v2 \ 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 \ rexp \ bool" +where + "POSIX v r \ (\ v : r \ (\v'. (\ v' : r \ flat v = flat v') \ v \r v'))" + +definition POSIX2 :: "val \ rexp \ bool" +where + "POSIX2 v r \ (\ v : r \ (\v'. (\ v' : r \ flat v = flat v') \ v 2\ 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)" "\ v1 : r1" "\ 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)" "\ v1 : r1" "\ 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 "(\v'. (\ v' : r2 \ flat v' = flat v2) \ v2 \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" "\v'. \ v' : r1 \ 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. \ 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 \ 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 \ Values (der c r) s" + shows "injval r c v \ 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 \ Values r (c#s)" "\s. flat v = c # s" + shows "projval r c v \ 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 \ (v \ Values r s \ (\v' \ Values r s. v 2\ v'))" + +lemma MValue_ALTE: + assumes "MValue v (ALT r1 r2) s" + shows "(\vl. v = Left vl \ MValue vl r1 s \ (\vr \ Values r2 s. length (flat vr) \ length (flat vl))) \ + (\vr. v = Right vr \ MValue vr r2 s \ (\vl \ 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" "\vr \ Values r2 s. length (flat vr) \ 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" "\vl \ 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) \ xs = ys" +by (metis list.sel(3)) + +lemma t2: "(xs = ys) \ (c#xs) = (c#ys)" +by (metis) + +lemma "\(nullable r) \ \(\v. \ v : r \ flat v = [])" +by (metis Prf_flat_L nullable_correctness) + + +lemma LeftRight: + assumes "(Left v1) \(der c (ALT r1 r2)) (Right v2)" + and "\ v1 : der c r1" "\ v2 : der c r2" + shows "(injval (ALT r1 r2) c (Left v1)) \(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) \(der c (ALT r1 r2)) (Left v2)" + and "\ v1 : der c r2" "\ v2 : der c r1" + shows "(injval (ALT r1 r2) c (Right v1)) \(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" "\ v1 : der c r1" + shows "injval r1 c v1 \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)) \(der c (SEQ r1 r2)) (Right v3)" + and "nullable r1" "\ v1 : der c r1" + shows "(injval (SEQ r1 r2) c (Seq v1 v2)) \(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 "\ v : r" "\nullable r" + shows "flat v \ []" +using assms +by (metis Prf_flat_L nullable_correctness) + +(* HERE *) + +lemma Prf_inj_test: + assumes "v1 \(der c r) v2" + "v1 \ Values (der c r) s" + "v2 \ Values (der c r) s" + "injval r c v1 \ Values r (c#s)" + "injval r c v2 \ Values r (c#s)" + shows "(injval r c v1) 2\ (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 \(der c r) v2" + "v1 \ Values (der c r) s" + "v2 \ Values (der c r) s" + "injval r c v1 \ Values r (c#s)" + "injval r c v2 \ Values r (c#s)" + shows "(injval r c v1) 2\ (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)" "\ 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)" "\ 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 \ []") +prefer 2 +apply (metis Prf_flat_L nullable_correctness) +apply(subgoal_tac "\s. flat v1a = c # s") +prefer 2 +apply (metis append_eq_Cons_conv) +apply(auto)[1] +oops + + +lemma POSIX_ex: "\ v : r \ \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: "\ v : r \ \v. POSIX v r \ \ 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 "\ v : (ALT r1 r2)" "POSIX v (ALT r1 r2)" + shows "(\v1. v = Left v1 \ POSIX v1 r1) \ (\v2. v = Right v2 \ 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)" "\ v : (ALT r1 r2)" + shows "(\v1. v = Left v1 \ POSIX v1 r1) \ (\v2. v = Right v2 \ POSIX v2 r2)" +using assms POSIX_ALT_cases by auto + +lemma Prf_flat_empty: + assumes "\ v : r" "flat v = []" + shows "nullable r" +using assms +apply(induct) +apply(auto) +done + +lemma POSIX_proj: + assumes "POSIX v r" "\ v : r" "\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" "\ v : r" "\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" "\ v : r" "\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 \(der c r) v2" "\ v1 : der c r" "\ v2 : der c r" "flat v1 = flat v2" + shows "(injval r c v1) \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 "\ 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 "\ 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 diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys2/Re1.thy --- /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 \ string set \ string set" ("_ ;; _" [100,100] 100) +where + "A ;; B = {s1 @ s2 | s1 s2. s1 \ A \ s2 \ 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 \ rexp list \ rexp" +where + "SEQS r [] = r" +| "SEQS r (r'#rs) = SEQ r (SEQS r' rs)" + +section {* Semantics of Regular Expressions *} + +fun + L :: "rexp \ 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) \ (L r2)" + +fun zeroable where + "zeroable NULL = True" +| "zeroable EMPTY = False" +| "zeroable (CHAR c) = False" +| "zeroable (ALT r1 r2) = (zeroable r1 \ zeroable r2)" +| "zeroable (SEQ r1 r2) = (zeroable r1 \ zeroable r2)" + +lemma L_ALT_cases: + "L (ALT r1 r2) \ {} \ (L r1 \ {}) \ (L r1 = {} \ L r2 \ {})" +by(auto) + +fun + nullable :: "rexp \ bool" +where + "nullable (NULL) = False" +| "nullable (EMPTY) = True" +| "nullable (CHAR c) = False" +| "nullable (ALT r1 r2) = (nullable r1 \ nullable r2)" +| "nullable (SEQ r1 r2) = (nullable r1 \ nullable r2)" + +lemma nullable_correctness: + shows "nullable r \ [] \ (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 \ val list \ val" +where + "Seqs v [] = v" +| "Seqs v (v'#vs) = Seqs (Seq v v') vs" + +section {* The string behind a value *} + +fun flat :: "val \ 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 \ 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 \ val \ rexp \ bool" ("\_ _ : _" [100, 100, 100] 100) +where + "\\s1 v1 : r1; \s2 v2 : r2\ \ \(s1 @ s2) (Seq v1 v2) : SEQ r1 r2" +| "\s v1 : r1 \ \s (Left v1) : ALT r1 r2" +| "\s v2 : r2 \ \s (Right v2) : ALT r1 r2" +| "\[] Void : EMPTY" +| "\[c] (Char c) : CHAR c" + +lemma Prfs_flat: + "\s v : r \ flat v = s" +apply(induct s v r rule: Prfs.induct) +apply(auto) +done + +inductive Prfn :: "nat \ val \ rexp \ bool" ("\_ _ : _" [100, 100, 100] 100) +where + "\\n1 v1 : r1; \n2 v2 : r2\ \ \(n1 + n2) (Seq v1 v2) : SEQ r1 r2" +| "\n v1 : r1 \ \n (Left v1) : ALT r1 r2" +| "\n v2 : r2 \ \n (Right v2) : ALT r1 r2" +| "\0 Void : EMPTY" +| "\1 (Char c) : CHAR c" + +lemma Prfn_flat: + "\n v : r \ length (flat v) = n" +apply(induct rule: Prfn.induct) +apply(auto) +done + +inductive Prf :: "val \ rexp \ bool" ("\ _ : _" [100, 100] 100) +where + "\\ v1 : r1; \ v2 : r2\ \ \ Seq v1 v2 : SEQ r1 r2" +| "\ v1 : r1 \ \ Left v1 : ALT r1 r2" +| "\ v2 : r2 \ \ Right v2 : ALT r1 r2" +| "\ Void : EMPTY" +| "\ Char c : CHAR c" + +lemma Prf_Prfn: + shows "\ v : r \ \(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 "\n v : r \ \ v : r" +apply(induct n v r rule: Prfn.induct) +apply(auto intro: Prf.intros) +done + +lemma Prf_Prfs: + shows "\ v : r \ \(flat v) v : r" +apply(induct v r rule: Prf.induct) +apply(auto intro: Prfs.intros) +done + +lemma Prfs_Prf: + shows "\s v : r \ \ v : r" +apply(induct s v r rule: Prfs.induct) +apply(auto intro: Prf.intros) +done + +lemma not_nullable_flat: + assumes "\ v : r" "\nullable r" + shows "flat v \ []" +using assms +apply(induct) +apply(auto) +done + + +fun mkeps :: "rexp \ 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 "\ mkeps r : r" +using assms +apply(induct rule: nullable.induct) +apply(auto intro: Prf.intros) +done + +lemma mkeps_nullable_n: + assumes "nullable(r)" shows "\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 "\[] (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 "\ v : r" shows "flat v \ 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. \ 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 \ string \ bool" ("_ \ _" [100, 100] 100) +where + "s1 \ s2 \ \s3. s1 @ s3 = s2" + +definition sprefix :: "string \ string \ bool" ("_ \ _" [100, 100] 100) +where + "s1 \ s2 \ (s1 \ s2 \ s1 \ s2)" + +lemma length_sprefix: + "s1 \ s2 \ length s1 < length s2" +unfolding sprefix_def prefix_def +by (auto) + +definition Prefixes :: "string \ string set" where + "Prefixes s \ {sp. sp \ s}" + +definition Suffixes :: "string \ string set" where + "Suffixes s \ rev ` (Prefixes (rev s))" + +lemma Suffixes_in: + "\s1. s1 @ s2 = s3 \ s2 \ Suffixes s3" +unfolding Suffixes_def Prefixes_def prefix_def image_def +apply(auto) +by (metis rev_rev_ident) + +lemma Prefixes_Cons: + "Prefixes (c # s) = {[]} \ {c # sp | sp. sp \ 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) \ (c # s2)) = (s1 \ s2)" +apply(auto simp add: prefix_def) +done + +lemma prefix_append: + "((s @ s1) \ (s @ s2)) = (s1 \ s2)" +apply(induct s) +apply(simp) +apply(simp add: prefix_Cons) +done + + + +definition Values :: "rexp \ string \ val set" where + "Values r s \ {v. \ v : r \ flat v \ s}" + +definition rest :: "val \ string \ string" where + "rest v s \ drop (length (flat v)) s" + +lemma rest_Suffixes: + "rest v s \ 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] \ s then {Char c} else {})" + "Values (ALT r1 r2) s = {Left v | v. v \ Values r1 s} \ {Right v | v. v \ Values r2 s}" + "Values (SEQ r1 r2) s = {Seq v1 v2 | v1 v2. v1 \ Values r1 s \ v2 \ 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="\(x, y). Seq x y" and + A="{(v1, v2) | v1 v2. v1 \ Values r1 s \ v2 \ Values r2 (rest v1 s)}" in finite_surj) +prefer 2 +apply(auto)[1] +apply(rule_tac B="\sp \ Suffixes s. {(v1, v2). v1 \ Values r1 s \ v2 \ 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 \ val \ bool" ("_ \ _") +where + "v1 \ v1' \ (Seq v1 v2) \ (Seq v1' v2')" +| "v2 \ v2' \ (Seq v1 v2) \ (Seq v1 v2')" +| "v1 \ v2 \ (Left v1) \ (Left v2)" +| "v1 \ v2 \ (Right v1) \ (Right v2)" +| "(Right v1) \ (Left v2)" +| "(Char c) \ (Char c)" +| "(Void) \ (Void)" + +lemma Gr_refl: + assumes "\ v : r" + shows "v \ v" +using assms +apply(induct) +apply(auto intro: GrOrd.intros) +done + +lemma Gr_total: + assumes "\ v1 : r" "\ v2 : r" + shows "v1 \ v2 \ v2 \ 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 \ v2" "v2 \ v3" "\ v1 : r" "\ v2 : r" "\ v3 : r" + shows "v1 \ 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 \ S \ (\v' \ S. v' \ v)" + +definition + "GrMax r s \ GrMaxM {v. \ v : r \ flat v = s}" + +inductive ValOrd3 :: "val \ val \ bool" ("_ 3\ _" [100, 100] 100) +where + "v2 3\ v2' \ (Seq v1 v2) 3\ (Seq v1 v2')" +| "v1 3\ v1' \ (Seq v1 v2) 3\ (Seq v1' v2')" +| "length (flat v1) \ length (flat v2) \ (Left v1) 3\ (Right v2)" +| "length (flat v2) > length (flat v1) \ (Right v2) 3\ (Left v1)" +| "v2 3\ v2' \ (Right v2) 3\ (Right v2')" +| "v1 3\ v1' \ (Left v1) 3\ (Left v1')" +| "Void 3\ Void" +| "(Char c) 3\ (Char c)" + + +section {* Sulzmann's Ordering of values *} + +inductive ValOrd :: "val \ rexp \ val \ bool" ("_ \_ _" [100, 100, 100] 100) +where + "v2 \r2 v2' \ (Seq v1 v2) \(SEQ r1 r2) (Seq v1 v2')" +| "\v1 \r1 v1'; v1 \ v1'\ \ (Seq v1 v2) \(SEQ r1 r2) (Seq v1' v2')" +| "length (flat v1) \ length (flat v2) \ (Left v1) \(ALT r1 r2) (Right v2)" +| "length (flat v2) > length (flat v1) \ (Right v2) \(ALT r1 r2) (Left v1)" +| "v2 \r2 v2' \ (Right v2) \(ALT r1 r2) (Right v2')" +| "v1 \r1 v1' \ (Left v1) \(ALT r1 r2) (Left v1')" +| "Void \EMPTY Void" +| "(Char c) \(CHAR c) (Char c)" + +inductive ValOrdStr :: "string \ val \ val \ bool" ("_ \ _ \_" [100, 100, 100] 100) +where + "\s \ v1 \ v1'; rest v1 s \ v2 \ v2'\ \ s \ (Seq v1 v2) \ (Seq v1' v2')" +| "\flat v2 \ flat v1; flat v1 \ s\ \ s \ (Left v1) \ (Right v2)" +| "\flat v1 \ flat v2; flat v2 \ s\ \ s \ (Right v2) \ (Left v1)" +| "s \ v2 \ v2' \ s \ (Right v2) \ (Right v2')" +| "s \ v1 \ v1' \ s \ (Left v1) \ (Left v1')" +| "s \ Void \ Void" +| "(c#s) \ (Char c) \ (Char c)" + +inductive ValOrd2 :: "val \ val \ bool" ("_ 2\ _" [100, 100] 100) +where + "v2 2\ v2' \ (Seq v1 v2) 2\ (Seq v1 v2')" +| "\v1 2\ v1'; v1 \ v1'\ \ (Seq v1 v2) 2\ (Seq v1' v2')" +| "length (flat v1) \ length (flat v2) \ (Left v1) 2\ (Right v2)" +| "length (flat v2) > length (flat v1) \ (Right v2) 2\ (Left v1)" +| "v2 2\ v2' \ (Right v2) 2\ (Right v2')" +| "v1 2\ v1' \ (Left v1) 2\ (Left v1')" +| "Void 2\ Void" +| "(Char c) 2\ (Char c)" + +lemma Ord1: + "v1 \r v2 \ v1 2\ v2" +apply(induct rule: ValOrd.induct) +apply(auto intro: ValOrd2.intros) +done + +lemma Ord2: + "v1 2\ v2 \ \r. v1 \r v2" +apply(induct v1 v2 rule: ValOrd2.induct) +apply(auto intro: ValOrd.intros) +done + +lemma Ord3: + "\v1 2\ v2; \ v1 : r\ \ v1 \r v2" +apply(induct v1 v2 arbitrary: r rule: ValOrd2.induct) +apply(auto intro: ValOrd.intros elim: Prf.cases) +done + + +lemma ValOrd_refl: + assumes "\ v : r" + shows "v \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 "\\ v1 : r; \ v2 : r\ \ v1 \r v2 \ v2 \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 "\\ v1 : r; \ v2 : r; v1 \r v2; v2 \r v1\ \ 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 \r v2 \ v1 \ Values r s \ v2 \ Values r s}" +unfolding refl_on_def +apply(auto) +apply(rule ValOrd_refl) +apply(simp add: Values_def) +done + +(* +inductive ValOrd3 :: "val \ rexp \ val \ bool" ("_ 3\_ _" [100, 100, 100] 100) +where + "\v2 3\r2 v2'; \ v1 : r1\ \ (Seq v1 v2) 3\(SEQ r1 r2) (Seq v1 v2')" +| "\v1 3\r1 v1'; v1 \ v1'; flat v2 = flat v2'; \ v2 : r2; \ v2' : r2\ + \ (Seq v1 v2) 3\(SEQ r1 r2) (Seq v1' v2')" +| "length (flat v1) \ length (flat v2) \ (Left v1) 3\(ALT r1 r2) (Right v2)" +| "length (flat v2) > length (flat v1) \ (Right v2) 3\(ALT r1 r2) (Left v1)" +| "v2 3\r2 v2' \ (Right v2) 3\(ALT r1 r2) (Right v2')" +| "v1 3\r1 v1' \ (Left v1) 3\(ALT r1 r2) (Left v1')" +| "Void 3\EMPTY Void" +| "(Char c) 3\(CHAR c) (Char c)" +*) + +section {* Posix definition *} + +definition POSIX :: "val \ rexp \ bool" +where + "POSIX v r \ (\ v : r \ (\v'. (\ v' : r \ flat v = flat v') \ v \r v'))" + +definition POSIX2 :: "val \ rexp \ bool" +where + "POSIX2 v r \ (\ v : r \ (\v'. (\ v' : r \ flat v = flat v') \ v 2\ 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 \ rexp \ string \ bool" +where + "POSIXs v r s \ (\s v : r \ (\v'. (\s v' : r \ v 2\ v')))" + +definition POSIXn :: "val \ rexp \ nat \ bool" +where + "POSIXn v r n \ (\n v : r \ (\v'. (\n v' : r \ v 2\ v')))" + +lemma "POSIXn v r (length (flat v)) \ 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 \ \s v: r \ 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)" "\ v1 : r1" "\ 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)" "\n1 v1 : r1" "\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)" "\s1 v1 : r1" "\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)" "\ v1 : r1" "\ 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)" "\n1 v1 : r1" "\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)" "\s1 v1 : r1" "\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 "(\v'. (\ v' : r2 \ flat v' = flat v2) \ v2 \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 "(\v'. (\n v' : r2 \ v2 2\ 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 "(\v'. (\s v' : r2 \ v2 2\ 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" "\v'. \ v' : r1 \ 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" "\s' v'. \s' v' : r1 \ 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 + "\POSIX (mkeps r2) r2; nullable r2; \ nullable r1\ + \ 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 \ rexp \ 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 \ rexp \ rexp" +where + "ders [] r = r" +| "ders (c # s) r = ders s (der c r)" + +fun + red :: "char \ rexp \ 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 \ 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 \ 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 \ 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 \ char \ val \ 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 \ char \ val \ 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 "\ v : der c r" shows "\ (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 "\ v : r" shows "\ (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 "\s v : der c r" shows "\(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 "\n v : der c r" shows "\(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 "\ v : r" and "\s. (flat v) = c # s" + shows "\ (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 "\(c#s) v : r" + shows "\s (projval r c v) : der c r" +using assms +apply(induct s\"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 "\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 "\ 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 "\ v : r" and "\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 "\ 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. \ 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 \ 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 \ Values (der c r) s" + shows "injval r c v \ 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 \ Values r (c#s)" "\s. flat v = c # s" + shows "projval r c v \ 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 \ (v \ Values r s \ (\v' \ Values r s. v 2\ 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 "(\v1 v2. MValue v1 r1 s \ MValue v2 r2 (rest v1 s) \ 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 "(\vl. v = Left vl \ MValue vl r1 s \ (\vr \ Values r2 s. length (flat vr) \ length (flat vl))) \ + (\vr. v = Right vr \ MValue vr r2 s \ (\vl \ 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" "\vr \ Values r2 s. length (flat vr) \ 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" "\vl \ 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: + "\nullable (red c r)" +apply(induct r) +apply(auto) +done + +lemma twq: + assumes "\ v : r" + shows "\ 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. \ 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) \ xs = ys" +by (metis list.sel(3)) + +lemma t2: "(xs = ys) \ (c#xs) = (c#ys)" +by (metis) + +lemma "\(nullable r) \ \(\v. \ v : r \ flat v = [])" +by (metis Prf_flat_L nullable_correctness) + + +lemma LeftRight: + assumes "(Left v1) \(der c (ALT r1 r2)) (Right v2)" + and "\ v1 : der c r1" "\ v2 : der c r2" + shows "(injval (ALT r1 r2) c (Left v1)) \(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) \(der c (ALT r1 r2)) (Left v2)" + and "\ v1 : der c r2" "\ v2 : der c r1" + shows "(injval (ALT r1 r2) c (Right v1)) \(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" "\ v1 : der c r1" + shows "injval r1 c v1 \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)) \(der c (SEQ r1 r2)) (Right v3)" + and "nullable r1" "\ v1 : der c r1" + shows "(injval (SEQ r1 r2) c (Seq v1 v2)) \(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 "\ v : r" "\nullable r" + shows "flat v \ []" +using assms +by (metis Prf_flat_L nullable_correctness) + +section {* TESTTEST *} + +inductive ValOrdA :: "val \ rexp \ val \ bool" ("_ A\_ _" [100, 100, 100] 100) +where + "v2 A\r2 v2' \ (Seq v1 v2) A\(SEQ r1 r2) (Seq v1 v2')" +| "v1 A\r1 v1' \ (Seq v1 v2) A\(SEQ r1 r2) (Seq v1' v2')" +| "length (flat v1) \ length (flat v2) \ (Left v1) A\(ALT r1 r2) (Right v2)" +| "length (flat v2) > length (flat v1) \ (Right v2) A\(ALT r1 r2) (Left v1)" +| "v2 A\r2 v2' \ (Right v2) A\(ALT r1 r2) (Right v2')" +| "v1 A\r1 v1' \ (Left v1) A\(ALT r1 r2) (Left v1')" +| "Void A\EMPTY Void" +| "(Char c) A\(CHAR c) (Char c)" + +inductive ValOrd4 :: "val \ rexp \ val \ bool" ("_ 4\ _ _" [100, 100] 100) +where + (*"v1 4\(der c r) v1' \ (injval r c v1) 4\r (injval r c v1')" +| "\v1 4\r v2; v2 4\r v3\ \ v1 4\r v3" +|*) + "\v1 4\r1 v1'; flat v2 = flat v2'; \ v2 : r2; \ v2' : r2\ \ (Seq v1 v2) 4\(SEQ r1 r2) (Seq v1' v2')" +| "\v2 4\r2 v2'; \ v1 : r1\ \ (Seq v1 v2) 4\(SEQ r1 r2) (Seq v1 v2')" +| "\flat v1 = flat v2; \ v1 : r1; \ v2 : r2\ \ (Left v1) 4\(ALT r1 r2) (Right v2)" +| "v2 4\r2 v2' \ (Right v2) 4\(ALT r1 r2) (Right v2')" +| "v1 4\r1 v1' \ (Left v1) 4\(ALT r1 r2) (Left v1')" +| "Void 4\(EMPTY) Void" +| "(Char c) 4\(CHAR c) (Char c)" + +lemma ValOrd4_Prf: + assumes "v1 4\r v2" + shows "\ v1 : r \ \ v2 : r" +using assms +apply(induct v1 r v2) +apply(auto intro: Prf.intros) +done + +lemma ValOrd4_flat: + assumes "v1 4\r v2" + shows "flat v1 = flat v2" +using assms +apply(induct v1 r v2) +apply(simp_all) +done + +lemma ValOrd4_refl: + assumes "\ v : r" + shows "v 4\r v" +using assms +apply(induct v r) +apply(auto intro: ValOrd4.intros) +done + +lemma + assumes "v1 4\r v2" "v2 4\r v3" + shows "v1 A\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\r v2" + shows "v1 A\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 \r v2" "\ v1 : r" "\ v2 : r" "flat v1 = flat v2" + shows "v1 4\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 \r v2" "\ v1 : r" "\ v2 : r" "flat v1 = flat v2" + shows "v1 4\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) \ [] \ flats v \ []" +apply(induct v) +apply(auto) +done + +lemma rr3: "flats v = [] \ flat v = []" +apply(induct v) +apply(auto) +done + +lemma POSIXs_der: + assumes "POSIXs v (der c r) s" "\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 \(der c r) v2" + "v1 \ Values (der c r) s" + "v2 \ Values (der c r) s" + "injval r c v1 \ Values r (c#s)" + "injval r c v2 \ Values r (c#s)" + shows "(injval r c v1) 2\ (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)) \ (flat v2)") +prefer 2 +apply(simp add: prefix_def) +apply(auto)[1] +(* HEREHERE *) + + +lemma Prf_inj_test: + assumes "v1 \r v2" + "v1 \ Values r s" + "v2 \ Values r s" + "injval r c v1 \ Values (red c r) (c#s)" + "injval r c v2 \ Values (red c r) (c#s)" + shows "(injval r c v1) \(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)) \ (flat v2)") +prefer 2 +apply(simp add: prefix_def) +apply(auto)[1] +(* HEREHERE *) + +lemma Prf_inj_test: + assumes "v1 \(der c r) v2" + "v1 \ Values (der c r) s" + "v2 \ Values (der c r) s" + "injval r c v1 \ Values r (c#s)" + "injval r c v2 \ Values r (c#s)" + shows "(injval r c v1) 2\ (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)) \ (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)" "\ 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)" "\ 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 \ []") +prefer 2 +apply (metis Prf_flat_L nullable_correctness) +apply(subgoal_tac "\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: "\ v : r \ \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: "\ v : r \ \v. POSIX v r \ \ 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 "\ v : (ALT r1 r2)" "POSIX v (ALT r1 r2)" + shows "(\v1. v = Left v1 \ POSIX v1 r1) \ (\v2. v = Right v2 \ 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)" "\ v : (ALT r1 r2)" + shows "(\v1. v = Left v1 \ POSIX v1 r1) \ (\v2. v = Right v2 \ POSIX v2 r2)" +using assms POSIX_ALT_cases by auto + +lemma Prf_flat_empty: + assumes "\ v : r" "flat v = []" + shows "nullable r" +using assms +apply(induct) +apply(auto) +done + +lemma POSIX_proj: + assumes "POSIX v r" "\ v : r" "\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 "\ 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" "\ v : r" "\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" "\ v : r" "\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 "\(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 \(der c r) v2" "\ v1 : der c r" "\ v2 : der c r" "flat v1 = flat v2" + shows "(injval r c v1) \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 "\ 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 \ {} \ \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 \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 "\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 "\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 "\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 "\ 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 "\ 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 *) diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys2/ReTest.thy --- /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 \ string set \ string set" ("_ ;; _" [100,100] 100) +where + "A ;; B = {s1 @ s2 | s1 s2. s1 \ A \ s2 \ 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 \ string set \ string set" +where + "Der c A \ {s. [c] @ s \ A}" + +definition + Ders :: "string \ string set \ string set" +where + "Ders s A \ {s' | s'. s @ s' \ 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 \ B) = Der c A \ Der c B" +unfolding Der_def +by auto + +lemma Der_seq [simp]: + shows "Der c (A ;; B) = (Der c A) ;; B \ (if [] \ A then Der c B else {})" +unfolding Der_def Sequ_def +apply (auto simp add: Cons_eq_append_conv) +done + +lemma seq_image: + assumes "\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 \ string set" ("_\" [101] 102) + for A :: "string set" +where + start[intro]: "[] \ A\" +| step[intro]: "\s1 \ A; s2 \ A\\ \ s1 @ s2 \ A\" + +lemma star_cases: + shows "A\ = {[]} \ A ;; A\" +unfolding Sequ_def +by (auto) (metis Star.simps) + + +fun + pow :: "string set \ nat \ string set" ("_ \ _" [100,100] 100) +where + "A \ 0 = {[]}" +| "A \ (Suc n) = A ;; (A \ n)" + +lemma star1: + shows "s \ A\ \ \n. s \ A \ 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 \ A \ n \ s \ A\" + 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\ = (\i. A \ i)" +using star1 star2 +apply(auto) +done + +lemma star4: + shows "s \ A \ n \ \ss. s = concat ss \ (\s' \ set ss. s' \ 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 "\s1 s2. f (s1 @ s2) = (f s1) @ (f s2)" + shows "(f ` A) \ n = f ` (A \ 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 "\s1 s2. f (s1 @ s2) = (f s1) @ (f s2)" + shows "(f ` A)\ = f ` (A\)" +apply(simp add: star3) +apply(simp add: image_UN) +apply(subst star5[OF assms]) +apply(simp) +done + +lemma star_decomp: + assumes a: "c # x \ A\" + shows "\a b. x = a @ b \ c # a \ A \ b \ A\" +using a +by (induct x\"c # x" rule: Star.induct) + (auto simp add: append_eq_Cons_conv) + +lemma Der_star [simp]: + shows "Der c (A\) = (Der c A) ;; A\" +proof - + have "Der c (A\) = Der c ({[]} \ A ;; A\)" + + by (simp only: star_cases[symmetric]) + also have "... = Der c (A ;; A\)" + by (simp only: Der_union Der_empty) (simp) + also have "... = (Der c A) ;; A\ \ (if [] \ A then Der c (A\) else {})" + by simp + also have "... = (Der c A) ;; A\" + unfolding Sequ_def Der_def + by (auto dest: star_decomp) + finally show "Der c (A\) = (Der c A) ;; A\" . +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 \ 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) \ (L r2)" +| "L (STAR r) = (L r)\" + +fun + nullable :: "rexp \ bool" +where + "nullable (NULL) = False" +| "nullable (EMPTY) = True" +| "nullable (CHAR c) = False" +| "nullable (ALT r1 r2) = (nullable r1 \ nullable r2)" +| "nullable (SEQ r1 r2) = (nullable r1 \ nullable r2)" +| "nullable (STAR r) = True" + +lemma nullable_correctness: + shows "nullable r \ [] \ (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 \ 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 \ rexp \ bool" ("\ _ : _" [100, 100] 100) +where + "\\ v1 : r1; \ v2 : r2\ \ \ Seq v1 v2 : SEQ r1 r2" +| "\ v1 : r1 \ \ Left v1 : ALT r1 r2" +| "\ v2 : r2 \ \ Right v2 : ALT r1 r2" +| "\ Void : EMPTY" +| "\ Char c : CHAR c" +| "\ Stars [] : STAR r" +| "\\ v : r; \ Stars vs : STAR r; flat v \ []\ \ \ Stars (v # vs) : STAR r" + +inductive + Prf :: "val \ rexp \ bool" ("\ _ : _" [100, 100] 100) +where + "\\ v1 : r1; \ v2 : r2\ \ \ Seq v1 v2 : SEQ r1 r2" +| "\ v1 : r1 \ \ Left v1 : ALT r1 r2" +| "\ v2 : r2 \ \ Right v2 : ALT r1 r2" +| "\ Void : EMPTY" +| "\ Char c : CHAR c" +| "\ Stars [] : STAR r" +| "\\ v : r; \ Stars vs : STAR r\ \ \ Stars (v # vs) : STAR r" + +lemma NPrf_imp_Prf: + assumes "\ v : r" + shows "\ v : r" +using assms +apply(induct) +apply(auto intro: Prf.intros) +done + +lemma NPrf_Prf_val: + shows "\ v : r \ \v'. flat v' = flat v \ \ v' : r" + and "\ Stars vs : r \ \vs'. flat (Stars vs') = flat (Stars vs) \ \ 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. \ v : r} = {flat v | v. \ v : r}" +apply(auto) +apply (metis NPrf_Prf_val(1)) +by (metis NPrf_imp_Prf) + + +lemma not_nullable_flat: + assumes "\ v : r" "\nullable r" + shows "flat v \ []" +using assms +apply(induct) +apply(auto) +done + +lemma Prf_flat_L: + assumes "\ v : r" shows "flat v \ L r" +using assms +apply(induct v r rule: Prf.induct) +apply(auto simp add: Sequ_def) +done + +lemma NPrf_flat_L: + assumes "\ v : r" shows "flat v \ L r" +using assms +by (metis NPrf_imp_Prf Prf_flat_L) + +lemma Prf_Stars: + assumes "\v \ set vs. \ v : r" + shows "\ 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 \ A\" + shows "\ss. concat ss = s \ (\s \ set ss. s \ 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 "\s\set ss. \v. s = flat v \ \ v : r" + shows "\vs. concat (map flat vs) = concat ss \ (\v\set vs. \ 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 "\s\set ss. \v. s = flat v \ \ v : r" + shows "\vs. concat (map flat vs) = concat ss \ (\v\set vs. \ 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. \ 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 "\vs::val list. concat (map flat vs) = x \ (\v \ set vs. \ 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. \ v : r}" +by (metis L_flat_Prf NPrf_Prf) + +text {* nicer proofs by Fahad *} + +lemma Prf_Star_flat_L: + assumes "\ v : STAR r" shows "flat v \ (L r)\" +using assms +apply(induct v r\"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. \ 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 \ string \ bool" ("_ \ _" [100, 100] 100) +where + "s1 \ s2 \ \s3. s1 @ s3 = s2" + +definition sprefix :: "string \ string \ bool" ("_ \ _" [100, 100] 100) +where + "s1 \ s2 \ (s1 \ s2 \ s1 \ s2)" + +lemma length_sprefix: + "s1 \ s2 \ length s1 < length s2" +unfolding sprefix_def prefix_def +by (auto) + +definition Prefixes :: "string \ string set" where + "Prefixes s \ {sp. sp \ s}" + +definition Suffixes :: "string \ string set" where + "Suffixes s \ rev ` (Prefixes (rev s))" + +definition SPrefixes :: "string \ string set" where + "SPrefixes s \ {sp. sp \ s}" + +definition SSuffixes :: "string \ string set" where + "SSuffixes s \ rev ` (SPrefixes (rev s))" + +lemma Suffixes_in: + "\s1. s1 @ s2 = s3 \ s2 \ Suffixes s3" +unfolding Suffixes_def Prefixes_def prefix_def image_def +apply(auto) +by (metis rev_rev_ident) + +lemma SSuffixes_in: + "\s1. s1 \ [] \ s1 @ s2 = s3 \ s2 \ 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) = {[]} \ {c # sp | sp. sp \ 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) \ (c # s2)) = (s1 \ s2)" +apply(auto simp add: prefix_def) +done + +lemma prefix_append: + "((s @ s1) \ (s @ s2)) = (s1 \ s2)" +apply(induct s) +apply(simp) +apply(simp add: prefix_Cons) +done + + +definition Values :: "rexp \ string \ val set" where + "Values r s \ {v. \ v : r \ flat v \ s}" + +definition SValues :: "rexp \ string \ val set" where + "SValues r s \ {v. \ v : r \ flat v = s}" + + +definition NValues :: "rexp \ string \ val set" where + "NValues r s \ {v. \ v : r \ flat v \ 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 \ string \ string" where + "rest v s \ drop (length (flat v)) s" + +lemma rest_Nil: + "rest v [] = []" +apply(simp add: rest_def) +done + +lemma rest_Suffixes: + "rest v s \ Suffixes s" +unfolding rest_def +by (metis Suffixes_in append_take_drop_id) + +lemma rest_SSuffixes: + assumes "flat v \ []" "s \ []" + shows "rest v s \ 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] \ s then {Char c} else {})" + "Values (ALT r1 r2) s = {Left v | v. v \ Values r1 s} \ {Right v | v. v \ Values r2 s}" + "Values (SEQ r1 r2) s = {Seq v1 v2 | v1 v2. v1 \ Values r1 s \ v2 \ Values r2 (rest v1 s)}" + "Values (STAR r) s = + {Stars []} \ {Stars (v # vs) | v vs. v \ Values r s \ Stars vs \ 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] \ s then {Char c} else {})" + "NValues (ALT r1 r2) s = {Left v | v. v \ NValues r1 s} \ {Right v | v. v \ NValues r2 s}" + "NValues (SEQ r1 r2) s = {Seq v1 v2 | v1 v2. v1 \ NValues r1 s \ v2 \ NValues r2 (rest v1 s)}" + "NValues (STAR r) s = + {Stars []} \ {Stars (v # vs) | v vs. v \ NValues r s \ flat v \ [] \ Stars vs \ 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 \ SValues r1 s} \ {Right v | v. v \ SValues r2 s}" + "SValues (SEQ r1 r2) s = {Seq v1 v2 | v1 v2. \s1 s2. s = s1 @ s2 \ v1 \ SValues r1 s1 \ v2 \ SValues r2 s2}" + "SValues (STAR r) s = (if s = [] then {Stars []} else {}) \ + {Stars (v # vs) | v vs. \s1 s2. s = s1 @ s2 \ v \ SValues r s1 \ Stars vs \ 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} \ finite {y. Q y} \ finite {(x, y) | x y. P x \ Q y}" + by (rule finite_subset [where B = "\x \ {x. P x}. \y \ {y. Q y}. {(x, y)}"]) auto + + +lemma NValues_finite_aux: + "(\(r, s). finite (NValues r s)) (r, s)" +apply(rule wf_induct[of "measure size <*lex*> measure length",where P="\(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="\(x, y). Seq x y" and + A="{(v1, v2) | v1 v2. v1 \ NValues rexp1 b \ v2 \ NValues rexp2 (rest v1 b)}" in finite_surj) +prefer 2 +apply(auto)[1] +apply(rule_tac B="\sp \ Suffixes b. {(v1, v2). v1 \ NValues rexp1 b \ v2 \ 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="\(v, vs). Stars (v # vs)" and + A="{(v, vs) | v vs. v \ NValues rexp b \ (flat v \ [] \ Stars vs \ 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="\sp \ SSuffixes b. {(v, vs) | v vs. v \ NValues rexp b \ Stars vs \ 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 \ NValues rexp [] \ 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 \ 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 \ rexp \ 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 \ rexp \ 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 \ char \ val \ 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 \ string \ 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 \ None + | Some(v) \ Some(injval r c v))" + +fun + lex2 :: "rexp \ string \ val" +where + "lex2 r [] = mkeps r" +| "lex2 r (c#s) = injval r c (lex2 (der c r) s)" + + +section {* Projection function *} + +fun projval :: "rexp \ char \ val \ 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 "\ 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 "\ v : der c r" + shows "\ (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 "\ v : r" and "\s. (flat v) = c # s" + shows "\ (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 "\ 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 "\ v : r" and "\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 "\ 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 \ rexp \ rexp \ bool" +where + "PC31 s r r' \ s \ L r" + +definition + PC41 :: "string \ string \ rexp \ rexp \ bool" +where + "PC41 s s' r r' \ (\x. (s @ x \ L r \ s' \ {x} ;; L r' \ x = []))" + + +lemma + L1: "\(nullable r1) \ [] \ L r2 \ PC31 [] r1 r2" and + L2: "s1 \ L(r1) \ [] \ L(r2) \ PC41 s1 [] r1 r2" and + L3: "s2 \ L(der c r2) \ PC31 s2 (der c r1) (der c r2) \ PC31 (c#s2) r1 r2" and + L4: "s1 \ L(der c r1) \ s2 \ L(r2) \ PC41 s1 s2 (der c r1) r2 \ PC41 (c#s1) s2 r1 r2" and + L5: "nullable(r1) \ s2 \ L(der c r2) \ PC31 s2 (SEQ (der c r1) r2) (der c r2) \ PC41 [] (c#s2) r1 r2" and + L6: "s0 \ L(der c r0) \ s \ L(STAR r0) \ PC41 s0 s (der c r0) (STAR r0) \ PC41 (c#s0) s r0 (STAR r0)" and + L7: "s' \ L(r') \ s' \ L(r) \ \PC31 s' r r'" and + L8: "s \ L(r) \ s' \ L(r') \ s @ x \ L(r) \ s' \ {x} ;; (L(r') ;; {y}) \ x \ [] \ \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 \ rexp \ rexp \ bool" +where + "PC32 s r r' \ \y. s \ (L r ;; {y})" + +definition + PC42 :: "string \ string \ rexp \ rexp \ bool" +where + "PC42 s s' r r' \ (\x. (s @ x \ L r \ (\y. s' \ {x} ;; (L r' ;; {y})) \ x = []))" + + +lemma + L1: "\(nullable r1) \ [] \ L r2 \ PC32 [] r1 r2" and + L2: "s1 \ L(r1) \ [] \ L(r2) \ PC42 s1 [] r1 r2" and + L3: "s2 \ L(der c r2) \ PC32 s2 (der c r1) (der c r2) \ PC32 (c#s2) r1 r2" and + L4: "s1 \ L(der c r1) \ s2 \ L(r2) \ PC42 s1 s2 (der c r1) r2 \ PC42 (c#s1) s2 r1 r2" and + L5: "nullable(r1) \ s2 \ L(der c r2) \ PC32 s2 (SEQ (der c r1) r2) (der c r2) \ PC42 [] (c#s2) r1 r2" and + L6: "s0 \ L(der c r0) \ s \ L(STAR r0) \ PC42 s0 s (der c r0) (STAR r0) \ PC42 (c#s0) s r0 (STAR r0)" and + L7: "s' \ L(r') \ s' \ L(r) \ \PC32 s' r r'" and + L8: "s \ L(r) \ s' \ L(r') \ s @ x \ L(r) \ s' \ {x} ;; (L(r') ;; {y}) \ x \ [] \ \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 \ rexp \ rexp \ bool" +where + "PC33 s r r' \ s \ L r" + +definition + PC43 :: "string \ string \ rexp \ rexp \ bool" +where + "PC43 s s' r r' \ (\x. (s @ x \ L r \ (\y. s' \ {x} ;; (L r' ;; {y})) \ x = []))" + +lemma + L1: "\(nullable r1) \ [] \ L r2 \ PC33 [] r1 r2" and + L2: "s1 \ L(r1) \ [] \ L(r2) \ PC43 s1 [] r1 r2" and + L3: "s2 \ L(der c r2) \ PC33 s2 (der c r1) (der c r2) \ PC33 (c#s2) r1 r2" and + L4: "s1 \ L(der c r1) \ s2 \ L(r2) \ PC43 s1 s2 (der c r1) r2 \ PC43 (c#s1) s2 r1 r2" and + L5: "nullable(r1) \ s2 \ L(der c r2) \ PC33 s2 (SEQ (der c r1) r2) (der c r2) \ PC43 [] (c#s2) r1 r2" and + L6: "s0 \ L(der c r0) \ s \ L(STAR r0) \ PC43 s0 s (der c r0) (STAR r0) \ PC43 (c#s0) s r0 (STAR r0)" and + L7: "s' \ L(r') \ s' \ L(r) \ \PC33 s' r r'" and + L8: "s \ L(r) \ s' \ L(r') \ s @ x \ L(r) \ s' \ {x} ;; (L(r') ;; {y}) \ x \ [] \ \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 \ rexp \ bool" ("\ _ : _" [100, 100] 100) +where + "\ Void : EMPTY" +| "\ Char c : CHAR c" +| "\ v : r1 \ \ Left v : ALT r1 r2" +| "\\ v : r2; flat v \ L r1\ \ \ Right v : ALT r1 r2" +| "\\ v1 : r1; \ v2 : r2; \(\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = flat v2 \ (flat v1 @ s\<^sub>3) \ L r1 \ s\<^sub>4 \ L r2)\ \ + \ Seq v1 v2 : SEQ r1 r2" +| "\\ v : r; \ Stars vs : STAR r; flat v \ []; + \(\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = flat (Stars vs) \ (flat v @ s\<^sub>3) \ L r \ s\<^sub>4 \ L (STAR r))\ \ + \ Stars (v#vs) : STAR r" +| "\ Stars [] : STAR r" + +lemma drop_append: + assumes "s1 \ s2" + shows "s1 @ drop (length s1) s2 = s2" +using assms +apply(simp add: prefix_def) +apply(auto) +done + +lemma royA: + assumes "\(\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = flat v2 \ (flat v1 @ s\<^sub>3) \ L r1 \ s\<^sub>4 \ L r2)" + shows "\s. (s \ L(ders (flat v1) r1) \ + s \ (flat v2) \ drop (length s) (flat v2) \ L r2 \ 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 "\s. (s \ L(ders (flat v1) r1) \ + s \ (flat v2) \ drop (length s) (flat v2) \ L r2 \ s = [])" + shows "\(\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = flat v2 \ (flat v1 @ s\<^sub>3) \ L r1 \ s\<^sub>4 \ L r2)" +using assms +apply - +apply(auto simp add: prefix_def ders_correctness Ders_def) +by (metis append_eq_conv_conj) + +lemma royC: + assumes "\s t. (s \ L(ders (flat v1) r1) \ + s \ (flat v2 @ t) \ drop (length s) (flat v2 @ t) \ L r2 \ s = [])" + shows "\(\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = flat v2 \ (flat v1 @ s\<^sub>3) \ L r1 \ s\<^sub>4 \ 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 \ rexp \ bool" ("2\ _ : _" [100, 100] 100) +where + "2\ Void : EMPTY" +| "2\ Char c : CHAR c" +| "2\ v : r1 \ 2\ Left v : ALT r1 r2" +| "\2\ v : r2; \t. flat v \ (L r1 ;; {t})\ \ 2\ Right v : ALT r1 r2" +| "\2\ v1 : r1; 2\ v2 : r2; + \s. ((flat v1 @ s \ L r1) \ + (\t. s \ (flat v2 @ t) \ drop (length s) (flat v2) \ (L r2 ;; {t}))) \ s = []\ \ + 2\ Seq v1 v2 : SEQ r1 r2" +| "\2\ v : r; 2\ Stars vs : STAR r; flat v \ []; + \s. ((flat v @ s \ L r) \ + (\t. s \ (flat (Stars vs) @ t) \ drop (length s) (flat (Stars vs)) \ (L (STAR r) ;; {t}))) \ s = []\ + \ 2\ Stars (v#vs) : STAR r" +| "2\ Stars [] : STAR r" + +lemma Roy2_props: + assumes "2\ v : r" + shows "\ v : r" +using assms +apply(induct) +apply(auto intro: Prf.intros) +done + +lemma Roy_mkeps_nullable: + assumes "nullable(r)" + shows "2\ (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 \ rexp \ val \ bool" ("_ \ _ \ _" [100, 100, 100] 100) +where + "[] \ EMPTY \ Void" +| "[c] \ (CHAR c) \ (Char c)" +| "s \ r1 \ v \ s \ (ALT r1 r2) \ (Left v)" +| "\s \ r2 \ v; s \ L(r1)\ \ s \ (ALT r1 r2) \ (Right v)" +| "\s1 \ r1 \ v1; s2 \ r2 \ v2; + \(\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ (s1 @ s\<^sub>3) \ L r1 \ s\<^sub>4 \ L r2)\ \ + (s1 @ s2) \ (SEQ r1 r2) \ (Seq v1 v2)" +| "\s1 \ r \ v; s2 \ STAR r \ Stars vs; flat v \ []; + \(\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ (s1 @ s\<^sub>3) \ L r \ s\<^sub>4 \ L (STAR r))\ + \ (s1 @ s2) \ STAR r \ Stars (v # vs)" +| "[] \ STAR r \ Stars []" + +inductive + PMatchX :: "string \ rexp \ val \ bool" ("\ _ \ _ \ _" [100, 100, 100] 100) +where + "\ s \ EMPTY \ Void" +| "\ (c # s) \ (CHAR c) \ (Char c)" +| "\ s \ r1 \ v \ \ s \ (ALT r1 r2) \ (Left v)" +| "\\ s \ r2 \ v; \(\s'. s' \ s \ flat v \ s' \ s' \ L(r1))\ \ \ s \ (ALT r1 r2) \ (Right v)" +| "\s1 \ r1 \ v1; \ s2 \ r2 \ v2; + \(\s3 s4. s3 \ [] \ (s3 @ s4) \ s2 \ (s1 @ s3) \ L r1 \ s4 \ L r2)\ \ + \ (s1 @ s2) \ (SEQ r1 r2) \ (Seq v1 v2)" +| "\s1 \ r \ v; \ s2 \ STAR r \ Stars vs; flat v \ []; + \(\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ (s\<^sub>3 @ s\<^sub>4) \ s2 \ (s1 @ s\<^sub>3) \ L r \ s\<^sub>4 \ L (STAR r))\ + \ \ (s1 @ s2) \ STAR r \ Stars (v # vs)" +| "\ s \ STAR r \ Stars []" + +lemma PMatch1: + assumes "s \ r \ v" + shows "\ 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 "\ s \ r \ v" + shows "\ 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 "\ s \ r \ v" + shows "flat v \ s" +using assms +apply(induct s r v rule: PMatchX.induct) +apply(auto simp add: prefix_def PMatch1) +done + +lemma PMatchX_PMatch: + assumes "\ s \ r \ v" "flat v = s" + shows "s \ r \ 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 \ r \ v" + shows "\ s \ r \ 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 "\ v : r" + shows "(flat v) \ r \ 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 \ r \ v" + shows "\ 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 "[] \ r \ 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 \ r \ v" + shows "\ 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 "\s \ r \ v1; s \ r \ v2\ \ v1 = v2" + and "\s \ (STAR r) \ Stars vs1; s \ (STAR r) \ Stars vs2\ \ 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 \ 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 \ 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 \ 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 \ r \ v" + shows "v \ Values r s" +using assms +apply(simp add: Values_def PMatch1) +by (metis append_Nil2 prefix_def) + +lemma PMatch2: + assumes "s \ (der c r) \ v" + shows "(c#s) \ r \ (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 "\ 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 \ A}" +apply(simp add: Sequ_def) +done + +lemma Sequ_not: + assumes "\t. s \ (L(der c r1) ;; {t})" "L r1 \ {}" + shows "\t. c # s \ (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\ v : (der c r)" "\s. c # s \ L r" + shows "2\ (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 "\t. c # flat va \ 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 \ 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 \ L r" + shows "\v. lex r s = Some(v) \ \ v : r \ 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 \ L r" + shows "\v. lex r s = Some(v) \ s \ r \ 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 \ L r" + shows "\v. lex r s = Some(v) \ \ v : r \ flat v = s" +using lex_correct3[OF assms] +apply(auto) +apply (metis PMatch1N) +by (metis PMatch1(2)) + + +lemma lex_correct5: + assumes "s \ L r" + shows "s \ r \ (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 \ rexp \ val \ bool" ("_ \_ _" [100, 100, 100] 100) +where + "v2 \r2 v2' \ (Seq v1 v2) \(SEQ r1 r2) (Seq v1 v2')" +| "\v1 \r1 v1'; v1 \ v1'\ \ (Seq v1 v2) \(SEQ r1 r2) (Seq v1' v2')" +| "length (flat v1) \ length (flat v2) \ (Left v1) \(ALT r1 r2) (Right v2)" +| "length (flat v2) > length (flat v1) \ (Right v2) \(ALT r1 r2) (Left v1)" +| "v2 \r2 v2' \ (Right v2) \(ALT r1 r2) (Right v2')" +| "v1 \r1 v1' \ (Left v1) \(ALT r1 r2) (Left v1')" +| "Void \EMPTY Void" +| "(Char c) \(CHAR c) (Char c)" +| "flat (Stars (v # vs)) = [] \ (Stars []) \(STAR r) (Stars (v # vs))" +| "flat (Stars (v # vs)) \ [] \ (Stars (v # vs)) \(STAR r) (Stars [])" +| "\v1 \r v2; v1 \ v2\ \ (Stars (v1 # vs1)) \(STAR r) (Stars (v2 # vs2))" +| "(Stars vs1) \(STAR r) (Stars vs2) \ (Stars (v # vs1)) \(STAR r) (Stars (v # vs2))" +| "(Stars []) \(STAR r) (Stars [])" + +lemma PMatch_ValOrd: + assumes "s \ r \ v" "v' \ SValues r s" + shows "v \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 \ string \ val \ bool" ("_ 2\_ _" [100, 100, 100] 100) +where + "v2 2\s v2' \ (Seq v1 v2) 2\(flat v1 @ s) (Seq v1 v2')" +| "\v1 2\s v1'; v1 \ v1'\ \ (Seq v1 v2) 2\s (Seq v1' v2')" +| "(flat v2) \ (flat v1) \ (Left v1) 2\(flat v1) (Right v2)" +| "(flat v1) \ (flat v2) \ (Right v2) 2\(flat v2) (Left v1)" +| "v2 2\s v2' \ (Right v2) 2\s (Right v2')" +| "v1 2\s v1' \ (Left v1) 2\s (Left v1')" +| "Void 2\[] Void" +| "(Char c) 2\[c] (Char c)" +| "flat (Stars (v # vs)) = [] \ (Stars []) 2\[] (Stars (v # vs))" +| "flat (Stars (v # vs)) \ [] \ (Stars (v # vs)) 2\(flat (Stars (v # vs))) (Stars [])" +| "\v1 2\s v2; v1 \ v2\ \ (Stars (v1 # vs1)) 2\s (Stars (v2 # vs2))" +| "(Stars vs1) 2\s (Stars vs2) \ (Stars (v # vs1)) 2\(flat v @ s) (Stars (v # vs2))" +| "(Stars []) 2\[] (Stars [])" + +lemma ValOrd2_string1: + assumes "v1 2\s v2" + shows "s \ flat v1" +using assms +apply(induct) +apply(auto simp add: prefix_def) +apply (metis append_assoc) +by (metis append_assoc) + + +lemma admissibility: + assumes "s \ r \ v" "\ v' : r" + shows "(\s'. (s' \ L(r) \ s' \ s) \ v 2\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 "\ s \ r \ v" "\ v' : r" + shows "v \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\ v : r" "\ v' : r" "flat v' \ flat v" + shows "v \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 "\ v : r" "\ v' : r" + shows "v \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 "\ v : r" "\ v' : r" "flat v' \ flat v" + shows "v \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 \ flat v1a \ flat v1a \ flat v1") +prefer 2 +apply(simp add: prefix_def sprefix_def) +apply (metis append_eq_append_conv2) +apply(erule disjE) +(* first case flat v1 \ flat v1a *) +apply(subst (asm) sprefix_def) +apply(subst (asm) (5) prefix_def) +apply(clarify) +apply(subgoal_tac "(s3 @ flat v2a) \ flat v2") +prefer 2 +apply(simp) +apply (metis append_assoc prefix_append) +apply(subgoal_tac "s3 \ []") +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 "\ v : r" + shows "v \r v" +using assms +apply(induct) +apply(auto intro: ValOrd.intros) +done + +lemma ValOrd_total: + shows "\\ v1 : r; \ v2 : r\ \ v1 \r v2 \ v2 \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 "\ v : r" "\ v' : r" "flat v' \ flat v" + shows "v \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 "\\ v1 : r; \ v2 : r; v1 \r v2; v2 \r v1\ \ v1 = v2" + and "\\ Stars vs1 : r; \ Stars vs2 : r; Stars vs1 \r Stars vs2; Stars vs2 \r Stars vs1\ \ 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 \ r \ v1" "\ v2 : r" "flat v2 \ s" + shows "v1 \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 \ r \ v1" "\ v2 : r" "flat v2 \ s" + shows "v1 \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 \ val \ bool" ("_ 2\ _" [100, 100] 100) +where + "v2 2\ v2' \ (Seq v1 v2) 2\ (Seq v1 v2')" +| "\v1 2\ v1'; v1 \ v1'\ \ (Seq v1 v2) 2\ (Seq v1' v2')" +| "length (flat v1) \ length (flat v2) \ (Left v1) 2\ (Right v2)" +| "length (flat v2) > length (flat v1) \ (Right v2) 2\ (Left v1)" +| "v2 2\ v2' \ (Right v2) 2\ (Right v2')" +| "v1 2\ v1' \ (Left v1) 2\ (Left v1')" +| "Void 2\ Void" +| "(Char c) 2\ (Char c)" + +lemma Ord1: + "v1 \r v2 \ v1 2\ v2" +apply(induct rule: ValOrd.induct) +apply(auto intro: ValOrd2.intros) +done + +lemma Ord2: + "v1 2\ v2 \ \r. v1 \r v2" +apply(induct v1 v2 rule: ValOrd2.induct) +apply(auto intro: ValOrd.intros) +done + +lemma Ord3: + "\v1 2\ v2; \ v1 : r\ \ v1 \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 \ rexp \ bool" +where + "POSIX v r \ (\ v : r \ (\v'. (\ v' : r \ flat v' \ flat v) \ v \r v'))" + +lemma ValOrd_refl: + assumes "\ v : r" + shows "v \r v" +using assms +apply(induct) +apply(auto intro: ValOrd.intros) +done + +lemma ValOrd_total: + shows "\\ v1 : r; \ v2 : r\ \ v1 \r v2 \ v2 \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 "\\ v1 : r; \ v2 : r; v1 \r v2; v2 \r v1\ \ 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" "\v'. \ v' : r1 \ 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 \ r \ v" "\ v' : r" + shows "length (flat v') \ 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 \ r \ 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 \ r \ v1" "\ v2 : r" "flat v2 = s" + shows "v1 \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 \r v2 \ v1 \ Values r s \ v2 \ 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 \ rexp \ bool" +where + "POSIX v r \ (\ v : r \ (\v'. (\ v' : r \ flat v = flat v') \ v \r v'))" + +definition POSIX2 :: "val \ rexp \ bool" +where + "POSIX2 v r \ (\ v : r \ (\v'. (\ v' : r \ flat v = flat v') \ v 2\ 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)" "\ v1 : r1" "\ 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)" "\ v1 : r1" "\ 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 "(\v'. (\ v' : r2 \ flat v' = flat v2) \ v2 \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" "\v'. \ v' : r1 \ 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. \ 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 \ 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 \ Values (der c r) s" + shows "injval r c v \ 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 \ Values r (c#s)" "\s. flat v = c # s" + shows "projval r c v \ 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 \ (v \ Values r s \ (\v' \ Values r s. v 2\ v'))" + +lemma MValue_ALTE: + assumes "MValue v (ALT r1 r2) s" + shows "(\vl. v = Left vl \ MValue vl r1 s \ (\vr \ Values r2 s. length (flat vr) \ length (flat vl))) \ + (\vr. v = Right vr \ MValue vr r2 s \ (\vl \ 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" "\vr \ Values r2 s. length (flat vr) \ 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" "\vl \ 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) \ xs = ys" +by (metis list.sel(3)) + +lemma t2: "(xs = ys) \ (c#xs) = (c#ys)" +by (metis) + +lemma "\(nullable r) \ \(\v. \ v : r \ flat v = [])" +by (metis Prf_flat_L nullable_correctness) + + +lemma LeftRight: + assumes "(Left v1) \(der c (ALT r1 r2)) (Right v2)" + and "\ v1 : der c r1" "\ v2 : der c r2" + shows "(injval (ALT r1 r2) c (Left v1)) \(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) \(der c (ALT r1 r2)) (Left v2)" + and "\ v1 : der c r2" "\ v2 : der c r1" + shows "(injval (ALT r1 r2) c (Right v1)) \(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" "\ v1 : der c r1" + shows "injval r1 c v1 \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)) \(der c (SEQ r1 r2)) (Right v3)" + and "nullable r1" "\ v1 : der c r1" + shows "(injval (SEQ r1 r2) c (Seq v1 v2)) \(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 "\ v : r" "\nullable r" + shows "flat v \ []" +using assms +by (metis Prf_flat_L nullable_correctness) + +(* HERE *) + +lemma Prf_inj_test: + assumes "v1 \(der c r) v2" + "v1 \ Values (der c r) s" + "v2 \ Values (der c r) s" + "injval r c v1 \ Values r (c#s)" + "injval r c v2 \ Values r (c#s)" + shows "(injval r c v1) 2\ (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 \(der c r) v2" + "v1 \ Values (der c r) s" + "v2 \ Values (der c r) s" + "injval r c v1 \ Values r (c#s)" + "injval r c v2 \ Values r (c#s)" + shows "(injval r c v1) 2\ (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)" "\ 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)" "\ 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 \ []") +prefer 2 +apply (metis Prf_flat_L nullable_correctness) +apply(subgoal_tac "\s. flat v1a = c # s") +prefer 2 +apply (metis append_eq_Cons_conv) +apply(auto)[1] +oops + + +lemma POSIX_ex: "\ v : r \ \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: "\ v : r \ \v. POSIX v r \ \ 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 "\ v : (ALT r1 r2)" "POSIX v (ALT r1 r2)" + shows "(\v1. v = Left v1 \ POSIX v1 r1) \ (\v2. v = Right v2 \ 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)" "\ v : (ALT r1 r2)" + shows "(\v1. v = Left v1 \ POSIX v1 r1) \ (\v2. v = Right v2 \ POSIX v2 r2)" +using assms POSIX_ALT_cases by auto + +lemma Prf_flat_empty: + assumes "\ v : r" "flat v = []" + shows "nullable r" +using assms +apply(induct) +apply(auto) +done + +lemma POSIX_proj: + assumes "POSIX v r" "\ v : r" "\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" "\ v : r" "\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" "\ v : r" "\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 \(der c r) v2" "\ v1 : der c r" "\ v2 : der c r" "flat v1 = flat v2" + shows "(injval r c v1) \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 "\ 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 "\ 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 diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys2/RegLangs.thy --- /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 \Sequential Composition of Languages\ + +definition + Sequ :: "string set \ string set \ string set" ("_ ;; _" [100,100] 100) +where + "A ;; B = {s1 @ s2 | s1 s2. s1 \ A \ s2 \ 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 \ string set \ string set" +where + "Der c A \ {s. c # s \ A}" + +definition + Ders :: "string \ string set \ string set" +where + "Ders s A \ {s'. s @ s' \ 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 \ B) = Der c A \ Der c B" +unfolding Der_def +by auto + +lemma Der_Sequ [simp]: + shows "Der c (A ;; B) = (Der c A) ;; B \ (if [] \ 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 \ string set" ("_\" [101] 102) + for A :: "string set" +where + start[intro]: "[] \ A\" +| step[intro]: "\s1 \ A; s2 \ A\\ \ s1 @ s2 \ A\" + +(* Arden's lemma *) + +lemma Star_cases: + shows "A\ = {[]} \ A ;; A\" +unfolding Sequ_def +by (auto) (metis Star.simps) + +lemma Star_decomp: + assumes "c # x \ A\" + shows "\s1 s2. x = s1 @ s2 \ c # s1 \ A \ s2 \ A\" +using assms +by (induct x\"c # x" rule: Star.induct) + (auto simp add: append_eq_Cons_conv) + +lemma Star_Der_Sequ: + shows "Der c (A\) \ (Der c A) ;; A\" +unfolding Der_def Sequ_def +by(auto simp add: Star_decomp) + + +lemma Der_star[simp]: + shows "Der c (A\) = (Der c A) ;; A\" +proof - + have "Der c (A\) = Der c ({[]} \ A ;; A\)" + by (simp only: Star_cases[symmetric]) + also have "... = Der c (A ;; A\)" + by (simp only: Der_union Der_empty) (simp) + also have "... = (Der c A) ;; A\ \ (if [] \ A then Der c (A\) else {})" + by simp + also have "... = (Der c A) ;; A\" + using Star_Der_Sequ by auto + finally show "Der c (A\) = (Der c A) ;; A\" . +qed + +lemma Star_concat: + assumes "\s \ set ss. s \ A" + shows "concat ss \ A\" +using assms by (induct ss) (auto) + +lemma Star_split: + assumes "s \ A\" + shows "\ss. concat ss = s \ (\s \ set ss. s \ A \ s \ [])" +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 \Regular Expressions\ + +datatype rexp = + ZERO +| ONE +| CH char +| SEQ rexp rexp +| ALT rexp rexp +| STAR rexp + +section \Semantics of Regular Expressions\ + +fun + L :: "rexp \ 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) \ (L r2)" +| "L (STAR r) = (L r)\" + + +section \Nullable, Derivatives\ + +fun + nullable :: "rexp \ bool" +where + "nullable (ZERO) = False" +| "nullable (ONE) = True" +| "nullable (CH c) = False" +| "nullable (ALT r1 r2) = (nullable r1 \ nullable r2)" +| "nullable (SEQ r1 r2) = (nullable r1 \ nullable r2)" +| "nullable (STAR r) = True" + + +fun + der :: "char \ rexp \ 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 \ rexp \ rexp" +where + "ders [] r = r" +| "ders (c # s) r = ders s (der c r)" + + +lemma nullable_correctness: + shows "nullable r \ [] \ (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 \ rexp \ ctxt list \ rexp * ctxt list" +and up :: "char \ rexp \ ctxt list \ 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 diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys2/Simplifying.thy --- /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 \ rexp * (val \ 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 \ string \ 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 \ None + | Some(v) \ Some(injval r c (fr v))))" + + +lemma slexer_better_simp: + "slexer r (c#s) = (case (slexer (fst (simp (der c r))) s) of + None \ None + | Some(v) \ 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 \ (fst (simp r)) \ v" + shows "s \ r \ ((snd (simp r)) v)" +using assms +proof(induct r arbitrary: s v rule: rexp.induct) + case (ALT r1 r2 s v) + have IH1: "\s v. s \ fst (simp r1) \ v \ s \ r1 \ snd (simp r1) v" by fact + have IH2: "\s v. s \ fst (simp r2) \ v \ s \ r2 \ snd (simp r2) v" by fact + have as: "s \ fst (simp (ALT r1 r2)) \ v" by fact + consider (ZERO_ZERO) "fst (simp r1) = ZERO" "fst (simp r2) = ZERO" + | (ZERO_NZERO) "fst (simp r1) = ZERO" "fst (simp r2) \ ZERO" + | (NZERO_ZERO) "fst (simp r1) \ ZERO" "fst (simp r2) = ZERO" + | (NZERO_NZERO) "fst (simp r1) \ ZERO" "fst (simp r2) \ ZERO" by auto + then show "s \ ALT r1 r2 \ snd (simp (ALT r1 r2)) v" + proof(cases) + case (ZERO_ZERO) + with as have "s \ ZERO \ v" by simp + then show "s \ ALT r1 r2 \ snd (simp (ALT r1 r2)) v" by (rule Posix_elims(1)) + next + case (ZERO_NZERO) + with as have "s \ fst (simp r2) \ v" by simp + with IH2 have "s \ r2 \ 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 \ L r1" by simp + ultimately have "s \ ALT r1 r2 \ Right (snd (simp r2) v)" by (rule Posix_ALT2) + then show "s \ ALT r1 r2 \ snd (simp (ALT r1 r2)) v" + using ZERO_NZERO by simp + next + case (NZERO_ZERO) + with as have "s \ fst (simp r1) \ v" by simp + with IH1 have "s \ r1 \ snd (simp r1) v" by simp + then have "s \ ALT r1 r2 \ Left (snd (simp r1) v)" by (rule Posix_ALT1) + then show "s \ ALT r1 r2 \ snd (simp (ALT r1 r2)) v" using NZERO_ZERO by simp + next + case (NZERO_NZERO) + with as have "s \ ALT (fst (simp r1)) (fst (simp r2)) \ v" by simp + then consider (Left) v1 where "v = Left v1" "s \ (fst (simp r1)) \ v1" + | (Right) v2 where "v = Right v2" "s \ (fst (simp r2)) \ v2" "s \ L (fst (simp r1))" + by (erule_tac Posix_elims(4)) + then show "s \ ALT r1 r2 \ snd (simp (ALT r1 r2)) v" + proof(cases) + case (Left) + then have "v = Left v1" "s \ r1 \ (snd (simp r1) v1)" using IH1 by simp_all + then show "s \ ALT r1 r2 \ snd (simp (ALT r1 r2)) v" using NZERO_NZERO + by (simp_all add: Posix_ALT1) + next + case (Right) + then have "v = Right v2" "s \ r2 \ (snd (simp r2) v2)" "s \ L r1" using IH2 L_fst_simp by simp_all + then show "s \ ALT r1 r2 \ 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: "\s v. s \ fst (simp r1) \ v \ s \ r1 \ snd (simp r1) v" by fact + have IH2: "\s v. s \ fst (simp r2) \ v \ s \ r2 \ snd (simp r2) v" by fact + have as: "s \ fst (simp (SEQ r1 r2)) \ v" by fact + consider (ONE_ONE) "fst (simp r1) = ONE" "fst (simp r2) = ONE" + | (ONE_NONE) "fst (simp r1) = ONE" "fst (simp r2) \ ONE" + | (NONE_ONE) "fst (simp r1) \ ONE" "fst (simp r2) = ONE" + | (NONE_NONE) "fst (simp r1) \ ONE" "fst (simp r2) \ ONE" + by auto + then show "s \ SEQ r1 r2 \ snd (simp (SEQ r1 r2)) v" + proof(cases) + case (ONE_ONE) + with as have b: "s \ ONE \ v" by simp + from b have "s \ r1 \ 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 "[] \ ONE \ Void" by (simp add: Posix_ONE) + then have "[] \ fst (simp r2) \ Void" using ONE_ONE by simp + then have "[] \ r2 \ snd (simp r2) Void" using IH2 by simp + ultimately have "([] @ []) \ SEQ r1 r2 \ Seq (snd (simp r1) Void) (snd (simp r2) Void)" + using Posix_SEQ by blast + then show "s \ SEQ r1 r2 \ snd (simp (SEQ r1 r2)) v" using c ONE_ONE by simp + next + case (ONE_NONE) + with as have b: "s \ fst (simp r2) \ v" by simp + from b have "s \ r2 \ snd (simp r2) v" using IH2 ONE_NONE by simp + moreover + have "[] \ ONE \ Void" by (simp add: Posix_ONE) + then have "[] \ fst (simp r1) \ Void" using ONE_NONE by simp + then have "[] \ r1 \ 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) \ SEQ r1 r2 \ Seq (snd (simp r1) Void) (snd (simp r2) v)" + by(rule_tac Posix_SEQ) auto + then show "s \ SEQ r1 r2 \ snd (simp (SEQ r1 r2)) v" using ONE_NONE by simp + next + case (NONE_ONE) + with as have "s \ fst (simp r1) \ v" by simp + with IH1 have "s \ r1 \ snd (simp r1) v" by simp + moreover + have "[] \ ONE \ Void" by (simp add: Posix_ONE) + then have "[] \ fst (simp r2) \ Void" using NONE_ONE by simp + then have "[] \ r2 \ snd (simp r2) Void" using IH2 by simp + ultimately have "(s @ []) \ SEQ r1 r2 \ Seq (snd (simp r1) v) (snd (simp r2) Void)" + by(rule_tac Posix_SEQ) auto + then show "s \ SEQ r1 r2 \ snd (simp (SEQ r1 r2)) v" using NONE_ONE by simp + next + case (NONE_NONE) + from as have 00: "fst (simp r1) \ ZERO" "fst (simp r2) \ 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 \ SEQ (fst (simp r1)) (fst (simp r2)) \ v" by simp + then obtain s1 s2 v1 v2 where eqs: "s = s1 @ s2" "v = Seq v1 v2" + "s1 \ (fst (simp r1)) \ v1" "s2 \ (fst (simp r2)) \ v2" + "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L r1 \ s\<^sub>4 \ L r2)" + by (erule_tac Posix_elims(5)) (auto simp add: L_fst_simp[symmetric]) + then have "s1 \ r1 \ (snd (simp r1) v1)" "s2 \ r2 \ (snd (simp r2) v2)" + using IH1 IH2 by auto + then show "s \ SEQ r1 r2 \ 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: "\r. slexer r s = lexer r s" by fact + show "slexer r (c # s) = lexer r (c # s)" + proof (cases "s \ L (der c r)") + case True + assume a1: "s \ L (der c r)" + then obtain v1 where a2: "lexer (der c r) s = Some v1" "s \ der c r \ v1" + using lexer_correct_Some by auto + from a1 have "s \ 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 \ (fst (simp (der c r))) \ 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 \ der c r \ (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 \ L (der c r)" + then have "lexer (der c r) s = None" using lexer_correct_None by simp + moreover + from b1 have "s \ 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 diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys2/SizeBound.thy --- /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 \Bit-Encodings\ + +datatype bit = Z | S + +fun code :: "val \ 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 \ val \ val" +where + "Stars_add v (Stars vs) = Stars (v # vs)" + +function + decode' :: "bit list \ rexp \ (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)) \ 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 \ rexp \ val option" +where + "decode ds r \ (let (v, ds') = decode' ds r + in (if ds' = [] then Some v else None))" + +lemma decode'_code_Stars: + assumes "\v\set vs. \ v : r \ (\x. decode' (code v @ x) r = (v, x)) \ flat v \ []" + shows "decode' (code (Stars vs) @ ds) (STAR r) = (Stars vs, ds)" + using assms + apply(induct vs) + apply(auto) + done + +lemma decode'_code: + assumes "\ 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 "\ 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 \ AALTs bs [r1, r2]" + +fun asize :: "arexp \ 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 \ 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 \ bool" + where + "nonalt (AALTs bs2 rs) = False" +| "nonalt r = True" + + +fun good :: "arexp \ 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)) = (\r' \ set (r1#r2#rs). good r' \ nonalt r')" +| "good (ASEQ _ AZERO _) = False" +| "good (ASEQ _ (AONE _) _) = False" +| "good (ASEQ _ _ AZERO) = False" +| "good (ASEQ cs r1 r2) = (good r1 \ good r2)" +| "good (ASTAR cs r) = True" + + + + +fun fuse :: "bit list \ arexp \ 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 \ 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 \ val \ 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 \ bool" +where + "bnullable (AZERO) = False" +| "bnullable (AONE bs) = True" +| "bnullable (ACHAR bs c) = False" +| "bnullable (AALTs bs rs) = (\r \ set rs. bnullable r)" +| "bnullable (ASEQ bs r1 r2) = (bnullable r1 \ bnullable r2)" +| "bnullable (ASTAR bs r) = True" + +fun + bmkeps :: "arexp \ 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 \ arexp \ 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 \ string \ 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 "\v\set vs. \ v : r \ 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 "\ 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 "\ 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 "\ 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 "\ 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 \ set rs" "bnullable x" + shows "bnullable (AALTs bs rs)" + using assms + apply(induct rs) + apply(auto) + done + +lemma r3: + assumes "\ bnullable r" + " \ x \ 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 "\r \ set rs. nullable (erase r) \ 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 "\ 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 "\ 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 "\ v : ders [] r" by fact + then have "\ 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: "\v. \ v : ders s r \ + Some (flex r id s v) = decode (retrieve (bders (intern r) s) v) r" by fact + have asm: "\ v : ders (s @ [c]) r" by fact + then have asm2: "\ 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 \ if bnullable (bders a s) then Some (bmkeps (bders a s)) else None" + + + +definition blexer where + "blexer r s \ 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 \ bders (intern r) s" + define ds where "ds \ ders s r" + assume asm: "nullable ds" + have era: "erase bds = ds" + unfolding ds_def bds_def by simp + have mke: "\ 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 \ ('a \ 'b) \ 'b set \ 'a list" + where + "distinctBy [] f acc = []" +| "distinctBy (x#xs) f acc = + (if (f x) \ acc then distinctBy xs f acc + else x # (distinctBy xs f ({f x} \ acc)))" + + + + +fun flts :: "arexp list \ 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 \ arexp list \ arexp" + where + "li _ [] = AZERO" +| "li bs [a] = fuse bs a" +| "li bs as = AALTs bs as" + + + + +fun bsimp_ASEQ :: "bit list \ arexp \ arexp \ 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 \ arexp list \ arexp" + where + "bsimp_AALTs _ [] = AZERO" +| "bsimp_AALTs bs1 [r] = fuse bs1 r" +| "bsimp_AALTs bs1 rs = AALTs bs1 rs" + + +fun bsimp :: "arexp \ 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 \ string \ 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 \ 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)) = \ (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 "\ (L ` erase ` (set (flts rs))) = \ (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 "( \(L ` acc) \ ( \ (L ` erase ` (set (distinctBy rs erase acc) ) ) )) = \(L ` acc) \ \ (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 " ( \ (L ` erase ` (set (distinctBy rs erase {}) ) ) ) = \ (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 \ AZERO" "r2 \ AZERO" "\bs. r1 \ 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 "\r \ 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 "\r \ set rs. \ bnullable r" "\r \ 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) = (\r \ set rs. bnullable r)" + apply(induct rs arbitrary: bs) + apply(simp) + apply(simp) + done + + + + + +fun nonnested :: "arexp \ 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 \ (\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 \ 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 "\r \ 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 "\x\set list. bnullable x" + shows "\x\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 "\r \ 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 "\x\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 \ arexp list \ 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) \ 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 \ L (der c r)" + shows "s \ der c r \ 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 \ arexp \ bool" ("_ \ _" [99, 99] 99) + where + "ASEQ bs AZERO r2 \ AZERO" +| "ASEQ bs r1 AZERO \ AZERO" +| "ASEQ bs (AONE bs1) r \ fuse (bs@bs1) r" +| "r1 \ r2 \ ASEQ bs r1 r3 \ ASEQ bs r2 r3" +| "r3 \ r4 \ ASEQ bs r1 r3 \ ASEQ bs r1 r4" +| "r \ r' \ (AALTs bs (rs1 @ [r] @ rs2)) \ (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) \ AALTs bs (rsa@rsb)" +| "AALTs bs (rsa@(AALTs bs1 rs1)# rsb) \ 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) \ 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 \ AALTs bs (map (fuse bs1) rs)" +| "AALTs bs [] \ AZERO" +| "AALTs bs [r] \ fuse bs r" +| "erase a1 = erase a2 \ AALTs bs (rsa@[a1]@rsb@[a2]@rsc) \ AALTs bs (rsa@[a1]@rsb@rsc)" + + +inductive rrewrites:: "arexp \ arexp \ bool" ("_ \* _" [100, 100] 100) + where +rs1[intro, simp]:"r \* r" +| rs2[intro]: "\r1 \* r2; r2 \ r3\ \ r1 \* r3" + +inductive srewrites:: "arexp list \ arexp list \ bool" (" _ s\* _" [100, 100] 100) + where +ss1: "[] s\* []" +|ss2: "\r \* r'; rs s\* rs'\ \ (r#rs) s\* (r'#rs')" +(*rs1 = [r1, r2, ..., rn] rs2 = [r1', r2', ..., rn'] +[r1, r2, ..., rn] \* [r1', r2, ..., rn] \* [...r2',...] \* [r1', r2',... rn'] +*) + + + +lemma r_in_rstar : "r1 \ r2 \ r1 \* r2" + using rrewrites.intros(1) rrewrites.intros(2) by blast + +lemma real_trans: + assumes a1: "r1 \* r2" and a2: "r2 \* r3" + shows "r1 \* r3" + using a2 a1 + apply(induct r2 r3 arbitrary: r1 rule: rrewrites.induct) + apply(auto) + done + + +lemma many_steps_later: "\r1 \ r2; r2 \* r3 \ \ r1 \* r3" + by (meson r_in_rstar real_trans) + + +lemma contextrewrites1: "r \* r' \ (AALTs bs (r#rs)) \* (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 \* r' \ (AALTs bs (rs1@[r]@rs)) \* (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\* rs2 \ (AALTs bs (rs@rs1)) \* (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\* rs2 \ AALTs bs rs1 \* AALTs bs rs2" + by (metis append.left_neutral srewrites_alt) + + +lemma star_seq: "r1 \* r2 \ ASEQ bs r1 r3 \* 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 \* r4 \ ASEQ bs r1 r3 \* ASEQ bs r1 r4" + apply(induct r3 r4 arbitrary: r1 rule: rrewrites.induct) + apply auto + using rrewrite.intros(5) by blast + + +lemma continuous_rewrite: "\r1 \* AZERO\ \ ASEQ bs1 r1 r2 \* AZERO" + apply(induction ra\"r1" rb\"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 \* (bsimp (AONE bs))" "AZERO \* bsimp AZERO" "ACHAR bs c \* (bsimp (ACHAR bs c))" + apply (simp add: rrewrites.intros(1)) + apply (simp add: rrewrites.intros(1)) + by (simp add: rrewrites.intros(1)) + +lemma trivialbsimpsrewrites: "\\x. x \ set rs \ x \* f x \ \ rs s\* (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 \* 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 \ arexp list \ bool" (" _ f\* _" [100, 100] 100) + where +fs1: "[] f\* []" +|fs2: "\rs f\* rs'\ \ (AZERO#rs) f\* rs'" +|fs3: "\rs f\* rs'\ \ ((AALTs bs rs1) # rs) f\* ((map (fuse bs) rs1) @ rs')" +|fs4: "\rs f\* rs';nonalt r; nonazero r\ \ (r#rs) f\* (r#rs')" + + + + + +lemma flts_prepend: "\nonalt a; nonazero a\ \ flts (a#rs) = a # (flts rs)" + by (metis append_Cons append_Nil flts_single1 k00) + +lemma fltsfrewrites: "rs f\* (flts rs)" + apply(induction rs) + apply simp + apply(rule fs1) + + apply(case_tac "a = AZERO") + + + using fs2 apply auto[1] + apply(case_tac "\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) \ AALTs bs rsb" + by (metis append_Nil rrewrite.intros(7)) + + +lemma frewritesaalts:"rs f\* rs' \ (AALTs bs (rs1@rs)) \* (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 \* 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 "\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\* (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: "\bs1 rs. (\x. x \ set rs \ x \* bsimp x) \ +AALTs bs1 rs \* AALTs bs1 (map bsimp rs)" + apply(subgoal_tac " rs s\* (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 \ ('a \ 'b) \ 'b set \ 'b set" + where + "distinctByAcc [] f acc = acc" +| "distinctByAcc (x#xs) f acc = + (if (f x) \ acc then distinctByAcc xs f acc + else (distinctByAcc xs f ({f x} \ acc)))" + +lemma dB_single_step: "distinctBy (a#rs) f {} = a # distinctBy rs f {f a}" + apply simp + done + +lemma somewhereInside: "r \ set rs \ \rs1 rs2. rs = rs1@[r]@rs2" + using split_list by fastforce + +lemma somewhereMapInside: "f r \ f ` set rs \ \rs1 rs2 a. rs = rs1@[a]@rs2 \ f a = f r" + apply auto + by (metis split_list) + +lemma alts_dBrewrites_withFront: " AALTs bs (rsa @ rs) \* 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 \ 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 \ set rs2)))) \ AALTs bs (rs1@ a # rs2 @ distinctBy rs erase + (insert (erase a) + (erase ` + (set rs1 \ 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 \ erase `set rsa") + + apply simp + apply(subgoal_tac "AALTs bs (rsa @ a # distinctBy rs erase (insert (erase a) (erase ` set rsa))) \ + 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 \* 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 "\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 \* AALTs bs1 (map bsimp rs)") + apply(subgoal_tac "AALTs bs1 (map bsimp rs) \* AALTs bs1 (flts (map bsimp rs))") + apply(subgoal_tac "AALTs bs1 (flts (map bsimp rs)) \* AALTs bs1 (distinctBy (flts (map bsimp rs)) erase {})") + apply(subgoal_tac "AALTs bs1 (distinctBy (flts (map bsimp rs)) erase {}) \* 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: "\r1 \ r2; bnullable r1 \ \ 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: "\r1 \ r2; \bnullable r1 \ \ \bnullable r2" + apply(induction r1 r2 rule: rrewrite.induct) + apply auto + apply (metis bnullable_correctness erase_fuse)+ + done + + +lemma rewritesnullable: "\ r1 \* r2; bnullable r1 \ \ bnullable r2" + apply(induction r1 r2 rule: rrewrites.induct) + apply simp + apply(rule rewritenullable) + apply simp + apply simp + done + +lemma nonbnullable_lists_concat: " \ \ (\r0\set rs1. bnullable r0); \ bnullable r; \ (\r0\set rs2. bnullable r0)\ \ +\(\r0 \ (set (rs1@[r]@rs2)). bnullable r0 ) " + apply simp + apply blast + done + + + +lemma nomember_bnullable: "\ \ (\r0\set rs1. bnullable r0); \ bnullable r; \ (\r0\set rs2. bnullable r0)\ + \ \bnullable (AALTs bs (rs1 @ [r] @ rs2))" + using nonbnullable_lists_concat qq3 by presburger + +lemma bnullable_segment: " bnullable (AALTs bs (rs1@[r]@rs2)) \ bnullable (AALTs bs rs1) \ bnullable (AALTs bs rs2) \ bnullable r" + apply(case_tac "\r0\set rs1. bnullable r0") + + using qq3 apply blast + apply(case_tac "bnullable r") + + apply blast + apply(case_tac "\r0\set rs2. bnullable r0") + + using bnullable.simps(4) apply presburger + apply(subgoal_tac "False") + + apply blast + + using nomember_bnullable by blast + + + +lemma bnullablewhichbmkeps: "\bnullable (AALTs bs (rs1@[r]@rs2)); \ bnullable (AALTs bs rs1); bnullable r \ + \ bmkeps (AALTs bs (rs1@[r]@rs2)) = bs @ (bmkeps r)" + using qq2 bnullable_Hdbmkeps_Hd by force + +lemma rrewrite_nbnullable: "\ r1 \ r2 ; \ bnullable r1 \ \ \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) + \ 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: "\bnullable (AALTs bs (rs1@rs2@rs3)); \bnullable (AALTs bs rs1); \bnullable (AALTs bs rs2)\ \ +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: "\bnullable (AALTs bs (rs1@rs2@rs3)); \bnullable (AALTs bs rs1); \bnullable (AALTs bs rs2)\ \ +bmkeps (AALTs bs (rs1@rs2@rs3) ) = bmkeps (AALTs bs rs3)" + apply(subgoal_tac "bnullable (AALTs bs rs3)") + apply(subgoal_tac "\r \ set (rs1@rs2). \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: " \bnullable (AALTs bs (rsa @ AALTs bs1 rs1 # rsb)); bnullable (AALTs bs (rsa @ map (fuse bs1) rs1 @ rsb))\ + \ 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: "\ r1 \ r2; (bnullable r1)\ \ 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 "\ 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: "\ (r1 \* r2); (bnullable r1)\ \ 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 \ r' \ AALTs bs (r # rs) \ AALTs bs (r' # rs)" + by (metis append_Cons append_Nil rrewrite.intros(6)) + +lemma alt_rewrite_front: "r \ r' \ AALT bs r r2 \ AALT bs r' r2" + using alts_rewrite_front by blast + +lemma to_zero_in_alt: " AALT bs (ASEQ [] AZERO r) r2 \ AALT bs AZERO r2" + by (simp add: alts_rewrite_front rrewrite.intros(1)) + +lemma alt_remove0_front: " AALT bs AZERO r \ AALTs bs [r]" + by (simp add: rrewrite0away) + +lemma alt_rewrites_back: "r2 \* r2' \AALT bs r1 r2 \* 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 \ r3 \ fuse bs r2 \* 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 \* r2' \ (fuse bs1 r2) \* (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 \ fuse bs1) rs1 = map (fuse bs1 \ 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)) \* 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 \ + bder c (AALTs bs (rsa @ [a1] @ rsb @ [a2] @ rsc)) \* + bder c (AALTs bs (rsa @ [a1] @ rsb @ rsc))" + apply(simp) + + using rrewrite.intros(13) by auto + +lemma rewrite_after_der: "r1 \ r2 \ (bder c r1) \* (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 "\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 \ 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 \* r2 \ (bder c r1) \* (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) \* (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) \ 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 diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys2/Spec.thy --- /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 \"Plain" 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 \ 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 \ concat (map flat vs)" + +lemma flat_Stars [simp]: + "flat (Stars vs) = flats vs" +by (induct vs) (auto) + + +section \Lexical Values\ + +inductive + Prf :: "val \ rexp \ bool" ("\ _ : _" [100, 100] 100) +where + "\\ v1 : r1; \ v2 : r2\ \ \ Seq v1 v2 : SEQ r1 r2" +| "\ v1 : r1 \ \ Left v1 : ALT r1 r2" +| "\ v2 : r2 \ \ Right v2 : ALT r1 r2" +| "\ Void : ONE" +| "\ Char c : CH c" +| "\v \ set vs. \ v : r \ flat v \ [] \ \ Stars vs : STAR r" + +inductive_cases Prf_elims: + "\ v : ZERO" + "\ v : SEQ r1 r2" + "\ v : ALT r1 r2" + "\ v : ONE" + "\ v : CH c" + "\ vs : STAR r" + +lemma Prf_Stars_appendE: + assumes "\ Stars (vs1 @ vs2) : STAR r" + shows "\ Stars vs1 : STAR r \ \ Stars vs2 : STAR r" +using assms +by (auto intro: Prf.intros elim!: Prf_elims) + + +lemma flats_Prf_value: + assumes "\s\set ss. \v. s = flat v \ \ v : r" + shows "\vs. flats vs = concat ss \ (\v\set vs. \ v : r \ flat v \ [])" +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 "\ v : r" + shows "flat v \ L r" +using assms +by (induct) (auto simp add: Sequ_def Star_concat) + +lemma L_flat_Prf2: + assumes "s \ L r" + shows "\v. \ v : r \ flat v = s" +using assms +proof(induct r arbitrary: s) + case (STAR r s) + have IH: "\s. s \ L r \ \v. \ v : r \ flat v = s" by fact + have "s \ L (STAR r)" by fact + then obtain ss where "concat ss = s" "\s \ set ss. s \ L r \ s \ []" + using Star_split by auto + then obtain vs where "flats vs = s" "\v\set vs. \ v : r \ flat v \ []" + using IH flats_Prf_value by metis + then show "\v. \ v : STAR r \ flat v = s" + using Prf.intros(6) flat_Stars by blast +next + case (SEQ r1 r2 s) + then show "\v. \ v : SEQ r1 r2 \ flat v = s" + unfolding Sequ_def L.simps by (fastforce intro: Prf.intros) +next + case (ALT r1 r2 s) + then show "\v. \ v : ALT r1 r2 \ 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. \ 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 \ string \ val set" +where "LV r s \ {v. \ v : r \ 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 \ Right ` LV r2 s" +unfolding LV_def +by (auto intro: Prf.intros elim: Prf.cases) + + +abbreviation + "Prefixes s \ {s'. prefix s' s}" + +abbreviation + "Suffixes s \ {s'. suffix s' s}" + +abbreviation + "SSuffixes s \ {s'. strict_suffix s' s}" + +lemma Suffixes_cons [simp]: + shows "Suffixes (c # s) = Suffixes s \ {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 \ 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 "\s. finite (LV r s)" + shows "finite (LV (STAR r) s)" +proof(induct s rule: length_induct) + fix s::"char list" + assume "\s'. length s' < length s \ finite (LV (STAR r) s')" + then have IH: "\s' \ SSuffixes s. finite (LV (STAR r) s')" + by (force simp add: strict_suffix_def suffix_def) + define f where "f \ \(v, vs). Stars (v # vs)" + define S1 where "S1 \ \s' \ Prefixes s. LV r s'" + define S2 where "S2 \ \s2 \ 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 []} \ f ` (S1 \ S2))" by simp + moreover + have "LV (STAR r) s \ {Stars []} \ f ` (S1 \ 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 \ \(v1, v2). Seq v1 v2" + define S1 where "S1 \ \s' \ Prefixes s. LV r1 s'" + define S2 where "S2 \ \s' \ Suffixes s. LV r2 s'" + have IHs: "\s. finite (LV r1 s)" "\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 \ f ` (S1 \ 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 inductive POSIX Definition\ + +inductive + Posix :: "string \ rexp \ val \ bool" ("_ \ _ \ _" [100, 100, 100] 100) +where + Posix_ONE: "[] \ ONE \ Void" +| Posix_CH: "[c] \ (CH c) \ (Char c)" +| Posix_ALT1: "s \ r1 \ v \ s \ (ALT r1 r2) \ (Left v)" +| Posix_ALT2: "\s \ r2 \ v; s \ L(r1)\ \ s \ (ALT r1 r2) \ (Right v)" +| Posix_SEQ: "\s1 \ r1 \ v1; s2 \ r2 \ v2; + \(\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ (s1 @ s\<^sub>3) \ L r1 \ s\<^sub>4 \ L r2)\ \ + (s1 @ s2) \ (SEQ r1 r2) \ (Seq v1 v2)" +| Posix_STAR1: "\s1 \ r \ v; s2 \ STAR r \ Stars vs; flat v \ []; + \(\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ (s1 @ s\<^sub>3) \ L r \ s\<^sub>4 \ L (STAR r))\ + \ (s1 @ s2) \ STAR r \ Stars (v # vs)" +| Posix_STAR2: "[] \ STAR r \ Stars []" + +inductive_cases Posix_elims: + "s \ ZERO \ v" + "s \ ONE \ v" + "s \ CH c \ v" + "s \ ALT r1 r2 \ v" + "s \ SEQ r1 r2 \ v" + "s \ STAR r \ v" + +lemma Posix1: + assumes "s \ r \ v" + shows "s \ L r" "flat v = s" +using assms + by(induct s r v rule: Posix.induct) + (auto simp add: Sequ_def) + +text \ + For a give value and string, our Posix definition + determines a unique value. +\ + +lemma Posix_determ: + assumes "s \ r \ v1" "s \ r \ v2" + shows "v1 = v2" +using assms +proof (induct s r v1 arbitrary: v2 rule: Posix.induct) + case (Posix_ONE v2) + have "[] \ ONE \ v2" by fact + then show "Void = v2" by cases auto +next + case (Posix_CH c v2) + have "[c] \ CH c \ v2" by fact + then show "Char c = v2" by cases auto +next + case (Posix_ALT1 s r1 v r2 v2) + have "s \ ALT r1 r2 \ v2" by fact + moreover + have "s \ r1 \ v" by fact + then have "s \ L r1" by (simp add: Posix1) + ultimately obtain v' where eq: "v2 = Left v'" "s \ r1 \ v'" by cases auto + moreover + have IH: "\v2. s \ r1 \ v2 \ 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 \ ALT r1 r2 \ v2" by fact + moreover + have "s \ L r1" by fact + ultimately obtain v' where eq: "v2 = Right v'" "s \ r2 \ v'" + by cases (auto simp add: Posix1) + moreover + have IH: "\v2. s \ r2 \ v2 \ 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) \ SEQ r1 r2 \ v'" + "s1 \ r1 \ v1" "s2 \ r2 \ v2" + "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L r1 \ s\<^sub>4 \ L r2)" by fact+ + then obtain v1' v2' where "v' = Seq v1' v2'" "s1 \ r1 \ v1'" "s2 \ r2 \ v2'" + apply(cases) apply (auto simp add: append_eq_append_conv2) + using Posix1(1) by fastforce+ + moreover + have IHs: "\v1'. s1 \ r1 \ v1' \ v1 = v1'" + "\v2'. s2 \ r2 \ v2' \ 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) \ STAR r \ v2" + "s1 \ r \ v" "s2 \ STAR r \ Stars vs" "flat v \ []" + "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L r \ s\<^sub>4 \ L (STAR r))" by fact+ + then obtain v' vs' where "v2 = Stars (v' # vs')" "s1 \ r \ v'" "s2 \ (STAR r) \ (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: "\v2. s1 \ r \ v2 \ v = v2" + "\v2. s2 \ STAR r \ v2 \ Stars vs = v2" by fact+ + ultimately show "Stars (v # vs) = v2" by auto +next + case (Posix_STAR2 r v2) + have "[] \ STAR r \ v2" by fact + then show "Stars [] = v2" by cases (auto simp add: Posix1) +qed + + +text \ + Our POSIX values are lexical values. +\ + +lemma Posix_LV: + assumes "s \ r \ v" + shows "v \ 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 \ r \ v" + shows "\ v : r" + using assms Posix_LV LV_def + by simp + +end diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys2/SpecAlts.thy --- /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 \ string set \ string set" ("_ ;; _" [100,100] 100) +where + "A ;; B = {s1 @ s2 | s1 s2. s1 \ A \ s2 \ 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 \ string set \ string set" +where + "Der c A \ {s. c # s \ A}" + +definition + Ders :: "string \ string set \ string set" +where + "Ders s A \ {s'. s @ s' \ 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 \ B) = Der c A \ Der c B" +unfolding Der_def + by auto + +lemma Der_Union [simp]: + shows "Der c (\B. A) = (\B. Der c A)" +unfolding Der_def +by auto + +lemma Der_Sequ [simp]: + shows "Der c (A ;; B) = (Der c A) ;; B \ (if [] \ 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 \ string set" ("_\" [101] 102) + for A :: "string set" +where + start[intro]: "[] \ A\" +| step[intro]: "\s1 \ A; s2 \ A\\ \ s1 @ s2 \ A\" + +(* Arden's lemma *) + +lemma Star_cases: + shows "A\ = {[]} \ A ;; A\" +unfolding Sequ_def +by (auto) (metis Star.simps) + +lemma Star_decomp: + assumes "c # x \ A\" + shows "\s1 s2. x = s1 @ s2 \ c # s1 \ A \ s2 \ A\" +using assms +by (induct x\"c # x" rule: Star.induct) + (auto simp add: append_eq_Cons_conv) + +lemma Star_Der_Sequ: + shows "Der c (A\) \ (Der c A) ;; A\" +unfolding Der_def Sequ_def +by(auto simp add: Star_decomp) + + +lemma Der_star [simp]: + shows "Der c (A\) = (Der c A) ;; A\" +proof - + have "Der c (A\) = Der c ({[]} \ A ;; A\)" + by (simp only: Star_cases[symmetric]) + also have "... = Der c (A ;; A\)" + by (simp only: Der_union Der_empty) (simp) + also have "... = (Der c A) ;; A\ \ (if [] \ A then Der c (A\) else {})" + by simp + also have "... = (Der c A) ;; A\" + using Star_Der_Sequ by auto + finally show "Der c (A\) = (Der c A) ;; A\" . +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 \ string set" +where + "L (ZERO) = {}" +| "L (ONE) = {[]}" +| "L (CHAR c) = {[c]}" +| "L (SEQ r1 r2) = (L r1) ;; (L r2)" +| "L (ALTS rs) = (\r \ set rs. L r)" +| "L (STAR r) = (L r)\" + + +section {* Nullable, Derivatives *} + +fun + nullable :: "rexp \ bool" +where + "nullable (ZERO) = False" +| "nullable (ONE) = True" +| "nullable (CHAR c) = False" +| "nullable (ALTS rs) = (\r \ set rs. nullable r)" +| "nullable (SEQ r1 r2) = (nullable r1 \ nullable r2)" +| "nullable (STAR r) = True" + + +fun + der :: "char \ rexp \ 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 \ rexp \ rexp" +where + "ders [] r = r" +| "ders (c # s) r = ders s (der c r)" + + +lemma nullable_correctness: + shows "nullable r \ [] \ (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 \ 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 \ 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 "(\r \ 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 \ rexp \ 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 \ {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) \ {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) \ 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 (\x. size (ders2 s x)) (flats rs) \ size_list (\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)) \ 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 \ 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 \ A}" + +lemma + "\rd \ derss2 (UNIV) r. size rd \ 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 \ 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 \ concat (map flat vs)" + +lemma flat_Stars [simp]: + "flat (Stars vs) = flats vs" +by (induct vs) (auto) + +lemma Star_concat: + assumes "\s \ set ss. s \ A" + shows "concat ss \ A\" +using assms by (induct ss) (auto) + +lemma Star_cstring: + assumes "s \ A\" + shows "\ss. concat ss = s \ (\s \ set ss. s \ A \ s \ [])" +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 \ rexp \ bool" ("\ _ : _" [100, 100] 100) +where + "\\ v1 : r1; \ v2 : r2\ \ \ Seq v1 v2 : SEQ r1 r2" +| "\\ v1 : (nth rs n); n < length rs\ \ \ (Nth n v1) : ALTS rs" +| "\ Void : ONE" +| "\ Char c : CHAR c" +| "\v \ set vs. \ v : r \ flat v \ [] \ \ Stars vs : STAR r" + +inductive_cases Prf_elims: + "\ v : ZERO" + "\ v : SEQ r1 r2" + "\ v : ALTS rs" + "\ v : ONE" + "\ v : CHAR c" + "\ vs : STAR r" + +lemma Prf_Stars_appendE: + assumes "\ Stars (vs1 @ vs2) : STAR r" + shows "\ Stars vs1 : STAR r \ \ Stars vs2 : STAR r" +using assms +by (auto intro: Prf.intros elim!: Prf_elims) + + +lemma Star_cval: + assumes "\s\set ss. \v. s = flat v \ \ v : r" + shows "\vs. flats vs = concat ss \ (\v\set vs. \ v : r \ flat v \ [])" +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 "\ v : r" + shows "flat v \ L r" +using assms + apply(induct) + apply(auto simp add: Sequ_def Star_concat) + done + +lemma L_flat_Prf2: + assumes "s \ L r" + shows "\v. \ v : r \ flat v = s" +using assms +proof(induct r arbitrary: s) + case (STAR r s) + have IH: "\s. s \ L r \ \v. \ v : r \ flat v = s" by fact + have "s \ L (STAR r)" by fact + then obtain ss where "concat ss = s" "\s \ set ss. s \ L r \ s \ []" + using Star_cstring by auto + then obtain vs where "flats vs = s" "\v\set vs. \ v : r \ flat v \ []" + using IH Star_cval by metis + then show "\v. \ v : STAR r \ flat v = s" + using Prf.intros(5) flat_Stars by blast +next + case (SEQ r1 r2 s) + then show "\v. \ v : SEQ r1 r2 \ flat v = s" + unfolding Sequ_def L.simps by (fastforce intro: Prf.intros) +next + case (ALTS rs s) + then show "\v. \ v : ALTS rs \ 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 "\n. nth list n = x \ 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. \ 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 \ string \ val set" +where "LV r s \ {v. \ v : r \ 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 \ {s'. prefix s' s}" + +abbreviation + "Suffixes s \ {s'. suffix s' s}" + +abbreviation + "SSuffixes s \ {s'. strict_suffix s' s}" + +lemma Suffixes_cons [simp]: + shows "Suffixes (c # s) = Suffixes s \ {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 \ 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 "\s. finite (LV r s)" + shows "finite (LV (STAR r) s)" +proof(induct s rule: length_induct) + fix s::"char list" + assume "\s'. length s' < length s \ finite (LV (STAR r) s')" + then have IH: "\s' \ SSuffixes s. finite (LV (STAR r) s')" + by (force simp add: strict_suffix_def suffix_def) + define f where "f \ \(v, vs). Stars (v # vs)" + define S1 where "S1 \ \s' \ Prefixes s. LV r s'" + define S2 where "S2 \ \s2 \ 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 []} \ f ` (S1 \ S2))" by simp + moreover + have "LV (STAR r) s \ {Stars []} \ f ` (S1 \ 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 \ \(v1, v2). Seq v1 v2" + define S1 where "S1 \ \s' \ Prefixes s. LV r1 s'" + define S2 where "S2 \ \s' \ Suffixes s. LV r2 s'" + have IHs: "\s. finite (LV r1 s)" "\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 \ f ` (S1 \ 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 \ rexp \ val \ bool" ("_ \ _ \ _" [100, 100, 100] 100) +where + Posix_ONE: "[] \ ONE \ Void" +| Posix_CHAR: "[c] \ (CHAR c) \ (Char c)" +| Posix_ALT1: "s \ r1 \ v \ s \ (ALT r1 r2) \ (Left v)" +| Posix_ALT2: "\s \ r2 \ v; s \ L(r1)\ \ s \ (ALT r1 r2) \ (Right v)" +| Posix_SEQ: "\s1 \ r1 \ v1; s2 \ r2 \ v2; + \(\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ (s1 @ s\<^sub>3) \ L r1 \ s\<^sub>4 \ L r2)\ \ + (s1 @ s2) \ (SEQ r1 r2) \ (Seq v1 v2)" +| Posix_STAR1: "\s1 \ r \ v; s2 \ STAR r \ Stars vs; flat v \ []; + \(\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ (s1 @ s\<^sub>3) \ L r \ s\<^sub>4 \ L (STAR r))\ + \ (s1 @ s2) \ STAR r \ Stars (v # vs)" +| Posix_STAR2: "[] \ STAR r \ Stars []" + +inductive_cases Posix_elims: + "s \ ZERO \ v" + "s \ ONE \ v" + "s \ CHAR c \ v" + "s \ ALT r1 r2 \ v" + "s \ SEQ r1 r2 \ v" + "s \ STAR r \ v" + +lemma Posix1: + assumes "s \ r \ v" + shows "s \ 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 \ r \ v1" "s \ r \ v2" + shows "v1 = v2" +using assms +proof (induct s r v1 arbitrary: v2 rule: Posix.induct) + case (Posix_ONE v2) + have "[] \ ONE \ v2" by fact + then show "Void = v2" by cases auto +next + case (Posix_CHAR c v2) + have "[c] \ CHAR c \ v2" by fact + then show "Char c = v2" by cases auto +next + case (Posix_ALT1 s r1 v r2 v2) + have "s \ ALT r1 r2 \ v2" by fact + moreover + have "s \ r1 \ v" by fact + then have "s \ L r1" by (simp add: Posix1) + ultimately obtain v' where eq: "v2 = Left v'" "s \ r1 \ v'" by cases auto + moreover + have IH: "\v2. s \ r1 \ v2 \ 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 \ ALT r1 r2 \ v2" by fact + moreover + have "s \ L r1" by fact + ultimately obtain v' where eq: "v2 = Right v'" "s \ r2 \ v'" + by cases (auto simp add: Posix1) + moreover + have IH: "\v2. s \ r2 \ v2 \ 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) \ SEQ r1 r2 \ v'" + "s1 \ r1 \ v1" "s2 \ r2 \ v2" + "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L r1 \ s\<^sub>4 \ L r2)" by fact+ + then obtain v1' v2' where "v' = Seq v1' v2'" "s1 \ r1 \ v1'" "s2 \ r2 \ v2'" + apply(cases) apply (auto simp add: append_eq_append_conv2) + using Posix1(1) by fastforce+ + moreover + have IHs: "\v1'. s1 \ r1 \ v1' \ v1 = v1'" + "\v2'. s2 \ r2 \ v2' \ 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) \ STAR r \ v2" + "s1 \ r \ v" "s2 \ STAR r \ Stars vs" "flat v \ []" + "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L r \ s\<^sub>4 \ L (STAR r))" by fact+ + then obtain v' vs' where "v2 = Stars (v' # vs')" "s1 \ r \ v'" "s2 \ (STAR r) \ (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: "\v2. s1 \ r \ v2 \ v = v2" + "\v2. s2 \ STAR r \ v2 \ Stars vs = v2" by fact+ + ultimately show "Stars (v # vs) = v2" by auto +next + case (Posix_STAR2 r v2) + have "[] \ STAR r \ 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 \ r \ v" + shows "v \ 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 diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys2/SpecExt.thy --- /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 \ string set \ string set" ("_ ;; _" [100,100] 100) +where + "A ;; B = {s1 @ s2 | s1 s2. s1 \ A \ s2 \ 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 ;; (\x\ B. C x)) = (\x\ B. A ;; C x)" +by (auto simp add: Sequ_def) + +section {* Semantic Derivative (Left Quotient) of Languages *} + +definition + Der :: "char \ string set \ string set" +where + "Der c A \ {s. c # s \ A}" + +definition + Ders :: "string \ string set \ string set" +where + "Ders s A \ {s'. s @ s' \ 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 \ B) = Der c A \ Der c B" +unfolding Der_def +by auto + +lemma Der_UNION [simp]: + shows "Der c (\x\A. B x) = (\x\A. Der c (B x))" +by (auto simp add: Der_def) + +lemma Der_Sequ [simp]: + shows "Der c (A ;; B) = (Der c A) ;; B \ (if [] \ 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 \ string set" ("_\" [101] 102) + for A :: "string set" +where + start[intro]: "[] \ A\" +| step[intro]: "\s1 \ A; s2 \ A\\ \ s1 @ s2 \ A\" + +(* Arden's lemma *) + +lemma Star_cases: + shows "A\ = {[]} \ A ;; A\" +unfolding Sequ_def +by (auto) (metis Star.simps) + +lemma Star_decomp: + assumes "c # x \ A\" + shows "\s1 s2. x = s1 @ s2 \ c # s1 \ A \ s2 \ A\" +using assms +by (induct x\"c # x" rule: Star.induct) + (auto simp add: append_eq_Cons_conv) + +lemma Star_Der_Sequ: + shows "Der c (A\) \ (Der c A) ;; A\" +unfolding Der_def Sequ_def +by(auto simp add: Star_decomp) + + +lemma Der_star [simp]: + shows "Der c (A\) = (Der c A) ;; A\" +proof - + have "Der c (A\) = Der c ({[]} \ A ;; A\)" + by (simp only: Star_cases[symmetric]) + also have "... = Der c (A ;; A\)" + by (simp only: Der_union Der_empty) (simp) + also have "... = (Der c A) ;; A\ \ (if [] \ A then Der c (A\) else {})" + by simp + also have "... = (Der c A) ;; A\" + using Star_Der_Sequ by auto + finally show "Der c (A\) = (Der c A) ;; A\" . +qed + +section {* Power operation for Sets *} + +fun + Pow :: "string set \ nat \ string set" ("_ \ _" [101, 102] 101) +where + "A \ 0 = {[]}" +| "A \ (Suc n) = A ;; (A \ n)" + +lemma Pow_empty [simp]: + shows "[] \ A \ n \ (n = 0 \ [] \ A)" +by(induct n) (auto simp add: Sequ_def) + +lemma Pow_Suc_rev: + "A \ (Suc n) = (A \ n) ;; A" +apply(induct n arbitrary: A) +apply(simp_all) +by (metis Sequ_assoc) + + +lemma Pow_decomp: + assumes "c # x \ A \ n" + shows "\s1 s2. x = s1 @ s2 \ c # s1 \ A \ s2 \ A \ (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 \ A\" + shows "\n. s \ A \ 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 \ A \ n" + shows "s \ A\" +using assms +apply(induct n arbitrary: s) +apply(auto simp add: Sequ_def) + done + +lemma + assumes "[] \ A" "n \ 0" "A \ {}" + shows "A \ (Suc n) = A \ n" + +lemma Der_Pow_0: + shows "Der c (A \ 0) = {}" +by(simp add: Der_def) + +lemma Der_Pow_Suc: + shows "Der c (A \ (Suc n)) = (Der c A) ;; (A \ 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 \ n) = (if n = 0 then {} else (Der c A) ;; (A \ (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 \ n) = (Der c A) ;; (A \ n)" +by (simp only: Pow.simps[symmetric] Der_Pow) (simp) + + +lemma Pow_Sequ_Un: + assumes "0 < x" + shows "(\n \ {..x}. (A \ n)) = ({[]} \ (\n \ {..x - Suc 0}. A ;; (A \ 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 "(\n \ {x..}. (A \ n)) = (\n \ {x - Suc 0..}. A ;; (A \ 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 \ 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) \ (L r2)" +| "L (STAR r) = (L r)\" +| "L (UPNTIMES r n) = (\i\{..n} . (L r) \ i)" +| "L (NTIMES r n) = (L r) \ n" +| "L (FROMNTIMES r n) = (\i\{n..} . (L r) \ i)" +| "L (NMTIMES r n m) = (\i\{n..m} . (L r) \ i)" +| "L (NOT r) = ((UNIV:: string set) - L r)" + +section {* Nullable, Derivatives *} + +fun + nullable :: "rexp \ bool" +where + "nullable (ZERO) = False" +| "nullable (ONE) = True" +| "nullable (CHAR c) = False" +| "nullable (ALT r1 r2) = (nullable r1 \ nullable r2)" +| "nullable (SEQ r1 r2) = (nullable r1 \ 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) = (\ nullable r)" + +fun + der :: "char \ rexp \ 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 \ der c r = ZERO" + shows "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))" + 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 \ A \ n" "s2 \ A \ m" + shows "s1 @ s2 \ A \ (n + m)" + using assms + apply(induct n arbitrary: m s1 s2) + apply(auto simp add: Sequ_def) + by blast + +lemma pow_add2: + assumes "x \ A \ (m + n)" + shows "x \ A \ m ;; A \ 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 "\m. s2 \ (L r) \ 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 "\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 \ 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 \ rexp \ rexp" +where + "ders [] r = r" +| "ders (c # s) r = ders s (der c r)" + + +lemma nullable_correctness: + shows "nullable r \ [] \ (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 \ 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 \ concat (map flat vs)" + +lemma flat_Stars [simp]: + "flat (Stars vs) = flats vs" +by (induct vs) (auto) + +lemma Star_concat: + assumes "\s \ set ss. s \ A" + shows "concat ss \ A\" +using assms by (induct ss) (auto) + +lemma Star_cstring: + assumes "s \ A\" + shows "\ss. concat ss = s \ (\s \ set ss. s \ A \ s \ [])" +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 "\s\set ss. s = []" + shows "concat ss = []" +using assms +by (induct ss) (auto) + +lemma Pow_cstring_nonempty: + assumes "s \ A \ n" + shows "\ss. concat ss = s \ length ss \ n \ (\s \ set ss. s \ A \ s \ [])" +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 \ A \ n" + shows "\ss1 ss2. concat (ss1 @ ss2) = s \ length (ss1 @ ss2) = n \ + (\s \ set ss1. s \ A \ s \ []) \ (\s \ set ss2. s \ A \ 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 \ rexp \ bool" ("\ _ : _" [100, 100] 100) +where + "\\ v1 : r1; \ v2 : r2\ \ \ Seq v1 v2 : SEQ r1 r2" +| "\ v1 : r1 \ \ Left v1 : ALT r1 r2" +| "\ v2 : r2 \ \ Right v2 : ALT r1 r2" +| "\ Void : ONE" +| "\ Char c : CHAR c" +| "\\v \ set vs. \ v : r \ flat v \ []\ \ \ Stars vs : STAR r" +| "\\v \ set vs. \ v : r \ flat v \ []; length vs \ n\ \ \ Stars vs : UPNTIMES r n" +| "\\v \ set vs1. \ v : r \ flat v \ []; + \v \ set vs2. \ v : r \ flat v = []; + length (vs1 @ vs2) = n\ \ \ Stars (vs1 @ vs2) : NTIMES r n" +| "\\v \ set vs1. \ v : r \ flat v \ []; + \v \ set vs2. \ v : r \ flat v = []; + length (vs1 @ vs2) = n\ \ \ Stars (vs1 @ vs2) : FROMNTIMES r n" +| "\\v \ set vs. \ v : r \ flat v \ []; length vs > n\ \ \ Stars vs : FROMNTIMES r n" +| "\\v \ set vs1. \ v : r \ flat v \ []; + \v \ set vs2. \ v : r \ flat v = []; + length (vs1 @ vs2) = n; length (vs1 @ vs2) \ m\ \ \ Stars (vs1 @ vs2) : NMTIMES r n m" +| "\\v \ set vs. \ v : r \ flat v \ []; + length vs > n; length vs \ m\ \ \ Stars vs : NMTIMES r n m" + + + + + +inductive_cases Prf_elims: + "\ v : ZERO" + "\ v : SEQ r1 r2" + "\ v : ALT r1 r2" + "\ v : ONE" + "\ v : CHAR c" + "\ vs : STAR r" + "\ vs : UPNTIMES r n" + "\ vs : NTIMES r n" + "\ vs : FROMNTIMES r n" + "\ vs : NMTIMES r n m" + +lemma Prf_Stars_appendE: + assumes "\ Stars (vs1 @ vs2) : STAR r" + shows "\ Stars vs1 : STAR r \ \ Stars vs2 : STAR r" +using assms +by (auto intro: Prf.intros elim!: Prf_elims) + + + +lemma flats_empty: + assumes "(\v\set vs. flat v = [])" + shows "flats vs = []" +using assms +by(induct vs) (simp_all) + +lemma Star_cval: + assumes "\s\set ss. \v. s = flat v \ \ v : r" + shows "\vs. flats vs = concat ss \ (\v\set vs. \ v : r \ flat v \ [])" +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 "\s\set ss. \v. s = flat v \ \ v : r" + shows "\vs1 vs2. flats (vs1 @ vs2) = concat ss \ length (vs1 @ vs2) = length ss \ + (\v\set vs1. \ v : r \ flat v \ []) \ + (\v\set vs2. \ v : r \ 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 "\s\set ss. \v. s = flat v \ \ v : r" + shows "\vs. flats vs = concat ss \ length vs \ length ss \ + (\v\set vs. \ v : r \ flat v \ [])" +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 "\v \ set vs. flat v \ A" + shows "flats vs \ A \ length vs" +using assms +by(induct vs)(auto simp add: Sequ_def) + +lemma Pow_flats_appends: + assumes "\v \ set vs1. flat v \ A" "\v \ set vs2. flat v \ A" + shows "flats vs1 @ flats vs2 \ A \ (length vs1 + length vs2)" +using assms +apply(induct vs1) +apply(auto simp add: Sequ_def Pow_flats) +done + +lemma L_flat_Prf1: + assumes "\ v : r" + shows "flat v \ 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 \ L r" + shows "\v. \ v : r \ flat v = s" +using assms +proof(induct r arbitrary: s) + case (STAR r s) + have IH: "\s. s \ L r \ \v. \ v : r \ flat v = s" by fact + have "s \ L (STAR r)" by fact + then obtain ss where "concat ss = s" "\s \ set ss. s \ L r \ s \ []" + using Star_cstring by auto + then obtain vs where "flats vs = s" "\v\set vs. \ v : r \ flat v \ []" + using IH Star_cval by metis + then show "\v. \ v : STAR r \ flat v = s" + using Prf.intros(6) flat_Stars by blast +next + case (SEQ r1 r2 s) + then show "\v. \ v : SEQ r1 r2 \ flat v = s" + unfolding Sequ_def L.simps by (fastforce intro: Prf.intros) +next + case (ALT r1 r2 s) + then show "\v. \ v : ALT r1 r2 \ flat v = s" + unfolding L.simps by (fastforce intro: Prf.intros) +next + case (NTIMES r n) + have IH: "\s. s \ L r \ \v. \ v : r \ flat v = s" by fact + have "s \ L (NTIMES r n)" by fact + then obtain ss1 ss2 where "concat (ss1 @ ss2) = s" "length (ss1 @ ss2) = n" + "\s \ set ss1. s \ L r \ s \ []" "\s \ set ss2. s \ L r \ s = []" + using Pow_cstring by force + then obtain vs1 vs2 where "flats (vs1 @ vs2) = s" "length (vs1 @ vs2) = n" + "\v\set vs1. \ v : r \ flat v \ []" "\v\set vs2. \ v : r \ 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 "\v. \ v : NTIMES r n \ flat v = s" + using Prf.intros(8) flat_Stars by blast +next + case (FROMNTIMES r n) + have IH: "\s. s \ L r \ \v. \ v : r \ flat v = s" by fact + have "s \ L (FROMNTIMES r n)" by fact + then obtain ss1 ss2 k where "concat (ss1 @ ss2) = s" "length (ss1 @ ss2) = k" "n \ k" + "\s \ set ss1. s \ L r \ s \ []" "\s \ set ss2. s \ L r \ s = []" + using Pow_cstring by force + then obtain vs1 vs2 where "flats (vs1 @ vs2) = s" "length (vs1 @ vs2) = k" "n \ k" + "\v\set vs1. \ v : r \ flat v \ []" "\v\set vs2. \ v : r \ 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 "\v. \ v : FROMNTIMES r n \ flat v = s" + apply(case_tac "length vs1 \ 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: "\s. s \ L r \ \v. \ v : r \ flat v = s" by fact + have "s \ L (NMTIMES r n m)" by fact + then obtain ss1 ss2 k where "concat (ss1 @ ss2) = s" "length (ss1 @ ss2) = k" "n \ k" "k \ m" + "\s \ set ss1. s \ L r \ s \ []" "\s \ set ss2. s \ L r \ s = []" + using Pow_cstring by (auto, blast) + then obtain vs1 vs2 where "flats (vs1 @ vs2) = s" "length (vs1 @ vs2) = k" "n \ k" "k \ m" + "\v\set vs1. \ v : r \ flat v \ []" "\v\set vs2. \ v : r \ 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 "\v. \ v : NMTIMES r n m \ flat v = s" + apply(case_tac "length vs1 \ 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: "\s. s \ L r \ \v. \ v : r \ flat v = s" by fact + have "s \ L (UPNTIMES r n)" by fact + then obtain ss where "concat ss = s" "\s \ set ss. s \ L r \ s \ []" "length ss \ n" + using Pow_cstring_nonempty by force + then obtain vs where "flats vs = s" "\v\set vs. \ v : r \ flat v \ []" "length vs \ n" + using IH flats_cval_nonempty by (smt order.trans) + then show "\v. \ v : UPNTIMES r n \ 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. \ v : r}" +using L_flat_Prf1 L_flat_Prf2 by blast + +thm Prf.intros +thm Prf.cases + +lemma + assumes "\ v : (STAR r)" + shows "\ 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 "\ v : (FROMNTIMES r 0)" + shows "\ 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 \ string \ val set" +where "LV r s \ {v. \ v : r \ 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 \ Right ` LV r2 s" +unfolding LV_def +apply(auto intro: Prf.intros elim: Prf.cases) +done + +abbreviation + "Prefixes s \ {s'. prefix s' s}" + +abbreviation + "Suffixes s \ {s'. suffix s' s}" + +abbreviation + "SSuffixes s \ {s'. strict_suffix s' s}" + +lemma Suffixes_cons [simp]: + shows "Suffixes (c # s) = Suffixes s \ {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 \ 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 \ {Stars (v # vs) | v vs. v \ V \ Stars vs \ Vs}" + +definition + "Stars_Append Vs1 Vs2 \ {Stars (vs1 @ vs2) | vs1 vs2. Stars vs1 \ Vs1 \ Stars vs2 \ Vs2}" + +fun Stars_Pow :: "val set \ nat \ 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 \ (Stars -` Vs))" + by(simp) + then have "finite ((\(v, vs). Stars (v # vs)) ` (V \ (Stars -` Vs)))" + by simp + moreover have "Stars_Cons V Vs = (\(v, vs). Stars (v # vs)) ` (V \ (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 \ Stars -` Vs1" + define UVs2 where "UVs2 \ 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 ((\(vs1, vs2). Stars (vs1 @ vs2)) ` (UVs1 \ UVs2))" + by simp + moreover + have "Stars_Append Vs1 Vs2 = (\(vs1, vs2). Stars (vs1 @ vs2)) ` (UVs1 \ 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 "\s. finite (LV r s)" + shows "finite (LV (STAR r) s)" +proof(induct s rule: length_induct) + fix s::"char list" + assume "\s'. length s' < length s \ finite (LV (STAR r) s')" + then have IH: "\s' \ SSuffixes s. finite (LV (STAR r) s')" + apply(auto simp add: strict_suffix_def suffix_def) + by force + define f where "f \ \(v, vs). Stars (v # vs)" + define S1 where "S1 \ \s' \ Prefixes s. LV r s'" + define S2 where "S2 \ \s2 \ 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 []} \ Stars_Cons S1 S2)" + by (simp add: finite_Stars_Cons) + moreover + have "LV (STAR r) s \ {Stars []} \ (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 \ 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)) [] = (\(v,vs). Stars (v#vs)) ` (LV r [] \ (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)) [] = + (\(v,vs). Stars (v#vs)) ` (LV r [] \ (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 \ Stars_Append (LV (STAR r) s) (\i\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 \ Stars_Append (LV (STAR r) s) (\i\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 "\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 \ Stars_Append (LV (STAR r) s) (\i\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 "\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 \ \(v1, v2). Seq v1 v2" + define S1 where "S1 \ \s' \ Prefixes s. LV r1 s'" + define S2 where "S2 \ \s' \ Suffixes s. LV r2 s'" + have IHs: "\s. finite (LV r1 s)" "\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 \ f ` (S1 \ 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 "\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 "\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 "\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 "\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 \ rexp \ val \ bool" ("_ \ _ \ _" [100, 100, 100] 100) +where + Posix_ONE: "[] \ ONE \ Void" +| Posix_CHAR: "[c] \ (CHAR c) \ (Char c)" +| Posix_ALT1: "s \ r1 \ v \ s \ (ALT r1 r2) \ (Left v)" +| Posix_ALT2: "\s \ r2 \ v; s \ L(r1)\ \ s \ (ALT r1 r2) \ (Right v)" +| Posix_SEQ: "\s1 \ r1 \ v1; s2 \ r2 \ v2; + \(\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ (s1 @ s\<^sub>3) \ L r1 \ s\<^sub>4 \ L r2)\ \ + (s1 @ s2) \ (SEQ r1 r2) \ (Seq v1 v2)" +| Posix_STAR1: "\s1 \ r \ v; s2 \ STAR r \ Stars vs; flat v \ []; + \(\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ (s1 @ s\<^sub>3) \ L r \ s\<^sub>4 \ L (STAR r))\ + \ (s1 @ s2) \ STAR r \ Stars (v # vs)" +| Posix_STAR2: "[] \ STAR r \ Stars []" +| Posix_NTIMES1: "\s1 \ r \ v; s2 \ NTIMES r (n - 1) \ Stars vs; flat v \ []; 0 < n; + \(\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ (s1 @ s\<^sub>3) \ L r \ s\<^sub>4 \ L (NTIMES r (n - 1)))\ + \ (s1 @ s2) \ NTIMES r n \ Stars (v # vs)" +| Posix_NTIMES2: "\\v \ set vs. [] \ r \ v; length vs = n\ + \ [] \ NTIMES r n \ Stars vs" +| Posix_UPNTIMES1: "\s1 \ r \ v; s2 \ UPNTIMES r (n - 1) \ Stars vs; flat v \ []; 0 < n; + \(\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ (s1 @ s\<^sub>3) \ L r \ s\<^sub>4 \ L (UPNTIMES r (n - 1)))\ + \ (s1 @ s2) \ UPNTIMES r n \ Stars (v # vs)" +| Posix_UPNTIMES2: "[] \ UPNTIMES r n \ Stars []" +| Posix_FROMNTIMES2: "\\v \ set vs. [] \ r \ v; length vs = n\ + \ [] \ FROMNTIMES r n \ Stars vs" +| Posix_FROMNTIMES1: "\s1 \ r \ v; s2 \ FROMNTIMES r (n - 1) \ Stars vs; flat v \ []; 0 < n; + \(\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ (s1 @ s\<^sub>3) \ L r \ s\<^sub>4 \ L (FROMNTIMES r (n - 1)))\ + \ (s1 @ s2) \ FROMNTIMES r n \ Stars (v # vs)" +| Posix_FROMNTIMES3: "\s1 \ r \ v; s2 \ STAR r \ Stars vs; flat v \ []; + \(\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ (s1 @ s\<^sub>3) \ L r \ s\<^sub>4 \ L (STAR r))\ + \ (s1 @ s2) \ FROMNTIMES r 0 \ Stars (v # vs)" +| Posix_NMTIMES2: "\\v \ set vs. [] \ r \ v; length vs = n; n \ m\ + \ [] \ NMTIMES r n m \ Stars vs" +| Posix_NMTIMES1: "\s1 \ r \ v; s2 \ NMTIMES r (n - 1) (m - 1) \ Stars vs; flat v \ []; 0 < n; n \ m; + \(\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ (s1 @ s\<^sub>3) \ L r \ s\<^sub>4 \ L (NMTIMES r (n - 1) (m - 1)))\ + \ (s1 @ s2) \ NMTIMES r n m \ Stars (v # vs)" +| Posix_NMTIMES3: "\s1 \ r \ v; s2 \ UPNTIMES r (m - 1) \ Stars vs; flat v \ []; 0 < m; + \(\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ (s1 @ s\<^sub>3) \ L r \ s\<^sub>4 \ L (UPNTIMES r (m - 1)))\ + \ (s1 @ s2) \ NMTIMES r 0 m \ Stars (v # vs)" + +inductive_cases Posix_elims: + "s \ ZERO \ v" + "s \ ONE \ v" + "s \ CHAR c \ v" + "s \ ALT r1 r2 \ v" + "s \ SEQ r1 r2 \ v" + "s \ STAR r \ v" + "s \ NTIMES r n \ v" + "s \ UPNTIMES r n \ v" + "s \ FROMNTIMES r n \ v" + "s \ NMTIMES r n m \ v" + +lemma Posix1: + assumes "s \ r \ v" + shows "s \ 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 "\(v1, v2) \ 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 \ r \ v1" "s \ r \ v2" + shows "v1 = v2" +using assms +proof (induct s r v1 arbitrary: v2 rule: Posix.induct) + case (Posix_ONE v2) + have "[] \ ONE \ v2" by fact + then show "Void = v2" by cases auto +next + case (Posix_CHAR c v2) + have "[c] \ CHAR c \ v2" by fact + then show "Char c = v2" by cases auto +next + case (Posix_ALT1 s r1 v r2 v2) + have "s \ ALT r1 r2 \ v2" by fact + moreover + have "s \ r1 \ v" by fact + then have "s \ L r1" by (simp add: Posix1) + ultimately obtain v' where eq: "v2 = Left v'" "s \ r1 \ v'" by cases auto + moreover + have IH: "\v2. s \ r1 \ v2 \ 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 \ ALT r1 r2 \ v2" by fact + moreover + have "s \ L r1" by fact + ultimately obtain v' where eq: "v2 = Right v'" "s \ r2 \ v'" + by cases (auto simp add: Posix1) + moreover + have IH: "\v2. s \ r2 \ v2 \ 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) \ SEQ r1 r2 \ v'" + "s1 \ r1 \ v1" "s2 \ r2 \ v2" + "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L r1 \ s\<^sub>4 \ L r2)" by fact+ + then obtain v1' v2' where "v' = Seq v1' v2'" "s1 \ r1 \ v1'" "s2 \ r2 \ v2'" + apply(cases) apply (auto simp add: append_eq_append_conv2) + using Posix1(1) by fastforce+ + moreover + have IHs: "\v1'. s1 \ r1 \ v1' \ v1 = v1'" + "\v2'. s2 \ r2 \ v2' \ 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) \ STAR r \ v2" + "s1 \ r \ v" "s2 \ STAR r \ Stars vs" "flat v \ []" + "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L r \ s\<^sub>4 \ L (STAR r))" by fact+ + then obtain v' vs' where "v2 = Stars (v' # vs')" "s1 \ r \ v'" "s2 \ (STAR r) \ (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: "\v2. s1 \ r \ v2 \ v = v2" + "\v2. s2 \ STAR r \ v2 \ Stars vs = v2" by fact+ + ultimately show "Stars (v # vs) = v2" by auto +next + case (Posix_STAR2 r v2) + have "[] \ STAR r \ 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) \ NTIMES r n \ v2" + "s1 \ r \ v" "s2 \ NTIMES r (n - 1) \ Stars vs" "flat v \ []" + "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L r \ s\<^sub>4 \ L (NTIMES r (n - 1 )))" by fact+ + then obtain v' vs' where "v2 = Stars (v' # vs')" "s1 \ r \ v'" "s2 \ (NTIMES r (n - 1)) \ (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: "\v2. s1 \ r \ v2 \ v = v2" + "\v2. s2 \ NTIMES r (n - 1) \ v2 \ 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) \ UPNTIMES r n \ v2" + "s1 \ r \ v" "s2 \ UPNTIMES r (n - 1) \ Stars vs" "flat v \ []" + "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L r \ s\<^sub>4 \ L (UPNTIMES r (n - 1 )))" by fact+ + then obtain v' vs' where "v2 = Stars (v' # vs')" "s1 \ r \ v'" "s2 \ (UPNTIMES r (n - 1)) \ (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: "\v2. s1 \ r \ v2 \ v = v2" + "\v2. s2 \ UPNTIMES r (n - 1) \ v2 \ 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) \ FROMNTIMES r n \ v2" + "s1 \ r \ v" "s2 \ FROMNTIMES r (n - 1) \ Stars vs" "flat v \ []" "0 < n" + "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L r \ s\<^sub>4 \ L (FROMNTIMES r (n - 1 )))" by fact+ + then obtain v' vs' where "v2 = Stars (v' # vs')" "s1 \ r \ v'" "s2 \ (FROMNTIMES r (n - 1)) \ (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: "\v2. s1 \ r \ v2 \ v = v2" + "\v2. s2 \ FROMNTIMES r (n - 1) \ v2 \ 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) \ FROMNTIMES r 0 \ v2" + "s1 \ r \ v" "s2 \ STAR r \ Stars vs" "flat v \ []" + "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L r \ s\<^sub>4 \ L (STAR r))" by fact+ + then obtain v' vs' where "v2 = Stars (v' # vs')" "s1 \ r \ v'" "s2 \ (STAR r) \ (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: "\v2. s1 \ r \ v2 \ v = v2" + "\v2. s2 \ STAR r \ v2 \ 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) \ NMTIMES r n m \ v2" + "s1 \ r \ v" "s2 \ NMTIMES r (n - 1) (m - 1) \ Stars vs" "flat v \ []" + "0 < n" "n \ m" + "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L r \ s\<^sub>4 \ L (NMTIMES r (n - 1) (m - 1)))" by fact+ + then obtain v' vs' where "v2 = Stars (v' # vs')" "s1 \ r \ v'" + "s2 \ (NMTIMES r (n - 1) (m - 1)) \ (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: "\v2. s1 \ r \ v2 \ v = v2" + "\v2. s2 \ NMTIMES r (n - 1) (m - 1) \ v2 \ 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) \ NMTIMES r 0 m \ v2" + "s1 \ r \ v" "s2 \ UPNTIMES r (m - 1) \ Stars vs" "flat v \ []" "0 < m" + "\ (\s\<^sub>3 s\<^sub>4. s\<^sub>3 \ [] \ s\<^sub>3 @ s\<^sub>4 = s2 \ s1 @ s\<^sub>3 \ L r \ s\<^sub>4 \ L (UPNTIMES r (m - 1 )))" by fact+ + then obtain v' vs' where "v2 = Stars (v' # vs')" "s1 \ r \ v'" "s2 \ (UPNTIMES r (m - 1)) \ (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: "\v2. s1 \ r \ v2 \ v = v2" + "\v2. s2 \ UPNTIMES r (m - 1) \ v2 \ 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 \ r \ v" + shows "v \ 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 diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys2/Sulzmann.thy --- /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 \ 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 \ val \ val" +where + "Stars_add v (Stars vs) = Stars (v # vs)" + +function + decode' :: "bit list \ rexp \ (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)) \ 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 \ rexp \ val option" +where + "decode ds r \ (let (v, ds') = decode' ds r + in (if ds' = [] then Some v else None))" + +lemma decode'_code_Stars: + assumes "\v\set vs. \ v : r \ (\x. decode' (code v @ x) r = (v, x)) \ flat v \ []" + shows "decode' (code (Stars vs) @ ds) (STAR r) = (Stars vs, ds)" + using assms + apply(induct vs) + apply(auto) + done + +lemma decode'_code: + assumes "\ 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 "\ 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 \ arexp \ 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 \ 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 \ val \ 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 \ 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 \ bool" +where + "bnullable (AZERO) = False" +| "bnullable (AONE bs) = True" +| "bnullable (ACH bs c) = False" +| "bnullable (AALT bs r1 r2) = (bnullable r1 \ bnullable r2)" +| "bnullable (ASEQ bs r1 r2) = (bnullable r1 \ bnullable r2)" +| "bnullable (ASTAR bs r) = True" + +fun + bmkeps :: "arexp \ 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 \ arexp \ 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 \ string \ 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 "\v\set vs. \ v : r \ 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 "\ 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 "\ 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 "\ 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 "\ 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 "\ 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 "\ v : ders [] r" by fact + then have "\ 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: "\v. \ v : ders s r \ + Some (flex r id s v) = decode (retrieve (bders (intern r) s) v) r" by fact + have asm: "\ v : ders (s @ [c]) r" by fact + then have asm2: "\ 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 \ 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 \ bders (intern r) s" + define ds where "ds \ ders s r" + assume asm: "nullable ds" + have era: "erase bds = ds" + unfolding ds_def bds_def by simp + have mke: "\ 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 diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys2/journal.pdf Binary file thys2/journal.pdf has changed diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys2/notes.pdf Binary file thys2/notes.pdf has changed diff -r 232aa2f19a75 -r ec5e4fe4cc70 thys2/paper.pdf Binary file thys2/paper.pdf has changed