diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,3 @@ +# 0.2 + +- Change LaTeX generation output diff --git a/rere.cabal b/rere.cabal --- a/rere.cabal +++ b/rere.cabal @@ -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 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) diff --git a/rere.sty b/rere.sty new file mode 100644 --- /dev/null +++ b/rere.sty @@ -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 diff --git a/src/RERE/CFG.hs b/src/RERE/CFG.hs --- a/src/RERE/CFG.hs +++ b/src/RERE/CFG.hs @@ -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. diff --git a/src/RERE/Examples.hs b/src/RERE/Examples.hs --- a/src/RERE/Examples.hs +++ b/src/RERE/Examples.hs @@ -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 "<>" (\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 diff --git a/src/RERE/Examples/JSON.hs b/src/RERE/Examples/JSON.hs --- a/src/RERE/Examples/JSON.hs +++ b/src/RERE/Examples/JSON.hs @@ -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) diff --git a/src/RERE/Gen.hs b/src/RERE/Gen.hs --- a/src/RERE/Gen.hs +++ b/src/RERE/Gen.hs @@ -23,6 +23,7 @@ -- $setup -- >>> import Test.QuickCheck.Random (mkQCGen) -- >>> import Test.QuickCheck.Gen (unGen) +-- >>> import RERE.Type -- >>> let runGen seed = maybe "<>" (\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 diff --git a/src/RERE/LaTeX.hs b/src/RERE/LaTeX.hs --- a/src/RERE/LaTeX.hs +++ b/src/RERE/LaTeX.hs @@ -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