{-# LANGUAGE CPP                 #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
#ifndef RERE_NO_CFG
{-# LANGUAGE Trustworthy       #-}
#elif __GLASGOW_HASKELL__ >=704
{-# LANGUAGE Safe                #-}
#elif __GLASGOW_HASKELL__ >=702
{-# LANGUAGE Trustworthy         #-}
#endif
-- | Pretty-print structures as LaTeX code.
--
-- Note: doesn't work with MathJax.
--
-- 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,
    putLatexTrace,
#ifndef RERE_NO_CFG
    putLatexCFG,
#endif
    ) where

import Control.Monad.Trans.State (State, evalState, get, put)
import Data.Char                 (ord)
import Data.Foldable             (for_)
import Data.List                 (intersperse)
import Data.Set                  (Set)
import Data.String               (IsString (..))
import Data.Void                 (Void)

import qualified Data.Set     as Set
import qualified RERE.CharSet as CS

import RERE.Absurd
import RERE.Type
import RERE.Var

#ifndef RERE_NO_CFG
import RERE.CFG

import           Data.Vec.Lazy (Vec (..))
import qualified Data.Vec.Lazy as V
#endif

#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (Monoid (..))
#endif

#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup (Semigroup (..))
#endif

-------------------------------------------------------------------------------
--
-------------------------------------------------------------------------------

-- | Pretty-print 'RE' as LaTeX code.
putLatex :: RE Void -> IO ()
putLatex :: RE Void -> IO ()
putLatex = String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. RE Void -> String
latexify

-------------------------------------------------------------------------------
-- Latex utilities
-------------------------------------------------------------------------------

data Prec
    = BotPrec
    | AltPrec
#ifdef RERE_INTERSECTION
    | AndPrec
#endif
    | AppPrec
    | StarPrec
  deriving (Prec -> Prec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Prec -> Prec -> Bool
$c/= :: Prec -> Prec -> Bool
== :: Prec -> Prec -> Bool
$c== :: Prec -> Prec -> Bool
Eq, Eq Prec
Prec -> Prec -> Bool
Prec -> Prec -> Ordering
Prec -> Prec -> Prec
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Prec -> Prec -> Prec
$cmin :: Prec -> Prec -> Prec
max :: Prec -> Prec -> Prec
$cmax :: Prec -> Prec -> Prec
>= :: Prec -> Prec -> Bool
$c>= :: Prec -> Prec -> Bool
> :: Prec -> Prec -> Bool
$c> :: Prec -> Prec -> Bool
<= :: Prec -> Prec -> Bool
$c<= :: Prec -> Prec -> Bool
< :: Prec -> Prec -> Bool
$c< :: Prec -> Prec -> Bool
compare :: Prec -> Prec -> Ordering
$ccompare :: Prec -> Prec -> Ordering
Ord, Int -> Prec
Prec -> Int
Prec -> [Prec]
Prec -> Prec
Prec -> Prec -> [Prec]
Prec -> Prec -> Prec -> [Prec]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Prec -> Prec -> Prec -> [Prec]
$cenumFromThenTo :: Prec -> Prec -> Prec -> [Prec]
enumFromTo :: Prec -> Prec -> [Prec]
$cenumFromTo :: Prec -> Prec -> [Prec]
enumFromThen :: Prec -> Prec -> [Prec]
$cenumFromThen :: Prec -> Prec -> [Prec]
enumFrom :: Prec -> [Prec]
$cenumFrom :: Prec -> [Prec]
fromEnum :: Prec -> Int
$cfromEnum :: Prec -> Int
toEnum :: Int -> Prec
$ctoEnum :: Int -> Prec
pred :: Prec -> Prec
$cpred :: Prec -> Prec
succ :: Prec -> Prec
$csucc :: Prec -> Prec
Enum, Int -> Prec -> ShowS
[Prec] -> ShowS
Prec -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Prec] -> ShowS
$cshowList :: [Prec] -> ShowS
show :: Prec -> String
$cshow :: Prec -> String
showsPrec :: Int -> Prec -> ShowS
$cshowsPrec :: Int -> Prec -> ShowS
Show)

-- | 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
    fromString :: String -> Piece
fromString = ShowS -> Piece
piece forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString

piece :: ShowS -> Piece
piece :: ShowS -> Piece
piece = Bool -> Bool -> ShowS -> Piece
Piece Bool
False Bool
False

-- | Modify a piece, preserving the underlying piece's spacing
-- behaviour.
--
preserve :: (Piece -> Piece) -> Piece -> Piece
preserve :: (Piece -> Piece) -> Piece -> Piece
preserve Piece -> Piece
f p :: Piece
p@(Piece Bool
a Bool
b ShowS
_) =
  Bool -> Bool -> ShowS -> Piece
Piece Bool
a Bool
b (Piece -> ShowS
unPiece (Piece -> Piece
f Piece
p))

unPiece :: Piece -> ShowS
unPiece :: Piece -> ShowS
unPiece (Piece Bool
_ Bool
_ ShowS
ss) = ShowS
ss

instance Semigroup Piece where
    Piece Bool
a Bool
b ShowS
x <> :: Piece -> Piece -> Piece
<> Piece Bool
c Bool
d ShowS
y = Bool -> Bool -> ShowS -> Piece
Piece Bool
a Bool
d (ShowS
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
sep forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
y) where
        sep :: ShowS
sep | Bool
b, Bool
c      = String -> ShowS
showString forall a. (IsString a, Monoid a) => a
rerespace
            | Bool
otherwise = forall a. a -> a
id

instance Monoid Piece where
    mempty :: Piece
mempty  = Bool -> Bool -> ShowS -> Piece
Piece Bool
False Bool
False forall a. a -> a
id
    mappend :: Piece -> Piece -> Piece
mappend = forall a. Semigroup a => a -> a -> a
(<>)

latexify :: RE Void -> String
latexify :: RE Void -> String
latexify RE Void
re0 = Piece -> ShowS
unPiece (forall s a. State s a -> s -> a
evalState (RE Piece -> State (Set NI) Piece
latexify' (forall (f :: * -> *) a b. (Functor f, Absurd a) => f a -> f b
vacuous RE Void
re0)) forall a. Set a
Set.empty) String
""

latexCS :: (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS :: forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
csname Maybe a
Nothing [] = forall a. Monoid a => [a] -> a
mconcat
 -- add extra space after plain csname to ensure there is no letter directly following
    [ a
"\\", forall a. IsString a => String -> a
fromString String
csname, a
" " ]
latexCS String
csname Maybe a
optarg [a]
args = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
    [ a
"\\", forall a. IsString a => String -> a
fromString String
csname, forall {a}. (Monoid a, IsString a) => Maybe a -> a
optwrap Maybe a
optarg ] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (Monoid a, IsString a) => a -> a
wrap [a]
args
  where
    optwrap :: Maybe a -> a
optwrap Maybe a
Nothing    = forall a. Monoid a => a
mempty
    optwrap (Just a
arg) = forall a. Monoid a => [a] -> a
mconcat [a
"[", a
arg, a
"]"]

    wrap :: a -> a
wrap a
arg = a
"{" forall a. Monoid a => a -> a -> a
`mappend` a
arg forall a. Monoid a => a -> a -> a
`mappend` a
"}"

preservingLatexCS :: String -> Maybe Piece -> Piece -> Piece
preservingLatexCS :: String -> Maybe Piece -> Piece -> Piece
preservingLatexCS String
csname Maybe Piece
optarg Piece
arg =
    (Piece -> Piece) -> Piece -> Piece
preserve (forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
csname Maybe Piece
optarg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return) Piece
arg

latexBegin :: String -> Piece
latexBegin :: String -> Piece
latexBegin String
envname =
    forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"begin" forall a. Maybe a
Nothing [forall a. IsString a => String -> a
fromString String
envname]

latexEnd :: String -> Piece
latexEnd :: String -> Piece
latexEnd String
envname =
    forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"end" forall a. Maybe a
Nothing [forall a. IsString a => String -> a
fromString String
envname]

rerespace :: (IsString a, Monoid a) => a
rerespace :: forall a. (IsString a, Monoid a) => a
rerespace = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerespace" forall a. Maybe a
Nothing []

rerelitset :: (IsString a, Monoid a) => a -> a
rerelitset :: forall a. (IsString a, Monoid a) => a -> a
rerelitset a
x = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerelitset" forall a. Maybe a
Nothing [a
x]

rerelitsetcomplement :: (IsString a, Monoid a) => a -> a
rerelitsetcomplement :: forall a. (IsString a, Monoid a) => a -> a
rerelitsetcomplement a
x = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerelitsetcomplement" forall a. Maybe a
Nothing [a
x]

rerealt :: Piece -> Piece -> Piece
rerealt :: Piece -> Piece -> Piece
rerealt Piece
x Piece
y = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerealt" forall a. Maybe a
Nothing [Piece
x, Piece
y]

rereintersect :: Piece -> Piece -> Piece
rereintersect :: Piece -> Piece -> Piece
rereintersect Piece
x Piece
y = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rereintersect" forall a. Maybe a
Nothing [Piece
x, Piece
y]

rerestar :: Piece -> Piece
rerestar :: Piece -> Piece
rerestar Piece
x = String -> Maybe Piece -> Piece -> Piece
preservingLatexCS String
"rerestar" forall a. Maybe a
Nothing Piece
x

beginrerealignedlet :: Piece
beginrerealignedlet :: Piece
beginrerealignedlet = String -> Piece
latexBegin String
"rerealignedlet"

endrerealignedlet :: Piece
endrerealignedlet :: Piece
endrerealignedlet = String -> Piece
latexEnd String
"rerealignedlet"

rereletreceqn :: Piece -> Piece -> Piece
rereletreceqn :: Piece -> Piece -> Piece
rereletreceqn Piece
x Piece
y = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rereletreceqn" forall a. Maybe a
Nothing [Piece
x, Piece
y]

rereleteqn :: Piece -> Piece -> Piece
rereleteqn :: Piece -> Piece -> Piece
rereleteqn Piece
x Piece
y = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rereleteqn" forall a. Maybe a
Nothing [Piece
x, Piece
y]

rereletrecin :: Piece -> Piece -> Piece -> Piece
rereletrecin :: Piece -> Piece -> Piece -> Piece
rereletrecin Piece
x Piece
y Piece
z = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rereletrecin" forall a. Maybe a
Nothing [Piece
x, Piece
y, Piece
z]

rereletin :: Piece -> Piece -> Piece -> Piece
rereletin :: Piece -> Piece -> Piece -> Piece
rereletin Piece
x Piece
y Piece
z = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rereletin" forall a. Maybe a
Nothing [Piece
x, Piece
y, Piece
z]

rerefix :: Piece -> Piece -> Piece
rerefix :: Piece -> Piece -> Piece
rerefix Piece
x Piece
y = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerefix" forall a. Maybe a
Nothing [Piece
x, Piece
y]

rereletbody :: Piece -> Piece
rereletbody :: Piece -> Piece
rereletbody Piece
x = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rereletbody" forall a. Maybe a
Nothing [Piece
x]

rerelit :: (IsString a, Monoid a) => a -> a
rerelit :: forall a. (IsString a, Monoid a) => a -> a
rerelit a
x = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerelit" forall a. Maybe a
Nothing [a
x]

rerelitrange :: (IsString a, Monoid a) => a -> a -> a
rerelitrange :: forall a. (IsString a, Monoid a) => a -> a -> a
rerelitrange a
x a
y = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerelitrange" forall a. Maybe a
Nothing [a
x, a
y]

rerestr :: (IsString a, Monoid a) => a -> a
rerestr :: forall a. (IsString a, Monoid a) => a -> a
rerestr a
x = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerestr" forall a. Maybe a
Nothing [a
x]

rerevar :: (IsString a, Monoid a) => a -> a
rerevar :: forall a. (IsString a, Monoid a) => a -> a
rerevar a
x = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerevar" forall a. Maybe a
Nothing [a
x]

rerevarsub :: (IsString a, Monoid a) => a -> a -> a
rerevarsub :: forall a. (IsString a, Monoid a) => a -> a -> a
rerevarsub a
x a
y = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerevarsub" forall a. Maybe a
Nothing [a
x, a
y]

rerevarsubsub :: (IsString a, Monoid a) => a -> a -> a -> a
rerevarsubsub :: forall a. (IsString a, Monoid a) => a -> a -> a -> a
rerevarsubsub a
x a
y a
z = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerevarsubsub" forall a. Maybe a
Nothing [a
x, a
y, a
z]

rerenull :: (IsString a, Monoid a) => a
rerenull :: forall a. (IsString a, Monoid a) => a
rerenull = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerenull" forall a. Maybe a
Nothing []

rerefull :: (IsString a, Monoid a) => a
rerefull :: forall a. (IsString a, Monoid a) => a
rerefull = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerefull" forall a. Maybe a
Nothing []

rereeps :: (IsString a, Monoid a) => a
rereeps :: forall a. (IsString a, Monoid a) => a
rereeps = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rereeps" forall a. Maybe a
Nothing []

beginreretrace :: Piece
beginreretrace :: Piece
beginreretrace = String -> Piece
latexBegin String
"reretrace"

endreretrace :: Piece
endreretrace :: Piece
endreretrace = String -> Piece
latexEnd String
"reretrace"

reretraceline :: Maybe Piece -> String -> String -> Piece
reretraceline :: Maybe Piece -> String -> String -> Piece
reretraceline Maybe Piece
o String
x String
y = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"reretraceline" Maybe Piece
o [forall a. IsString a => String -> a
fromString String
x, forall a. IsString a => String -> a
fromString String
y]

beginrerecfg :: Piece
beginrerecfg :: Piece
beginrerecfg = String -> Piece
latexBegin String
"rerecfg"

endrerecfg :: Piece
endrerecfg :: Piece
endrerecfg = String -> Piece
latexEnd String
"rerecfg"

rerecfgproduction :: Piece -> Piece -> Piece
rerecfgproduction :: Piece -> Piece -> Piece
rerecfgproduction Piece
x Piece
y = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerecfgproduction" forall a. Maybe a
Nothing [Piece
x, Piece
y]

rerecharstar :: String
rerecharstar :: String
rerecharstar = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerecharstar" forall a. Maybe a
Nothing []
rerecharplus :: String
rerecharplus :: String
rerecharplus = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerecharplus" forall a. Maybe a
Nothing []
rerecharminus :: String
rerecharminus :: String
rerecharminus = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerecharminus" forall a. Maybe a
Nothing []
rerecharpopen :: String
rerecharpopen :: String
rerecharpopen = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerecharpopen" forall a. Maybe a
Nothing []
rerecharpclose :: String
rerecharpclose :: String
rerecharpclose = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerecharpclose" forall a. Maybe a
Nothing []
rerecharbopen :: String
rerecharbopen :: String
rerecharbopen = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerecharbopen" forall a. Maybe a
Nothing []
rerecharbclose :: String
rerecharbclose :: String
rerecharbclose = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerecharbclose" forall a. Maybe a
Nothing []
rerecharcopen :: String
rerecharcopen :: String
rerecharcopen = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerecharcopen" forall a. Maybe a
Nothing []
rerecharcclose :: String
rerecharcclose :: String
rerecharcclose = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerecharcclose" forall a. Maybe a
Nothing []
rerecharbackslash :: String
rerecharbackslash :: String
rerecharbackslash = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerecharbackslash" forall a. Maybe a
Nothing []
rerecharhash :: String
rerecharhash :: String
rerecharhash = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerecharhash" forall a. Maybe a
Nothing []
rerechartilde :: String
rerechartilde :: String
rerechartilde = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerechartilde" forall a. Maybe a
Nothing []
rerecharspace :: String
rerecharspace :: String
rerecharspace = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerecharspace" forall a. Maybe a
Nothing []
rerecharampersand :: String
rerecharampersand :: String
rerecharampersand = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerecharampersand" forall a. Maybe a
Nothing []
rerecharpercent :: String
rerecharpercent :: String
rerecharpercent = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerecharpercent" forall a. Maybe a
Nothing []
rerecharunderscore :: String
rerecharunderscore :: String
rerecharunderscore = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerecharunderscore" forall a. Maybe a
Nothing []
rerecharhat :: String
rerecharhat :: String
rerecharhat = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerecharhat" forall a. Maybe a
Nothing []
rerechardollar :: String
rerechardollar :: String
rerechardollar = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerechardollar" forall a. Maybe a
Nothing []

rerecharcode :: String -> String
rerecharcode :: ShowS
rerecharcode String
x = forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerecharcode" forall a. Maybe a
Nothing [String
x]

nullPiece :: Piece
nullPiece :: Piece
nullPiece = forall a. (IsString a, Monoid a) => a
rerenull

fullPiece :: Piece
fullPiece :: Piece
fullPiece = forall a. (IsString a, Monoid a) => a
rerefull

epsPiece :: Piece
epsPiece :: Piece
epsPiece = forall a. (IsString a, Monoid a) => a
rereeps

latexify' :: RE Piece -> State (Set NI) Piece
latexify' :: RE Piece -> State (Set NI) Piece
latexify' = Prec -> RE Piece -> State (Set NI) Piece
go Prec
BotPrec where
    go :: Prec -> RE Piece -> State (Set NI) Piece
    go :: Prec -> RE Piece -> State (Set NI) Piece
go Prec
_ RE Piece
Null    = forall (m :: * -> *) a. Monad m => a -> m a
return Piece
nullPiece
    go Prec
_ RE Piece
Full    = forall (m :: * -> *) a. Monad m => a -> m a
return Piece
fullPiece
    go Prec
_ RE Piece
Eps     = forall (m :: * -> *) a. Monad m => a -> m a
return Piece
epsPiece
    go Prec
_ (Ch CharSet
cs) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case CharSet -> [(Char, Char)]
CS.toIntervalList CharSet
cs of
        []                   -> Piece
nullPiece
        [(Char
lo,Char
hi)] | Char
lo forall a. Eq a => a -> a -> Bool
== Char
hi -> Char -> Piece
latexCharPiece Char
lo
        [(Char, Char)]
xs | Int
sz forall a. Ord a => a -> a -> Bool
< Int
sz'        -> forall a. (IsString a, Monoid a) => a -> a
rerelitset (forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse Piece
", " forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Char, Char) -> Piece
latexCharRange [(Char, Char)]
xs))
           | Bool
