{-# 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 (String -> IO ()) -> (RE Void -> String) -> RE Void -> IO ()
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
(Prec -> Prec -> Bool) -> (Prec -> Prec -> Bool) -> Eq Prec
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
Eq Prec
-> (Prec -> Prec -> Ordering)
-> (Prec -> Prec -> Bool)
-> (Prec -> Prec -> Bool)
-> (Prec -> Prec -> Bool)
-> (Prec -> Prec -> Bool)
-> (Prec -> Prec -> Prec)
-> (Prec -> Prec -> Prec)
-> Ord 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
$cp1Ord :: Eq Prec
Ord, Int -> Prec
Prec -> Int
Prec -> [Prec]
Prec -> Prec
Prec -> Prec -> [Prec]
Prec -> Prec -> Prec -> [Prec]
(Prec -> Prec)
-> (Prec -> Prec)
-> (Int -> Prec)
-> (Prec -> Int)
-> (Prec -> [Prec])
-> (Prec -> Prec -> [Prec])
-> (Prec -> Prec -> [Prec])
-> (Prec -> Prec -> Prec -> [Prec])
-> Enum 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
(Int -> Prec -> ShowS)
-> (Prec -> String) -> ([Prec] -> ShowS) -> Show Prec
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 (ShowS -> Piece) -> (String -> ShowS) -> String -> 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 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
sep ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
y) where
        sep :: ShowS
sep | Bool
b, Bool
c      = String -> ShowS
showString String
forall a. (IsString a, Monoid a) => a
rerespace
            | Bool
otherwise = ShowS
forall a. a -> a
id

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

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

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

    wrap :: a -> a
wrap a
arg = a
"{" a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
arg a -> a -> a
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 (String -> Maybe Piece -> [Piece] -> Piece
forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
csname Maybe Piece
optarg ([Piece] -> Piece) -> (Piece -> [Piece]) -> Piece -> Piece
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Piece -> [Piece]
forall (m :: * -> *) a. Monad m => a -> m a
return) Piece
arg

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

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

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

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

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

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

rereintersect :: Piece -> Piece -> Piece
rereintersect :: Piece -> Piece -> Piece
rereintersect Piece
x Piece
y = String -> Maybe Piece -> [Piece] -> Piece
forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rereintersect" Maybe Piece
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" Maybe Piece
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 = String -> Maybe Piece -> [Piece] -> Piece
forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rereletreceqn" Maybe Piece
forall a. Maybe a
Nothing [Piece
x, Piece
y]

rereleteqn :: Piece -> Piece -> Piece
rereleteqn :: Piece -> Piece -> Piece
rereleteqn Piece
x Piece
y = String -> Maybe Piece -> [Piece] -> Piece
forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rereleteqn" Maybe Piece
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 = String -> Maybe Piece -> [Piece] -> Piece
forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rereletrecin" Maybe Piece
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 = String -> Maybe Piece -> [Piece] -> Piece
forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rereletin" Maybe Piece
forall a. Maybe a
Nothing [Piece
x, Piece
y, Piece
z]

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

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

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

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

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

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

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

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

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

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

