rere 0.1 → 0.2
raw patch · 8 files changed
+370/−134 lines, 8 filesdep ~QuickCheckdep ~aesondep ~base
Dependency ranges changed: QuickCheck, aeson, base, criterion, fin, semigroups, tasty, transformers, vec, void
Files
- changelog.md +3/−0
- rere.cabal +31/−23
- rere.sty +76/−0
- src/RERE/CFG.hs +3/−0
- src/RERE/Examples.hs +20/−19
- src/RERE/Examples/JSON.hs +3/−0
- src/RERE/Gen.hs +4/−3
- src/RERE/LaTeX.hs +230/−89
+ changelog.md view
@@ -0,0 +1,3 @@+# 0.2++- Change LaTeX generation output
rere.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: rere-version: 0.1+version: 0.2 synopsis: Regular-expressions extended with fixpoints for context-free powers @@ -13,7 +13,11 @@ maintainer: Oleg Grenrus <oleg.grenrus@iki.fi> license: BSD-3-Clause license-file: LICENSE-extra-source-files: jsverify.json+extra-source-files:+ changelog.md+ jsverify.json+ rere.sty+ tested-with: GHC ==7.0.4 || ==7.2.2@@ -25,50 +29,51 @@ || ==8.2.2 || ==8.4.4 || ==8.6.5- || ==8.8.3- || ==8.10.1+ || ==8.8.4+ || ==8.10.4+ || ==9.0.1 source-repository head type: git location: https://github.com/phadej/rere.git flag rere-cfg- description: CFG functionality, needs dependency on fin and vec+ description: CFG functionality, adds dependency on fin and vec default: True manual: True flag rere-intersection- description: Add add intersection constructor. EXPERIMENTAL+ description: Add intersection constructor. EXPERIMENTAL default: False manual: True library- default-language: Haskell2010- hs-source-dirs: src- ghc-options: -Wall+ default-language: Haskell2010+ hs-source-dirs: src+ ghc-options: -Wall - if impl(ghc >=8.10)+ if impl(ghc >=9) ghc-options: -Wmissing-safe-haskell-mode -Winferred-safe-imports - -- GHC boot library+ -- GHC boot libraries build-depends:- , base >=4.3.0.0 && <4.15+ , base >=4.3.0.0 && <4.16 , containers ^>=0.4.0.0 || ^>=0.5.0.0 || ^>=0.6.0.1 , parsec ^>=3.1.12.0 , transformers ^>=0.3.0.0 || ^>=0.4.2.0 || ^>=0.5.2.0 -- other dependencies- build-depends: QuickCheck ^>=2.13.2+ build-depends: QuickCheck ^>=2.14.2 -- compat if !impl(ghc >=7.10)- build-depends: void ^>=0.7.2+ build-depends: void ^>=0.7.3 if !impl(ghc >=8.0)- build-depends: semigroups >=0.18.4 && <0.20+ build-depends: semigroups >=0.18.5 && <0.20 -- expose examples first, so `cabal repl` loads them.- exposed-modules: RERE.Examples+ exposed-modules: RERE.Examples if (flag(rere-cfg) && impl(ghc >=7.8)) exposed-modules: RERE.Examples.JSON@@ -85,20 +90,23 @@ RERE.Type RERE.Var - other-modules: RERE.Tuples+ other-modules: RERE.Tuples if (flag(rere-cfg) && impl(ghc >=7.8)) build-depends:- , fin ^>=0.1.1- , vec ^>=0.3+ , fin ^>=0.2+ , vec ^>=0.4 exposed-modules: RERE.CFG+ else- cpp-options: -DRERE_NO_CFG+ cpp-options: -DRERE_NO_CFG if flag(rere-intersection) cpp-options: -DRERE_INTERSECTION + x-docspec-options: -XOverloadedStrings+ benchmark simple type: exitcode-stdio-1.0 default-language: Haskell2010@@ -115,7 +123,7 @@ , rere if !(flag(rere-cfg) && impl(ghc >=7.8))- cpp-options: -DRERE_NO_CFG+ cpp-options: -DRERE_NO_CFG if flag(rere-intersection) cpp-options: -DRERE_INTERSECTION@@ -134,7 +142,7 @@ other-modules: DerpConv ghc-options: -Wall -rtsopts build-depends:- , aeson ^>=1.4.6.0+ , aeson ^>=1.4.6.0 || ^>=1.5.0.0 , attoparsec , base , bytestring@@ -173,7 +181,7 @@ , QuickCheck , quickcheck-instances ^>=0.3.22 , rere- , tasty ^>=1.2.3+ , tasty ^>=1.4.0.1 , tasty-quickcheck ^>=0.10.1.1 if flag(rere-intersection)
+ rere.sty view
@@ -0,0 +1,76 @@+\NeedsTeXFormat{LaTeX2e}+\ProvidesPackage{rere}[2020/03/28 package rere]++\newif\if@rerelmodern\@rerelmodernfalse+\DeclareOption{lmodern}{\@rerelmoderntrue}++\ProcessOptions\relax++\if@rerelmodern+\RequirePackage[T1]{fontenc}+\RequirePackage{lmodern}+\fi++\RequirePackage{amsmath}+\RequirePackage{amssymb}+\RequirePackage{xcolor}++\colorlet{reresym}{green!50!black}% green+\colorlet{rerelit}{red!80!black}% red+\colorlet{rereidn}{blue}% blue+\colorlet{rerestr}{red!50!blue}% purple++\newcommand\rerespace{\,}+\newcommand\rerenull{{\color{reresym}\varnothing}}+\newcommand\rerealphabet{{\color{reresym}\Sigma}}+\newcommand\rerefull{\rerestar{\rerealphabet}}+\newcommand\rereeps{{\color{reresym}\varepsilon}}+\newcommand\rerelit[1]{{\color{rerelit}\texttt{#1}}}+\newcommand\rerelitset[1]{\{{#1}\}}+\newcommand\rerelitsetcomplement[1]{\{{#1}\}^c}+\newcommand\rerelitrange[2]{{#1}\ldots{#2}}+\newcommand\rerestr[1]{{\color{rerestr}\texttt{#1}}}+\newcommand\rerevar[1]{{\color{rereidn}\mathit{#1}}}+\newcommand\rerevarsub[2]{{\color{rereidn}\mathit{#1}_{#2}}}+\newcommand\rerevarsubsub[3]{{\color{rereidn}\mathit{#1}_{{#2};{#3}}}}+\newcommand\rerealt[2]{{#1}\cup{#2}}+\newcommand\rereintersect[2]{{#1}\cap{#2}}+\newcommand\rerestar[1]{{#1}^\ast}+\newcommand\rereconcat[2]{{#1}{#2}}+\newenvironment{reretrace}{\aligned}{\endaligned}+\newenvironment{rerecfg}{\aligned}{\endaligned}+\newenvironment{rerealignedlet}{\aligned[t]\rereLET~&\alignedat[t]{2}}{\endaligned}+\newcommand\reretraceline[3][]{{#2} &\ \vdash\ifx\relax#1\relax\else_{#1}\fi\ {#3} \\}+\newcommand\rerecfgproduction[2]{{#1} &= {#2} \\}+\newcommand\rereLET{\mathbf{let}}+\newcommand\rereIN{\mathbf{in}}+\newcommand\rereFIX{\mathbf{fix}}+\newcommand\rereEQ{=}+\newcommand\rereRECEQ{=_{R}}+\newcommand\rereleteqn[2]{&{#1}&&\rereEQ{#2}\\}+\newcommand\rereletreceqn[2]{&{#1}&&\rereRECEQ{#2}\\}+\newcommand\rereletbody[1]{\endalignedat\\\rereIN~&{#1}}+\newcommand\rereletin[3]{\rereLET~{#1}\rereEQ{#2}~\rereIN~{#3}}+\newcommand\rereletrecin[3]{\rereLET~{#1}\rereRECEQ{#2}~\rereIN~{#3}}+\newcommand\rerefix[2]{\rereFIX~{#1}\rereEQ{#2}}+\newcommand\rerecharpopen{(}+\newcommand\rerecharpclose{)}+\newcommand\rerecharbopen{[}+\newcommand\rerecharbclose{]}+\newcommand\rerecharcopen{\{}+\newcommand\rerecharcclose{\}}+\newcommand\rerecharplus{+}+\newcommand\rerecharminus{-}+\newcommand\rerecharstar{*}+\newcommand\rerecharbackslash{\textbackslash}+\newcommand\rerecharhash{\#}+\newcommand\rerechartilde{\~}+\newcommand\rerecharspace{\textvisiblespace}+\newcommand\rerecharampersand{\&}+\newcommand\rerecharpercent{\%}+\newcommand\rerecharunderscore{\_}+\newcommand\rerecharhat{\^}+\newcommand\rerechardollar{\$}+\newcommand\rerecharcode[1]{\textnormal{\normalcolor #1}}++\endinput
src/RERE/CFG.hs view
@@ -29,6 +29,9 @@ -- $setup -- >>> :set -XOverloadedStrings+-- >>> import Data.Fin (Fin (..))+-- >>> import Data.Vec.Lazy (Vec (..))+-- >>> import RERE -- | Context-free grammar represented as @n@ equations -- of 'RE' ('CFGBase') with @n@ variables.
src/RERE/Examples.hs view
@@ -43,6 +43,7 @@ -- >>> import Test.QuickCheck.Random (mkQCGen) -- >>> import Test.QuickCheck.Gen (unGen) -- >>> import Control.Monad.ST (runST)+-- >>> import RERE -- >>> let runGen seed = maybe "<<null>>" (\g' -> unGen g' (mkQCGen seed) 10) -- >>> let showRef re = matchDebugR re "" @@ -92,11 +93,11 @@ -- >>> matchR ex1 "ababa" -- False ----- >>> runGen 42 (generate 10 20 ex1)--- "ababab"+-- >>> runGen 43 (generate 10 20 ex1)+-- "abababababababababab" -- -- >>> runGen 44 (generate 10 20 ex1)--- "abababababababababab"+-- "ababab" -- ex1 :: RE Void ex1 = star_ (ch_ 'a' <> ch_ 'b')@@ -124,7 +125,7 @@ -- True -- -- >>> runGen 42 (generate 10 20 ex2)--- "aaaaaaaaaaa"+-- "aaaaaa" -- -- >>> runGen 44 (generate 10 20 ex2) -- "aaaaaaaaaa"@@ -158,11 +159,11 @@ -- >>> matchR ex3 "ababa" -- False ----- >>> runGen 42 (generate 10 20 ex3)--- "ab"+-- >>> runGen 43 (generate 10 20 ex3)+-- "abababab" ----- >>> runGen 50 (generate 10 20 ex3)--- "ababab"+-- >>> runGen 44 (generate 10 20 ex3)+-- "abab" -- ex3 :: RE Void ex3 = Fix "x" (Eps \/ ch_ 'a' <> ch_ 'b' <> Var B)@@ -187,11 +188,11 @@ -- >>> matchR ex4 "aaaabbbb" -- True ----- >>> runGen 42 (generate 10 20 ex4)--- "aabb"+-- >>> runGen 43 (generate 10 20 ex4)+-- "ab" ----- >>> runGen 45 (generate 10 20 ex4)--- "aaabbb"+-- >>> runGen 47 (generate 10 20 ex4)+-- "aaaabbbb" -- ex4 :: RE Void ex4 = Fix "x" (Eps \/ ch_ 'a' <> Var B <> ch_ 'b')@@ -222,11 +223,11 @@ -- >>> matchR ex5 "ababa" -- False ----- >>> runGen 42 (generate 10 20 ex5)+-- >>> runGen 43 (generate 10 20 ex5) -- "ab" ----- >>> runGen 45 (generate 10 20 ex5)--- "ababab"+-- >>> runGen 51 (generate 10 20 ex5)+-- "abab" -- ex5 :: RE Void ex5 = Fix "x" (Eps \/ Var B <> ch_ 'a' <> ch_ 'b')@@ -255,8 +256,8 @@ -- >>> matchR ex6 "(1+2)*3" -- True ----- >>> runGen 42 (generate 5 5 ex6)--- "96+(09493+90790)*19"+-- >>> runGen 43 (generate 5 5 ex6)+-- "74501+(534*19450)*(99050)" -- ex6 :: RE Void ex6 = let_ "d" (Ch "0123456789")@@ -312,8 +313,8 @@ -- >>> charClasses ex7 -- fromList "\NUL()*+,0:" ----- >>> runGen 42 (generate 5 5 ex7)--- "(0181+912595*00+((1228)+467+(80)+(216406))*(65)+4+5*5149+994734)"+-- >>> runGen 43 (generate 5 5 ex7)+-- "(3431*((0337+5+070346+4))+76848+((4126+350875)*98769+308194+270+03118)+888*(95+90904)+(301069+7+715835)+2809)" -- ex7 :: Ord a => RE a ex7 = cfgToRE exCfgN exCfg
src/RERE/Examples/JSON.hs view
@@ -24,6 +24,9 @@ import Data.Semigroup (Semigroup (..)) #endif +-- $setup+-- >>> import RERE+ -- | Size of JSON grammar, 22. type Size = N.Mult2 (N.Plus N.Nat5 N.Nat6)
src/RERE/Gen.hs view
@@ -23,6 +23,7 @@ -- $setup -- >>> import Test.QuickCheck.Random (mkQCGen) -- >>> import Test.QuickCheck.Gen (unGen)+-- >>> import RERE.Type -- >>> let runGen seed = maybe "<<null>>" (\g' -> unGen g' (mkQCGen seed) 10) -------------------------------------------------------------------------------@@ -31,11 +32,11 @@ -- | Generate strings. ----- >>> runGen 42 $ generate 10 10 $ star_ (ch_ 'a')--- "aaa"+-- >>> runGen 43 $ generate 10 10 $ star_ (ch_ 'a')+-- "aaaaaaaaaa" -- -- >>> runGen 44 $ generate 10 10 $ star_ (ch_ 'a')--- "aaaaaaaaaa"+-- "aaa" -- generate :: Int -- ^ star upper size
src/RERE/LaTeX.hs view
@@ -13,14 +13,8 @@ -- -- Note: doesn't work with MathJax. ----- Requires @xcolor@ package. You need to define colors, for example:------ @--- \\colorlet{rerelit}{red!80!black} % literal characters--- \\colorlet{reresym}{green!50!black} % symbols: eps and emptyset--- \\colorlet{rereidn}{blue} % identifiers--- \\colorlet{rerestr}{red!50!blue} % strings (subscripts)--- @+-- Requires rere.sty distributed with this package, or definition of+-- the macros that are provided by rere.sty in some other way. -- module RERE.LaTeX ( putLatex,@@ -82,23 +76,10 @@ | StarPrec deriving (Eq, Ord, Enum, Show) -literalColor :: String-symbolColor :: String-identColor :: String-stringColor :: String--#if !defined(NO_COLOR)-literalColor = "\\color{rerelit}"-symbolColor = "\\color{reresym}"-identColor = "\\color{rereidn}"-stringColor = "\\color{rerestr}"-#else-literalColor = ""-symbolColor = ""-identColor = ""-stringColor = ""-#endif-+-- | The Booleans indicate whether the piece needs spacing if+-- combined with another spacing-sensitive piece before and/or+-- after.+-- data Piece = Piece !Bool !Bool ShowS instance IsString Piece where@@ -107,12 +88,19 @@ piece :: ShowS -> Piece piece = Piece False False +-- | Modify a piece, preserving the underlying piece's spacing+-- behaviour.+--+preserve :: (Piece -> Piece) -> Piece -> Piece+preserve f p@(Piece a b _) =+ Piece a b (unPiece (f p))+ unPiece :: Piece -> ShowS unPiece (Piece _ _ ss) = ss instance Semigroup Piece where Piece a b x <> Piece c d y = Piece a d (x . sep . y) where- sep | b, c = showString "\\,"+ sep | b, c = showString rerespace | otherwise = id instance Monoid Piece where@@ -122,14 +110,165 @@ latexify :: RE Void -> String latexify re0 = unPiece (evalState (latexify' (vacuous re0)) Set.empty) "" +latexCS :: (IsString a, Monoid a) => String -> Maybe a -> [a] -> a+latexCS csname Nothing [] = mconcat+ -- add extra space after plain csname to ensure there is no letter directly following+ [ "\\", fromString csname, " " ]+latexCS csname optarg args = mconcat $+ [ "\\", fromString csname, optwrap optarg ] ++ map wrap args+ where+ optwrap Nothing = mempty+ optwrap (Just arg) = mconcat ["[", arg, "]"]++ wrap arg = "{" `mappend` arg `mappend` "}"++preservingLatexCS :: String -> Maybe Piece -> Piece -> Piece+preservingLatexCS csname optarg arg =+ preserve (latexCS csname optarg . return) arg++latexBegin :: String -> Piece+latexBegin envname =+ latexCS "begin" Nothing [fromString envname]++latexEnd :: String -> Piece+latexEnd envname =+ latexCS "end" Nothing [fromString envname]++rerespace :: (IsString a, Monoid a) => a+rerespace = latexCS "rerespace" Nothing []++rerelitset :: (IsString a, Monoid a) => a -> a+rerelitset x = latexCS "rerelitset" Nothing [x]++rerelitsetcomplement :: (IsString a, Monoid a) => a -> a+rerelitsetcomplement x = latexCS "rerelitsetcomplement" Nothing [x]++rerealt :: Piece -> Piece -> Piece+rerealt x y = latexCS "rerealt" Nothing [x, y]++rereintersect :: Piece -> Piece -> Piece+rereintersect x y = latexCS "rereintersect" Nothing [x, y]++rerestar :: Piece -> Piece+rerestar x = preservingLatexCS "rerestar" Nothing x++beginrerealignedlet :: Piece+beginrerealignedlet = latexBegin "rerealignedlet"++endrerealignedlet :: Piece+endrerealignedlet = latexEnd "rerealignedlet"++rereletreceqn :: Piece -> Piece -> Piece+rereletreceqn x y = latexCS "rereletreceqn" Nothing [x, y]++rereleteqn :: Piece -> Piece -> Piece+rereleteqn x y = latexCS "rereleteqn" Nothing [x, y]++rereletrecin :: Piece -> Piece -> Piece -> Piece+rereletrecin x y z = latexCS "rereletrecin" Nothing [x, y, z]++rereletin :: Piece -> Piece -> Piece -> Piece+rereletin x y z = latexCS "rereletin" Nothing [x, y, z]++rerefix :: Piece -> Piece -> Piece+rerefix x y = latexCS "rerefix" Nothing [x, y]++rereletbody :: Piece -> Piece+rereletbody x = latexCS "rereletbody" Nothing [x]++rerelit :: (IsString a, Monoid a) => a -> a+rerelit x = latexCS "rerelit" Nothing [x]++rerelitrange :: (IsString a, Monoid a) => a -> a -> a+rerelitrange x y = latexCS "rerelitrange" Nothing [x, y]++rerestr :: (IsString a, Monoid a) => a -> a+rerestr x = latexCS "rerestr" Nothing [x]++rerevar :: (IsString a, Monoid a) => a -> a+rerevar x = latexCS "rerevar" Nothing [x]++rerevarsub :: (IsString a, Monoid a) => a -> a -> a+rerevarsub x y = latexCS "rerevarsub" Nothing [x, y]++rerevarsubsub :: (IsString a, Monoid a) => a -> a -> a -> a+rerevarsubsub x y z = latexCS "rerevarsubsub" Nothing [x, y, z]++rerenull :: (IsString a, Monoid a) => a+rerenull = latexCS "rerenull" Nothing []++rerefull :: (IsString a, Monoid a) => a+rerefull = latexCS "rerefull" Nothing []++rereeps :: (IsString a, Monoid a) => a+rereeps = latexCS "rereeps" Nothing []++beginreretrace :: Piece+beginreretrace = latexBegin "reretrace"++endreretrace :: Piece+endreretrace = latexEnd "reretrace"++reretraceline :: Maybe Piece -> String -> String -> Piece+reretraceline o x y = latexCS "reretraceline" o [fromString x, fromString y]++beginrerecfg :: Piece+beginrerecfg = latexBegin "rerecfg"++endrerecfg :: Piece+endrerecfg = latexEnd "rerecfg"++rerecfgproduction :: Piece -> Piece -> Piece+rerecfgproduction x y = latexCS "rerecfgproduction" Nothing [x, y]++rerecharstar :: String+rerecharstar = latexCS "rerecharstar" Nothing []+rerecharplus :: String+rerecharplus = latexCS "rerecharplus" Nothing []+rerecharminus :: String+rerecharminus = latexCS "rerecharminus" Nothing []+rerecharpopen :: String+rerecharpopen = latexCS "rerecharpopen" Nothing []+rerecharpclose :: String+rerecharpclose = latexCS "rerecharpclose" Nothing []+rerecharbopen :: String+rerecharbopen = latexCS "rerecharbopen" Nothing []+rerecharbclose :: String+rerecharbclose = latexCS "rerecharbclose" Nothing []+rerecharcopen :: String+rerecharcopen = latexCS "rerecharcopen" Nothing []+rerecharcclose :: String+rerecharcclose = latexCS "rerecharcclose" Nothing []+rerecharbackslash :: String+rerecharbackslash = latexCS "rerecharbackslash" Nothing []+rerecharhash :: String+rerecharhash = latexCS "rerecharhash" Nothing []+rerechartilde :: String+rerechartilde = latexCS "rerechartilde" Nothing []+rerecharspace :: String+rerecharspace = latexCS "rerecharspace" Nothing []+rerecharampersand :: String+rerecharampersand = latexCS "rerecharampersand" Nothing []+rerecharpercent :: String+rerecharpercent = latexCS "rerecharpercent" Nothing []+rerecharunderscore :: String+rerecharunderscore = latexCS "rerecharunderscore" Nothing []+rerecharhat :: String+rerecharhat = latexCS "rerecharhat" Nothing []+rerechardollar :: String+rerechardollar = latexCS "rerechardollar" Nothing []++rerecharcode :: String -> String+rerecharcode x = latexCS "rerecharcode" Nothing [x]+ nullPiece :: Piece-nullPiece = fromString $ "{" ++ symbolColor ++ "\\emptyset}"+nullPiece = rerenull fullPiece :: Piece-fullPiece = fromString $ "{" ++ symbolColor ++ "\\Sigma^\\ast}"+fullPiece = rerefull epsPiece :: Piece-epsPiece = fromString $ "{" ++ symbolColor ++ "\\varepsilon}"+epsPiece = rereeps latexify' :: RE Piece -> State (Set NI) Piece latexify' = go BotPrec where@@ -140,8 +279,8 @@ go _ (Ch cs) = return $ case CS.toIntervalList cs of [] -> nullPiece [(lo,hi)] | lo == hi -> latexCharPiece lo- xs | sz < sz' -> "\\{" <> mconcat (intersperse ", " $ map latexCharRange xs) <> "\\}"- | otherwise -> "\\{" <> mconcat (intersperse ", " $ map latexCharRange $ CS.toIntervalList ccs) <> "\\}^c"+ xs | sz < sz' -> rerelitset (mconcat (intersperse ", " $ map latexCharRange xs))+ | otherwise -> rerelitsetcomplement (mconcat (intersperse ", " $ map latexCharRange $ CS.toIntervalList ccs)) where ccs = CS.complement cs sz = CS.size cs@@ -150,23 +289,23 @@ go d (App r s) = parens (d > AppPrec) $ do r' <- go AppPrec r s' <- go AppPrec s- return (r' <> s')+ return $ r' <> s' -- not via a control sequence to preserve the spacing hack go d (Alt r s) = parens (d > AltPrec) $ do r' <- go AltPrec r s' <- go AltPrec s- return $ r' <> "\\cup" <> s'+ return $ rerealt r' s' #ifdef RERE_INTERSECTION go d (And r s) = parens (d > AndPrec) $ do r' <- go AndPrec r s' <- go AndPrec s- return $ r' <> "\\cap" <> s'+ return $ rereintersect r' s' #endif go d (Star r) = parens (d > StarPrec) $ do r' <- go StarPrec r- return (r' <> "^\\star")+ return $ rerestar r' go _ (Var x) = return x @@ -178,8 +317,7 @@ r2 <- go BotPrec r' - let acc = "\\begin{aligned}[t] \\mathbf{let}\\, &"- <> v <> "=_R" <> r2+ let acc = beginrerealignedlet <> rereletreceqn v r2 goLet acc s' @@ -190,8 +328,7 @@ r2 <- go BotPrec r - let acc = "\\begin{aligned}[t] \\mathbf{let}\\, &"- <> v <> "=" <> r2+ let acc = beginrerealignedlet <> rereleteqn v r2 goLet acc s' @@ -204,10 +341,7 @@ r2 <- go BotPrec r' s2 <- go BotPrec s' - return $ "\\mathbf{let}\\,"- <> v <> "=_R" <> r2- <> "\\,\\mathbf{in}\\,"- <> s2+ return $ rereletrecin v r2 s2 go d (Let n r s) = parens (d > BotPrec) $ do i <- newUnique n@@ -217,10 +351,7 @@ r2 <- go BotPrec r s2 <- go BotPrec s' - return $ "\\mathbf{let}\\,"- <> v <> "=" <> r2- <> "\\,\\mathbf{in}\\,"- <> s2+ return $ rereletin v r2 s2 go d (Fix n r) = parens (d > BotPrec) $ do i <- newUnique n@@ -228,7 +359,7 @@ let r' = fmap (unvar v id) r r'' <- go BotPrec r'- return $ piece $ showString "\\mathbf{fix}\\," . unPiece v . showChar '=' . unPiece r''+ return $ rerefix v r'' goLet :: Piece -> RE Piece -> State (Set NI) Piece@@ -240,8 +371,7 @@ r2 <- go BotPrec r' - let acc = acc0 <> " \\\\ &"- <> v <> "=_R" <> r2+ let acc = acc0 <> rereletreceqn v r2 goLet acc s' @@ -252,43 +382,51 @@ r2 <- go BotPrec r - let acc = acc0 <> " \\\\ &"- <> v <> "=" <> r2+ let acc = acc0 <> rereleteqn v r2 goLet acc s' goLet acc s = do s' <- go BotPrec s- return $ acc <> "\\\\ \\mathbf{in}\\, &" <> s' <> "\\end{aligned}"+ return $ acc <> rereletbody s' <> endrerealignedlet parens :: Bool -> State (Set NI) Piece -> State (Set NI) Piece parens True = fmap $ \(Piece _ _ x) -> piece $ showChar '(' . x . showChar ')' parens False = id latexChar :: Char -> String-latexChar = latexChar' literalColor+latexChar c = rerelit (latexChar' c) -latexChar' :: String -> Char -> String-latexChar' col '*' = "\\text{" ++ col ++ "*}"-latexChar' col '+' = "\\text{" ++ col ++ "+}"-latexChar' col '-' = "\\text{" ++ col ++ "-}"-latexChar' col '(' = "\\text{" ++ col ++ "(}"-latexChar' col ')' = "\\text{" ++ col ++ ")}"-latexChar' col '[' = "\\text{" ++ col ++ "[}"-latexChar' col ']' = "\\text{" ++ col ++ "]}"-latexChar' col '\\' = "\\text{" ++ col ++ "\\textbackslash}"-latexChar' col '#' = "\\text{" ++ col ++ "\\#}"-latexChar' col c- | c <= '\x20' || c >= '\127' = show (ord c)- | otherwise = "{" ++ col ++ "\\mathtt{" ++ [c] ++ "}}"+latexChar' :: Char -> String+latexChar' '*' = rerecharstar+latexChar' '+' = rerecharplus+latexChar' '-' = rerecharminus+latexChar' '(' = rerecharpopen+latexChar' ')' = rerecharpclose+latexChar' '[' = rerecharbopen+latexChar' ']' = rerecharbclose+latexChar' '{' = rerecharcopen+latexChar' '}' = rerecharcclose+latexChar' '\\' = rerecharbackslash+latexChar' '#' = rerecharhash+latexChar' '~' = rerechartilde+latexChar' ' ' = rerecharspace+latexChar' '&' = rerecharampersand+latexChar' '%' = rerecharpercent+latexChar' '_' = rerecharunderscore+latexChar' '^' = rerecharhat+latexChar' '$' = rerechardollar+latexChar' c+ | c <= '\x20' || c >= '\127' = rerecharcode (show (ord c))+ | otherwise = [c] latexCharPiece :: Char -> Piece-latexCharPiece c = "{" <> fromString (latexChar c) <> "}"+latexCharPiece c = fromString (latexChar c) latexCharRange :: (Char, Char) -> Piece latexCharRange (lo, hi) | lo == hi = latexCharPiece lo- | otherwise = latexCharPiece lo <> " \\ldots " <> latexCharPiece hi+ | otherwise = rerelitrange (latexCharPiece lo) (latexCharPiece hi) data NI = NI String [Char] Int deriving (Eq, Ord) @@ -299,20 +437,20 @@ put (Set.insert (NI n cs i) s) return i +latexString :: String -> String+latexString cs = rerestr (concatMap latexChar' cs)+ showVar :: Name -> Int -> Piece showVar (N n cs) i- = Piece True True- $ showString $ "{" ++ identColor ++ "\\mathit{" ++ n ++ "}" ++ sub ++ "}"+ = Piece True True $ showString var where- cs' = showCS cs+ cs' = latexString cs i' = showI i - sub | null cs && null i' = ""- | not (null cs) && not (null i') = "_{" ++ cs' ++ ";" ++ i' ++ "}"- | otherwise = "_{" ++ cs' ++ i' ++ "}"-- showCS :: [Char] -> String- showCS ds = "\\mathtt{" ++ stringColor ++ concatMap (latexChar' "") ds ++ "}"+ var :: String+ var | null cs && null i' = rerevar n+ | not (null cs) && not (null i') = rerevarsubsub n cs' i'+ | otherwise = rerevarsub n (cs' <> i') showI :: Int -> String showI 0 = ""@@ -333,13 +471,16 @@ go acc re [] = (nullable re, re, acc []) go acc re str@(c:cs) = go (acc . ((str, re) :)) (derivative c re) cs +putPieceLn :: Piece -> IO ()+putPieceLn = putStrLn . ($ "") . unPiece+ displayTrace :: (Bool, RE Void, [(String, RE Void)]) -> IO () displayTrace (matched, final, steps) = do- putStrLn "\\begin{aligned}"+ putPieceLn beginreretrace for_ steps $ \(str, re) ->- putStrLn $ "& \\mathtt{" ++ stringColor ++ concatMap (latexChar' "") str ++ "} &&\\vdash" ++ sub (nullable re) ++ " " ++ latexify re ++ " \\\\"- putStrLn $ "&{" ++ symbolColor ++ " \\varepsilon} &&\\vdash" ++ sub matched ++ " " ++ latexify final ++ " \\\\"- putStrLn "\\end{aligned}"+ putPieceLn $ reretraceline (Just (sub (nullable re))) (latexString str) (latexify re)+ putPieceLn $ reretraceline (Just (sub matched)) rereeps (latexify final)+ putPieceLn endreretrace print matched print final@@ -356,16 +497,16 @@ #ifndef RERE_NO_CFG -- | Pretty-print 'CFG' given the names. putLatexCFG :: Vec n Name -> CFG n Void -> IO ()-putLatexCFG names cfg = putStrLn (latexifyCfg names cfg)+putLatexCFG names cfg = mapM_ putPieceLn (latexifyCfg names cfg) -latexifyCfg :: forall n. Vec n Name -> CFG n Void -> String+latexifyCfg :: forall n. Vec n Name -> CFG n Void -> [Piece] latexifyCfg names cfg =- unlines $ ["\\begin{aligned}"] ++ go names cfg ++ ["\\end{aligned}"]+ [beginrerecfg] ++ go names cfg ++ [endrerecfg] where initS :: State (Set NI) () initS = for_ names newUnique - go :: Vec m Name -> Vec m (CFGBase n Void) -> [String]+ go :: Vec m Name -> Vec m (CFGBase n Void) -> [Piece] go VNil VNil = [] go (n ::: ns) (e ::: es) = eq' : go ns es where e' = fmap (either (\i -> showVar (names V.! i) 0) absurd) e@@ -374,10 +515,10 @@ eq = do initS e'' <- latexify' e'- return $ n' <> " &= " <> e'' <> " \\\\"+ return $ rerecfgproduction n' e'' - eq' :: String- eq' = unPiece (evalState eq Set.empty) ""+ eq' :: Piece+ eq' = evalState eq Set.empty #if __GLASGOW_HASKELL__ <711 go _ _ = error "silly GHC" #endif