otherwise       -> forall a. (IsString a, Monoid a) => a -> a
rerelitsetcomplement (forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse Piece
", " forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Char, Char) -> Piece
latexCharRange forall a b. (a -> b) -> a -> b
$ CharSet -> [(Char, Char)]
CS.toIntervalList CharSet
ccs))
      where
        ccs :: CharSet
ccs = CharSet -> CharSet
CS.complement CharSet
cs
        sz :: Int
sz  = CharSet -> Int
CS.size CharSet
cs
        sz' :: Int
sz' = CharSet -> Int
CS.size CharSet
ccs

    go Prec
d (App RE Piece
r RE Piece
s) = Bool -> State (Set NI) Piece -> State (Set NI) Piece
parens (Prec
d forall a. Ord a => a -> a -> Bool
> Prec
AppPrec) forall a b. (a -> b) -> a -> b
$ do
        Piece
r'  <- Prec -> RE Piece -> State (Set NI) Piece
go Prec
AppPrec RE Piece
r
        Piece
s'  <- Prec -> RE Piece -> State (Set NI) Piece
go Prec
AppPrec RE Piece
s
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Piece
r' forall a. Semigroup a => a -> a -> a
<> Piece
s' -- not via a control sequence to preserve the spacing hack

    go Prec
d (Alt RE Piece
r RE Piece
s) = Bool -> State (Set NI) Piece -> State (Set NI) Piece
parens (Prec
d forall a. Ord a => a -> a -> Bool
> Prec
AltPrec) forall a b. (a -> b) -> a -> b
$ do
        Piece