rereeps :: (IsString a, Monoid a) => a
rereeps :: a
rereeps = String -> Maybe a -> [a] -> a
forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rereeps" Maybe a
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 = String -> Maybe Piece -> [Piece] -> Piece
forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"reretraceline" Maybe Piece
o [String -> Piece
forall a. IsString a => String -> a
fromString String
x, String -> Piece
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 = String -> Maybe Piece -> [Piece] -> Piece
forall a. (IsString a, Monoid a) => String -> Maybe a -> [a] -> a
latexCS String
"rerecfgproduction" Maybe Piece
forall a. Maybe a
Nothing [Piece
x, Piece
y]

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

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

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

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

epsPiece :: Piece
epsPiece :: Piece
epsPiece = Piece
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    = Piece -> State (Set NI) Piece
forall (m :: * -> *) a. Monad m => a -> m a
return Piece
nullPiece
    go Prec
_ RE Piece
Full    = Piece -> State (Set NI) Piece
forall (m :: * -> *) a. Monad m => a -> m a
return Piece
fullPiece
    go Prec
_ RE Piece
Eps     = Piece -> State (Set NI) Piece
forall (m :: * -> *) a. Monad m => a -> m a
return Piece
epsPiece
    go Prec
_ (Ch CharSet
cs) = Piece -> State (Set NI) Piece
forall (m :: * -> *) a. Monad m => a -> m a
return (Piece -> State (Set NI) Piece) -> Piece -> State (Set NI) Piece
forall a b. (a -> b) -> a -> b
$ case CharSet -> [(Char, Char)]
CS.toIntervalList CharSet
cs of
        []                   -> Piece
nullPiece
        [(Char
lo,Char
hi)] | Char
lo Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
hi -> Char -> Piece
latexCharPiece Char
lo
        [(Char, Char)]
xs | Int
sz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sz'        -> Piece -> Piece
forall a. (IsString a, Monoid a) => a -> a
rerelitset ([Piece] -> Piece
forall a. Monoid a => [a] -> a
mconcat (Piece -> [Piece] -> [Piece]
forall a. a -> [a] -> [a]
intersperse Piece
", " ([Piece] -> [Piece]) -> [Piece] -> [Piece]
forall a b. (a -> b) -> a -> b
$ ((Char, Char) -> Piece) -> [(Char, Char)] -> [Piece]
forall a b. (a -> b) -> [a] -> [b]
map (Char, Char) -> Piece
latexCharRange [(Char, Char)]
xs))
           | Bool
otherwise       -> Piece -> Piece
forall a. (IsString a, Monoid a) => a -> a
rerelitsetcomplement ([Piece] -> Piece
forall a. Monoid a => [a] -> a
mconcat (Piece -> [Piece] -> [Piece]
forall a. a -> [a] -> [a]
intersperse Piece
", " ([Piece] -> [Piece]) -> [Piece] -> [Piece]
forall a b. (a -> b) -> a -> b
$ ((Char, Char) -> Piece) -> [(Char, Char)] -> [Piece]
forall a b. (a -> b) -> [a] -> [b]
map (Char, Char) -> Piece
latexCharRange ([(Char, Char)] -> [Piece]) -> [(Char, Char)] -> [Piece]
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 Prec -> Prec -> Bool
forall a. Ord a => a -> a -> Bool
> Prec
AppPrec) (State (Set NI) Piece -> State (Set NI) Piece)
-> State (Set NI) Piece -> State (Set NI) Piece
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
        Piece -> State (Set NI) Piece
forall (m :: * -> *) a. Monad m => a -> m a
return (Piece -> State (Set NI) Piece) -> Piece -> State (Set NI) Piece
forall a b. (a -> b) -> a -> b
$ Piece
r' Piece -> Piece -> Piece
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 Prec -> Prec -> Bool
forall a. Ord a => a -> a -> Bool
> Prec
AltPrec) (State (Set NI) Piece -> State (Set NI) Piece)
-> State (Set NI) Piece -> State (Set NI) Piece
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
        Piece -> State (Set NI) Piece
forall (m :: * -> *) a. Monad m => a -> m a
return (Piece -> State (Set NI) Piece) -> Piece -> State (Set NI) Piece
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 Prec -> Prec -> Bool
forall a. Ord a => a -> a -> Bool
> Prec
StarPrec) (State (Set NI) Piece -> State (Set NI) Piece)
-> State (Set NI) Piece -> State (Set NI) Piece
forall a b. (a -> b) -> a -> b
$ do
        Piece
r' <- Prec -> RE Piece -> State (Set NI) Piece
go Prec
StarPrec RE Piece
r
        Piece -> State (Set NI) Piece
forall (m :: * -> *) a. Monad m => a -> m a
return (Piece -> State (Set NI) Piece) -> Piece -> State (Set NI) Piece
forall a b. (a -> b) -> a -> b
$ Piece -> Piece
rerestar Piece
r'

    go Prec
_ (Var Piece
x) = Piece -> State (Set NI) Piece
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 Prec -> Prec -> Bool
forall a. Ord a => a -> a -> Bool
> Prec
BotPrec) (State (Set NI) Piece -> State (Set NI) Piece)
-> State (Set NI) Piece -> State (Set NI) Piece
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' = (Var Piece -> Piece) -> RE (Var Piece) -> RE Piece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Piece -> (Piece -> Piece) -> Var Piece -> Piece
forall r a. r -> (a -> r) -> Var a -> r
unvar Piece
v Piece -> Piece
forall a. a -> a
id) RE (Var Piece)
r
        let s' :: RE Piece
