{-# 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
module RERE.Type (
RE (..),
ch_, (\/), star_, let_, fix_, (>>>=),
#ifdef RERE_INTERSECTION
(/\),
#endif
string_,
nullable,
derivative,
match,
compact,
size,
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
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
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 :: 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
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 :: Char -> RE Void -> RE Void
derivative :: Char -> RE Void -> RE Void
derivative = Char -> RE Void -> RE Void
derivative1
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 :: 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
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
= 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 :: 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 :: 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 :: 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
(>>>=) :: 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 >>>=
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
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
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
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_ 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
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_ 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)
-> (Var a -> Maybe b)
-> (RE (Var (Var a)) -> RE (Var b))
-> Maybe (RE b)
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 \/
(\/) :: 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 /\
(/\) :: 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)
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
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