r'  <- Prec -> RE Piece -> State (Set NI) Piece
go Prec
AltPrec RE Piece
r
        Piece
s'  <- Prec -> RE Piece -> State (Set NI) Piece
go Prec
AltPrec RE Piece
s
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Piece -> Piece -> Piece
rerealt Piece
r' Piece
s'

#ifdef RERE_INTERSECTION
    go d (And r s) = parens (d > AndPrec) $ do
        r'  <- go AndPrec r
        s'  <- go AndPrec s
        return $ rereintersect r' s'
#endif

    go Prec
d (Star RE Piece
r) = Bool -> State (Set NI) Piece -> State (Set NI) Piece
parens (Prec
d forall a. Ord a => a -> a -> Bool
> Prec
StarPrec) forall a b. (a -> b) -> a -> b
$ do
        Piece
r' <- Prec -> RE Piece -> State (Set NI) Piece
go Prec
StarPrec RE Piece
r
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Piece -> Piece
rerestar Piece
r'

    go Prec
_ (Var Piece
x) = forall (m :: * -> *) a. Monad m => a -> m a
return Piece
x

    go Prec
d (Let Name
n (Fix Name
_ RE (Var Piece)
r) s :: RE (Var Piece)
s@Let {}) = Bool -> State (Set NI) Piece -> State (Set NI) Piece
parens (Prec
d forall a. Ord a => a -> a -> Bool
> Prec
BotPrec) forall a b. (a -> b) -> a -> b
$ do
        Int