s' = (Var Piece -> Piece) -> RE (Var Piece) -> RE Piece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Piece -> (Piece -> Piece) -> Var Piece -> Piece
forall r a. r -> (a -> r) -> Var a -> r
unvar Piece
v Piece -> Piece
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 Piece -> Piece -> Piece
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 Prec -> Prec -> Bool
forall a. Ord a => a -> a -> Bool
> Prec
BotPrec) (State (Set NI) Piece -> State (Set NI) Piece)
-> State (Set NI) Piece -> State (Set NI) Piece
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' = (Var Piece -> Piece) -> RE (Var Piece) -> RE Piece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Piece -> (Piece -> Piece) -> Var Piece -> Piece
forall r a. r -> (a -> r) -> Var a -> r
unvar Piece
v Piece -> Piece
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 Piece -> Piece -> Piece
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 Prec -> Prec -> Bool
forall a. Ord a => a -> a -> Bool
> Prec
BotPrec) (State (Set NI) Piece -> State (Set NI) Piece)
-> State (Set NI) Piece -> State (Set NI) Piece
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' = (Var Piece -> Piece) -> RE (Var Piece) -> RE Piece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Piece -> (Piece -> Piece) -> Var Piece -> Piece
forall r a. r -> (a -> r) -> Var a -> r
unvar Piece
v Piece -> Piece
forall a. a -> a
id) RE (Var Piece)
r
        let s' :: RE Piece
s' = (Var Piece -> Piece) -> RE (Var Piece) -> RE Piece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Piece -> (Piece -> Piece) -> Var Piece -> Piece
forall r a. r -> (a -> r) -> Var a -> r
unvar Piece
v Piece -> Piece
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'

        Piece -> State (Set NI) Piece
forall (m :: * -> *) a. Monad m => a -> m a
return (Piece -> State (Set NI) Piece) -> Piece -> State (Set NI) Piece
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 Prec -> Prec -> Bool
forall a. Ord a => a -> a -> Bool
> Prec
BotPrec) (State (Set NI) Piece -> State (Set NI) Piece)
-> State (Set NI) Piece -> State (Set NI) Piece
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' = (Var Piece -> Piece) -> RE (Var Piece) -> RE Piece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Piece -> (Piece -> Piece) -> Var Piece -> Piece
forall r a. r -> (a -> r) -> Var a -> r
unvar Piece
v Piece -> Piece
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'

        Piece -> State (Set NI) Piece
forall (m :: * -> *) a. Monad m => a -> m a
return (Piece -> State (Set NI) Piece) -> Piece -> State (Set NI) Piece
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 Prec -> Prec -> Bool
forall a. Ord a => a -> a -> Bool
> Prec
BotPrec) (State (Set NI) Piece -> State (Set NI) Piece)
-> State (Set NI) Piece -> State (Set NI) Piece
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' = (Var Piece -> Piece) -> RE (Var Piece) -> RE Piece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Piece -> (Piece -> Piece) -> Var Piece -> Piece
forall r a. r -> (a -> r) -> Var a -> r
unvar Piece
v Piece -> Piece
forall a. a -> a
id) RE (Var Piece)
r

        Piece
r'' <- Prec -> RE Piece -> State (Set NI) Piece
go Prec
BotPrec RE Piece
r'
        Piece -> State (Set NI) Piece
forall (m :: * -> *) a. Monad m => a -> m a
return (Piece -> State (Set NI) Piece) -> Piece -> State (Set NI) Piece
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' = (Var Piece -> Piece) -> RE (Var Piece) -> RE Piece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Piece -> (Piece -> Piece) -> Var Piece -> Piece
forall r a. r -> (a -> r) -> Var a -> r
unvar Piece
v Piece -> Piece
forall a. a -> a
id) RE (Var Piece)
r
        let s' :: RE Piece
