{-# LANGUAGE CPP                 #-}
-- #define RERE_DEBUG

{-# LANGUAGE ScopedTypeVariables #-}

#ifdef RERE_DEBUG
#if __GLASGOW_HASKELL__ >=702
{-# LANGUAGE Trustworthy         #-}
#endif
#else
#if __GLASGOW_HASKELL__ >=710
{-# LANGUAGE Safe                #-}
#elif __GLASGOW_HASKELL__ >=702
{-# LANGUAGE Trustworthy         #-}
#endif
#endif

-- | Regular expression with explicit sharing.
--
-- 'RST' is an opaque type, to maintain the invariants.
module RERE.ST (
    RST,
    matchST,
    matchDebugST,
    ) where

#ifdef RERE_DEBUG
import Debug.Trace
#endif

import Control.Monad.Fix         (mfix)
import Control.Monad.Trans.State (State, evalState, get, modify, put, runState)
import Data.Void                 (Void, vacuous)
import Data.Word                 (Word64)

import qualified Data.Map as Map
import qualified Data.Set as Set

import           RERE.CharClasses
import qualified RERE.CharSet     as CS
import qualified RERE.Type        as R
import           RERE.Var

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$), (<$>), (<*>))
#endif

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

import Control.Monad.ST
import Data.STRef

-- Alt (Ch "b") (Alt (App (Alt (Star (Ch "c")) (Ch "c")) Full) (Ch "de"))
-- Alt Null (App Eps Full)

-------------------------------------------------------------------------------
-- Parameters
-------------------------------------------------------------------------------

matchIter :: Int
matchIter :: Int
matchIter = Int
20

nullableIter :: Int
nullableIter :: Int
nullableIter = Int
10

-------------------------------------------------------------------------------
-- Type
-------------------------------------------------------------------------------

-- | Knot-tied recursive regular expression.
data RST s = RST
    { forall s. RST s -> Def s
_rrDef        :: Def s
    , forall s. RST s -> Word64
_rrId         :: !Word64
    ,  forall s. RST s -> Char -> ST s (RST s)
rrDerivative :: !(Char -> ST s (RST s))
    ,  forall s. RST s -> ST s (RST s)
rrCompact    :: !(ST s (RST s))
    }

data Def s
    = Eps
    | Full
    | Ch CS.CharSet
    | App (RST s) (RST s)
    | Alt (RST s) (RST s)
#ifdef RERE_INTERSECTION
    | And (RST s) (RST s)
#endif
    | Star (RST s)

    | Del (RST s)

-------------------------------------------------------------------------------
-- Make
-------------------------------------------------------------------------------

data Ctx s = Ctx
    { forall s. Ctx s -> STRef s Word64
ctxId  :: STRef s Word64
    , forall s. Ctx s -> RST s
ctxNull :: RST s
    , forall s. Ctx s -> RST s
ctxFull :: RST s
    , forall s. Ctx s -> RST s
ctxEps  :: RST s
    }

newCtx :: ST s (Ctx s)
newCtx :: forall s. ST s (Ctx s)
newCtx = do
    STRef s Word64
i <- forall a s. a -> ST s (STRef s a)
newSTRef Word64
3
    let n :: RST s
n = forall s.
Def s -> Word64 -> (Char -> ST s (RST s)) -> ST s (RST s) -> RST s
RST (forall s. CharSet -> Def s
Ch CharSet
CS.empty) Word64
0 (\Char
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return RST s
n) (forall (m :: * -> *) a. Monad m => a -> m a
return RST s
n)
    let f :: RST s
f = forall s.
Def s -> Word64 -> (Char -> ST s (RST s)) -> ST s (RST s) -> RST s
RST forall s. Def s
Full          Word64
1 (\Char
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return RST s
f) (forall (m :: * -> *) a. Monad m => a -> m a
return RST s
f)
        e :: RST s
e = forall s.
Def s -> Word64 -> (Char -> ST s (RST s)) -> ST s (RST s) -> RST s
RST forall s. Def s
Eps           Word64
2 (\Char
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall {s}. RST s
n) (forall (m :: * -> *) a. Monad m => a -> m a
return RST s
e)

    forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. STRef s Word64 -> RST s -> RST s -> RST s -> Ctx s
Ctx STRef s Word64
i forall {s}. RST s
n forall {s}. RST s
f forall {s}. RST s
e)

makeRST :: Ctx s -> Def s -> ST s (RST s)
makeRST :: forall s. Ctx s -> Def s -> ST s (RST s)
makeRST Ctx s
ctx Def s
def = do
    Word64
i <- forall s a. STRef s a -> ST s a
readSTRef (forall s. Ctx s -> STRef s Word64
ctxId Ctx s
ctx)
    forall s a. STRef s a -> a -> ST s ()
writeSTRef (forall s. Ctx s -> STRef s Word64
ctxId Ctx s
ctx) (Word64
i forall a. Num a => a -> a -> a
+ Word64
1)
    STRef s (Map Char (RST s))
dref <- forall a s. a -> ST s (STRef s a)
newSTRef forall k a. Map k a
Map.empty
    STRef s (Maybe (RST s))
cref <- forall a s. a -> ST s (STRef s a)
newSTRef forall a. Maybe a
Nothing

    let d :: Char -> ST s (RST s)
d Char
ch = do
            Map Char (RST s)
m <- forall s a. STRef s a -> ST s a
readSTRef STRef s (Map Char (RST s))
dref
            case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Char
ch Map Char (RST s)
m of
                Just RST s
x -> forall (m :: * -> *) a. Monad m => a -> m a
return RST s
x
                Maybe (RST s)
Nothing -> forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix forall a b. (a -> b) -> a -> b
$ \RST s
deriv -> do
                    forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (Map Char (RST s))
dref (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Char
ch RST s
deriv Map Char (RST s)
m)
                    forall s. Ctx s -> Char -> Def s -> ST s (RST s)
derivativeDef Ctx s
ctx Char
ch Def s
def

    let c :: ST s (RST s)
c = do
          Maybe (RST s)
mcompacted <- forall s a. STRef s a -> ST s a
readSTRef STRef s (Maybe (RST s))
cref
          case Maybe (RST s)
mcompacted of
              Just RST s
compacted -> forall (m :: * -> *) a. Monad m => a -> m a
return RST s
compacted
              Maybe (RST s)
Nothing        -> forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix forall a b. (a -> b) -> a -> b
$ \RST s
compacted -> do
                  forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (Maybe (RST s))
cref (forall a. a -> Maybe a
Just RST s
compacted)
                  forall s. Ctx s -> Def s -> ST s (RST s)
compactDef Ctx s
ctx Def s
def

    forall (m :: * -> *) a. Monad m => a -> m a
return (forall s.
Def s -> Word64 -> (Char -> ST s (RST s)) -> ST s (RST s) -> RST s
RST Def s
def Word64
i Char -> ST s (RST s)
d ST s (RST s)
c)

-------------------------------------------------------------------------------
-- Show
-------------------------------------------------------------------------------

instance Show (RST s) where
    showsPrec :: Int -> RST s -> ShowS
showsPrec = Set Word64 -> Int -> RST s -> ShowS
go forall a. Set a
Set.empty where
        go :: Set.Set Word64 -> Int -> RST s -> ShowS
        go :: Set Word64 -> Int -> RST s -> ShowS
go Set Word64
past Int
d (RST Def s
def Word64
i Char -> ST s (RST s)
_ ST s (RST s)
_) =
            if forall a. Ord a => a -> Set a -> Bool
Set.member Word64
i Set Word64
past
            then String -> ShowS
showString String
"<<loop " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Word64
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
">>"
            else Set Word64 -> Int -> Word64 -> Def s -> ShowS
go' (forall a. Ord a => a -> Set a -> Set a
Set.insert Word64
i Set Word64
past) Int
d Word64
i Def s
def

        go' :: Set.Set Word64 -> Int -> Word64 -> Def s -> ShowS
        go' :: Set Word64 -> Int -> Word64 -> Def s -> ShowS
go' Set Word64
_    Int
_ Word64
_ Def s
Eps       = String -> ShowS
showString String
"Eps"
        go' Set Word64
_    Int
_ Word64
_ Def s
Full      = String -> ShowS
showString String
"Full"
        go' Set Word64
_    Int
d Word64
_ (Ch CharSet
c)    = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Ch " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 CharSet
c
        go' Set Word64
past Int
d Word64
i (App RST s
r RST s
s)
            = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10)
            forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"App"
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
showSub Word64
i
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Word64 -> Int -> RST s -> ShowS
go Set Word64
past Int
11 RST s
r
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Word64 -> Int -> RST s -> ShowS
go Set Word64
past Int
11 RST s
s
        go' Set Word64
