{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE DeriveFoldable    #-}
{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE OverloadedStrings #-}
#if __GLASGOW_HASKELL__ >=704
{-# LANGUAGE Safe              #-}
#elif __GLASGOW_HASKELL__ >=702
{-# LANGUAGE Trustworthy       #-}
#endif
-- | Regular-expression with fixed points.
module RERE.Type (
    -- * Regular expression type
    RE (..),
    -- * Smart constructors
    ch_, (\/), star_, let_, fix_, (>>>=),
#ifdef RERE_INTERSECTION
    (/\),
#endif
    string_,
    -- * Operations
    nullable,
    derivative,
    match,
    compact,
    size,
    -- * Internals
    derivative1,
    derivative2,
    ) where

import Control.Monad (ap)
import Data.String   (IsString (..))
import Data.Void     (Void)

import qualified Data.Set        as Set
import qualified RERE.CharSet    as CS
import qualified Test.QuickCheck as QC

import RERE.Absurd
import RERE.Tuples
import RERE.Var

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

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

(<&>) :: Functor f => f a -> (a -> b) -> f b
<&> :: forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
(<&>) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

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

-- | Regular expression with fixed point.
data RE a
    = Null
    | Full
    | Eps
    | Ch CS.CharSet
    | App (RE a) (RE a)
    | Alt (RE a) (RE a)
    | Star (RE a)

#ifdef RERE_INTERSECTION
    | And (RE a) (RE a)
#endif

    | Var a
    | Let Name (RE a) (RE (Var a))
    | Fix Name        (RE (Var a))
  deriving (RE a -> RE a -> Bool
forall a. Eq a => RE a -> RE a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RE a -> RE a -> Bool
$c/= :: forall a. Eq a => RE a -> RE a -> Bool
== :: RE a -> RE a -> Bool
$c== :: forall a. Eq a => RE a -> RE a -> Bool
Eq, RE a -> RE a -> Ordering
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
forall {a}. Ord a => Eq (RE a)
forall a. Ord a => RE a -> RE a -> Bool
forall a. Ord a => RE a -> RE a -> Ordering
forall a. Ord a => RE a -> RE a -> RE a
min :: RE a -> RE a -> RE a
$cmin :: forall a. Ord a => RE a -> RE a -> RE a
max :: RE a -> RE a -> RE a
$cmax :: forall a. Ord a => RE a -> RE a -> RE a
>= :: RE a -> RE a -> Bool
$c>= :: forall a. Ord a => RE a -> RE a -> Bool
> :: RE a -> RE a -> Bool
$c> :: forall a. Ord a => RE a -> RE a -> Bool
<= :: RE a -> RE a -> Bool
$c<= :: forall a. Ord a => RE a -> RE a -> Bool
< :: RE a -> RE a -> Bool
$c< :: forall a. Ord a => RE a -> RE a -> Bool
compare :: RE a -> RE a -> Ordering
$ccompare :: forall a. Ord a => RE a -> RE a -> Ordering
Ord, Int -> RE a -> ShowS
forall a. Show a => Int -> RE a -> ShowS
forall a. Show a => [RE a] -> ShowS
forall a. Show a => RE a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RE a] -> ShowS
$cshowList :: forall a. Show a => [RE a] -> ShowS
show :: RE a -> String
$cshow :: forall a. Show a => RE a -> String
showsPrec :: Int -> RE a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> RE a -> ShowS
Show, forall a b. a -> RE b -> RE a
forall a b. (a -> b) -> RE a -> RE b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> RE b -> RE a
$c<$ :: forall a b. a -> RE b -> RE a
fmap :: forall a b. (a -> b) -> RE a -> RE b
$cfmap :: forall a b. (a -> b) -> RE a -> RE b
Functor, forall a. Eq a => a -> RE a -> Bool
forall a. Num a => RE a -> a
forall a. Ord a => RE a -> a
forall m. Monoid m => RE m -> m
forall a. RE a -> Bool
forall a. RE a -> Int
forall a. RE a -> [a]
forall a. (a -> a -> a) -> RE a -> a
forall m a. Monoid m => (a -> m) -> RE a -> m
forall b a. (b -> a -> b) -> b -> RE a -> b
forall a b. (a -> b -> b) -> b -> RE a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => RE a -> a
$cproduct :: forall a. Num a => RE a -> a
sum :: forall a. Num a => RE a -> a
$csum :: forall a. Num a => RE a -> a
minimum :: forall a. Ord a => RE a -> a
$cminimum :: forall a. Ord a => RE a -> a
maximum :: forall a. Ord a => RE a -> a
$cmaximum :: forall a. Ord a => RE a -> a
elem :: forall a. Eq a => a -> RE a -> Bool
$celem :: forall a. Eq a => a -> RE a -> Bool
length :: forall a. RE a -> Int
$clength :: forall a. RE a -> Int
null :: forall a. RE a -> Bool
$cnull :: forall a. RE a -> Bool
toList :: forall a. RE a -> [a]
$ctoList :: forall a. RE a -> [a]
foldl1 :: forall a. (a -> a -> a) -> RE a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> RE a -> a
foldr1 :: forall a. (a -> a -> a) -> RE a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> RE a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> RE a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> RE a -> b
foldl :: forall b a. (b -> a -> b) -> b -> RE a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> RE a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> RE a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> RE a -> b
foldr :: forall a b. (a -> b -> b) -> b -> RE a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> RE a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> RE a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> RE a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> RE a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> RE a -> m
fold :: forall m. Monoid m => RE m -> m
$cfold :: forall m. Monoid m => RE m -> m
Foldable, Functor RE
Foldable RE
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => RE (m a) -> m (RE a)
forall (f :: * -> *) a. Applicative f => RE (f a) -> f (RE a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> RE a -> m (RE b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RE a -> f (RE b)
sequence :: forall (m :: * -> *) a. Monad m => RE (m a) -> m (RE a)
$csequence :: forall (m :: * -> *) a. Monad m => RE (m a) -> m (RE a)
mapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> RE a -> m (RE b)
$cmapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> RE a -> m (RE b)
sequenceA :: forall (f :: * -> *) a. Applicative f => RE (f a) -> f (RE a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => RE (f a) -> f (RE a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RE a -> f (RE b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RE a -> f (RE b)
Traversable)

instance Ord a => IsString (RE a) where
    fromString :: String -> RE a
fromString = forall a. Ord a => String -> RE a
string_

instance Applicative RE where
    pure :: forall a. a -> RE a
pure = forall a. a -> RE a
Var
    <*> :: forall a b. RE (a -> b) -> RE a -> RE b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad RE where
    return :: forall a. a -> RE a
return = forall a. a -> RE a
Var

    RE a
Null       >>= :: forall a b. RE a -> (a -> RE b) -> RE b
>>= a -> RE b
_ = forall a. RE a
Null
    RE a
Full       >>= a -> RE b
_ = forall a. RE a
Full
    RE a
Eps        >>= a -> RE b
_ = forall a. RE a
Eps
    Ch CharSet
c       >>= a -> RE b
_ = forall a. CharSet -> RE a
Ch CharSet
c
    App RE a
r RE a
s    >>= a -> RE b
k = forall a. RE a -> RE a -> RE a
App (RE a
r forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> RE b
k) (RE a
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> RE b
k)
    Alt RE a
r RE a
s    >>= a -> RE b
k = forall a. RE a -> RE a -> RE a
Alt (RE a
r forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> RE b
k) (RE a
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> RE b
k)
    Star RE a
r     >>= a -> RE b
k = forall a. RE a -> RE a
Star (RE a
r forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> RE b
k)
    Var a
a      >>= a -> RE b
k = a -> RE b
k a
a
    Let Name
n RE a
s RE (Var a)
r  >>= a -> RE b
k = forall a. Name -> RE a -> RE (Var a) -> RE a
Let Name
n (RE a
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> RE b
k) (RE (Var a)
r forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall r a. r -> (a -> r) -> Var a -> r
unvar (forall a. a -> RE a
Var forall a. Var a
B) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Var a
F forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> RE b
k))
    Fix Name
n RE (Var a)
r1   >>= a -> RE b
k = forall a. Name -> RE (Var a) -> RE a
Fix Name
n (RE (Var a)
r1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall r a. r -> (a -> r) -> Var a -> r
unvar (forall a. a -> RE a
Var forall a. Var a
B) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Var a
F forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> RE b
k))

#ifdef RERE_INTERSECTION
    And r s    >>= k = And (r >>= k) (s >>= k)
#endif



-------------------------------------------------------------------------------
-- QuickCheck
-------------------------------------------------------------------------------

arb :: Ord a => Int -> [QC.Gen a] -> QC.Gen (RE a)
arb :: forall a. Ord a => Int -> [Gen a] -> Gen (RE a)
arb Int
n [Gen a]
vars = forall a. [(Int, Gen a)] -> Gen a
QC.frequency forall a b. (a -> b) -> a -> b
$
    [ (Int
1, forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. RE a
Null)
    , (Int
1, forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. RE a
Full)
    , (Int
1, forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. RE a
Eps)
    , (Int
5, forall a. CharSet -> RE a
Ch forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> CharSet
CS.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Gen a
QC.elements String
"abcdef")
    ] forall a. [a] -> [a] -> [a]
++
    [ (Int
10, forall a. a -> RE a
Var forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
g) | Gen a
g <- [Gen a]
vars ] forall a. [a] -> [a] -> [a]
++
    (if Int
n forall a. Ord a => a -> a -> Bool
> Int
1
     then [ (Int
20, Gen (RE a)
app), (Int
20, Gen (RE a)
alt),  (Int
10, Gen (RE a)
st), (Int
10, Gen (RE a)
letG), (Int
5, Gen (RE a)
fixG)
#if RERE_INTERSECTION
          , (10, and_)
#endif
          ]
     else [])
  where
    alt :: Gen (RE a)
alt = forall {b}. (RE a -> RE a -> b) -> Gen b
binary forall a. Ord a => RE a -> RE a -> RE a
(\/)

#if RERE_INTERSECTION
    and_ = binary (/\)
#endif

    app :: Gen (RE a)
app = forall {b}. (RE a -> RE a -> b) -> Gen b
binary forall a. Semigroup a => a -> a -> a
(<>)

    binary :: (RE a -> RE a -> b) -> Gen b
binary RE a -> RE a -> b
f = do
        Int
m <- forall a. Random a => (a, a) -> Gen a
QC.choose (Int
0, Int
n)
        RE a
x <- forall a. Ord a => Int -> [Gen a] -> Gen (RE a)
arb Int
m [Gen a]
vars
        RE a
y <- forall a. Ord a => Int -> [Gen a] -> Gen (RE a)
arb (Int
n forall a. Num a => a -> a -> a
- Int
m) [Gen a]
vars
        forall (m :: * -> *) a. Monad m => a -> m a
return (RE a -> RE a -> b
f RE a
x RE a
y)

    st :: Gen (RE a)
st = do
        Int
m <- forall a. Random a => (a, a) -> Gen a
QC.choose (Int
0, Int
n forall a. Num a => a -> a -> a
- Int
1)
        RE a
x <- forall a. Ord a => Int -> [Gen a] -> Gen (RE a)
arb Int
m [Gen a]
vars
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. RE a -> RE a
star_ RE a
x)

    letG :: Gen (RE a)
letG = do
        Int
m <- forall a. Random a => (a, a) -> Gen a
QC.choose (Int
0, Int
n)
        Name
name <- Gen Name
arbName
        RE a
x <- forall a. Ord a => Int -> [Gen a] -> Gen (RE a)
arb Int
m [Gen a]
vars
        RE (Var a)
y <- forall a. Ord a => Int -> [Gen a] -> Gen (RE a)
arb Int
m (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Var a
B forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Var a
F) [Gen a]
vars)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
name RE a
x RE (Var a)
y

    fixG :: Gen (RE a)
fixG = do
        Int
m <- forall a. Random a => (a, a) -> Gen a
QC.choose (Int
0, Int
n)
        Name
name <- Gen Name
arbName
        RE (Var a)
y <- forall a. Ord a => Int -> [Gen a] -> Gen (RE a)
arb Int
m (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Var a
B forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Var a
F) [Gen a]
vars)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Ord a => Name -> RE (Var a) -> RE a
fix_ Name
name RE (Var a)
y

instance (Absurd a, Ord a) => QC.Arbitrary (RE a) where
    arbitrary :: Gen (RE a)
arbitrary = forall a. (Int -> Gen a) -> Gen a
QC.sized forall a b. (a -> b) -> a -> b
$ \Int
n -> forall a. Ord a => Int -> [Gen a] -> Gen (RE a)
arb Int
n []
    shrink :: RE a -> [RE a]
shrink    = forall a. RE a -> [RE a]
shr

shr :: RE a -> [RE a]
shr :: forall a. RE a -> [RE a]
shr RE a
Null   = []
shr RE a
Eps    = [forall a. RE a
Null]
shr RE a
Full   = [forall a. RE a
Eps]
shr (Ch CharSet
_) = [forall a. RE a
Null, forall a. RE a
Eps]

shr (App RE a
r RE a
s) = RE a
r forall a. a -> [a] -> [a]
: RE a
s forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. RE a -> RE a -> RE a
App) (forall (f :: * -> * -> *) a b.
Arbitrary2 f =>
(a -> [a]) -> (b -> [b]) -> f a b -> [f a b]
QC.liftShrink2 forall a. RE a -> [RE a]
shr forall a. RE a -> [RE a]
shr (RE a
r, RE a
s))
shr (Alt RE a
r RE a
s) = RE a
r forall a. a -> [a] -> [a]
: RE a
s forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. RE a -> RE a -> RE a
Alt) (forall (f :: * -> * -> *) a b.
Arbitrary2 f =>
(a -> [a]) -> (b -> [b]) -> f a b -> [f a b]
QC.liftShrink2 forall a. RE a -> [RE a]
shr forall a. RE a -> [RE a]
shr (RE a
r, RE a
s))
shr (Star RE a
r)  = RE a
r forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. RE a -> RE a
Star (forall a. RE a -> [RE a]
shr RE a
r)

#ifdef RERE_INTERSECTION
shr (And r s) = r : s :  map (uncurry And) (QC.liftShrink2 shr shr (r, s))
#endif

shr (Var a
_) = []
shr (Let Name
n RE a
r RE (Var a)
s) = RE a
r forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a. Name -> RE a -> RE (Var a) -> RE a
Let Name
n)) (forall (f :: * -> * -> *) a b.
Arbitrary2 f =>
(a -> [a]) -> (b -> [b]) -> f a b -> [f a b]
QC.liftShrink2 forall a. RE a -> [RE a]
shr forall a. RE a -> [RE a]
shr (RE a
r, RE (Var a)
s))
shr (Fix Name
n RE (Var a)
r) = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Name -> RE (Var a) -> RE a
Fix Name
n) (forall a. RE a -> [RE a]
shr RE (Var a)
r)