s' = (Var Piece -> Piece) -> RE (Var Piece) -> RE Piece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Piece -> (Piece -> Piece) -> Var Piece -> Piece
forall r a. r -> (a -> r) -> Var a -> r
unvar Piece
v Piece -> Piece
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 Piece -> Piece -> Piece
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' = (Var Piece -> Piece) -> RE (Var Piece) -> RE Piece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Piece -> (Piece -> Piece) -> Var Piece -> Piece
forall r a. r -> (a -> r) -> Var a -> r
unvar Piece
v Piece -> Piece
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 Piece -> Piece -> Piece
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
        Piece -> State (Set NI) Piece
forall (m :: * -> *) a. Monad m => a -> m a
return (Piece -> State (Set NI) Piece) -> Piece -> State (Set NI) Piece
forall a b. (a -> b) -> a -> b
$ Piece
acc Piece -> Piece -> Piece
forall a. Semigroup a => a -> a -> a
<> Piece -> Piece
rereletbody Piece
s' Piece -> Piece -> Piece
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  = (Piece -> Piece) -> State (Set NI) Piece -> State (Set NI) Piece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Piece -> Piece) -> State (Set NI) Piece -> State (Set NI) Piece)
-> (Piece -> Piece) -> State (Set NI) Piece -> State (Set NI) Piece
forall a b. (a -> b) -> a -> b
$ \(Piece Bool
_ Bool
_ ShowS
x) -> ShowS -> Piece
piece (ShowS -> Piece) -> ShowS -> Piece
forall a b. (a -> b) -> a -> b
$ Char -> ShowS
showChar Char
'(' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
')'
    parens Bool
False = State (Set NI) Piece -> State (Set NI) Piece
forall a. a -> a
id

latexChar :: Char -> String
latexChar :: Char -> String
latexChar Char
c = ShowS
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 Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x20' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\127' = ShowS
rerecharcode (Int -> String
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 = String -> Piece
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
hi  = Char -> Piece
latexCharPiece Char
lo
    | Bool
otherwise = Piece -> Piece -> Piece
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
(NI -> NI -> Bool) -> (NI -> NI -> Bool) -> Eq NI
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
Eq NI
-> (NI -> NI -> Ordering)
-> (NI -> NI -> Bool)
-> (NI -> NI -> Bool)
-> (NI -> NI -> Bool)
-> (NI -> NI -> Bool)
-> (NI -> NI -> NI)
-> (NI -> NI -> NI)
-> Ord 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
$cp1Ord :: Eq NI
Ord)

newUnique :: Name -> State (Set NI) Int
newUnique :: Name -> State (Set NI) Int
newUnique (N String
n String
cs) = StateT (Set NI) Identity (Set NI)
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT (Set NI) Identity (Set NI)
-> (Set NI -> State (Set NI) Int) -> State (Set NI) Int
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 | NI -> Set NI -> Bool
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Set NI
s
           | Bool
otherwise = do
        Set NI -> StateT (Set NI) Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (NI -> Set NI -> Set NI
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)
        Int -> State (Set NI) Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i

latexString :: String -> String
latexString :: ShowS
latexString String
cs = ShowS
forall a. (IsString a, Monoid a) => a -> a
rerestr ((Char -> String) -> ShowS
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 (ShowS -> Piece) -> ShowS -> Piece
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 | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cs Bool -> Bool -> Bool
&& String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
i'             = ShowS
forall a. (IsString a, Monoid a) => a -> a
rerevar String
n
        | Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cs) Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
i') = String -> String -> ShowS
forall a. (IsString a, Monoid a) => a -> a -> a -> a
rerevarsubsub String
n String
cs' String
i'
        | Bool
otherwise                      = String -> ShowS
forall a. (IsString a, Monoid a) => a -> a -> a
rerevarsub String
n (String
cs' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
i')

    showI :: Int -> String
    showI :: Int -> String
showI Int
0 = String
""
    showI Int
j = Int -> String
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 = ([(String, RE Void)] -> [(String, RE Void)])
-> RE Void -> String -> (Bool, RE Void, [(String, RE Void)])
forall c.
([(String, RE Void)] -> c)
-> RE Void -> String -> (Bool, RE Void, c)
go [(String, RE Void)] -> [(String, RE Void)]
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 []         = (RE Void -> Bool
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 ([(String, RE Void)] -> c)
-> ([(String, RE Void)] -> [(String, RE Void)])
-> [(String, RE Void)]
-> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String
str, RE Void
re) (String, RE Void) -> [(String, RE Void)] -> [(String, RE Void)]
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 (String -> IO ()) -> (Piece -> String) -> Piece -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"") (ShowS -> String) -> (Piece -> ShowS) -> Piece -> 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
    [(String, RE Void)] -> ((String, RE Void) -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(String, RE Void)]