past Int
d Word64
i (Alt RST s
r RST s
s)
            = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10)
            forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Alt"
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
showSub Word64
i
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Word64 -> Int -> RST s -> ShowS
go Set Word64
past Int
11 RST s
r
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Word64 -> Int -> RST s -> ShowS
go Set Word64
past Int
11 RST s
s
#ifdef RERE_INTERSECTION
        go' past d i (And r s)
            = showParen (d > 10)
            $ showString "And"
            . showSub i
            . showChar ' ' . go past 11 r
            . showChar ' ' . go past 11 s
#endif
        go' Set Word64
past Int
d Word64
i (Star RST s
r)
            = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10)
            forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Star"
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
showSub Word64
i
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Word64 -> Int -> RST s -> ShowS
go Set Word64
past Int
11 RST s
r

        go' Set Word64
past Int
d Word64
i (Del RST s
r)
            = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10)
            forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Del"
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
showSub Word64
i
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Word64 -> Int -> RST s -> ShowS
go Set Word64
past Int
11 RST s
r

        showSub :: a -> ShowS
showSub a
i = Char -> ShowS
showChar Char
'_' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows a
i

_size :: RST s -> Int
_size :: forall s. RST s -> Int
_size RST s
rr = forall s a. State s a -> s -> a
evalState (forall {m :: * -> *} {b} {s}.
(Monad m, Num b, Enum b) =>
RST s -> StateT (Set Word64) m b
go RST s
rr) forall a. Set a
Set.empty where
    go :: RST s -> StateT (Set Word64) m b
go (RST Def s
def Word64
i Char -> ST s (RST s)
_ ST s (RST s)
_) = do
        Set Word64
visited <- forall (m :: * -> *) s. Monad m => StateT s m s
get
        if forall a. Ord a => a -> Set a -> Bool
Set.member Word64
i Set Word64
visited
        then forall (m :: * -> *) a. Monad m => a -> m a