arbName :: QC.Gen Name
arbName :: Gen Name
arbName = forall a. [a] -> Gen a
QC.elements [Name
"x",Name
"y",Name
"z"]

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

-- | Match string by iteratively differentiating the regular expression.
--
-- This version is slow, consider using 'RERE.matchR'.
match :: RE Void -> String -> Bool
match :: RE Void -> String -> Bool
match !RE Void
re []     = forall a. RE a -> Bool
nullable RE Void
re
match !RE Void
re (Char
c:String
cs) = RE Void -> String -> Bool
match (Char -> RE Void -> RE Void
derivative Char
c RE Void
re) String
cs

-------------------------------------------------------------------------------
-- nullability and derivative
-------------------------------------------------------------------------------

-- | Whether the regular expression accepts empty string,
-- or whether the formal language contains empty string.
--
-- >>> nullable Eps
-- True
--
-- >>> nullable (ch_ 'c')
-- False
--
nullable :: RE a -> Bool
nullable :: forall a. RE a -> Bool
nullable = RE Bool -> Bool
nullable' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const Bool
False)

nullable' :: RE Bool -> Bool
nullable' :: RE Bool -> Bool
nullable' RE Bool
Null      = Bool
False
nullable' RE Bool
Full      = Bool
True
nullable' RE Bool
Eps       = Bool
True
nullable' (Ch CharSet
_)    = Bool
False
nullable' (App RE Bool
r RE Bool
s) = RE Bool -> Bool
nullable' RE Bool
r Bool -> Bool -> Bool
&& RE Bool -> Bool
nullable' RE Bool
s
nullable' (Alt RE Bool
r RE Bool
s) = RE Bool -> Bool
nullable' RE Bool
r Bool -> Bool -> Bool
|| RE Bool -> Bool
nullable' RE Bool
s
nullable' (Star RE Bool
_)  = Bool
True