i <- Name -> State (Set NI) Int
newUnique Name
n
        let v :: Piece
v  = Name -> Int -> Piece
showVar Name
n Int
i
        let r' :: RE Piece
r' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall r a. r -> (a -> r) -> Var a -> r
unvar Piece
v forall a. a -> a
id) RE (Var Piece)
r
        let s' :: RE Piece
s' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall r a. r -> (a -> r) -> Var a -> r
unvar Piece
v forall a. a -> a
id) RE (Var Piece)
s

        Piece
r2 <- Prec -> RE Piece -> State (Set NI) Piece
go Prec
BotPrec RE Piece
r'

        let acc :: Piece
acc = Piece
beginrerealignedlet forall a. Semigroup a => a -> a -> a
<> Piece -> Piece -> Piece
rereletreceqn Piece
v Piece
r2

        Piece -> RE Piece -> State (Set NI) Piece
goLet Piece
acc RE Piece
s'

    go Prec
d (Let Name
n RE Piece
r s :: RE (Var Piece)
s@Let {}) = Bool -> State (Set NI) Piece -> State (Set NI) Piece
parens (Prec
d forall a. Ord a => a -> a -> Bool
> Prec
BotPrec) forall a b. (a -> b) -> a -> b
$ do
        Int
i <- Name -> State (Set NI) Int
newUnique Name
n
        let v :: Piece