return b
1
        else do
            forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (forall a. Ord a => a -> Set a -> Set a
Set.insert Word64
i Set Word64
visited)
            forall a. Enum a => a -> a
succ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Def s -> StateT (Set Word64) m b
go' Def s
def

    go' :: Def s -> StateT (Set Word64) m b
go' Def s
Eps       = forall (m :: * -> *) a. Monad m => a -> m a
return b
0
    go' Def s
Full      = forall (m :: * -> *) a. Monad m => a -> m a
return b
0
    go' (Ch CharSet
_)    = forall (m :: * -> *) a. Monad m => a -> m a
return b
0
    go' (App RST s
r RST s
s) = forall {a}. (Enum a, Num a) => a -> a -> a
plus1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RST s -> StateT (Set Word64) m b
go RST s
r forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RST s -> StateT (Set Word64) m b
go RST s
s
    go' (Alt RST s
r RST s
s) = forall {a}. (Enum a, Num a) => a -> a -> a
plus1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RST s -> StateT (Set Word64) m b
go RST s
r forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RST s -> StateT (Set Word64) m b
go RST s
s
#ifdef RERE_INTERSECTION
    go' (And r s) = plus1 <$> go r <*> go s
#endif
    go' (Star RST s
r)  = forall a. Enum a => a -> a
succ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RST s -> StateT (Set Word64) m b
go RST s
r
    go' (Del RST s
r)   = forall a. Enum a => a -> a
succ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RST s -> StateT (Set Word64) m b
go RST s
r

    plus1 :: a -> a -> a
plus1 a
x a
y = forall a. Enum a => a -> a
succ (a
x forall a. Num a => a -> a -> a
+ a
y)

-------------------------------------------------------------------------------
-- Conversion
-------------------------------------------------------------------------------

-- | Convert 'R.RE' to 'RST'.
fromRE :: forall s. Ctx s -> R.RE Void -> ST s (RST s)
fromRE :: forall s. Ctx s -> RE Void -> ST s (RST s)
fromRE Ctx s
ctx RE Void
re = RE (RST s) -> ST s (RST s)
go (forall (f :: * -> *) a. Functor f => f Void -> f a
vacuous RE Void
re) where
    go :: R.RE (RST s) -> ST s (RST s)

    go :: RE (RST s) -> ST s (RST s)
go RE (RST s)
R.Null   = forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Ctx s -> RST s
ctxNull Ctx s
ctx)
    go RE (RST s)
R.Full   = forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Ctx s -> RST s
ctxFull Ctx s
ctx)
    go RE (RST s)
R.Eps    = forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Ctx s -> RST s
ctxEps Ctx s
ctx)
    go (R.Ch CharSet
c)
        | CharSet -> Bool
CS.null CharSet
c = forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Ctx s -> RST s
ctxNull Ctx s
ctx)
        | Bool
otherwise = forall s. Ctx s -> Def s -> ST s (RST s)
makeRST Ctx s
ctx (forall s. CharSet -> Def s
Ch CharSet
c)

    go (R.App RE (RST s)
r RE (RST s)
s) = do
        RST s
r' <- RE (RST s) -> ST s (RST s)
go RE (RST s)
r
        RST s
s' <- RE (RST s) -> ST s (RST s)
go RE (RST s)
s
        forall s. Ctx s -> Def s -> ST s (RST s)