#ifdef RERE_INTERSECTION
nullable' (And r s) = nullable' r && nullable' s
#endif

nullable' (Var Bool
a)      = Bool
a
nullable' (Let Name
_ RE Bool
r RE (Var Bool)
s)  = RE Bool -> Bool
nullable' (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall r a. r -> (a -> r) -> Var a -> r
unvar (RE Bool -> Bool
nullable' RE Bool
r) forall a. a -> a
id) RE (Var Bool)
s)
nullable' (Fix Name
_ RE (Var Bool)
r1)   = RE Bool -> Bool
nullable' (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall r a. r -> (a -> r) -> Var a -> r
unvar Bool
False forall a. a -> a
id) RE (Var Bool)
r1)

-- | Derivative of regular exression to respect of character.
-- @'derivative' c r@ is \(D_c(r)\).
derivative :: Char -> RE Void -> RE Void
derivative :: Char -> RE Void -> RE Void
derivative = Char -> RE Void -> RE Void
derivative1

-- | 'derivative1' and 'derivative2' are slightly different
-- implementations internally. We are interested in comparing
-- whether either one is noticeably faster (no).
derivative2 :: Char -> RE Void -> RE Void
derivative2 :: Char -> RE Void -> RE Void
derivative2 Char
c = forall b. Ord b => RE (Triple Bool b b) -> RE b
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. (Functor f, Absurd a) => f a -> f b
vacuous where
    go :: Ord b => RE (Triple Bool b b) -> RE b
    go :: forall b. Ord b => RE (Triple Bool b b) -> RE b
go RE (Triple Bool b b)
Null = forall a. RE a
Null
    go RE (Triple Bool b b)
Full = forall a. RE a
Full
    go RE (Triple Bool b b)
Eps = forall a. RE a
Null
    go (Ch CharSet
x)
        | Char -> CharSet -> Bool
CS.member Char
c CharSet
x = forall a. RE a
Eps
        | Bool
otherwise     = forall a. RE a
Null
    go (App RE (Triple Bool b b)
r RE (Triple Bool b b)
s)
        | RE Bool -> Bool
nullable' (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. Triple a b c -> a
fstOf3 RE (Triple Bool b b)
r) = forall b. Ord b => RE (Triple Bool b b) -> RE b
go RE (Triple Bool b b)
s forall a. Ord a => RE a -> RE a -> RE a
\/ (forall b. Ord b => RE (Triple Bool b b) -> RE b
go RE (Triple Bool b b)
r forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. Triple a b c -> c
trdOf3 RE (Triple Bool b b)
s)
        | Bool