steps (((String, RE Void) -> IO ()) -> IO ())
-> ((String, RE Void) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(String
str, RE Void
re) ->
        Piece -> IO ()
putPieceLn (Piece -> IO ()) -> Piece -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Piece -> String -> String -> Piece
reretraceline (Piece -> Maybe Piece
forall a. a -> Maybe a
Just (Bool -> Piece
forall p p. IsString p => p -> p
sub (RE Void -> Bool
forall a. RE a -> Bool
nullable RE Void
re))) (ShowS
latexString String
str) (RE Void -> String
latexify RE Void
re)
    Piece -> IO ()
putPieceLn (Piece -> IO ()) -> Piece -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Piece -> String -> String -> Piece
reretraceline (Piece -> Maybe Piece
forall a. a -> Maybe a
Just (Bool -> Piece
forall p p. IsString p => p -> p
sub Bool
matched)) String
forall a. (IsString a, Monoid a) => a
rereeps (RE Void -> String
latexify RE Void
final)
    Piece -> IO ()
putPieceLn Piece
endreretrace

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

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

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

#ifndef RERE_NO_CFG
-- | Pretty-print 'CFG' given the names.
putLatexCFG :: Vec n Name -> CFG n Void -> IO ()
putLatexCFG :: Vec n Name -> CFG n Void -> IO ()
putLatexCFG Vec n Name
names CFG n Void
cfg = (Piece -> IO ()) -> [Piece] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Piece -> IO ()
putPieceLn (Vec n Name -> CFG n Void -> [Piece]
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 :: Vec n Name -> CFG n Void -> [Piece]
latexifyCfg Vec n Name
names CFG n Void
cfg =
    [Piece
beginrerecfg] [Piece] -> [Piece] -> [Piece]
forall a. [a] -> [a] -> [a]
++ Vec n Name -> CFG n Void -> [Piece]
forall (m :: Nat). Vec m Name -> Vec m (CFGBase n Void) -> [Piece]
go Vec n Name
names CFG n Void
cfg [Piece] -> [Piece] -> [Piece]
forall a. [a] -> [a] -> [a]
++ [Piece
endrerecfg]
  where
    initS :: State (Set NI) ()
    initS :: StateT (Set NI) Identity ()
initS = Vec n Name
-> (Name -> State (Set NI) Int) -> StateT (Set NI) Identity ()
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 :: 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' Piece -> [Piece] -> [Piece]
forall a. a -> [a] -> [a]
: Vec n1 Name -> Vec n1 (CFGBase n Void) -> [Piece]
forall (m :: Nat). Vec m Name -> Vec m (CFGBase n Void) -> [Piece]
go Vec n1 Name
ns Vec n1 (CFGBase n Void)
Vec n1 (CFGBase n Void)
es where
        e' :: RE Piece
e' = (Either (Fin n) Void -> Piece) -> CFGBase n Void -> RE Piece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Fin n -> Piece) -> (Void -> Piece) -> Either (Fin n) Void -> Piece
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\Fin n
i -> Name -> Int -> Piece
showVar (Vec n Name
names Vec n Name -> Fin n -> Name
forall (n :: Nat) a. Vec n a -> Fin n -> a
V.! Fin n
i) Int
0) Void -> Piece
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
            StateT (Set NI) Identity ()
initS
            Piece
e'' <- RE Piece -> State (Set NI) Piece
latexify' RE Piece
e'
            Piece -> State (Set NI) Piece
forall (m :: * -> *) a. Monad m => a -> m a
return (Piece -> State (Set NI) Piece) -> Piece -> State (Set NI) Piece
forall a b. (a -> b) -> a -> b
$ Piece -> Piece -> Piece
rerecfgproduction Piece
n' Piece
e''

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