makeRST Ctx s
ctx (forall s. RST s -> RST s -> Def s
App RST s
r' RST s
s')

    go (R.Alt RE (RST s)
r RE (RST s)
s) = do
        RST s
r' <- RE (RST s) -> ST s (RST s)
go RE (RST s)
r
        RST s
s' <- RE (RST s) -> ST s (RST s)
go RE (RST s)
s
        forall s. Ctx s -> Def s -> ST s (RST s)
makeRST Ctx s
ctx (forall s. RST s -> RST s -> Def s
Alt RST s
r' RST s
s')

#ifdef RERE_INTERSECTION
    go (R.And r s) = do
        r' <- go r
        s' <- go s
        makeRST ctx (And r' s')
#endif

    go (R.Star RE (RST s)
r) = do
        RST s
r' <- RE (RST s) -> ST s (RST s)
go RE (RST s)
r
        forall s. Ctx s -> Def s -> ST s (RST s)
makeRST Ctx s
ctx (forall s. RST s -> Def s
Star RST s
r')

    go (R.Var RST s
r) = forall (m :: * -> *) a. Monad m => a -> m a
return RST s
r

    go (R.Let Name
_ RE (RST s)
r RE (Var (RST s))
s) = do
        RST s
r' <- RE (RST s) -> ST s (RST s)
go RE (RST s)
r
        RE (RST s) -> ST s (RST s)
go (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall r a. r -> (a -> r) -> Var a -> r
unvar RST s
r' forall a. a -> a
id) RE (Var (RST s))
s)

    go (R.Fix Name
_ RE (Var (RST s))
r) = forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix forall a b. (a -> b) -> a -> b
$ \RST s
res -> do
        RE (RST s) -> ST s (RST s)
go (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall r a. r -> (a -> r) -> Var a -> r
unvar RST s
res forall a. a -> a
id) RE (Var (RST s))
r)

-------------------------------------------------------------------------------
-- Match
-------------------------------------------------------------------------------

-- | Convert 'R.RE' to 'RST' and then match.
--
-- Significantly faster than 'RERE.Type.match'.
matchST :: R.RE Void -> String -> Bool
matchST :: RE Void -> String -> Bool
matchST RE Void
re String
str = forall a. (forall s. ST s a) -> a
runST forall s. ST s Bool
go0
  where
    go0 :: ST s Bool
    go0 :: forall s. ST s Bool
go0 = do
        Ctx s
ctx <- forall s. ST s (Ctx s)
newCtx
        RST s
rr <- forall s. Ctx s -> RE Void -> ST s (RST s)
fromRE Ctx s
ctx RE Void
re
        let cc :: CharClasses
cc = forall a. RE a -> CharClasses
charClasses RE Void
re
        forall s. Ctx s -> CharClasses -> String -> RST s -> ST s Bool
go Ctx s
ctx CharClasses
cc String
str RST s
rr

    go :: Ctx s -> CharClasses -> String -> RST s -> ST s Bool
    go :: forall s. Ctx s -> CharClasses -> String -> RST s -> ST s Bool
go Ctx s
ctx CharClasses
_  []     RST s
rr = forall s. Ctx s -> RST s -> ST s Bool
nullableR' Ctx s
ctx RST s
rr
    go Ctx s
ctx CharClasses
cc (Char
c:String
cs) RST s
rr = do
        let c' :: Char
c' = CharClasses -> Char -> Char
classOfChar CharClasses
cc Char
c
        RST s
rr' <- forall s. Char -> RST s -> ST s (RST s)
derivativeR Char
c' RST s
rr
        RST s
rr'' <- forall s. Int -> RST s -> ST s (RST s)
compactRN Int
matchIter RST s
rr'
#ifdef RERE_DEBUG
        let size1 = _size rr'
            size2 = _size rr''
        traceM ("size: " ++ show size1 ++ " ~> " ++ show size2)
        if size1 < size2
        then traceM (show rr')
        else pure ()
#endif
        forall s. Ctx s -> CharClasses -> String -> RST s -> ST s Bool
go Ctx s
ctx CharClasses
cc String
cs RST s
rr''

-- | Match and print final 'RR' + stats.
matchDebugST :: R.RE Void -> String -> IO ()
matchDebugST :: RE Void -> String -> IO ()
matchDebugST RE Void
re String
str = forall a. (forall s. ST s a) -> a
runST forall s. ST s (IO ())
go0 where
    go0 :: ST s (IO ())
    go0 :: forall s. ST s (IO ())
go0 = do
        Ctx s
ctx <- forall s. ST s (Ctx s)
newCtx
        RST s
rr <- forall s. Ctx s -> RE Void -> ST s (RST s)
fromRE Ctx s
ctx RE Void
re
        forall s. Ctx s -> String -> RST s -> ST s (IO ())
go Ctx s
ctx String
str RST s
rr

    go :: Ctx s -> String -> RST s -> ST s (IO ())
    go :: forall s. Ctx s -> String -> RST s -> ST s (IO ())
go Ctx s
ctx [] RST s
rr = do
        Bool
n <- forall s. Ctx s -> RST s -> ST s Bool
nullableR' Ctx s
ctx RST s
rr

        -- rn <- makeRST ctx (Del rr)
        -- (rn', trace) <- compactRTrace nullableIter rn

        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStr forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
            [ String
"size: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall s. RST s -> Int
_size RST s
rr)
            , String
"show: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show RST s
rr
            , String
"null: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Bool
n
            ]
            {-
            , "nul2: " ++ show (nullableR rr)
            , "dels: " ++ show rn'
            ] ++
            [ "    - " ++ show t
            | t <- trace
            ]
            -}

    go Ctx s
ctx (Char
c:String
cs) RST s
rr = do
        RST s
rr' <- forall s. Char -> RST s -> ST s (RST s)
derivativeR Char
c RST s
rr
        RST s
rr'' <- forall s. Int -> RST s -> ST s (RST s)
compactRN Int
matchIter RST s
rr'
        forall s. Ctx s -> String -> RST s -> ST s (IO ())
go Ctx s
ctx String
cs RST s
rr''


-------------------------------------------------------------------------------
-- Compact
-------------------------------------------------------------------------------

compactR :: RST s -> ST s (RST s)
compactR :: forall s. RST s -> ST s (RST s)
compactR = forall s. RST s -> ST s (RST s)
rrCompact

compactDef :: Ctx s -> Def s -> ST s (RST s)
compactDef :: forall s. Ctx s -> Def s -> ST s (RST s)
compactDef Ctx s
ctx Def s
r0 = case Def s
r0 of
    Def s
Eps  -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Ctx s -> RST s
ctxEps Ctx s
ctx)
    Def s
Full -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Ctx s -> RST s
ctxFull Ctx s
ctx)
    Ch CharSet
cs | CharSet -> Bool
CS.null CharSet
cs -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Ctx s -> RST s
ctxNull Ctx s
ctx)
          | Bool
otherwise  -> forall s. Ctx s -> Def s -> ST s (RST s)
makeRST Ctx s
ctx Def s
r0

    Alt (RST (Ch CharSet
x) Word64
_ Char -> ST s (RST s)
_ ST s (RST s)
_) (RST (Ch CharSet
y) Word64
_ Char -> ST s (RST s)
_ ST s (RST s)
_) ->
        forall s. Ctx s -> Def s -> ST s (RST s)
