{-# 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
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
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
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)
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
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
[ 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'
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
putLatexTrace :: RE Void -> String -> IO ()
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 :: p -> a
sub p
_ = a
""
#ifndef RERE_NO_CFG
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