otherwise                 =           forall b. Ord b => RE (Triple Bool b b) -> RE b
go RE (Triple Bool b b)
r forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. Triple a b c -> c
trdOf3 RE (Triple Bool b b)
s

    go (Alt RE (Triple Bool b b)
r RE (Triple Bool b b)
s) = forall b. Ord b => RE (Triple Bool b b) -> RE b
go RE (Triple Bool b b)
r forall a. Ord a => RE a -> RE a -> RE a
\/ forall b. Ord b => RE (Triple Bool b b) -> RE b
go RE (Triple Bool b b)
s
    go r0 :: RE (Triple Bool b b)
r0@(Star RE (Triple Bool b b)
r) = forall b. Ord b => RE (Triple Bool b b) -> RE b
go RE (Triple Bool b b)
r forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. Triple a b c -> c
trdOf3 RE (Triple Bool b b)
r0

#ifdef RERE_INTERSECTION
    go (And r s) = go r /\ go s
#endif

    go (Var Triple Bool b b
x) = forall a. a -> RE a
Var (forall a b c. Triple a b c -> b
sndOf3 Triple Bool b b
x)

    go (Let Name
n RE (Triple Bool b b)
r RE (Var (Triple Bool b b))
s)
        | Just RE (Triple Bool b b)
s' <- forall a. RE (Var a) -> Maybe (RE a)
unused RE (Var (Triple Bool b b))
s
        = forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n
               (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. Triple a b c -> c
trdOf3 RE (Triple Bool b b)
r)
               (forall b. Ord b => RE (Triple Bool b b) -> RE b
go (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b b' c c' a.
(b -> b') -> (c -> c') -> Triple a b c -> Triple a b' c'
bimap forall a. a -> Var a
F forall a. a -> Var a
F) RE (Triple Bool b b)
s'))

        | Bool
otherwise
        = forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. Triple a b c -> c
trdOf3 RE (Triple Bool b b)
r)
        forall a b. (a -> b) -> a -> b
$ forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n' (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Var a
F RE b
r')
        forall a b. (a -> b) -> a -> b
$ forall b. Ord b => RE (Triple Bool b b) -> RE b
go
        forall a b. (a -> b) -> a -> b
$ RE (Var (Triple Bool b b))
s forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Var (Triple Bool b b)
var -> case Var (Triple Bool b b)
var of
            Var (Triple Bool b b)
B   -> forall a b c. a -> b -> c -> Triple a b c
T (RE Bool -> Bool
nullable' (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. Triple a b c -> a
fstOf3 RE (Triple Bool b b)
r)) forall a. Var a
B (forall a. a -> Var a
F forall a. Var a
B)
            F Triple Bool b b
x -> forall b b' c c' a.
(b -> b') -> (c -> c') -> Triple a b c -> Triple a b' c'
bimap (forall a. a -> Var a
F forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Var a
F) (forall a. a -> Var a
F forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Var a
F) Triple Bool b b
x
      where
        r' :: RE b
r' = forall b. Ord b => RE (Triple Bool b b) -> RE b
go RE (Triple Bool b b)
r
        n' :: Name
n' = Char -> Name -> Name
derivativeName Char
c Name
n

    go r0 :: RE (Triple Bool b b)
r0@(Fix Name
n RE (Var (Triple Bool b b))
r)
        = forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. Triple a b c -> c
trdOf3 RE (Triple Bool b b)
r0)
        forall a b. (a -> b) -> a -> b
$ forall a. Ord a => Name -> RE (Var a) -> RE a
fix_ Name
n'
        forall a b. (a -> b) -> a -> b
$ forall b. Ord b => RE (Triple Bool b b) -> RE b
go
        forall a b. (a -> b) -> a -> b
$ RE (Var (Triple Bool b b))
r forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Var (Triple Bool b b)
var -> case Var (Triple Bool b b)
var of
            Var (Triple Bool b b)
B   -> forall a b c. a -> b -> c -> Triple a b c
T (RE Bool -> Bool
nullable' (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. Triple a b c -> a
fstOf3 RE (Triple Bool b b)
r0)) forall a. Var a
B (forall a. a -> Var a
F forall a. Var a
B)
            F Triple Bool b b
x -> forall b b' c c' a.
(b -> b') -> (c -> c') -> Triple a b c -> Triple a b' c'
bimap (forall a. a -> Var a
F forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Var a
F) (forall a. a -> Var a
F forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Var a
F) Triple Bool b b
x
      where
        n' :: Name
n' = Char -> Name -> Name
derivativeName Char
c Name
n

-- | 'derivative1' and 'derivative2' are slightly different
-- implementations internally. We are interested in comparing
-- whether either one is noticeably faster (no).
derivative1 :: Char -> RE Void -> RE Void
derivative1 :: Char -> RE Void -> RE Void
derivative1 Char
c = forall a b.
(Ord a, Ord b) =>
(a -> Triple Bool b b) -> RE a -> RE b
go forall a b. Absurd a => a -> b
absurd where
    -- function to calculate nullability and derivative of a variable
    go :: (Ord a, Ord b) => (a -> Triple Bool b b) -> RE a -> RE b
    go :: forall a b.
(Ord a, Ord b) =>
(a -> Triple Bool b b) -> RE a -> RE b
go a -> Triple Bool b b
_ RE a
Null = forall a. RE a
Null
    go a -> Triple Bool b b
_ RE a
Full = forall a. RE a
Full
    go a -> Triple Bool b b
_ RE a
Eps   = forall a. RE a
Null
    go a -> Triple Bool b b
_ (Ch CharSet
x)
        | Char -> CharSet -> Bool
CS.member Char
c CharSet
x = forall a. RE a
Eps
        | Bool
otherwise     = forall a. RE a
Null
    go a -> Triple Bool b b
f (App RE a
r RE a
s)
        | RE Bool -> Bool
nullable' (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. Triple a b c -> a
fstOf3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Triple Bool b b
f) RE a
r) = forall a b.
(Ord a, Ord b) =>
(a -> Triple Bool b b) -> RE a -> RE b
go a -> Triple Bool b b
f RE a
s forall a. Ord a => RE a -> RE a -> RE a
\/ (forall a b.
(Ord a, Ord b) =>
(a -> Triple Bool b b) -> RE a -> RE b
go a -> Triple Bool b b
f RE a
r forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. Triple a b c -> c
trdOf3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Triple Bool b b
f) RE a
s)
        | Bool
