{-# 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
<&> :: f a -> (a -> b) -> f b
(<&>) = ((a -> b) -> f a -> f b) -> f a -> (a -> b) -> f b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> b) -> f a -> f b
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
(RE a -> RE a -> Bool) -> (RE a -> RE a -> Bool) -> Eq (RE a)
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, Eq (RE a)
Eq (RE a)
-> (RE a -> RE a -> Ordering)
-> (RE a -> RE a -> Bool)
-> (RE a -> RE a -> Bool)
-> (RE a -> RE a -> Bool)
-> (RE a -> RE a -> Bool)
-> (RE a -> RE a -> RE a)
-> (RE a -> RE a -> RE a)
-> Ord (RE a)
RE a -> RE a -> Bool
RE a -> RE a -> Ordering
RE a -> RE a -> RE a
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
$cp1Ord :: forall a. Ord a => Eq (RE a)
Ord, Int -> RE a -> ShowS
[RE a] -> ShowS
RE a -> String
(Int -> RE a -> ShowS)
-> (RE a -> String) -> ([RE a] -> ShowS) -> Show (RE a)
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, a -> RE b -> RE a
(a -> b) -> RE a -> RE b
(forall a b. (a -> b) -> RE a -> RE b)
-> (forall a b. a -> RE b -> RE a) -> Functor RE
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
<$ :: a -> RE b -> RE a
$c<$ :: forall a b. a -> RE b -> RE a
fmap :: (a -> b) -> RE a -> RE b
$cfmap :: forall a b. (a -> b) -> RE a -> RE b
Functor, RE a -> Bool
(a -> m) -> RE a -> m
(a -> b -> b) -> b -> RE a -> b
(forall m. Monoid m => RE m -> m)
-> (forall m a. Monoid m => (a -> m) -> RE a -> m)
-> (forall m a. Monoid m => (a -> m) -> RE a -> m)
-> (forall a b. (a -> b -> b) -> b -> RE a -> b)
-> (forall a b. (a -> b -> b) -> b -> RE a -> b)
-> (forall b a. (b -> a -> b) -> b -> RE a -> b)
-> (forall b a. (b -> a -> b) -> b -> RE a -> b)
-> (forall a. (a -> a -> a) -> RE a -> a)
-> (forall a. (a -> a -> a) -> RE a -> a)
-> (forall a. RE a -> [a])
-> (forall a. RE a -> Bool)
-> (forall a. RE a -> Int)
-> (forall a. Eq a => a -> RE a -> Bool)
-> (forall a. Ord a => RE a -> a)
-> (forall a. Ord a => RE a -> a)
-> (forall a. Num a => RE a -> a)
-> (forall a. Num a => RE a -> a)
-> Foldable RE
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 :: RE a -> a
$cproduct :: forall a. Num a => RE a -> a
sum :: RE a -> a
$csum :: forall a. Num a => RE a -> a
minimum :: RE a -> a
$cminimum :: forall a. Ord a => RE a -> a
maximum :: RE a -> a
$cmaximum :: forall a. Ord a => RE a -> a
elem :: a -> RE a -> Bool
$celem :: forall a. Eq a => a -> RE a -> Bool
length :: RE a -> Int
$clength :: forall a. RE a -> Int
null :: RE a -> Bool
$cnull :: forall a. RE a -> Bool
toList :: RE a -> [a]
$ctoList :: forall a. RE a -> [a]
foldl1 :: (a -> a -> a) -> RE a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> RE a -> a
foldr1 :: (a -> a -> a) -> RE a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> RE a -> a
foldl' :: (b -> a -> b) -> b -> RE a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> RE a -> b
foldl :: (b -> a -> b) -> b -> RE a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> RE a -> b
foldr' :: (a -> b -> b) -> b -> RE a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> RE a -> b
foldr :: (a -> b -> b) -> b -> RE a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> RE a -> b
foldMap' :: (a -> m) -> RE a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> RE a -> m
foldMap :: (a -> m) -> RE a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> RE a -> m
fold :: RE m -> m
$cfold :: forall m. Monoid m => RE m -> m
Foldable, Functor RE
Foldable RE
Functor RE
-> Foldable RE
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> RE a -> f (RE b))
-> (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 (m :: * -> *) a. Monad m => RE (m a) -> m (RE a))
-> Traversable RE
(a -> f b) -> RE a -> f (RE b)
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 :: RE (m a) -> m (RE a)
$csequence :: forall (m :: * -> *) a. Monad m => RE (m a) -> m (RE a)
mapM :: (a -> m b) -> RE a -> m (RE b)
$cmapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> RE a -> m (RE b)
sequenceA :: RE (f a) -> f (RE a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => RE (f a) -> f (RE a)
traverse :: (a -> f b) -> RE a -> f (RE b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RE a -> f (RE b)
$cp2Traversable :: Foldable RE
$cp1Traversable :: Functor RE
Traversable)

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

instance Applicative RE where
    pure :: a -> RE a
pure = a -> RE a
forall a. a -> RE a
Var
    <*> :: RE (a -> b) -> RE a -> RE 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 :: a -> RE a
return = a -> RE a
forall a. a -> RE a
Var

    RE a
Null       >>= :: RE a -> (a -> RE b) -> RE b
>>= a -> RE b
_ = RE b
forall a. RE a
Null
    RE a
Full       >>= a -> RE b
_ = RE b
forall a. RE a
Full
    RE a
Eps        >>= a -> RE b
_ = RE b
forall a. RE a
Eps
    Ch CharSet
c       >>= a -> RE b
_ = CharSet -> RE b
forall a. CharSet -> RE a
Ch CharSet
c
    App RE a
r RE a
s    >>= a -> RE b
k = RE b -> RE b -> RE b
forall a. RE a -> RE a -> RE a
App (RE a
r RE a -> (a -> RE b) -> RE b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> RE b
k) (RE a
s RE a -> (a -> RE b) -> RE b
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 = RE b -> RE b -> RE b
forall a. RE a -> RE a -> RE a
Alt (RE a
r RE a -> (a -> RE b) -> RE b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> RE b
k) (RE a
s RE a -> (a -> RE b) -> RE b
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 = RE b -> RE b
forall a. RE a -> RE a
Star (RE a
r RE a -> (a -> RE b) -> RE b
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 = Name -> RE b -> RE (Var b) -> RE b
forall a. Name -> RE a -> RE (Var a) -> RE a
Let Name
n (RE a
s RE a -> (a -> RE b) -> RE b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> RE b
k) (RE (Var a)
r RE (Var a) -> (Var a -> RE (Var b)) -> RE (Var b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RE (Var b) -> (a -> RE (Var b)) -> Var a -> RE (Var b)
forall r a. r -> (a -> r) -> Var a -> r
unvar (Var b -> RE (Var b)
forall a. a -> RE a
Var Var b
forall a. Var a
B) ((b -> Var b) -> RE b -> RE (Var b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Var b
forall a. a -> Var a
F (RE b -> RE (Var b)) -> (a -> RE b) -> a -> RE (Var b)
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 = Name -> RE (Var b) -> RE b
forall a. Name -> RE (Var a) -> RE a
Fix Name
n (RE (Var a)
r1 RE (Var a) -> (Var a -> RE (Var b)) -> RE (Var b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RE (Var b) -> (a -> RE (Var b)) -> Var a -> RE (Var b)
forall r a. r -> (a -> r) -> Var a -> r
unvar (Var b -> RE (Var b)
forall a. a -> RE a
Var Var b
forall a. Var a
B) ((b -> Var b) -> RE b -> RE (Var b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Var b
forall a. a -> Var a
F (RE b -> RE (Var b)) -> (a -> RE b) -> a -> RE (Var b)
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 :: Int -> [Gen a] -> Gen (RE a)
arb Int
n [Gen a]
vars = [(Int, Gen (RE a))] -> Gen (RE a)
forall a. [(Int, Gen a)] -> Gen a
QC.frequency ([(Int, Gen (RE a))] -> Gen (RE a))
-> [(Int, Gen (RE a))] -> Gen (RE a)
forall a b. (a -> b) -> a -> b
$
    [ (Int
1, RE a -> Gen (RE a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure RE a
forall a. RE a
Null)
    , (Int
1, RE a -> Gen (RE a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure RE a
forall a. RE a
Full)
    , (Int
1, RE a -> Gen (RE a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure RE a
forall a. RE a
Eps)
    , (Int
5, CharSet -> RE a
forall a. CharSet -> RE a
Ch (CharSet -> RE a) -> (Char -> CharSet) -> Char -> RE a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> CharSet
CS.singleton (Char -> RE a) -> Gen Char -> Gen (RE a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Gen Char
forall a. [a] -> Gen a
QC.elements String
"abcdef")
    ] [(Int, Gen (RE a))] -> [(Int, Gen (RE a))] -> [(Int, Gen (RE a))]
forall a. [a] -> [a] -> [a]
++
    [ (Int
10, a -> RE a
forall a. a -> RE a
Var (a -> RE a) -> Gen a -> Gen (RE a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
g) | Gen a
g <- [Gen a]
vars ] [(Int, Gen (RE a))] -> [(Int, Gen (RE a))] -> [(Int, Gen (RE a))]
forall a. [a] -> [a] -> [a]
++
    (if Int
n Int -> Int -> Bool
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 = (RE a -> RE a -> RE a) -> Gen (RE a)
forall b. (RE a -> RE a -> b) -> Gen b
binary RE a -> RE a -> RE a
forall a. Ord a => RE a -> RE a -> RE a
(\/)

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

    app :: Gen (RE a)
app = (RE a -> RE a -> RE a) -> Gen (RE a)
forall b. (RE a -> RE a -> b) -> Gen b
binary RE a -> RE a -> RE a
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 <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
QC.choose (Int
0, Int
n)
        RE a
x <- Int -> [Gen a] -> Gen (RE a)
forall a. Ord a => Int -> [Gen a] -> Gen (RE a)
arb Int
m [Gen a]
vars
        RE a
y <- Int -> [Gen a] -> Gen (RE a)
forall a. Ord a => Int -> [Gen a] -> Gen (RE a)
arb (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m) [Gen a]
vars
        b -> Gen b
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 <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
QC.choose (Int
0, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        RE a
x <- Int -> [Gen a] -> Gen (RE a)
forall a. Ord a => Int -> [Gen a] -> Gen (RE a)
arb Int
m [Gen a]
vars
        RE a -> Gen (RE a)
forall (m :: * -> *) a. Monad m => a -> m a
return (RE a -> RE a
forall a. RE a -> RE a
star_ RE a
x)

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

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

shr (App RE a
r RE a
s) = RE a
r RE a -> [RE a] -> [RE a]
forall a. a -> [a] -> [a]
: RE a
s RE a -> [RE a] -> [RE a]
forall a. a -> [a] -> [a]
: ((RE a, RE a) -> RE a) -> [(RE a, RE a)] -> [RE a]
forall a b. (a -> b) -> [a] -> [b]
map ((RE a -> RE a -> RE a) -> (RE a, RE a) -> RE a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry RE a -> RE a -> RE a
forall a. RE a -> RE a -> RE a
App) ((RE a -> [RE a])
-> (RE a -> [RE a]) -> (RE a, RE a) -> [(RE a, RE a)]
forall (f :: * -> * -> *) a b.
Arbitrary2 f =>
(a -> [a]) -> (b -> [b]) -> f a b -> [f a b]
QC.liftShrink2 RE a -> [RE a]
forall a. RE a -> [RE a]
shr RE a -> [RE a]
forall a. RE a -> [RE a]
shr (RE a
r, RE a
s))
shr (Alt RE a
r RE a
s) = RE a
r RE a -> [RE a] -> [RE a]
forall a. a -> [a] -> [a]
: RE a
s RE a -> [RE a] -> [RE a]
forall a. a -> [a] -> [a]
: ((RE a, RE a) -> RE a) -> [(RE a, RE a)] -> [RE a]
forall a b. (a -> b) -> [a] -> [b]
map ((RE a -> RE a -> RE a) -> (RE a, RE a) -> RE a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry RE a -> RE a -> RE a
forall a. RE a -> RE a -> RE a
Alt) ((RE a -> [RE a])
-> (RE a -> [RE a]) -> (RE a, RE a) -> [(RE a, RE a)]
forall (f :: * -> * -> *) a b.
Arbitrary2 f =>
(a -> [a]) -> (b -> [b]) -> f a b -> [f a b]
QC.liftShrink2 RE a -> [RE a]
forall a. RE a -> [RE a]
shr RE a -> [RE a]
forall a. RE a -> [RE a]
shr (RE a
r, RE a
s))
shr (Star RE a
r)  = RE a
r RE a -> [RE a] -> [RE a]
forall a. a -> [a] -> [a]
: (RE a -> RE a) -> [RE a] -> [RE a]
forall a b. (a -> b) -> [a] -> [b]
map RE a -> RE a
forall a. RE a -> RE a
Star (RE a -> [RE a]
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 RE a -> [RE a] -> [RE a]
forall a. a -> [a] -> [a]
: ((RE a, RE (Var a)) -> RE a) -> [(RE a, RE (Var a))] -> [RE a]
forall a b. (a -> b) -> [a] -> [b]
map ((RE a -> RE (Var a) -> RE a) -> (RE a, RE (Var a)) -> RE a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Name -> RE a -> RE (Var a) -> RE a
forall a. Name -> RE a -> RE (Var a) -> RE a
Let Name
n)) ((RE a -> [RE a])
-> (RE (Var a) -> [RE (Var a)])
-> (RE a, RE (Var a))
-> [(RE a, RE (Var a))]
forall (f :: * -> * -> *) a b.
Arbitrary2 f =>
(a -> [a]) -> (b -> [b]) -> f a b -> [f a b]
QC.liftShrink2 RE a -> [RE a]
forall a. RE a -> [RE a]
shr RE (Var a) -> [RE (Var a)]
forall a. RE a -> [RE a]
shr (RE a
r, RE (Var a)
s))
shr (Fix Name
n RE (Var a)
r) = (RE (Var a) -> RE a) -> [RE (Var a)] -> [RE a]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> RE (Var a) -> RE a
forall a. Name -> RE (Var a) -> RE a
Fix Name
n) (RE (Var a) -> [RE (Var a)]
forall a. RE a -> [RE a]
shr RE (Var a)
r)

arbName :: QC.Gen Name
arbName :: Gen Name
arbName = [Name] -> Gen Name
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 []     = RE Void -> Bool
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 :: RE a -> Bool
nullable = RE Bool -> Bool
nullable' (RE Bool -> Bool) -> (RE a -> RE Bool) -> RE a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> RE a -> RE Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> a -> Bool
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' ((Var Bool -> Bool) -> RE (Var Bool) -> RE Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> (Bool -> Bool) -> Var Bool -> Bool
forall r a. r -> (a -> r) -> Var a -> r
unvar (RE Bool -> Bool
nullable' RE Bool
r) Bool -> Bool
forall a. a -> a
id) RE (Var Bool)
s)
nullable' (Fix Name
_ RE (Var Bool)
r1)   = RE Bool -> Bool
nullable' ((Var Bool -> Bool) -> RE (Var Bool) -> RE Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> (Bool -> Bool) -> Var Bool -> Bool
forall r a. r -> (a -> r) -> Var a -> r
unvar Bool
False Bool -> Bool
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 = RE (Triple Bool Void Void) -> RE Void
forall b. Ord b => RE (Triple Bool b b) -> RE b
go (RE (Triple Bool Void Void) -> RE Void)
-> (RE Void -> RE (Triple Bool Void Void)) -> RE Void -> RE Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RE Void -> RE (Triple Bool Void Void)
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 :: RE (Triple Bool b b) -> RE b
go RE (Triple Bool b b)
Null = RE b
forall a. RE a
Null
    go RE (Triple Bool b b)
Full = RE b
forall a. RE a
Full
    go RE (Triple Bool b b)
Eps = RE b
forall a. RE a
Null
    go (Ch CharSet
x)
        | Char -> CharSet -> Bool
CS.member Char
c CharSet
x = RE b
forall a. RE a
Eps
        | Bool
otherwise     = RE b
forall a. RE a
Null
    go (App RE (Triple Bool b b)
r RE (Triple Bool b b)
s)
        | RE Bool -> Bool
nullable' ((Triple Bool b b -> Bool) -> RE (Triple Bool b b) -> RE Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Triple Bool b b -> Bool
forall a b c. Triple a b c -> a
fstOf3 RE (Triple Bool b b)
r) = RE (Triple Bool b b) -> RE b
forall b. Ord b => RE (Triple Bool b b) -> RE b
go RE (Triple Bool b b)
s RE b -> RE b -> RE b
forall a. Ord a => RE a -> RE a -> RE a
\/ (RE (Triple Bool b b) -> RE b
forall b. Ord b => RE (Triple Bool b b) -> RE b
go RE (Triple Bool b b)
r RE b -> RE b -> RE b
forall a. Semigroup a => a -> a -> a
<> (Triple Bool b b -> b) -> RE (Triple Bool b b) -> RE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Triple Bool b b -> b
forall a b c. Triple a b c -> c
trdOf3 RE (Triple Bool b b)
s)
        | Bool
otherwise                 =           RE (Triple Bool b b) -> RE b
forall b. Ord b => RE (Triple Bool b b) -> RE b
go RE (Triple Bool b b)
r RE b -> RE b -> RE b
forall a. Semigroup a => a -> a -> a
<> (Triple Bool b b -> b) -> RE (Triple Bool b b) -> RE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Triple Bool b b -> b
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) = RE (Triple Bool b b) -> RE b
forall b. Ord b => RE (Triple Bool b b) -> RE b
go RE (Triple Bool b b)
r RE b -> RE b -> RE b
forall a. Ord a => RE a -> RE a -> RE a
\/ RE (Triple Bool b b) -> RE b
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) = RE (Triple Bool b b) -> RE b
forall b. Ord b => RE (Triple Bool b b) -> RE b
go RE (Triple Bool b b)
r RE b -> RE b -> RE b
forall a. Semigroup a => a -> a -> a
<> (Triple Bool b b -> b) -> RE (Triple Bool b b) -> RE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Triple Bool b b -> b
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) = b -> RE b
forall a. a -> RE a
Var (Triple Bool b b -> b
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' <- RE (Var (Triple Bool b b)) -> Maybe (RE (Triple Bool b b))
forall a. RE (Var a) -> Maybe (RE a)
unused RE (Var (Triple Bool b b))
s
        = Name -> RE b -> RE (Var b) -> RE b
forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n
               ((Triple Bool b b -> b) -> RE (Triple Bool b b) -> RE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Triple Bool b b -> b
forall a b c. Triple a b c -> c
trdOf3 RE (Triple Bool b b)
r)
               (RE (Triple Bool (Var b) (Var b)) -> RE (Var b)
forall b. Ord b => RE (Triple Bool b b) -> RE b
go ((Triple Bool b b -> Triple Bool (Var b) (Var b))
-> RE (Triple Bool b b) -> RE (Triple Bool (Var b) (Var b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> Var b)
-> (b -> Var b) -> Triple Bool b b -> Triple Bool (Var b) (Var b)
forall b b' c c' a.
(b -> b') -> (c -> c') -> Triple a b c -> Triple a b' c'
bimap b -> Var b
forall a. a -> Var a
F b -> Var b
forall a. a -> Var a
F) RE (Triple Bool b b)
s'))

        | Bool
otherwise
        = Name -> RE b -> RE (Var b) -> RE b
forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n ((Triple Bool b b -> b) -> RE (Triple Bool b b) -> RE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Triple Bool b b -> b
forall a b c. Triple a b c -> c
trdOf3 RE (Triple Bool b b)
r)
        (RE (Var b) -> RE b) -> RE (Var b) -> RE b
forall a b. (a -> b) -> a -> b
$ Name -> RE (Var b) -> RE (Var (Var b)) -> RE (Var b)
forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n' ((b -> Var b) -> RE b -> RE (Var b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Var b
forall a. a -> Var a
F RE b
r')
        (RE (Var (Var b)) -> RE (Var b)) -> RE (Var (Var b)) -> RE (Var b)
forall a b. (a -> b) -> a -> b
$ RE (Triple Bool (Var (Var b)) (Var (Var b))) -> RE (Var (Var b))
forall b. Ord b => RE (Triple Bool b b) -> RE b
go
        (RE (Triple Bool (Var (Var b)) (Var (Var b))) -> RE (Var (Var b)))
-> RE (Triple Bool (Var (Var b)) (Var (Var b))) -> RE (Var (Var b))
forall a b. (a -> b) -> a -> b
$ RE (Var (Triple Bool b b))
s RE (Var (Triple Bool b b))
-> (Var (Triple Bool b b)
    -> Triple Bool (Var (Var b)) (Var (Var b)))
-> RE (Triple Bool (Var (Var b)) (Var (Var b)))
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   -> Bool
-> Var (Var b)
-> Var (Var b)
-> Triple Bool (Var (Var b)) (Var (Var b))
forall a b c. a -> b -> c -> Triple a b c
T (RE Bool -> Bool
nullable' ((Triple Bool b b -> Bool) -> RE (Triple Bool b b) -> RE Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Triple Bool b b -> Bool
forall a b c. Triple a b c -> a
fstOf3 RE (Triple Bool b b)
r)) Var (Var b)
forall a. Var a
B (Var b -> Var (Var b)
forall a. a -> Var a
F Var b
forall a. Var a
B)
            F Triple Bool b b
x -> (b -> Var (Var b))
-> (b -> Var (Var b))
-> Triple Bool b b
-> Triple Bool (Var (Var b)) (Var (Var b))
forall b b' c c' a.
(b -> b') -> (c -> c') -> Triple a b c -> Triple a b' c'
bimap (Var b -> Var (Var b)
forall a. a -> Var a
F (Var b -> Var (Var b)) -> (b -> Var b) -> b -> Var (Var b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Var b
forall a. a -> Var a
F) (Var b -> Var (Var b)
forall a. a -> Var a
F (Var b -> Var (Var b)) -> (b -> Var b) -> b -> Var (Var b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Var b
forall a. a -> Var a
F) Triple Bool b b
x
      where
        r' :: RE b
r' = RE (Triple Bool b b) -> RE b
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)
        = Name -> RE b -> RE (Var b) -> RE b
forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n ((Triple Bool b b -> b) -> RE (Triple Bool b b) -> RE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Triple Bool b b -> b
forall a b c. Triple a b c -> c
trdOf3 RE (Triple Bool b b)
r0)
        (RE (Var b) -> RE b) -> RE (Var b) -> RE b
forall a b. (a -> b) -> a -> b
$ Name -> RE (Var (Var b)) -> RE (Var b)
forall a. Ord a => Name -> RE (Var a) -> RE a
fix_ Name
n'
        (RE (Var (Var b)) -> RE (Var b)) -> RE (Var (Var b)) -> RE (Var b)
forall a b. (a -> b) -> a -> b
$ RE (Triple Bool (Var (Var b)) (Var (Var b))) -> RE (Var (Var b))
forall b. Ord b => RE (Triple Bool b b) -> RE b
go
        (RE (Triple Bool (Var (Var b)) (Var (Var b))) -> RE (Var (Var b)))
-> RE (Triple Bool (Var (Var b)) (Var (Var b))) -> RE (Var (Var b))
forall a b. (a -> b) -> a -> b
$ RE (Var (Triple Bool b b))
r RE (Var (Triple Bool b b))
-> (Var (Triple Bool b b)
    -> Triple Bool (Var (Var b)) (Var (Var b)))
-> RE (Triple Bool (Var (Var b)) (Var (Var b)))
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   -> Bool
-> Var (Var b)
-> Var (Var b)
-> Triple Bool (Var (Var b)) (Var (Var b))
forall a b c. a -> b -> c -> Triple a b c
T (RE Bool -> Bool
nullable' ((Triple Bool b b -> Bool) -> RE (Triple Bool b b) -> RE Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Triple Bool b b -> Bool
forall a b c. Triple a b c -> a
fstOf3 RE (Triple Bool b b)
r0)) Var (Var b)
forall a. Var a
B (Var b -> Var (Var b)
forall a. a -> Var a
F Var b
forall a. Var a
B)
            F Triple Bool b b
x -> (b -> Var (Var b))
-> (b -> Var (Var b))
-> Triple Bool b b
-> Triple Bool (Var (Var b)) (Var (Var b))
forall b b' c c' a.
(b -> b') -> (c -> c') -> Triple a b c -> Triple a b' c'
bimap (Var b -> Var (Var b)
forall a. a -> Var a
F (Var b -> Var (Var b)) -> (b -> Var b) -> b -> Var (Var b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Var b
forall a. a -> Var a
F) (Var b -> Var (Var b)
forall a. a -> Var a
F (Var b -> Var (Var b)) -> (b -> Var b) -> b -> Var (Var b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Var b
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 = (Void -> Triple Bool Void Void) -> RE Void -> RE Void
forall a b.
(Ord a, Ord b) =>
(a -> Triple Bool b b) -> RE a -> RE b
go Void -> Triple Bool Void Void
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 :: (a -> Triple Bool b b) -> RE a -> RE b
go a -> Triple Bool b b
_ RE a
Null = RE b
forall a. RE a
Null
    go a -> Triple Bool b b
_ RE a
Full = RE b
forall a. RE a
Full
    go a -> Triple Bool b b
_ RE a
Eps   = RE b
forall a. RE a
Null
    go a -> Triple Bool b b
_ (Ch CharSet
x)
        | Char -> CharSet -> Bool
CS.member Char
c CharSet
x = RE b
forall a. RE a
Eps
        | Bool
otherwise     = RE b
forall a. RE a
Null
    go a -> Triple Bool b b
f (App RE a
r RE a
s)
        | RE Bool -> Bool
nullable' ((a -> Bool) -> RE a -> RE Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Triple Bool b b -> Bool
forall a b c. Triple a b c -> a
fstOf3 (Triple Bool b b -> Bool) -> (a -> Triple Bool b b) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Triple Bool b b
f) RE a
r) = (a -> Triple Bool b b) -> RE a -> RE b
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 RE b -> RE b -> RE b
forall a. Ord a => RE a -> RE a -> RE a
\/ ((a -> Triple Bool b b) -> RE a -> RE b
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 RE b -> RE b -> RE b
forall a. Semigroup a => a -> a -> a
<> (a -> b) -> RE a -> RE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Triple Bool b b -> b
forall a b c. Triple a b c -> c
trdOf3 (Triple Bool b b -> b) -> (a -> Triple Bool b b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Triple Bool b b
f) RE a
s)
        | Bool
otherwise                       =            (a -> Triple Bool b b) -> RE a -> RE b
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 RE b -> RE b -> RE b
forall a. Semigroup a => a -> a -> a
<> (a -> b) -> RE a -> RE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Triple Bool b b -> b
forall a b c. Triple a b c -> c
trdOf3 (Triple Bool b b -> b) -> (a -> Triple Bool b b) -> a -> b
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) = (a -> Triple Bool b b) -> RE a -> RE b
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 RE b -> RE b -> RE b
forall a. Ord a => RE a -> RE a -> RE a
\/ (a -> Triple Bool b b) -> RE a -> RE b
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) = (a -> Triple Bool b b) -> RE a -> RE b
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 RE b -> RE b -> RE b
forall a. Semigroup a => a -> a -> a
<> (a -> b) -> RE a -> RE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Triple Bool b b -> b
forall a b c. Triple a b c -> c
trdOf3 (Triple Bool b b -> b) -> (a -> Triple Bool b b) -> a -> b
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) = b -> RE b
forall a. a -> RE a
Var (Triple Bool b b -> b
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' <- RE (Var a) -> Maybe (RE a)
forall a. RE (Var a) -> Maybe (RE a)
unused RE (Var a)
s
          -- spare the binding
        = Name -> RE b -> RE (Var b) -> RE b
forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n
               ((a -> b) -> RE a -> RE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Triple Bool b b -> b
forall a b c. Triple a b c -> c
trdOf3 (Triple Bool b b -> b) -> (a -> Triple Bool b b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Triple Bool b b
f) RE a
r)
               ((a -> Triple Bool (Var b) (Var b)) -> RE a -> RE (Var b)
forall a b.
(Ord a, Ord b) =>
(a -> Triple Bool b b) -> RE a -> RE b
go ((b -> Var b)
-> (b -> Var b) -> Triple Bool b b -> Triple Bool (Var b) (Var b)
forall b b' c c' a.
(b -> b') -> (c -> c') -> Triple a b c -> Triple a b' c'
bimap b -> Var b
forall a. a -> Var a
F b -> Var b
forall a. a -> Var a
F (Triple Bool b b -> Triple Bool (Var b) (Var b))
-> (a -> Triple Bool b b) -> a -> Triple Bool (Var b) (Var b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Triple Bool b b
f) RE a
s')

        | Bool
otherwise
        = Name -> RE b -> RE (Var b) -> RE b
forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n ((a -> b) -> RE a -> RE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Triple Bool b b -> b
forall a b c. Triple a b c -> c
trdOf3 (Triple Bool b b -> b) -> (a -> Triple Bool b b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Triple Bool b b
f) RE a
r)
        (RE (Var b) -> RE b) -> RE (Var b) -> RE b
forall a b. (a -> b) -> a -> b
$ Name -> RE (Var b) -> RE (Var (Var b)) -> RE (Var b)
forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n' ((b -> Var b) -> RE b -> RE (Var b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Var b
forall a. a -> Var a
F RE b
r')
        (RE (Var (Var b)) -> RE (Var b)) -> RE (Var (Var b)) -> RE (Var b)
forall a b. (a -> b) -> a -> b
$ (Var a -> Triple Bool (Var (Var b)) (Var (Var b)))
-> RE (Var a) -> RE (Var (Var 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   -> Bool
-> Var (Var b)
-> Var (Var b)
-> Triple Bool (Var (Var b)) (Var (Var b))
forall a b c. a -> b -> c -> Triple a b c
T (RE Bool -> Bool
nullable' ((a -> Bool) -> RE a -> RE Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Triple Bool b b -> Bool
forall a b c. Triple a b c -> a
fstOf3 (Triple Bool b b -> Bool) -> (a -> Triple Bool b b) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Triple Bool b b
f) RE a
r)) Var (Var b)
forall a. Var a
B (Var b -> Var (Var b)
forall a. a -> Var a
F Var b
forall a. Var a
B)
            F a
x -> (b -> Var (Var b))
-> (b -> Var (Var b))
-> Triple Bool b b
-> Triple Bool (Var (Var b)) (Var (Var b))
forall b b' c c' a.
(b -> b') -> (c -> c') -> Triple a b c -> Triple a b' c'
bimap (Var b -> Var (Var b)
forall a. a -> Var a
F (Var b -> Var (Var b)) -> (b -> Var b) -> b -> Var (Var b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Var b
forall a. a -> Var a
F) (Var b -> Var (Var b)
forall a. a -> Var a
F (Var b -> Var (Var b)) -> (b -> Var b) -> b -> Var (Var b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Var b
forall a. a -> Var a
F) (a -> Triple Bool b b
f a
x))
        (RE (Var a) -> RE (Var (Var b))) -> RE (Var a) -> RE (Var (Var b))
forall a b. (a -> b) -> a -> b
$ RE (Var a)
s
      where
        r' :: RE b
r' = (a -> Triple Bool b b) -> RE a -> RE b
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)
        = Name -> RE b -> RE (Var b) -> RE b
forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n ((a -> b) -> RE a -> RE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Triple Bool b b -> b
forall a b c. Triple a b c -> c
trdOf3 (Triple Bool b b -> b) -> (a -> Triple Bool b b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Triple Bool b b
f) RE a
r0)
        (RE (Var b) -> RE b) -> RE (Var b) -> RE b
forall a b. (a -> b) -> a -> b
$ Name -> RE (Var (Var b)) -> RE (Var b)
forall a. Ord a => Name -> RE (Var a) -> RE a
fix_ Name
n'
        (RE (Var (Var b)) -> RE (Var b)) -> RE (Var (Var b)) -> RE (Var b)
forall a b. (a -> b) -> a -> b
$ (Var a -> Triple Bool (Var (Var b)) (Var (Var b)))
-> RE (Var a) -> RE (Var (Var 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   -> Bool
-> Var (Var b)
-> Var (Var b)
-> Triple Bool (Var (Var b)) (Var (Var b))
forall a b c. a -> b -> c -> Triple a b c
T (RE Bool -> Bool
nullable' ((a -> Bool) -> RE a -> RE Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Triple Bool b b -> Bool
forall a b c. Triple a b c -> a
fstOf3 (Triple Bool b b -> Bool) -> (a -> Triple Bool b b) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Triple Bool b b
f) RE a
r0)) Var (Var b)
forall a. Var a
B (Var b -> Var (Var b)
forall a. a -> Var a
F Var b
forall a. Var a
B)
            F a
x -> (b -> Var (Var b))
-> (b -> Var (Var b))
-> Triple Bool b b
-> Triple Bool (Var (Var b)) (Var (Var b))
forall b b' c c' a.
(b -> b') -> (c -> c') -> Triple a b c -> Triple a b' c'
bimap (Var b -> Var (Var b)
forall a. a -> Var a
F (Var b -> Var (Var b)) -> (b -> Var b) -> b -> Var (Var b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Var b
forall a. a -> Var a
F) (Var b -> Var (Var b)
forall a. a -> Var a
F (Var b -> Var (Var b)) -> (b -> Var b) -> b -> Var (Var b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Var b
forall a. a -> Var a
F) (a -> Triple Bool b b
f a
x))
        (RE (Var a) -> RE (Var (Var b))) -> RE (Var a) -> RE (Var (Var b))
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 :: RE (Var a) -> Maybe (RE a)
unused = (Var a -> Maybe a) -> RE (Var a) -> Maybe (RE a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Maybe a -> (a -> Maybe a) -> Var a -> Maybe a
forall r a. r -> (a -> r) -> Var a -> r
unvar Maybe a
forall a. Maybe a
Nothing a -> Maybe a
forall a. a -> Maybe a
Just)

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

-- | Size of 'RE'. Counts constructors.
--
size :: RE a -> Int
size :: 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)   = Int -> Int
forall a. Enum a => a -> a
succ (RE a -> Int
forall a. RE a -> Int
size RE a
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ RE a -> Int
forall a. RE a -> Int
size RE a
s)
size (Alt RE a
r RE a
s)   = Int -> Int
forall a. Enum a => a -> a
succ (RE a -> Int
forall a. RE a -> Int
size RE a
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ RE a -> Int
forall a. RE a -> Int
size RE a
s)
size (Star RE a
r)    = Int -> Int
forall a. Enum a => a -> a
succ (RE a -> Int
forall a. RE a -> Int
size RE a
r)
size (Let Name
_ RE a
r RE (Var a)
s) = Int -> Int
forall a. Enum a => a -> a
succ (RE a -> Int
forall a. RE a -> Int
size RE a
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ RE (Var a) -> Int
forall a. RE a -> Int
size RE (Var a)
s)
size (Fix Name
_ RE (Var a)
r)   = Int -> Int
forall a. Enum a => a -> a
succ (RE (Var a) -> Int
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 :: 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)   = RE a -> RE a
forall a. Ord a => RE a -> RE a
compact RE a
r RE a -> RE a -> RE a
forall a. Semigroup a => a -> a -> a
<> RE a -> RE a
forall a. Ord a => RE a -> RE a
compact RE a
s
compact (Alt RE a
r RE a
s)   = RE a -> RE a
forall a. Ord a => RE a -> RE a
compact RE a
r RE a -> RE a -> RE a
forall a. Ord a => RE a -> RE a -> RE a
\/ RE a -> RE a
forall a. Ord a => RE a -> RE a
compact RE a
s
compact (Star RE a
r)    = RE a -> RE a
forall a. RE a -> RE a
star_ (RE a -> RE a
forall a. Ord a => RE a -> RE a
compact RE a
r)
compact (Let Name
n RE a
r RE (Var a)
s) = Name -> RE a -> RE (Var a) -> RE a
forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n (RE a -> RE a
forall a. Ord a => RE a -> RE a
compact RE a
r) (RE (Var a) -> RE (Var a)
forall a. Ord a => RE a -> RE a
compact RE (Var a)
s)
compact (Fix Name
n RE (Var a)
r)   = Name -> RE (Var a) -> RE a
forall a. Ord a => Name -> RE (Var a) -> RE a
fix_ Name
n (RE (Var a) -> RE (Var a)
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       >>>= :: RE a -> (a -> RE b) -> RE b
>>>= a -> RE b
_ = RE b
forall a. RE a
Null
RE a
Full       >>>= a -> RE b
_ = RE b
forall a. RE a
Full
RE a
Eps        >>>= a -> RE b
_ = RE b
forall a. RE a
Eps
Ch CharSet
c       >>>= a -> RE b
_ = CharSet -> RE b
forall a. CharSet -> RE a
Ch CharSet
c
App RE a
r RE a
s    >>>= a -> RE b
k = (RE a
r RE a -> (a -> RE b) -> RE b
forall b a. Ord b => RE a -> (a -> RE b) -> RE b
>>>= a -> RE b
k) RE b -> RE b -> RE b
forall a. Semigroup a => a -> a -> a
<> (RE a
s RE a -> (a -> RE b) -> RE b
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 RE a -> (a -> RE b) -> RE b
forall b a. Ord b => RE a -> (a -> RE b) -> RE b
>>>= a -> RE b
k) RE b -> RE b -> RE b
forall a. Ord a => RE a -> RE a -> RE a
\/ (RE a
s RE a -> (a -> RE b) -> RE b
forall b a. Ord b => RE a -> (a -> RE b) -> RE b
>>>= a -> RE b
k)
Star RE a
r     >>>= a -> RE b
k = RE b -> RE b
forall a. RE a -> RE a
star_ (RE a
r RE a -> (a -> RE b) -> RE b
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 = Name -> RE b -> RE (Var b) -> RE b
forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n (RE a
s RE a -> (a -> RE b) -> RE b
forall b a. Ord b => RE a -> (a -> RE b) -> RE b
>>>= a -> RE b
k) (RE (Var a)
r RE (Var a) -> (Var a -> RE (Var b)) -> RE (Var b)
forall b a. Ord b => RE a -> (a -> RE b) -> RE b
>>>= RE (Var b) -> (a -> RE (Var b)) -> Var a -> RE (Var b)
forall r a. r -> (a -> r) -> Var a -> r
unvar (Var b -> RE (Var b)
forall a. a -> RE a
Var Var b
forall a. Var a
B) ((b -> Var b) -> RE b -> RE (Var b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Var b
forall a. a -> Var a
F (RE b -> RE (Var b)) -> (a -> RE b) -> a -> RE (Var b)
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 = Name -> RE (Var b) -> RE b
forall a. Ord a => Name -> RE (Var a) -> RE a
fix_ Name
n (RE (Var a)
r1 RE (Var a) -> (Var a -> RE (Var b)) -> RE (Var b)
forall b a. Ord b => RE a -> (a -> RE b) -> RE b
>>>= RE (Var b) -> (a -> RE (Var b)) -> Var a -> RE (Var b)
forall r a. r -> (a -> r) -> Var a -> r
unvar (Var b -> RE (Var b)
forall a. a -> RE a
Var Var b
forall a. Var a
B) ((b -> Var b) -> RE b -> RE (Var b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Var b
forall a. a -> Var a
F (RE b -> RE (Var b)) -> (a -> RE b) -> a -> RE (Var b)
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_ :: Char -> RE a
ch_ = CharSet -> RE a
forall a. CharSet -> RE a
Ch (CharSet -> RE a) -> (Char -> CharSet) -> Char -> RE a
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_ :: String -> RE a
string_ []  = RE a
forall a. RE a
Eps
string_ [Char
c] = Char -> RE a
forall a. Char -> RE a
ch_ Char
c
string_ String
xs  = (Char -> RE a -> RE a) -> RE a -> String -> RE a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Char
c RE a
r -> Char -> RE a
forall a. Char -> RE a
ch_ Char
c RE a -> RE a -> RE a
forall a. Semigroup a => a -> a -> a
<> RE a
r) RE a
forall a. RE a
Eps String
xs

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

-- | Smart 'Let'
let_ :: Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ :: 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
    = Name -> RE a -> RE (Var a) -> RE a
forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
m RE a
x
    (RE (Var a) -> RE a) -> RE (Var a) -> RE a
forall a b. (a -> b) -> a -> b
$ Name -> RE (Var a) -> RE (Var (Var a)) -> RE (Var a)
forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n RE (Var a)
r ((Var a -> Var (Var a)) -> RE (Var a) -> RE (Var (Var a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Var (Var a) -> (a -> Var (Var a)) -> Var a -> Var (Var a)
forall r a. r -> (a -> r) -> Var a -> r
unvar Var (Var a)
forall a. Var a
B (Var a -> Var (Var a)
forall a. a -> Var a
F (Var a -> Var (Var a)) -> (a -> Var a) -> a -> Var (Var a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Var a
forall a. a -> Var a
F)) RE (Var a)
s)
let_ Name
_ RE a
r RE (Var a)
s
    | RE a -> Bool
forall a. RE a -> Bool
cheap RE a
r
    = RE (Var a)
s RE (Var a) -> (Var a -> RE a) -> RE a
forall b a. Ord b => RE a -> (a -> RE b) -> RE b
>>>= RE a -> (a -> RE a) -> Var a -> RE a
forall r a. r -> (a -> r) -> Var a -> r
unvar RE a
r a -> RE a
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 = Name -> RE a -> RE (Var a) -> RE a
forall a. Name -> RE a -> RE (Var a) -> RE a
postlet_ Name
n RE a
r (Var a -> RE (Var a) -> RE (Var a) -> RE (Var a)
forall a. Ord a => a -> RE a -> RE a -> RE a
go Var a
forall a. Var a
B ((a -> Var a) -> RE a -> RE (Var a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Var a
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 :: a -> RE a -> RE a -> RE a
go a
v RE a
x RE a
y | RE a
x RE a -> RE a -> Bool
forall a. Eq a => a -> a -> Bool
== RE a
y = a -> RE a
forall a. a -> RE a
Var a
v
    go a
_ RE a
_ RE a
Eps       = RE a
forall a. RE a
Eps
    go a
_ RE a
_ RE a
Null      = RE a
forall a. RE a
Null
    go a
_ RE a
_ RE a
Full      = RE a
forall a. RE a
Full
    go a
_ RE a
_ (Ch CharSet
c)    = CharSet -> RE a
forall a. CharSet -> RE a
Ch CharSet
c
    go a
v RE a
x (App RE a
a RE a
b) = RE a -> RE a -> RE a
forall a. RE a -> RE a -> RE a
App (a -> RE a -> RE a -> RE a
forall a. Ord a => a -> RE a -> RE a -> RE a
go a
v RE a
x RE a
a) (a -> RE a -> RE a -> RE 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) = RE a -> RE a -> RE a
forall a. RE a -> RE a -> RE a
Alt (a -> RE a -> RE a -> RE a
forall a. Ord a => a -> RE a -> RE a -> RE a
go a
v RE a
x RE a
a) (a -> RE a -> RE a -> RE 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)  = RE a -> RE a
forall a. RE a -> RE a
Star (a -> RE a -> RE a -> RE a
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) = a -> RE a
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 RE a -> RE a -> Bool
forall a. Eq a => a -> a -> Bool
== RE a
a    = a -> RE a -> RE a -> RE a
forall a. Ord a => a -> RE a -> RE a -> RE a
go a
v RE a
x ((Var a -> a) -> RE (Var a) -> RE a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> (a -> a) -> Var a -> a
forall r a. r -> (a -> r) -> Var a -> r
unvar a
v a -> a
forall a. a -> a
id) RE (Var a)
b)
        | Bool
otherwise = Name -> RE a -> RE (Var a) -> RE a
forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
m (a -> RE a -> RE a -> RE a
forall a. Ord a => a -> RE a -> RE a -> RE a
go a
v RE a
x RE a
a) (Var a -> RE (Var a) -> RE (Var a) -> RE (Var a)
forall a. Ord a => a -> RE a -> RE a -> RE a
go (a -> Var a
forall a. a -> Var a
F a
v) ((a -> Var a) -> RE a -> RE (Var a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Var a
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) = Name -> RE (Var a) -> RE a
forall a. Ord a => Name -> RE (Var a) -> RE a
fix_ Name
m (Var a -> RE (Var a) -> RE (Var a) -> RE (Var a)
forall a. Ord a => a -> RE a -> RE a -> RE a
go (a -> Var a
forall a. a -> Var a
F a
v) ((a -> Var a) -> RE a -> RE (Var a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Var a
forall a. a -> Var a
F RE a
x) RE (Var a)
a)

postlet_ :: Name -> RE a -> RE (Var a) -> RE a
postlet_ :: 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' <- RE (Var a) -> Maybe (RE a)
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       = Name -> RE a -> RE (Var a) -> RE a
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_ :: Name -> RE (Var a) -> RE a
fix_ Name
n RE (Var a)
r
    | Just RE a
r' <- (Var a -> Maybe a) -> RE (Var a) -> Maybe (RE a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Maybe a -> (a -> Maybe a) -> Var a -> Maybe a
forall r a. r -> (a -> r) -> Var a -> r
unvar Maybe a
forall a. Maybe a
Nothing a -> Maybe a
forall a. a -> Maybe a
Just) RE (Var a)
r
    = RE a
r'
    | (RE (Var a)
r RE (Var a) -> (Var a -> RE a) -> RE a
forall b a. Ord b => RE a -> (a -> RE b) -> RE b
>>>= RE a -> (a -> RE a) -> Var a -> RE a
forall r a. r -> (a -> r) -> Var a -> r
unvar RE a
forall a. RE a
Null a -> RE a
forall a. a -> RE a
Var) RE a -> RE a -> Bool
forall a. Eq a => a -> a -> Bool
== RE a
forall a. RE a
Null
     = RE a
forall a. RE a
Null
    | Just RE a
r' <- RE (Var a)
-> (Var a -> Maybe a)
-> (RE (Var (Var a)) -> RE (Var a))
-> Maybe (RE a)
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 (Maybe a -> (a -> Maybe a) -> Var a -> Maybe a
forall r a. r -> (a -> r) -> Var a -> r
unvar Maybe a
forall a. Maybe a
Nothing a -> Maybe a
forall a. a -> Maybe a
Just) (Name -> RE (Var (Var a)) -> RE (Var a)
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 = Name -> RE (Var a) -> RE a
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 :: 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' <- (Var a -> Maybe b) -> RE (Var a) -> Maybe (RE b)
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
    = RE b -> Maybe (RE b)
forall a. a -> Maybe a
Just
    (RE b -> Maybe (RE b)) -> RE b -> Maybe (RE b)
forall a b. (a -> b) -> a -> b
$ Name -> RE b -> RE (Var b) -> RE b
forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
m RE b
r' (RE (Var b) -> RE b) -> RE (Var b) -> RE b
forall a b. (a -> b) -> a -> b
$ RE (Var (Var a)) -> RE (Var b)
mk (RE (Var (Var a)) -> RE (Var b)) -> RE (Var (Var a)) -> RE (Var b)
forall a b. (a -> b) -> a -> b
$ (Var (Var a) -> Var (Var a))
-> RE (Var (Var a)) -> RE (Var (Var a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Var (Var a) -> Var (Var a)
forall a. Var (Var a) -> Var (Var a)
swapVar RE (Var (Var a))
s
    | Bool
otherwise
    = RE (Var (Var a))
-> (Var (Var a) -> Maybe b)
-> (RE (Var (Var (Var a))) -> RE (Var b))
-> Maybe (RE b)
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
        (Maybe b -> (Var a -> Maybe b) -> Var (Var a) -> Maybe b
forall r a. r -> (a -> r) -> Var a -> r
unvar Maybe b
forall a. Maybe a
Nothing Var a -> Maybe b
un)
        (RE (Var (Var a)) -> RE (Var b)
mk (RE (Var (Var a)) -> RE (Var b))
-> (RE (Var (Var (Var a))) -> RE (Var (Var a)))
-> RE (Var (Var (Var a)))
-> RE (Var b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name
-> RE (Var (Var a)) -> RE (Var (Var (Var a))) -> RE (Var (Var a))
forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
m ((Var a -> Var (Var a)) -> RE (Var a) -> RE (Var (Var a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Var a) -> Var a -> Var (Var a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Var a
forall a. a -> Var a
F) RE (Var a)
r) (RE (Var (Var (Var a))) -> RE (Var (Var a)))
-> (RE (Var (Var (Var a))) -> RE (Var (Var (Var a))))
-> RE (Var (Var (Var a)))
-> RE (Var (Var a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Var (Var (Var a)) -> Var (Var (Var a)))
-> RE (Var (Var (Var a))) -> RE (Var (Var (Var a)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Var (Var a) -> Var (Var a))
-> Var (Var (Var a)) -> Var (Var (Var a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Var (Var a) -> Var (Var a)
forall a. Var (Var a) -> Var (Var a)
swapVar))
floatOut RE (Var a)
_ Var a -> Maybe b
_ RE (Var (Var a)) -> RE (Var b)
_ = Maybe (RE b)
forall a. Maybe a
Nothing

cheap :: RE a -> Bool
cheap :: 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
_         = RE a
forall a. RE a
Null
    RE a
_         <> RE a
Null      = RE a
forall a. RE a
Null
    RE a
Full      <> RE a
Full      = RE a
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         = Name -> RE a -> RE (Var a) -> RE a
forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n RE a
x (RE (Var a)
r RE (Var a) -> RE (Var a) -> RE (Var a)
forall a. Semigroup a => a -> a -> a
<> (a -> Var a) -> RE a -> RE (Var a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Var a
forall a. a -> Var a
F RE a
s)
    RE a
r         <> Let Name
n RE a
x RE (Var a)
s = Name -> RE a -> RE (Var a) -> RE a
forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n RE a
x ((a -> Var a) -> RE a -> RE (Var a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Var a
forall a. a -> Var a
F RE a
r RE (Var a) -> RE (Var a) -> RE (Var a)
forall a. Semigroup a => a -> a -> a
<> RE (Var a)
s)
    RE a
r         <> RE a
s         = RE a -> RE a -> RE a
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       \/ :: RE a -> RE a -> RE a
\/ RE a
s       | RE a
r RE a -> RE a -> Bool
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
_       = RE a
forall a. RE a
Full
RE a
_       \/ RE a
Full    = RE a
forall a. RE a
Full
Ch CharSet
a    \/ Ch CharSet
b    = CharSet -> RE a
forall a. CharSet -> RE a
Ch (CharSet -> CharSet -> CharSet
CS.union CharSet
a CharSet
b)
RE a
Eps     \/ RE a
r       | RE a -> Bool
forall a. RE a -> Bool
nullable RE a
r = RE a
r
RE a
r       \/ RE a
Eps     | RE a -> Bool
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       = Name -> RE a -> RE (Var a) -> RE a
forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n RE a
x (RE (Var a)
r RE (Var a) -> RE (Var a) -> RE (Var a)
forall a. Ord a => RE a -> RE a -> RE a
\/ (a -> Var a) -> RE a -> RE (Var a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Var a
forall a. a -> Var a
F RE a
s)
RE a
r       \/ Let Name
n RE a
x RE (Var a)
s = Name -> RE a -> RE (Var a) -> RE a
forall a. Ord a => Name -> RE a -> RE (Var a) -> RE a
let_ Name
n RE a
x ((a -> Var a) -> RE a -> RE (Var a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Var a
forall a. a -> Var a
F RE a
r RE (Var a) -> RE (Var a) -> RE (Var a)
forall a. Ord a => RE a -> RE a -> RE a
\/ RE (Var a)
s)
RE a
r       \/ RE a
s       = (RE a -> RE a -> RE a) -> RE a -> [RE a] -> RE a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RE a -> RE a -> RE a
forall a. RE a -> RE a -> RE a
alt' RE a
forall a. RE a
Null ([RE a] -> RE a) -> [RE a] -> RE a
forall a b. (a -> b) -> a -> b
$ [RE a] -> [RE a]
forall a. Ord a => [a] -> [a]
ordNub (RE a -> [RE a] -> [RE a]
forall a. RE a -> [RE a] -> [RE a]
unfoldAlt RE a
r ([RE a] -> [RE a]) -> ([RE a] -> [RE a]) -> [RE a] -> [RE a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RE a -> [RE a] -> [RE a]
forall a. RE a -> [RE a] -> [RE a]
unfoldAlt RE a
s ([RE a] -> [RE a]) -> [RE a] -> [RE a]
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    = RE a -> RE a -> RE a
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 :: RE a -> [RE a] -> [RE a]
unfoldAlt (Alt RE a
a RE a
b) = RE a -> [RE a] -> [RE a]
forall a. RE a -> [RE a] -> [RE a]
unfoldAlt RE a
a ([RE a] -> [RE a]) -> ([RE a] -> [RE a]) -> [RE a] -> [RE a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RE a -> [RE a] -> [RE a]
forall a. RE a -> [RE a] -> [RE a]
unfoldAlt RE a
b
unfoldAlt RE a
r         = (RE a
r RE a -> [RE a] -> [RE a]
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 :: [a] -> [a]
ordNub = Set a -> [a] -> [a]
forall a. Ord a => Set a -> [a] -> [a]
go Set a
forall a. Set a
Set.empty where
    go :: Set a -> [a] -> [a]
go !Set a
_ []     = []
    go !Set a
s (a
x:[a]
xs)
        | a -> Set a -> Bool
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 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Set a -> [a] -> [a]
go (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
x Set a
s) [a]
xs