makeRST Ctx s
ctx (forall s. CharSet -> Def s
Ch (CharSet -> CharSet -> CharSet
CS.union CharSet
x CharSet
y))
    Alt (RST (Ch CharSet
x) Word64
_ Char -> ST s (RST s)
_ ST s (RST s)
_) RST s
s | CharSet -> Bool
CS.null CharSet
x ->
        forall s. RST s -> ST s (RST s)
compactR RST s
s
    Alt RST s
r (RST (Ch CharSet
x) Word64
_ Char -> ST s (RST s)
_ ST s (RST s)
_) | CharSet -> Bool
CS.null CharSet
x ->
        forall s. RST s -> ST s (RST s)
compactR RST s
r
    Alt (RST Def s
Full Word64
_ Char -> ST s (RST s)
_ ST s (RST s)
_) RST s
_ ->
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Ctx s -> RST s
ctxFull Ctx s
ctx)
    Alt RST s
_ (RST Def s
Full Word64
_ Char -> ST s (RST s)
_ ST s (RST s)
_) ->
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Ctx s -> RST s
ctxFull Ctx s
ctx)
    Alt (RST Def s
Eps Word64
_ Char -> ST s (RST s)
_ ST s (RST s)
_) (RST Def s
Eps Word64
_ Char -> ST s (RST s)
_ ST s (RST s)
_) ->
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Ctx s -> RST s
ctxEps Ctx s
ctx)
    Alt RST s
r RST s
s -> do
        RST s
r' <- forall s. RST s -> ST s (RST s)
compactR RST s
r
        RST s
s' <- forall s. RST s -> ST s (RST s)
compactR RST s
s
        forall s. Ctx s -> Def s -> ST s (RST s)
makeRST Ctx s
ctx (forall s. RST s -> RST s -> Def s
Alt RST s
r' RST s
s')

    App (RST Def s
Eps Word64
_ Char -> ST s (RST s)
_ ST s (RST s)
_) RST s
s ->
        forall s. RST s -> ST s (RST s)
compactR RST s
s
    App RST s
r (RST Def s
Eps Word64
_ Char -> ST s (RST s)
_ ST s (RST s)
_) ->
        forall s. RST s -> ST s (RST s)
compactR RST s
r
    App (RST (Ch CharSet
x) Word64
_ Char -> ST s (RST s)
_ ST s (RST s)
_) RST s
_ | CharSet -> Bool
CS.null CharSet
x ->
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Ctx s -> RST s
ctxNull Ctx s
ctx)
    App RST s
_ (RST (Ch CharSet
x) Word64
_ Char -> ST s (RST s)
_ ST s (RST s)
_) | CharSet -> Bool
CS.null CharSet
x ->
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Ctx s -> RST s
ctxNull Ctx s
ctx)
    App RST s
r RST s
s -> do
        RST s
r' <- forall s. RST s -> ST s (RST s)
compactR RST s
r
        RST s
s' <- forall s. RST s -> ST s (RST s)
compactR RST s
s
        forall s. Ctx s -> Def s -> ST s (RST s)
makeRST Ctx s
ctx (forall s. RST s -> RST s -> Def s
App RST s
r' RST s
s')

#ifdef RERE_INTERSECTION
    And r s -> do
        r' <- compactR r
        s' <- compactR s
        makeRST ctx (And r' s')
#endif

    Star (RST (Ch CharSet
x) Word64
_ Char -> ST s (RST s)
_ ST s (RST s)
_) | CharSet -> Bool
CS.null CharSet
x ->
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Ctx s -> RST s
ctxEps Ctx s
ctx)
    Star (RST Def s
Eps Word64
_ Char -> ST s (RST s)
_ ST s (RST s)
_) ->
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Ctx s -> RST s
ctxEps Ctx s
ctx)
    Star r :: RST s
r@(RST Star {} Word64
_ Char -> ST s (RST s)
_ ST s (RST s)
_) ->
        forall s. RST s -> ST s (RST s)
compactR RST s
r
    Star RST s
r -> do
        RST s
r' <- forall s. RST s -> ST s (RST s)
compactR RST s
r
        forall s. Ctx s -> Def s -> ST s (RST s)
makeRST Ctx s
ctx (forall s. RST s -> Def s
Star RST s
r')

    Del (RST Def s
Full Word64
_ Char -> ST s (RST s)
_ ST s (RST s)
_ )      -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Ctx s -> RST s
ctxEps Ctx s
ctx)
    Del (RST (Star RST s
_) Word64
_ Char -> ST s (RST s)
_ ST s (RST s)
_ )  -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Ctx s -> RST s
ctxEps Ctx s
ctx)
    Del (RST Def s
Eps Word64
_ Char -> ST s (RST s)
_ ST s (RST s)
_ )       -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Ctx s -> RST s
ctxEps Ctx s
ctx)
    Del (RST (Ch CharSet
_) Word64
_ Char -> ST s (RST s)
_ ST s (RST s)
_)     -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Ctx s -> RST s
ctxNull Ctx s
ctx)
    Del r :: RST s
r@(RST (Del RST s
_) Word64
_ Char -> ST s (RST s)
_ ST s (RST s)
_ ) -> forall (m :: * -> *) a. Monad m => a -> m a
return RST s
r

    Del (RST (App RST s
r RST s
s) Word64
_ Char -> ST s (RST s)
_ ST s (RST s)
_) -> do
        RST s