v  = Name -> Int -> Piece
showVar Name
n Int
i
        let s' :: RE Piece
s' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall r a. r -> (a -> r) -> Var a -> r
unvar Piece
v forall a. a -> a
id) RE (Var Piece)
s

        Piece
r2 <- Prec -> RE Piece -> State (Set NI) Piece
go Prec
BotPrec RE Piece
r

        let acc :: Piece
acc = Piece
beginrerealignedlet forall a. Semigroup a => a -> a -> a
<> Piece -> Piece -> Piece
rereleteqn Piece
v Piece
r2

        Piece -> RE Piece -> State (Set NI) Piece
goLet Piece
acc RE Piece
s'

    go Prec
d (Let Name
n (Fix Name
_ RE (Var Piece)
r) RE (Var Piece)
s) = Bool -> State (Set NI) Piece -> State (Set NI) Piece
parens (Prec
d forall a. Ord a => a -> a -> Bool
> Prec
BotPrec) forall a b. (a -> b) -> a -> b
$ do
        Int
i <- Name -> State (Set NI) Int
newUnique Name
n
        let v :: Piece
v  = Name -> Int -> Piece
showVar Name
n Int
i
        let r' :: RE Piece
r' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall r a. r -> (a -> r) -> Var a -> r
unvar Piece
v forall a. a -> a
id) RE (Var Piece)
r
        let s' :: RE Piece
s' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall r a. r -> (a -> r) -> Var a -> r
unvar Piece
v forall a. a -> a
id) RE (Var Piece)
s

        Piece
r2 <- Prec -> RE Piece -> State (Set NI) Piece
go Prec
BotPrec RE Piece
r'
        Piece
s2 <- Prec -> RE Piece -> State (Set NI) Piece
go Prec
BotPrec RE Piece
s'

        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Piece -> Piece -> Piece -> Piece
rereletrecin Piece
v Piece
r2 Piece
s2

    go Prec
d (Let Name
n RE Piece
r RE (Var Piece)
s) = Bool -> State (Set NI) Piece -> State (Set NI) Piece
parens (Prec
d forall a. Ord a => a -> a -> Bool
> Prec
BotPrec) forall a b. (a -> b) -> a -> b
$ do
        Int
i <- Name -> State (Set NI) Int
newUnique Name
n
        let v :: Piece
v  = Name -> Int -> Piece
showVar Name
n Int
i
        let s' :: RE Piece
s' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall r a. r -> (a -> r) -> Var a -> r
unvar Piece
v forall a. a -> a
id) RE (Var Piece)
s

        Piece
r2 <- Prec -> RE Piece -> State (Set NI) Piece
go Prec
BotPrec RE Piece
r
        Piece