otherwise                       =            forall a b.
(Ord a, Ord b) =>
(a -> Triple Bool b b) -> RE a -> RE b
go a -> Triple Bool b b
f RE a
r forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. Triple a b c -> c
trdOf3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Triple Bool b b
f) RE a
s
    go a -> Triple Bool b b
f (Alt RE a
r RE a
s) = forall a b.
(Ord a, Ord b) =>
(a -> Triple Bool b b) -> RE a -> RE b
go a -> Triple Bool b b
f RE a
r forall a. Ord a => RE a -> RE a -> RE a
\/ forall a b.
(Ord a, Ord b) =>
(a -> Triple Bool b b) -> RE a -> RE b
go a -> Triple Bool b b
f RE a
s
    go a -> Triple Bool b b
f r0 :: RE a
r0@(Star RE a
r) = forall a b.
(Ord a, Ord b) =>
(a -> Triple Bool b b) -> RE a -> RE b
go a -> Triple Bool b b
f RE a
r forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. Triple a b c -> c
trdOf3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Triple Bool b b
f) RE a
r0

#ifdef RERE_INTERSECTION
    go f (And r s) = go f r /\ go f s
#endif

    go a -> Triple Bool b b
f (Var a
a) = forall a. a -> RE a
Var (forall a b c. Triple a b c -> b
sndOf3 (a -> Triple Bool b b
f a
a))
    go a -> Triple Bool b b
f (Let Name
n RE a
r RE (Var a)
s)
        | Just RE a
s' <- forall a. RE (Var a) -> Maybe (RE a)
unused RE (Var a)
s
          -- spare the binding
        = forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n
               (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. Triple a b c -> c
trdOf3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Triple Bool b b
f) RE a
r)
               (forall a b.
(Ord a, Ord b) =>
(a -> Triple Bool b b) -> RE a -> RE b
go (forall b b' c c' a.
(b -> b') -> (c -> c') -> Triple a b c -> Triple a b' c'
bimap forall a. a -> Var a
F forall a. a -> Var a
F forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Triple Bool b b
f) RE a
s')

        | Bool
otherwise
        = forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. Triple a b c -> c
trdOf3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Triple Bool b b
f) RE a
r)
        forall a b. (a -> b) -> a -> b
$ forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n' (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Var a
F RE b
r')
        forall a b. (a -> b) -> a -> b
$ forall a b.
(Ord a, Ord b) =>
(a -> Triple Bool b b) -> RE a -> RE b
go (\Var a
var ->  case Var a
var of
            Var a
B   -> forall a b c. a -> b -> c -> Triple a b c
T (RE Bool -> Bool
nullable' (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. Triple a b c -> a
fstOf3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Triple Bool b b
f) RE a
r)) forall a. Var a
B (forall a. a -> Var a
F forall a. Var a
B)
            F a
x -> forall b b' c c' a.
(b -> b') -> (c -> c') -> Triple a b c -> Triple a b' c'
bimap (forall a. a -> Var a
F forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Var a
F) (forall a. a -> Var a
F forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Var a
F) (a -> Triple Bool b b
f a
x))
        forall a b. (a -> b) -> a -> b
$ RE (Var a)
s
      where
        r' :: RE b
r' = forall a b.
(Ord a, Ord b) =>
(a -> Triple Bool b b) -> RE a -> RE b
go a -> Triple Bool b b
f RE a
r
        n' :: Name
n' = Char -> Name -> Name
derivativeName Char
c Name
n
    go a -> Triple Bool b b
f r0 :: RE a
r0@(Fix Name
n RE (Var a)
r)
        = forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. Triple a b c -> c
trdOf3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Triple Bool b b
f) RE a
r0)
        forall a b. (a -> b) -> a -> b
$ forall a. Ord a => Name -> RE (Var a) -> RE a
fix_ Name
n'
        forall a b. (a -> b) -> a -> b
$ forall a b.
(Ord a, Ord b) =>
(a -> Triple Bool b b) -> RE a -> RE b
go (\Var a
var -> case Var a
var of
            Var a
B   -> forall a b c. a -> b -> c -> Triple a b c
T (RE Bool -> Bool
nullable' (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. Triple a b c -> a
fstOf3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Triple Bool b b
f) RE a
r0)) forall a. Var a
B (forall a. a -> Var a
F forall a. Var a
B)
            F a
x -> forall b b' c c' a.
(b -> b') -> (c -> c') -> Triple a b c -> Triple a b' c'
bimap (forall a. a -> Var a
F forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Var a
F) (forall a. a -> Var a
F forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Var a
F) (a -> Triple Bool b b
f a
x))
        forall a b. (a -> b) -> a -> b
$ RE (Var a)
r
      where
        n' :: Name
n' = Char -> Name -> Name
derivativeName Char
c Name
n

-------------------------------------------------------------------------------
-- unused
-------------------------------------------------------------------------------

unused :: RE (Var a) -> Maybe (RE a)
unused :: forall a. RE (Var a) -> Maybe (RE a)
unused = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall r a. r -> (a -> r) -> Var a -> r
unvar forall a. Maybe a
Nothing forall a. a -> Maybe a
Just)

-------------------------------------------------------------------------------
-- size
-------------------------------------------------------------------------------

-- | Size of 'RE'. Counts constructors.
--
size :: RE a -> Int
size :: forall a. RE a -> Int
size RE a
Null        = Int
1
size RE a
Full        = Int
1
size RE a
Eps         = Int
1
size (Ch CharSet
_)      = Int
1
size (Var a
_)     = Int
1
size (App RE a
r RE a
s)   = forall a. Enum a => a -> a
succ (forall a. RE a -> Int
size RE a
r forall a. Num a => a -> a -> a
+ forall a. RE a -> Int
size RE a
s)
size (Alt RE a
r RE a
s)   = forall a. Enum a => a -> a
succ (forall a. RE a -> Int
size RE a
r forall a. Num a => a -> a -> a
+ forall a. RE a -> Int
size RE a
s)
size (Star RE a
r)    = forall a. Enum a => a -> a
succ (forall a. RE a -> Int
size RE a
r)
size (Let Name
_ RE a
r RE (Var a)
s) = forall a. Enum a => a -> a
succ (forall a. RE a -> Int
size RE a
r forall a. Num a => a -> a -> a
+ forall a. RE a -> Int
size RE (Var a)
s)
size (Fix Name
_ RE (Var a)
r)   = forall a. Enum a => a -> a
succ (forall a. RE a -> Int
size RE (Var a)
r)
#ifdef RERE_INTERSECTION
size (And r s)   = succ (size r + size s)
#endif