r' <- forall s. Ctx s -> Def s -> ST s (RST s)
makeRST Ctx s
ctx (forall s. RST s -> Def s
Del RST s
r)
        RST s
s' <- forall s. Ctx s -> Def s -> ST s (RST s)
makeRST Ctx s
ctx (forall s. RST s -> Def s
Del RST s
s)
        forall s. Ctx s -> Def s -> ST s (RST s)
makeRST Ctx s
ctx (forall s. RST s -> RST s -> Def s
App RST s
r' RST s
s')
    Del (RST (Alt RST s
r RST s
s) Word64
_ Char -> ST s (RST s)
_ ST s (RST s)
_) -> do
        RST s
r' <- forall s. Ctx s -> Def s -> ST s (RST s)
makeRST Ctx s
ctx (forall s. RST s -> Def s
Del RST s
r)
        RST s
s' <- forall s. Ctx s -> Def s -> ST s (RST s)
makeRST Ctx s
ctx (forall s. RST s -> Def s
Del RST s
s)
        forall s. Ctx s -> Def s -> ST s (RST s)
makeRST Ctx s
ctx (forall s. RST s -> RST s -> Def s
Alt RST s
r' RST s
s')
#ifdef RERE_INTERSECTION
    Del (RST (And r s) _ _ _) -> do
        r' <- makeRST ctx (Del r)
        s' <- makeRST ctx (Del s)
        makeRST ctx (And r' s')
#endif

compactRN :: Int ->  RST s -> ST s (RST s)
compactRN :: forall s. Int -> RST s -> ST s (RST s)
compactRN Int
n RST s
rr | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return RST s
rr
               | Bool
otherwise = forall s. RST s -> ST s (RST s)
compactR RST s
rr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s. Int -> RST s -> ST s (RST s)
compactRN (Int
n forall a. Num a => a -> a -> a
- Int
1)

_compactRTrace :: Int -> RST s -> ST s (RST s, [RST s])
_compactRTrace :: forall s. Int -> RST s -> ST s (RST s, [RST s])
_compactRTrace Int
n RST s
rr
    | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return (RST s
rr, [])
    | Bool
otherwise = do
        RST s
rr' <- forall s. RST s -> ST s (RST s)
compactR RST s
rr
        (RST s
rr'', [RST s]
tr) <- forall s. Int -> RST s -> ST s (RST s, [RST s])
_compactRTrace (Int
n forall a. Num a => a -> a -> a
- Int
1) RST s
rr'
        forall (m :: * -> *) a. Monad m => a -> m a
return (RST s
rr'', RST s
rr forall a. a -> [a] -> [a]
: [RST s]
tr)

-------------------------------------------------------------------------------
-- Derivative
-------------------------------------------------------------------------------

derivativeR :: Char -> RST s -> ST s (RST s)
derivativeR :: forall s. Char -> RST s -> ST s (RST s)
derivativeR = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s. RST s -> Char -> ST s (RST s)
rrDerivative

derivativeDef :: Ctx s -> Char -> Def s -> ST s (RST s)
derivativeDef :: forall s. Ctx s -> Char -> Def s -> ST s (RST s)
derivativeDef Ctx s
ctx Char
_ Def s
Eps =
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Ctx s -> RST s
ctxNull Ctx s
ctx)
derivativeDef Ctx s
ctx Char
_ Def s
Full =
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Ctx s -> RST s
ctxFull Ctx s
ctx)
derivativeDef Ctx s
ctx Char
_ (Del RST s
_) = do
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Ctx s -> RST s
ctxNull Ctx s
ctx)
derivativeDef Ctx s
ctx Char
c (Ch CharSet
x)
    | Char -> CharSet -> Bool
CS.member Char
c CharSet
x = forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Ctx s -> RST s
ctxEps Ctx s
ctx)
    | Bool
otherwise     = forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. Ctx s -> RST s
ctxNull Ctx s
ctx)
derivativeDef Ctx s
ctx Char
c (Alt RST s
r RST s
s) = do
    RST s
r' <- forall s. Char -> RST s -> ST s (RST s)
derivativeR Char
c RST s
r
    RST s
s' <- forall s. Char -> RST s -> ST s (RST s)
derivativeR Char
c RST s
s
    forall s. Ctx s -> Def s -> ST s (RST s)