s2 <- Prec -> RE Piece -> State (Set NI) Piece
go Prec
BotPrec RE Piece
s'

        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Piece -> Piece -> Piece -> Piece
rereletin Piece
v Piece
r2 Piece
s2

    go Prec
d (Fix Name
n RE (Var Piece)
r) = Bool -> State (Set NI) Piece -> State (Set NI) Piece
parens (Prec
d forall a. Ord a => a -> a -> Bool
> Prec
BotPrec) forall a b. (a -> b) -> a -> b
$ do
        Int
i <- Name -> State (Set NI) Int
newUnique Name
n
        let v :: Piece
v  = Name -> Int -> Piece
showVar Name
n Int
i
        let r' :: RE Piece
r' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall r a. r -> (a -> r) -> Var a -> r
unvar Piece
v forall a. a -> a
id) RE (Var Piece)
r

        Piece
r'' <- Prec -> RE Piece -> State (Set NI) Piece
go Prec
BotPrec RE Piece
r'
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Piece -> Piece -> Piece
rerefix Piece
v Piece
r''


    goLet :: Piece -> RE Piece -> State (Set NI) Piece
    goLet :: Piece -> RE Piece -> State (Set NI) Piece
goLet Piece
acc0 (Let Name
n (Fix Name
_ RE (Var Piece)
r) RE (Var Piece)
s) = do
        Int
i <- Name -> State (Set NI) Int
newUnique Name
n
        let v :: Piece
v  = Name -> Int -> Piece
showVar Name
n Int
i
        let r' :: RE Piece
r' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall r a. r -> (a -> r) -> Var a -> r
unvar Piece
v forall a. a -> a
id) RE (Var Piece)
r
        let s' :: RE Piece
s' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall r a. r -> (a -> r) -> Var a -> r
unvar Piece
v forall a. a -> a
id) RE (Var Piece)
s

        Piece
r2 <- Prec -> RE Piece -> State (Set NI) Piece
go Prec
BotPrec RE Piece
r'

        let acc :: Piece
acc = Piece
acc0 forall a. Semigroup a => a -> a -> a
<> Piece -> Piece -> Piece
rereletreceqn Piece
v Piece
r2

        Piece -> RE Piece -> State (Set NI) Piece
goLet Piece
acc RE Piece
s'

    goLet Piece
acc0 (Let Name
n RE Piece
r RE (Var Piece)
s) = do
        Int
i <- Name -> State (Set NI) Int
newUnique Name
n
        let v :: Piece
v  = Name -> Int -> Piece
showVar Name
n Int
i
        let s' :: RE Piece
s' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall r a. r -> (a -> r) -> Var a -> r
unvar Piece
v forall a. a -> a
id) RE (Var Piece)
s

        Piece
r2 <- Prec -> RE Piece -> State (Set NI) Piece
go Prec
BotPrec RE Piece
r

        let acc :: Piece
acc = Piece
acc0 forall a. Semigroup a => a -> a -> a
<> Piece -> Piece -> Piece
rereleteqn Piece
v Piece
r2

        Piece -> RE Piece -> State (Set NI) Piece
goLet Piece
acc RE Piece
s'

    goLet Piece
acc RE Piece
s = do
        Piece
s' <- Prec -> RE Piece -> State (Set NI) Piece
go Prec
BotPrec RE Piece
s
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Piece
acc forall a. Semigroup a => a -> a -> a
<> Piece -> Piece
rereletbody Piece
s' forall a. Semigroup a => a -> a -> a
<> Piece
endrerealignedlet

    parens :: Bool -> State (Set NI) Piece -> State (Set NI) Piece
    parens :: Bool -> State (Set NI) Piece -> State (Set NI) Piece
parens Bool
True  = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ \(Piece Bool
_ Bool
_ ShowS
x) -> ShowS -> Piece
piece forall a b. (a -> b) -> a -> b
$ Char -> ShowS
showChar Char
'(' forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
')'
    parens Bool
False = forall a. a -> a
id

latexChar :: Char -> String
latexChar :: Char -> String
latexChar Char
c = forall a. (IsString a, Monoid a) => a -> a
rerelit (Char -> String
latexChar' Char
c)

latexChar' :: Char -> String
latexChar' :: Char -> String
latexChar' Char
'*'  = String
rerecharstar
latexChar' Char
'+'  = String
rerecharplus
latexChar' Char
'-'  = String
rerecharminus
latexChar' Char
'('  = String
rerecharpopen
latexChar' Char
')'  = String
rerecharpclose
latexChar' Char
'['  = String
rerecharbopen
latexChar' Char
']'  = String
rerecharbclose
latexChar' Char
'{'  = String
rerecharcopen
latexChar' Char
'}'  = String
rerecharcclose
latexChar' Char
'\\' = String
rerecharbackslash
latexChar' Char
'#'  = String
rerecharhash
latexChar' Char
'~'  = String
rerechartilde
latexChar' Char
' '  = String
rerecharspace
latexChar' Char
'&'  = String
rerecharampersand
latexChar' Char
'%'  = String
rerecharpercent
latexChar' Char
'_'  = String
rerecharunderscore
latexChar' Char
'^'  = String
rerecharhat
latexChar' Char
'$'  = String
rerechardollar
latexChar' Char
c
    | Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x20' Bool -> Bool -> Bool
|| Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\127' = ShowS
rerecharcode (forall a. Show a => a -> String
show (Char -> Int
ord Char
c))
    | Bool
otherwise                  = [Char
c]

latexCharPiece :: Char -> Piece
latexCharPiece :: Char -> Piece
latexCharPiece Char
c = forall a. IsString a => String -> a
fromString (Char -> String
latexChar Char
c)

latexCharRange :: (Char, Char) -> Piece
latexCharRange :: (Char, Char) -> Piece
latexCharRange (Char
lo, Char
hi)
    | Char
lo forall a. Eq a => a -> a -> Bool
== Char
hi  = Char -> Piece
latexCharPiece Char
lo
    | Bool
otherwise = forall a. (IsString a, Monoid a) => a -> a -> a
rerelitrange (Char -> Piece
latexCharPiece Char
lo) (Char -> Piece
latexCharPiece Char
hi)

data NI = NI String [Char] Int deriving (NI -> NI -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NI -> NI -> Bool
$c/= :: NI -> NI -> Bool
== :: NI -> NI -> Bool
$c== :: NI -> NI -> Bool
Eq, Eq NI
NI -> NI -> Bool
NI -> NI -> Ordering
NI -> NI -> NI
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NI -> NI -> NI
$cmin :: NI -> NI -> NI
max :: NI -> NI -> NI
$cmax :: NI -> NI -> NI
>= :: NI -> NI -> Bool
$c>= :: NI -> NI -> Bool
> :: NI -> NI -> Bool
$c> :: NI -> NI -> Bool
<= :: NI -> NI -> Bool
$c<= :: NI -> NI -> Bool
< :: NI -> NI -> Bool
$c< :: NI -> NI -> Bool
compare :: NI -> NI -> Ordering
$ccompare :: NI -> NI -> Ordering
Ord)

newUnique :: Name -> State (Set NI) Int
newUnique :: Name -> State (Set NI) Int
newUnique (N String
n String
cs) = forall (m :: * -> *) s. Monad m => StateT s m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Set NI -> State (Set NI) Int
go Int
0 where
    go :: Int -> Set NI -> State (Set NI) Int
go Int
i Set NI
s | forall a. Ord a => a -> Set a -> Bool
Set.member (String -> String -> Int -> NI
NI String
n String
cs Int
i) Set NI
s = Int -> Set NI -> State (Set NI) Int
go (Int
i forall a. Num a => a -> a -> a
+ Int
1) Set NI
s
           | Bool
otherwise = do
        forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (forall a. Ord a => a -> Set a -> Set a
Set.insert (String -> String -> Int -> NI
NI String
n String
cs Int
i) Set NI
s)
        forall (m :: * -> *) a. Monad m => a -> m a
return Int
i

latexString :: String -> String
latexString :: ShowS
latexString String
cs = forall a. (IsString a, Monoid a) => a -> a
rerestr (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
latexChar' String
cs)

showVar :: Name -> Int -> Piece
showVar :: Name -> Int -> Piece
showVar (N String
n String
cs) Int
i
    = Bool -> Bool -> ShowS -> Piece
Piece Bool
True Bool
True forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
var
  where
    cs' :: String
cs' = ShowS
latexString String
cs
    i' :: String
i'  = Int -> String
showI Int
i

    var :: String
    var :: String
var | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cs Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
i'             = forall a. (IsString a, Monoid a) => a -> a
rerevar String
n
        | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cs) Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
i') = forall a. (IsString a, Monoid a) => a -> a -> a -> a
rerevarsubsub String
n String
cs' String
i'
        | Bool
otherwise                      = forall a. (IsString a, Monoid a) => a -> a -> a
rerevarsub String
n (String
cs' forall a. Semigroup a => a -> a -> a
<> String
i')

    showI :: Int -> String
    showI :: Int -> String
showI Int
0 = String
""
    showI Int
j = forall a. Show a => a -> String
show Int
j

-------------------------------------------------------------------------------
-- Trace
-------------------------------------------------------------------------------

-- | Run 'match' variant, collect intermediate steps, and
-- pretty-print that trace.
--
putLatexTrace :: RE Void -> String -> IO ()
putLatexTrace :: RE Void -> String -> IO ()
putLatexTrace RE Void
re String
str = (Bool, RE Void, [(String, RE Void)]) -> IO ()
displayTrace (RE Void -> String -> (Bool, RE Void, [(String, RE Void)])
traced RE Void
re String
str)

traced :: RE Void -> String -> (Bool, RE Void, [(String, RE Void)])
traced :: RE Void -> String -> (Bool, RE Void, [(String, RE Void)])
traced = forall {c}.
([(String, RE Void)] -> c)
-> RE Void -> String -> (Bool, RE Void, c)
go forall a. a -> a
id where
    go :: ([(String, RE Void)] -> c)
-> RE Void -> String -> (Bool, RE Void, c)
go [(String, RE Void)] -> c
acc RE Void
re []         = (forall a. RE a -> Bool
nullable RE Void
re, RE Void
re, [(String, RE Void)] -> c
acc [])
    go [(String, RE Void)] -> c
acc RE Void
re str :: String
str@(Char
c:String
cs) = ([(String, RE Void)] -> c)
-> RE Void -> String -> (Bool, RE Void, c)
go ([(String, RE Void)] -> c
acc forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String
str, RE Void
re) forall a. a -> [a] -> [a]
:)) (Char -> RE Void -> RE Void
derivative Char
c RE Void
re) String
cs