-------------------------------------------------------------------------------
-- compact
-------------------------------------------------------------------------------

-- | Re-apply smart constructors on 'RE' structure,
-- thus potentially making it smaller.
--
-- This function is slow.
compact :: Ord a => RE a -> RE a
compact :: forall a. Ord a => RE a -> RE a
compact r :: RE a
r@RE a
Null      = RE a
r
compact r :: RE a
r@RE a
Full      = RE a
r
compact r :: RE a
r@RE a
Eps       = RE a
r
compact r :: RE a
r@(Ch CharSet
_)    = RE a
r
compact r :: RE a
r@(Var a
_)   = RE a
r
compact (App RE a
r RE a
s)   = forall a. Ord a => RE a -> RE a
compact RE a
r forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => RE a -> RE a
compact RE a
s
compact (Alt RE a
r RE a
s)   = forall a. Ord a => RE a -> RE a
compact RE a
r forall a. Ord a => RE a -> RE a -> RE a
\/ forall a. Ord a => RE a -> RE a
compact RE a
s
compact (Star RE a
r)    = forall a. RE a -> RE a
star_ (forall a. Ord a => RE a -> RE a
compact RE a
r)
compact (Let Name
n RE a
r RE (Var a)
s) = forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n (forall a. Ord a => RE a -> RE a
compact RE a
r) (forall a. Ord a => RE a -> RE a
compact RE (Var a)
s)
compact (Fix Name
n RE (Var a)
r)   = forall a. Ord a => Name -> RE (Var a) -> RE a
fix_ Name
n (forall a. Ord a => RE a -> RE a
compact RE (Var a)
r)
#ifdef RERE_INTERSECTION
compact (And r s)   = compact r /\ compact s
#endif

-------------------------------------------------------------------------------
-- smart constructors
-------------------------------------------------------------------------------

-- | Variable substitution.
(>>>=) :: Ord b => RE a -> (a -> RE b) -> RE b
RE a
Null       >>>= :: forall b a. Ord b => RE a -> (a -> RE b) -> RE b
>>>= a -> RE b
_ = forall a. RE a
Null
RE a
Full       >>>= a -> RE b
_ = forall a. RE a
Full
RE a
Eps        >>>= a -> RE b
_ = forall a. RE a
Eps
Ch CharSet
c       >>>= a -> RE b
_ = forall a. CharSet -> RE a
Ch CharSet
c
App RE a
r RE a
s    >>>= a -> RE b
k = (RE a
r forall b a. Ord b => RE a -> (a -> RE b) -> RE b
>>>= a -> RE b
k) forall a. Semigroup a => a -> a -> a
<> (RE a
s forall b a. Ord b => RE a -> (a -> RE b) -> RE b
>>>= a -> RE b
k)
Alt RE a
r RE a
s    >>>= a -> RE b
k = (RE a
r forall b a. Ord b => RE a -> (a -> RE b) -> RE b
>>>= a -> RE b
k) forall a. Ord a => RE a -> RE a -> RE a
\/ (RE a
s forall b a. Ord b => RE a -> (a -> RE b) -> RE b
>>>= a -> RE b
k)
Star RE a
r     >>>= a -> RE b
k = forall a. RE a -> RE a
star_ (RE a
r forall b a. Ord b => RE a -> (a -> RE b) -> RE b
>>>= a -> RE b
k)
Var a
a      >>>= a -> RE b
k = a -> RE b
k a
a
Let Name
n RE a
s RE (Var a)
r  >>>= a -> RE b
k = forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n (RE a
s forall b a. Ord b => RE a -> (a -> RE b) -> RE b
>>>= a -> RE b
k) (RE (Var a)
r forall b a. Ord b => RE a -> (a -> RE b) -> RE b
>>>= forall r a. r -> (a -> r) -> Var a -> r
unvar (forall a. a -> RE a
Var forall a. Var a
B) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Var a
F forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> RE b
k))
Fix Name
n RE (Var a)
r1   >>>= a -> RE b
k = forall a. Ord a => Name -> RE (Var a) -> RE a
fix_ Name
n (RE (Var a)
r1 forall b a. Ord b => RE a -> (a -> RE b) -> RE b
>>>= forall r a. r -> (a -> r) -> Var a -> r
unvar (forall a. a -> RE a
Var forall a. Var a
B) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Var a
F forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> RE b
k))

#ifdef RERE_INTERSECTION
And r s    >>>= k = (r >>>= k) /\ (s >>>= k)
#endif

infixl 4 >>>=

-- | Smart 'Ch', as it takes 'Char' argument.
ch_ :: Char -> RE a
ch_ :: forall a. Char -> RE a
ch_ = forall a. CharSet -> RE a
Ch forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> CharSet
CS.singleton

-- | Construct literal 'String' regex.
string_ :: Ord a => String -> RE a
string_ :: forall a. Ord a => String -> RE a
string_ []  = forall a. RE a
Eps
string_ [Char
c] = forall a. Char -> RE a
ch_ Char
c
string_ String
xs  = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Char
c RE a
r -> forall a. Char -> RE a
ch_ Char
c forall a. Semigroup a => a -> a -> a
<> RE a
r) forall a. RE a
Eps String
xs

-- | Smart 'Star'.
star_ :: RE a -> RE a
star_ :: forall a. RE a -> RE a
star_ RE a
Null       = forall a. RE a
Eps
star_ RE a
Eps        = forall a. RE a
Eps
star_ RE a
Full       = forall a. RE a
Full
star_ r :: RE a
r@(Star RE a
_) = RE a
r
star_ RE a
r          = forall a. RE a -> RE a
Star RE a
r

-- | Smart 'Let'
let_ :: Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ :: forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n (Let Name
m RE a
x RE (Var a)
r) RE (Var a)
s
    = forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
m RE a
x
    forall a b. (a -> b) -> a -> b
$ forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n RE (Var a)
r (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall r a. r -> (a -> r) -> Var a -> r
unvar forall a. Var a
B (forall a. a -> Var a
F forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Var a
F)) RE (Var a)
s)
let_ Name
_ RE a
r RE (Var a)
s
    | forall a. RE a -> Bool
cheap RE a
r
    = RE (Var a)