makeRST Ctx s
ctx (forall s. RST s -> RST s -> Def s
Alt RST s
r' RST s
s')
#ifdef RERE_INTERSECTION
derivativeDef ctx c (And r s) = do
    r' <- derivativeR c r
    s' <- derivativeR c s
    makeRST ctx (And r' s')
#endif
derivativeDef Ctx s
ctx Char
c (Star RST s
r) = do
    RST s
r' <- forall s. Char -> RST s -> ST s (RST s)
derivativeR Char
c RST s
r
    RST s
starR <- forall s. Ctx s -> Def s -> ST s (RST s)
makeRST Ctx s
ctx (forall s. RST s -> Def s
Star RST s
r)
    forall s. Ctx s -> Def s -> ST s (RST s)
makeRST Ctx s
ctx (forall s. RST s -> RST s -> Def s
App RST s
r' RST s
starR)
derivativeDef Ctx s
ctx Char
c (App RST s
r RST s
s) = do
    RST s
r' <- forall s. Char -> RST s -> ST s (RST s)
derivativeR Char
c RST s
r
    RST s
s' <- forall s. Char -> RST s -> ST s (RST s)
derivativeR Char
c RST s
s

    RST s
dr <- forall s. Ctx s -> Def s -> ST s (RST s)
makeRST Ctx s
ctx (forall s. RST s -> Def s
Del RST s
r)

    RST s
lft <- forall s. Ctx s -> Def s -> ST s (RST s)
makeRST Ctx s
ctx (forall s. RST s -> RST s -> Def s
App RST s
dr RST s
s')
    RST s
rgt <- forall s. Ctx s -> Def s -> ST s (RST s)
makeRST Ctx s
ctx (forall s. RST s -> RST s -> Def s
App RST s
r' RST s
s)

    forall s. Ctx s -> Def s -> ST s (RST s)
makeRST Ctx s
ctx (forall s. RST s -> RST s -> Def s
Alt RST s
lft RST s
rgt)

-------------------------------------------------------------------------------
-- Nullable equations
-------------------------------------------------------------------------------

-- | Whether 'RST' is nullable.
--
-- @
-- 'R.nullable' re = 'nullableR' ('fromRE' re)
-- @
nullableR :: RST s -> Bool
nullableR :: forall s. RST s -> Bool
nullableR RST s
r =
    let (BoolExpr
bexpr, Map Word64 BoolExpr
eqs) = forall s. RST s -> (BoolExpr, Map Word64 BoolExpr)
equations RST s
r
    in BoolExpr -> Map Word64 BoolExpr -> Bool
lfp BoolExpr
bexpr Map Word64 BoolExpr
eqs

nullableR' :: Ctx s -> RST s -> ST s Bool
nullableR' :: forall s. Ctx s -> RST s -> ST s Bool
nullableR' Ctx s
ctx RST s
rr = forall s. Ctx s -> Def s -> ST s (RST s)
makeRST Ctx s
ctx (forall s. RST s -> Def s
Del RST s
rr) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {t} {s}. (Ord t, Num t) => t -> RST s -> ST s Bool
go Int
nullableIter where
    go :: t -> RST s -> ST s Bool
go t
_ (RST Def s
Eps     Word64
_ Char -> ST s (RST s)
_ ST s (RST s)
_) = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    go t
_ (RST (Ch CharSet
_)  Word64
_ Char -> ST s (RST s)
_ ST s (RST s)
_) = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

    go t
n RST s
rr' | t
n forall a. Ord a => a -> a -> Bool
<= t
0 = forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. RST s -> Bool
nullableR RST s
rr')
             | Bool
otherwise = forall s. RST s -> ST s (RST s)
compactR RST s
rr' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= t -> RST s -> ST s Bool
go (t
n forall a. Num a => a -> a -> a
- t
1)

equations :: RST s -> (BoolExpr, Map.Map Word64 BoolExpr)
equations :: forall s. RST s -> (BoolExpr, Map Word64 BoolExpr)
equations RST s
r =
    let (BoolExpr
bexpr, Map Word64 (Def s)
next) = forall s a. State s a -> s -> (a, s)
runState (forall s. RST s -> State (Map Word64 (Def s)) BoolExpr
collectEquation RST s
r) forall k a. Map k a
Map.empty
    in (BoolExpr
bexpr, forall s. Map Word64 (Def s) -> Map Word64 BoolExpr
collectEquations Map Word64 (Def s)
next)

collectEquations :: Map.Map Word64 (Def s)-> Map.Map Word64 BoolExpr
collectEquations :: forall s. Map Word64 (Def s) -> Map Word64 BoolExpr
collectEquations = forall {s}.
Map Word64 BoolExpr -> Map Word64 (Def s) -> Map Word64 BoolExpr
go forall k a. Map k a
Map.empty where
    go :: Map Word64 BoolExpr -> Map Word64 (Def s) -> Map Word64 BoolExpr
go Map Word64 BoolExpr
acc Map Word64 (Def s)
queue = case forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.minViewWithKey Map Word64 (Def s)
queue of
        Maybe ((Word64, Def s), Map Word64 (Def s))
Nothing               -> Map Word64 BoolExpr
acc
        Just ((Word64
i, Def s
r), Map Word64 (Def s)
queue')
            | forall k a. Ord k => k -> Map k a -> Bool
Map.member Word64
i Map Word64 BoolExpr
acc -> Map Word64 BoolExpr -> Map Word64 (Def s) -> Map Word64 BoolExpr
go Map Word64 BoolExpr
acc Map Word64 (Def s)
queue'
            | Bool
otherwise        ->
                let (BoolExpr
bexpr, Map Word64 (Def s)
next) = forall s a. State s a -> s -> (a, s)
runState (forall s. Def s -> State (Map Word64 (Def s)) BoolExpr
collectEquation' Def s
r) forall k a. Map k a
Map.empty
                in Map Word64 BoolExpr -> Map Word64 (Def s) -> Map Word64 BoolExpr
go (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Word64
i BoolExpr
bexpr Map Word64 BoolExpr
acc) (Map Word64 (Def s)
queue' forall a. Semigroup a => a -> a -> a
<> Map Word64 (Def s)
next)

collectEquation :: RST s -> State (Map.Map Word64 (Def s)) BoolExpr
collectEquation :: forall s. RST s -> State (Map Word64 (Def s)) BoolExpr
collectEquation (RST Def s
def Word64
i Char -> ST s (RST s)
_ ST s (RST s)
_) = do
    forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Word64
i Def s
def)
    forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> BoolExpr
BVar Word64
i)

collectEquation' :: Def s -> State (Map.Map Word64 (Def s)) BoolExpr
collectEquation' :: forall s. Def s -> State (Map Word64 (Def s)) BoolExpr
collectEquation' Def s
Eps       = forall (m :: * -> *) a. Monad m => a -> m a
return BoolExpr
BTrue
collectEquation' Def s
Full      = forall (m :: * -> *) a. Monad m => a -> m a
return BoolExpr
BTrue
collectEquation' (Ch CharSet
_)    = forall (m :: * -> *) a. Monad m => a -> m a
return BoolExpr
BFalse
collectEquation' (Del RST s
r)   = forall s. RST s -> State (Map Word64 (Def s)) BoolExpr
collectEquation RST s
r
collectEquation' (App RST s
r RST s
s) = BoolExpr -> BoolExpr -> BoolExpr
band forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. RST s -> State (Map Word64 (Def s)) BoolExpr
collectEquation RST s
r forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s. RST s -> State (Map Word64 (Def s)) BoolExpr
collectEquation RST s
s
collectEquation' (Alt RST s
r RST s
s) = BoolExpr -> BoolExpr -> BoolExpr
bor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. RST s -> State (Map Word64 (Def s)) BoolExpr
collectEquation RST s
r forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s. RST s -> State (Map Word64 (Def s)) BoolExpr
collectEquation RST s
s
collectEquation' (Star RST s
_)  = forall (m :: * -> *) a. Monad m => a -> m a
return BoolExpr
BTrue
#ifdef RERE_INTERSECTION
collectEquation' (And r s) = band <$> collectEquation r <*> collectEquation s
#endif