putPieceLn :: Piece -> IO ()
putPieceLn :: Piece -> IO ()
putPieceLn = String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ String
"") forall b c a. (b -> c) -> (a -> b) -> a -> c
. Piece -> ShowS
unPiece

displayTrace :: (Bool, RE Void, [(String, RE Void)]) -> IO ()
displayTrace :: (Bool, RE Void, [(String, RE Void)]) -> IO ()
displayTrace (Bool
matched, RE Void
final, [(String, RE Void)]
steps) = do
    Piece -> IO ()
putPieceLn Piece
beginreretrace
    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(String, RE Void)]
steps forall a b. (a -> b) -> a -> b
$ \(String
str, RE Void
re) ->
        Piece -> IO ()
putPieceLn forall a b. (a -> b) -> a -> b
$ Maybe Piece -> String -> String -> Piece
reretraceline (forall a. a -> Maybe a
Just (forall {a} {p}. IsString a => p -> a
sub (forall a. RE a -> Bool
nullable RE Void
re))) (ShowS
latexString String
str) (RE Void -> String
latexify RE Void
re)
    Piece -> IO ()
putPieceLn forall a b. (a -> b) -> a -> b
$ Maybe Piece -> String -> String -> Piece
reretraceline (forall a. a -> Maybe a
Just (forall {a} {p}. IsString a => p -> a
sub Bool
matched)) forall a. (IsString a, Monoid a) => a
rereeps (RE Void -> String
latexify RE Void
final)
    Piece -> IO ()
putPieceLn Piece
endreretrace

    forall a. Show a => a -> IO ()
print Bool
matched
    forall a. Show a => a -> IO ()
print RE Void
final

  where
    -- sub True  = "_\\varepsilon"
    -- sub False = "_\\kappa"
    sub :: p -> a
sub p
_ = a
""

-------------------------------------------------------------------------------
-- CFG
-------------------------------------------------------------------------------

#ifndef RERE_NO_CFG
-- | Pretty-print 'CFG' given the names.
putLatexCFG :: Vec n Name -> CFG n Void -> IO ()
putLatexCFG :: forall (n :: Nat). Vec n Name -> CFG n Void -> IO ()
putLatexCFG Vec n Name
names CFG n Void
cfg = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Piece -> IO ()
putPieceLn (forall (n :: Nat). Vec n Name -> CFG n Void -> [Piece]
latexifyCfg Vec n Name
names CFG n Void
cfg)

latexifyCfg :: forall n. Vec n Name -> CFG n Void -> [Piece]
latexifyCfg :: forall (n :: Nat). Vec n Name -> CFG n Void -> [Piece]
latexifyCfg Vec n Name
names CFG n Void
cfg =
    [Piece
beginrerecfg] forall a. [a] -> [a] -> [a]
++ forall (m :: Nat). Vec m Name -> Vec m (CFGBase n Void) -> [Piece]
go Vec n Name
names CFG n Void
cfg forall a. [a] -> [a] -> [a]
++ [Piece
endrerecfg]
  where
    initS :: State (Set NI) ()
    initS :: State (Set NI) ()
initS = forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Vec n Name
names Name -> State (Set NI) Int
newUnique

    go :: Vec m Name -> Vec m (CFGBase n Void) -> [Piece]
    go :: forall (m :: Nat). Vec m Name -> Vec m (CFGBase n Void) -> [Piece]
go Vec m Name
VNil       Vec m (CFGBase n Void)
VNil       = []
    go (Name
n ::: Vec n1 Name
ns) (CFGBase n Void
e ::: Vec n1 (CFGBase n Void)
es) = Piece
eq' forall a. a -> [a] -> [a]
: forall (m :: Nat). Vec m Name -> Vec m (CFGBase n Void) -> [Piece]
go Vec n1 Name
ns Vec n1 (CFGBase n Void)
es where
        e' :: RE Piece
e' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\Fin n
i -> Name -> Int -> Piece
showVar (Vec n Name
names forall (n :: Nat) a. Vec n a -> Fin n -> a
V.! Fin n
i) Int
0) forall a b. Absurd a => a -> b
absurd) CFGBase n Void
e
        n' :: Piece
n' = Name -> Int -> Piece
showVar Name
n Int
0

        eq :: State (Set NI) Piece
eq = do
            State (Set NI) ()
initS
            Piece
e'' <- RE Piece -> State (Set NI) Piece
latexify' RE Piece
e'
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Piece -> Piece -> Piece
rerecfgproduction Piece
n' Piece
e''

        eq' :: Piece
        eq' :: Piece
eq' = forall s a. State s a -> s -> a
evalState State (Set NI) Piece
eq forall a. Set a
Set.empty
#if __GLASGOW_HASKELL__  <711
    go _ _ = error "silly GHC"
#endif
#endif