s forall b a. Ord b => RE a -> (a -> RE b) -> RE b
>>>= forall r a. r -> (a -> r) -> Var a -> r
unvar RE a
r forall a. a -> RE a
Var
-- let_ _ r s
--     | foldMap (unvar (Sum 1) (\_ -> Sum 0)) s <=  Sum (1 :: Int)
--     = s >>>= unvar r Var
let_ Name
n RE a
r RE (Var a)
s = forall a. Name -> RE a -> RE (Var a) -> RE a
postlet_ Name
n RE a
r (forall a. Ord a => a -> RE a -> RE a -> RE a
go forall a. Var a
B (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Var a
F RE a
r) RE (Var a)
s) where
    go :: Ord a => a -> RE a -> RE a -> RE a
    go :: forall a. Ord a => a -> RE a -> RE a -> RE a
go a
v RE a
x RE a
y | RE a
x forall a. Eq a => a -> a -> Bool
== RE a
y = forall a. a -> RE a
Var a
v
    go a
_ RE a
_ RE a
Eps       = forall a. RE a
Eps
    go a
_ RE a
_ RE a
Null      = forall a. RE a
Null
    go a
_ RE a
_ RE a
Full      = forall a. RE a
Full
    go a
_ RE a
_ (Ch CharSet
c)    = forall a. CharSet -> RE a
Ch CharSet
c
    go a
v RE a
x (App RE a
a RE a
b) = forall a. RE a -> RE a -> RE a
App (forall a. Ord a => a -> RE a -> RE a -> RE a
go a
v RE a
x RE a
a) (forall a. Ord a => a -> RE a -> RE a -> RE a
go a
v RE a
x RE a
b)
    go a
v RE a
x (Alt RE a
a RE a
b) = forall a. RE a -> RE a -> RE a
Alt (forall a. Ord a => a -> RE a -> RE a -> RE a
go a
v RE a
x RE a
a) (forall a. Ord a => a -> RE a -> RE a -> RE a
go a
v RE a
x RE a
b)
    go a
v RE a
x (Star RE a
a)  = forall a. RE a -> RE a
Star (forall a. Ord a => a -> RE a -> RE a -> RE a
go a
v RE a
x RE a
a)

#ifdef RERE_INTERSECTION
    go v x (And a b) = And (go v x a) (go v x b)
#endif

    go a
_ RE a
_ (Var a
v) = forall a. a -> RE a
Var a
v
    go a
v RE a
x (Let Name
m RE a
a RE (Var a)
b)
        | RE a
x forall a. Eq a => a -> a -> Bool
== RE a
a    = forall a. Ord a => a -> RE a -> RE a -> RE a
go a
v RE a
x (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall r a. r -> (a -> r) -> Var a -> r
unvar a
v forall a. a -> a
id) RE (Var a)
b)
        | Bool
otherwise = forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
m (forall a. Ord a => a -> RE a -> RE a -> RE a
go a
v RE a
x RE a
a) (forall a. Ord a => a -> RE a -> RE a -> RE a
go (forall a. a -> Var a
F a
v) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Var a
F RE a
x) RE (Var a)
b)
    go a
v RE a
x (Fix Name
m RE (Var a)
a) = forall a. Ord a => Name -> RE (Var a) -> RE a
fix_ Name
m (forall a. Ord a => a -> RE a -> RE a -> RE a
go (forall a. a -> Var a
F a
v) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Var a
F RE a
x) RE (Var a)
a)

postlet_ :: Name -> RE a -> RE (Var a) -> RE a
postlet_ :: forall a. Name -> RE a -> RE (Var a) -> RE a
postlet_ Name
_ RE a
r (Var Var a
B) = RE a
r
postlet_ Name
_ RE a
_ RE (Var a)
s
    | Just RE a
s' <- forall a. RE (Var a) -> Maybe (RE a)
unused RE (Var a)
s
    = RE a
s'
postlet_ Name
n RE a
r RE (Var a)
s       = forall a. Name -> RE a -> RE (Var a) -> RE a
Let Name
n RE a
r RE (Var a)
s

-- | Smart 'Fix'.
fix_ :: Ord a => Name -> RE (Var a) -> RE a
fix_ :: forall a. Ord a => Name -> RE (Var a) -> RE a
fix_ Name
n RE (Var a)
r
    | Just RE a
r' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall r a. r -> (a -> r) -> Var a -> r
unvar forall a. Maybe a
Nothing forall a. a -> Maybe a
Just) RE (Var a)
r
    = RE a
r'
    | (RE (Var a)
r forall b a. Ord b => RE a -> (a -> RE b) -> RE b
>>>= forall r a. r -> (a -> r) -> Var a -> r
unvar forall a. RE a
Null forall a. a -> RE a
Var) forall a. Eq a => a -> a -> Bool
== forall a. RE a
Null
     = forall a. RE a
Null
    | Just RE a
r' <- forall a b.
(Ord a, Ord b) =>
RE (Var a)
-> (Var a -> Maybe b)
-> (RE (Var (Var a)) -> RE (Var b))
-> Maybe (RE b)
floatOut RE (Var a)
r (forall r a. r -> (a -> r) -> Var a -> r
unvar forall a. Maybe a
Nothing forall a. a -> Maybe a
Just) (forall a. Ord a => Name -> RE (Var a) -> RE a
fix_ Name
n)
    = RE a
r'
  where
-- fix_ n (Let m r s)
--     | Just r' <- traverse (unvar Nothing Just) r
--     = let_ m r' (fix_ n (fmap swapVar s))
fix_ Name
n RE (Var a)
r = forall a. Name -> RE (Var a) -> RE a
Fix Name
n RE (Var a)
r

floatOut
    :: (Ord a, Ord b)
    => RE (Var a)                        -- ^ expression
    -> (Var a -> Maybe b)                -- ^ float out var
    -> (RE (Var (Var a)) -> RE (Var b))  -- ^ binder
    -> Maybe (RE b)                      -- ^ maybe an expression with let floaten out
floatOut :: forall a b.
(Ord a, Ord b) =>
RE (Var a)
-> (Var a -> Maybe b)
-> (RE (Var (Var a)) -> RE (Var b))
-> Maybe (RE b)
floatOut (Let Name
m RE (Var a)
r RE (Var (Var a))
s) Var a -> Maybe b
un RE (Var (Var a)) -> RE (Var b)
mk
    | Just RE b
r' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Var a -> Maybe b
un RE (Var a)
r
    = forall a. a -> Maybe a
Just
    forall a b. (a -> b) -> a -> b
$ forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
m RE b
r' forall a b. (a -> b) -> a -> b
$ RE (Var (Var a)) -> RE (Var b)
mk forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Var (Var a) -> Var (Var a)
swapVar RE (Var (Var a))
s
    | Bool
otherwise
    = forall a b.
(Ord a, Ord b) =>
RE (Var a)
-> (Var a -> Maybe b)
-> (RE (Var (Var a)) -> RE (Var b))
-> Maybe (RE b)
floatOut
        RE (Var (Var a))
s
        (forall r a. r -> (a -> r) -> Var a -> r
unvar forall a. Maybe a
Nothing Var a -> Maybe b
un)
        (RE (Var (Var a)) -> RE (Var b)
mk forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
m (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Var a
F) RE (Var a)
r) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Var (Var a) -> Var (Var a)
swapVar))
floatOut RE (Var a)
_ Var a -> Maybe b
_ RE (Var (Var a)) -> RE (Var b)
_ = forall a. Maybe a
Nothing

cheap :: RE a -> Bool
cheap :: forall a. RE a -> Bool
cheap RE a
Eps     = Bool
True
cheap RE a
Null   = Bool
True
cheap (Ch CharSet
_)  = Bool
True
cheap (Var a
_) = Bool
True
cheap RE a
_       = Bool
False

instance Ord a => Semigroup (RE a) where
    RE a
Null      <> :: RE a -> RE a -> RE a
<> RE a
_         = forall a. RE a
Null
    RE a
_         <> RE a
Null      = forall a. RE a
Null
    RE a
Full      <> RE a
Full      = forall a. RE a
Full
    RE a
Eps       <> RE a
r         = RE a
r
    RE a
r         <> RE a
Eps       = RE a
r
    Let Name
n RE a
x RE (Var a)
r <> RE a
s         = forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n RE a
x (RE (Var a)
r forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Var a
F RE a
s)
    RE a
r         <> Let Name
n RE a
x RE (Var a)
s = forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n RE a
x (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Var a
F RE a
r forall a. Semigroup a => a -> a -> a
<> RE (Var a)
s)
    RE a
r         <> RE a
s         = forall a. RE a -> RE a -> RE a
App RE a
r RE a
s

infixl 5 \/
-- | Smart 'Alt'.
(\/) :: Ord a => RE a -> RE a -> RE a
RE a
r       \/ :: forall a. Ord a => RE a -> RE a -> RE a
\/ RE a
s       | RE a
r forall a. Eq a => a -> a -> Bool
== RE a
s = RE a
r
RE a
Null    \/ RE a
r       = RE a
r
RE a
r       \/ RE a
Null    = RE a
r
RE a
Full    \/ RE a
_       = forall a. RE a
Full
RE a
_       \/ RE a
Full    = forall a. RE a
Full
Ch CharSet
a    \/ Ch CharSet
b    = forall a. CharSet -> RE a
Ch (CharSet -> CharSet -> CharSet
CS.union CharSet
a CharSet
b)
RE a
Eps     \/ RE a
r       | forall a. RE a -> Bool
nullable RE a
r = RE a
r
RE a
r       \/ RE a
Eps     | forall a. RE a -> Bool
nullable RE a
r = RE a
r
Let Name
n RE a
x RE (Var a)
r \/ RE a
s       = forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n RE a
x (RE (Var a)
r forall a. Ord a => RE a -> RE a -> RE a
\/ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Var a
F RE a
s)
RE a
r       \/ Let Name
n RE a
x RE (Var a)
s = forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n RE a
x (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Var a
F RE a
r forall a. Ord a => RE a -> RE a -> RE a
\/ RE (Var a)
s)
RE a
r       \/ RE a
s       = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. RE a -> RE a -> RE a
alt' forall a. RE a
Null forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
ordNub (forall a. RE a -> [RE a] -> [RE a]
unfoldAlt RE a
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RE a -> [RE a] -> [RE a]
unfoldAlt RE a
s forall a b. (a -> b) -> a -> b
$ [])
  where
    alt' :: RE a -> RE a -> RE a
alt' RE a
x RE a
Null = RE a
x
    alt' RE a
x RE a
y    = forall a. RE a -> RE a -> RE a
Alt RE a
x RE a
y

#ifdef RERE_INTERSECTION
infixl 6 /\ -- silly CPP
-- | Smart 'Alt'.
(/\) :: Ord a => RE a -> RE a -> RE a
r       /\ s       | r == s = r
Null    /\ _       = Null
_       /\ Null    = Null
Full    /\ r       = r
r       /\ Full    = r
Ch a    /\ Ch b    = Ch (CS.intersection a b)
-- nullable is not precise here, so we cannot return Null when non nullable.
Eps     /\ r       | nullable r = Eps
r       /\ Eps     | nullable r = Eps
Let n x r /\ s       = let_ n x (r /\ fmap F s)
r       /\ Let n x s = let_ n x (fmap F r /\ s)
r       /\ s       = foldr and' Full $ ordNub (unfoldAnd r . unfoldAnd s $ [])
  where
    and' x Full = x
    and' x y    = And x y
#endif

-------------------------------------------------------------------------------
-- Tools
-------------------------------------------------------------------------------

unfoldAlt :: RE a -> [RE a] -> [RE a]
unfoldAlt :: forall a. RE a -> [RE a] -> [RE a]
unfoldAlt (Alt RE a
a RE a
b) = forall a. RE a -> [RE a] -> [RE a]
unfoldAlt RE a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RE a -> [RE a] -> [RE a]
unfoldAlt RE a
b
unfoldAlt RE a
r         = (RE a
r forall a. a -> [a] -> [a]
:)

#ifdef RERE_INTERSECTION
unfoldAnd :: RE a -> [RE a] -> [RE a]
unfoldAnd (And a b) = unfoldAnd a . unfoldAnd b
unfoldAnd r         = (r :)
#endif

ordNub :: (Ord a) => [a] -> [a]
ordNub :: forall a. Ord a => [a] -> [a]
ordNub = forall {a}. Ord a => Set a -> [a] -> [a]
go forall a. Set a
Set.empty where
    go :: Set a -> [a] -> [a]
go !Set a
_ []     = []
    go !Set a
s (a
x:[a]
xs)
        | forall a. Ord a => a -> Set a -> Bool
Set.member a
x Set a
s = Set a -> [a] -> [a]
go Set a
s [a]
xs
        | Bool
otherwise      = a
x forall a. a -> [a] -> [a]
: Set a -> [a] -> [a]
go (forall a. Ord a => a -> Set a -> Set a
Set.insert a
x Set a
s) [a]
xs