lfp :: BoolExpr -> Map.Map Word64 BoolExpr -> Bool
lfp :: BoolExpr -> Map Word64 BoolExpr -> Bool
lfp BoolExpr
b Map Word64 BoolExpr
exprs = Map Word64 Bool -> Bool
go (Bool
False forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Map Word64 BoolExpr
exprs) where
    go :: Map Word64 Bool -> Bool
go Map Word64 Bool
curr
        | Map Word64 Bool
curr forall a. Eq a => a -> a -> Bool
== Map Word64 Bool
next = BoolExpr -> Bool
evaluate BoolExpr
b
        | Bool
otherwise    = Map Word64 Bool -> Bool
go Map Word64 Bool
next
      where
        next :: Map Word64 Bool
next = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BoolExpr -> Bool
evaluate Map Word64 BoolExpr
exprs

        evaluate :: BoolExpr -> Bool
        evaluate :: BoolExpr -> Bool
evaluate BoolExpr
BTrue      = Bool
True
        evaluate BoolExpr
BFalse     = Bool
False
        evaluate (BOr BoolExpr
x BoolExpr
y)  = BoolExpr -> Bool
evaluate BoolExpr
x Bool -> Bool -> Bool
|| BoolExpr -> Bool
evaluate BoolExpr
y
        evaluate (BAnd BoolExpr
x BoolExpr
y) = BoolExpr -> Bool
evaluate BoolExpr
x Bool -> Bool -> Bool
&& BoolExpr -> Bool
evaluate BoolExpr
y
        evaluate (BVar Word64
i)   = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Bool
False Word64
i Map Word64 Bool
curr

-------------------------------------------------------------------------------
-- BoolExpr
-------------------------------------------------------------------------------

data BoolExpr
    = BVar Word64
    | BTrue
    | BFalse
    | BOr BoolExpr BoolExpr
    | BAnd BoolExpr BoolExpr
  deriving (Int -> BoolExpr -> ShowS
[BoolExpr] -> ShowS
BoolExpr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BoolExpr] -> ShowS
$cshowList :: [BoolExpr] -> ShowS
show :: BoolExpr -> String
$cshow :: BoolExpr -> String
showsPrec :: Int -> BoolExpr -> ShowS
$cshowsPrec :: Int -> BoolExpr -> ShowS
Show)

band :: BoolExpr -> BoolExpr -> BoolExpr
band :: BoolExpr -> BoolExpr -> BoolExpr
band BoolExpr
BFalse BoolExpr
_      = BoolExpr
BFalse
band BoolExpr
_      BoolExpr
BFalse = BoolExpr
BFalse
band BoolExpr
BTrue  BoolExpr
r      = BoolExpr
r
band BoolExpr
r      BoolExpr
BTrue  = BoolExpr
r
band BoolExpr
r      BoolExpr
s      = BoolExpr -> BoolExpr -> BoolExpr
BAnd BoolExpr
r BoolExpr
s

bor :: BoolExpr -> BoolExpr -> BoolExpr
bor :: BoolExpr -> BoolExpr -> BoolExpr
bor BoolExpr
BFalse BoolExpr
r      = BoolExpr
r
bor BoolExpr
r      BoolExpr
BFalse = BoolExpr
r
bor BoolExpr
BTrue  BoolExpr
_      = BoolExpr
BTrue
bor BoolExpr
_      BoolExpr
BTrue  = BoolExpr
BTrue
bor BoolExpr
r      BoolExpr
s      = BoolExpr -> BoolExpr -> BoolExpr
BOr BoolExpr
r BoolExpr
s