module GF.Speech.RegExp (RE(..), 
                         epsilonRE, nullRE, 
                         isEpsilon, isNull,
                         unionRE, concatRE, seqRE,
                         repeatRE, minimizeRE,
                         mapRE, mapRE', joinRE,
                         symbolsRE,
                         dfa2re, prRE) where

import Data.List

import GF.Data.Utilities
import GF.Speech.FiniteState

data RE a = 
      REUnion [RE a]  -- ^ REUnion [] is null
    | REConcat [RE a] -- ^ REConcat [] is epsilon
    | RERepeat (RE a)
    | RESymbol 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)


dfa2re :: (Ord a) => DFA a -> RE a
dfa2re :: DFA a -> RE a
dfa2re = DFA (RE a) -> RE a
forall a. Ord a => DFA (RE a) -> RE a
finalRE (DFA (RE a) -> RE a) -> (DFA a -> DFA (RE a)) -> DFA a -> RE a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DFA (RE a) -> DFA (RE a)
forall a. Ord a => DFA (RE a) -> DFA (RE a)
elimStates (DFA (RE a) -> DFA (RE a))
-> (DFA a -> DFA (RE a)) -> DFA a -> DFA (RE a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Int, Int, RE a)] -> [(Int, Int, RE a)])
-> DFA (RE a) -> DFA (RE a)
forall n b a. ([(n, n, b)] -> [(n, n, b)]) -> FA n a b -> FA n a b
modifyTransitions [(Int, Int, RE a)] -> [(Int, Int, RE a)]
forall a b a.
(Ord a, Ord b, Ord a) =>
[(a, b, RE a)] -> [(a, b, RE a)]
merge (DFA (RE a) -> DFA (RE a))
-> (DFA a -> DFA (RE a)) -> DFA a -> DFA (RE a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DFA (RE a) -> DFA (RE a)
forall n a a. FA n a (RE a) -> FA n a (RE a)
addLoops
             (DFA (RE a) -> DFA (RE a))
-> (DFA a -> DFA (RE a)) -> DFA a -> DFA (RE a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> RE a -> DFA (RE a) -> DFA (RE a)
forall a b n. a -> b -> FA n a b -> FA n a b
oneFinalState () RE a
forall a. RE a
epsilonRE (DFA (RE a) -> DFA (RE a))
-> (DFA a -> DFA (RE a)) -> DFA a -> DFA (RE a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> RE a) -> DFA a -> DFA (RE a)
forall b c n a. (b -> c) -> FA n a b -> FA n a c
mapTransitions a -> RE a
forall a. a -> RE a
RESymbol 
  where addLoops :: FA n a (RE a) -> FA n a (RE a)
addLoops FA n a (RE a)
fa = [(n, n, RE a)] -> FA n a (RE a) -> FA n a (RE a)
forall n b a. [(n, n, b)] -> FA n a b -> FA n a b
newTransitions [(n
s,n
s,RE a
forall a. RE a
nullRE) | (n
s,a
_) <- FA n a (RE a) -> [(n, a)]
forall n a b. FA n a b -> [(n, a)]
states FA n a (RE a)
fa] FA n a (RE a)
fa
        merge :: [(a, b, RE a)] -> [(a, b, RE a)]
merge [(a, b, RE a)]
es = [(a
f,b
t,[RE a] -> RE a
forall a. Ord a => [RE a] -> RE a
unionRE [RE a]
ls) 
                        | ((a
f,b
t),[RE a]
ls) <- [((a, b), RE a)] -> [((a, b), [RE a])]
forall a b. Ord a => [(a, b)] -> [(a, [b])]
buildMultiMap [((a
f,b
t),RE a
l) | (a
f,b
t,RE a
l) <- [(a, b, RE a)]
es]]

elimStates :: (Ord a) => DFA (RE a) -> DFA (RE a)
elimStates :: DFA (RE a) -> DFA (RE a)
elimStates DFA (RE a)
fa =
    case [Int
s | (Int
s,()
_) <- DFA (RE a) -> [(Int, ())]
forall n a b. FA n a b -> [(n, a)]
states DFA (RE a)
fa, DFA (RE a) -> Int -> Bool
forall n a b. Eq n => FA n a b -> n -> Bool
isInternal DFA (RE a)
fa Int
s] of
      [] -> DFA (RE a)
fa
      Int
sE:[Int]
_ -> DFA (RE a) -> DFA (RE a)
forall a. Ord a => DFA (RE a) -> DFA (RE a)
elimStates (DFA (RE a) -> DFA (RE a)) -> DFA (RE a) -> DFA (RE a)
forall a b. (a -> b) -> a -> b
$ (RE a -> RE a -> RE a)
-> [(Int, Int, RE a)] -> DFA (RE a) -> DFA (RE a)
forall n b a.
Eq n =>
(b -> b -> b) -> [(n, n, b)] -> FA n a b -> FA n a b
insertTransitionsWith (\RE a
x RE a
y -> [RE a] -> RE a
forall a. Ord a => [RE a] -> RE a
unionRE [RE a
x,RE a
y]) [(Int, Int, RE a)]
ts (DFA (RE a) -> DFA (RE a)) -> DFA (RE a) -> DFA (RE a)
forall a b. (a -> b) -> a -> b
$ Int -> DFA (RE a) -> DFA (RE a)
forall n a b. Ord n => n -> FA n a b -> FA n a b
removeState Int
sE DFA (RE a)
fa
          where sAs :: [(Int, RE a)]
sAs = Int -> DFA (RE a) -> [(Int, RE a)]
forall n a b. Eq n => n -> FA n a b -> [(n, b)]
nonLoopTransitionsTo Int
sE DFA (RE a)
fa
                sBs :: [(Int, RE a)]
sBs = Int -> DFA (RE a) -> [(Int, RE a)]
forall n a b. Eq n => n -> FA n a b -> [(n, b)]
nonLoopTransitionsFrom Int
sE DFA (RE a)
fa
                r2 :: RE a
r2 = [RE a] -> RE a
forall a. Ord a => [RE a] -> RE a
unionRE ([RE a] -> RE a) -> [RE a] -> RE a
forall a b. (a -> b) -> a -> b
$ Int -> DFA (RE a) -> [RE a]
forall n a b. Eq n => n -> FA n a b -> [b]
loops Int
sE DFA (RE a)
fa
                ts :: [(Int, Int, RE a)]
ts = [(Int
sA, Int
sB, RE a -> RE a -> RE a
r RE a
r1 RE a
r3) | (Int
sA,RE a
r1) <- [(Int, RE a)]
sAs, (Int
sB,RE a
r3) <- [(Int, RE a)]
sBs]
                r :: RE a -> RE a -> RE a
r RE a
r1 RE a
r3 = [RE a] -> RE a
forall a. [RE a] -> RE a
concatRE [RE a
r1, RE a -> RE a
forall a. RE a -> RE a
repeatRE RE a
r2, RE a
r3]

epsilonRE :: RE a
epsilonRE :: RE a
epsilonRE = [RE a] -> RE a
forall a. [RE a] -> RE a
REConcat []

nullRE :: RE a
nullRE :: RE a
nullRE = [RE a] -> RE a
forall a. [RE a] -> RE a
REUnion []

isNull :: RE a -> Bool
isNull :: RE a -> Bool
isNull (REUnion []) = Bool
True
isNull RE a
_ = Bool
False

isEpsilon :: RE a -> Bool
isEpsilon :: RE a -> Bool
isEpsilon (REConcat []) = Bool
True
isEpsilon RE a
_ = Bool
False

unionRE :: Ord a => [RE a] -> RE a
unionRE :: [RE a] -> RE a
unionRE = [RE a] -> RE a
forall a. [RE a] -> RE a
unionOrId ([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]
forall a. Ord a => [a] -> [a]
nub' ([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] -> [RE a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RE a -> [RE a]
forall a. RE a -> [RE a]
toList 
  where 
    toList :: RE a -> [RE a]
toList (REUnion [RE a]
xs) = [RE a]
xs
    toList RE a
x = [RE a
x]
    unionOrId :: [RE a] -> RE a
unionOrId [RE a
r] = RE a
r
    unionOrId [RE a]
rs = [RE a] -> RE a
forall a. [RE a] -> RE a
REUnion [RE a]
rs

concatRE :: [RE a] -> RE a
concatRE :: [RE a] -> RE a
concatRE [RE a]
xs | (RE a -> Bool) -> [RE a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any RE a -> Bool
forall a. RE a -> Bool
isNull [RE a]
xs = RE a
forall a. RE a
nullRE
            | Bool
otherwise = case (RE a -> [RE a]) -> [RE a] -> [RE a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RE a -> [RE a]
forall a. RE a -> [RE a]
toList [RE a]
xs of
                            [RE a
r] -> RE a
r
                            [RE a]
rs -> [RE a] -> RE a
forall a. [RE a] -> RE a
REConcat [RE a]
rs
  where
    toList :: RE a -> [RE a]
toList (REConcat [RE a]
xs) = [RE a]
xs
    toList RE a
x = [RE a
x]

seqRE :: [a] -> RE a
seqRE :: [a] -> RE a
seqRE = [RE a] -> RE a
forall a. [RE a] -> RE a
concatRE ([RE a] -> RE a) -> ([a] -> [RE a]) -> [a] -> RE a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> RE a) -> [a] -> [RE a]
forall a b. (a -> b) -> [a] -> [b]
map a -> RE a
forall a. a -> RE a
RESymbol

repeatRE :: RE a -> RE a
repeatRE :: RE a -> RE a
repeatRE RE a
x | RE a -> Bool
forall a. RE a -> Bool
isNull RE a
x Bool -> Bool -> Bool
|| RE a -> Bool
forall a. RE a -> Bool
isEpsilon RE a
x = RE a
forall a. RE a
epsilonRE
           | Bool
otherwise = RE a -> RE a
forall a. RE a -> RE a
RERepeat RE a
x

finalRE :: Ord a => DFA (RE a) -> RE a
finalRE :: DFA (RE a) -> RE a
finalRE DFA (RE a)
fa = [RE a] -> RE a
forall a. [RE a] -> RE a
concatRE [RE a -> RE a
forall a. RE a -> RE a
repeatRE RE a
r1, RE a
r2, 
                       RE a -> RE a
forall a. RE a -> RE a
repeatRE ([RE a] -> RE a
forall a. Ord a => [RE a] -> RE a
unionRE [RE a
r3, [RE a] -> RE a
forall a. [RE a] -> RE a
concatRE [RE a
r4, RE a -> RE a
forall a. RE a -> RE a
repeatRE RE a
r1, RE a
r2]])]
  where 
    s0 :: Int
s0 = DFA (RE a) -> Int
forall n a b. FA n a b -> n
startState DFA (RE a)
fa
    [Int
sF] = DFA (RE a) -> [Int]
forall n a b. FA n a b -> [n]
finalStates DFA (RE a)
fa
    r1 :: RE a
r1 = [RE a] -> RE a
forall a. Ord a => [RE a] -> RE a
unionRE ([RE a] -> RE a) -> [RE a] -> RE a
forall a b. (a -> b) -> a -> b
$ Int -> DFA (RE a) -> [RE a]
forall n a b. Eq n => n -> FA n a b -> [b]
loops Int
s0 DFA (RE a)
fa
    r2 :: RE a
r2 = [RE a] -> RE a
forall a. Ord a => [RE a] -> RE a
unionRE ([RE a] -> RE a) -> [RE a] -> RE a
forall a b. (a -> b) -> a -> b
$ ((Int, RE a) -> RE a) -> [(Int, RE a)] -> [RE a]
forall a b. (a -> b) -> [a] -> [b]
map (Int, RE a) -> RE a
forall a b. (a, b) -> b
snd ([(Int, RE a)] -> [RE a]) -> [(Int, RE a)] -> [RE a]
forall a b. (a -> b) -> a -> b
$ Int -> DFA (RE a) -> [(Int, RE a)]
forall n a b. Eq n => n -> FA n a b -> [(n, b)]
nonLoopTransitionsTo Int
sF DFA (RE a)
fa
    r3 :: RE a
r3 = [RE a] -> RE a
forall a. Ord a => [RE a] -> RE a
unionRE ([RE a] -> RE a) -> [RE a] -> RE a
forall a b. (a -> b) -> a -> b
$ Int -> DFA (RE a) -> [RE a]
forall n a b. Eq n => n -> FA n a b -> [b]
loops Int
sF DFA (RE a)
fa
    r4 :: RE a
r4 = [RE a] -> RE a
forall a. Ord a => [RE a] -> RE a
unionRE ([RE a] -> RE a) -> [RE a] -> RE a
forall a b. (a -> b) -> a -> b
$ ((Int, RE a) -> RE a) -> [(Int, RE a)] -> [RE a]
forall a b. (a -> b) -> [a] -> [b]
map (Int, RE a) -> RE a
forall a b. (a, b) -> b
snd ([(Int, RE a)] -> [RE a]) -> [(Int, RE a)] -> [RE a]
forall a b. (a -> b) -> a -> b
$ Int -> DFA (RE a) -> [(Int, RE a)]
forall n a b. Eq n => n -> FA n a b -> [(n, b)]
nonLoopTransitionsFrom Int
sF DFA (RE a)
fa

reverseRE :: RE a -> RE a
reverseRE :: RE a -> RE a
reverseRE (REConcat [RE a]
xs) = [RE a] -> RE a
forall a. [RE a] -> RE a
REConcat ([RE a] -> RE a) -> [RE a] -> RE a
forall a b. (a -> b) -> a -> b
$ (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
reverseRE ([RE a] -> [RE a]) -> [RE a] -> [RE a]
forall a b. (a -> b) -> a -> b
$ [RE a] -> [RE a]
forall a. [a] -> [a]
reverse [RE a]
xs
reverseRE (REUnion [RE a]
xs) = [RE a] -> RE a
forall a. [RE a] -> RE a
REUnion ((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
reverseRE [RE a]
xs)
reverseRE (RERepeat RE a
x) = RE a -> RE a
forall a. RE a -> RE a
RERepeat (RE a -> RE a
forall a. RE a -> RE a
reverseRE RE a
x)
reverseRE RE a
x = RE a
x

minimizeRE :: Ord a => RE a -> RE a
minimizeRE :: RE a -> RE a
minimizeRE = RE a -> RE a
forall a. RE a -> RE a
reverseRE (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
forall a. Ord a => RE a -> RE a
mergeForward (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
forall a. RE a -> RE a
reverseRE (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
forall a. Ord a => RE a -> RE a
mergeForward

mergeForward :: Ord a => RE a -> RE a
mergeForward :: RE a -> RE a
mergeForward (REUnion [RE a]
xs) = 
    [RE a] -> RE a
forall a. Ord a => [RE a] -> RE a
unionRE [[RE a] -> RE a
forall a. [RE a] -> RE a
concatRE [RE a -> RE a
forall a. Ord a => RE a -> RE a
mergeForward RE a
y,RE a -> RE a
forall a. Ord a => RE a -> RE a
mergeForward ([RE a] -> RE a
forall a. Ord a => [RE a] -> RE a
unionRE [RE a]
rs)] | (RE a
y,[RE a]
rs) <- [(RE a, RE a)] -> [(RE a, [RE a])]
forall a b. Ord a => [(a, b)] -> [(a, [b])]
buildMultiMap ((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)
forall a. RE a -> (RE a, RE a)
firstRE [RE a]
xs)]
mergeForward (REConcat (RE a
x:[RE a]
xs)) = [RE a] -> RE a
forall a. [RE a] -> RE a
concatRE [RE a -> RE a
forall a. Ord a => RE a -> RE a
mergeForward RE a
x,RE a -> RE a
forall a. Ord a => RE a -> RE a
mergeForward ([RE a] -> RE a
forall a. [RE a] -> RE a
REConcat [RE a]
xs)]
mergeForward (RERepeat RE a
r) = RE a -> RE a
forall a. RE a -> RE a
repeatRE (RE a -> RE a
forall a. Ord a => RE a -> RE a
mergeForward RE a
r)
mergeForward RE a
r = RE a
r

firstRE :: RE a -> (RE a, RE a)
firstRE :: RE a -> (RE a, RE a)
firstRE (REConcat (RE a
x:[RE a]
xs)) = (RE a
x, [RE a] -> RE a
forall a. [RE a] -> RE a
REConcat [RE a]
xs)
firstRE RE a
r = (RE a
r,RE a
forall a. RE a
epsilonRE)

mapRE :: (a -> b) -> RE a -> RE b
mapRE :: (a -> b) -> RE a -> RE b
mapRE a -> b
f = (a -> RE b) -> RE a -> RE b
forall a b. (a -> RE b) -> RE a -> RE b
mapRE' (b -> RE b
forall a. a -> RE a
RESymbol (b -> RE b) -> (a -> b) -> a -> RE b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

mapRE' :: (a -> RE b) -> RE a -> RE b
mapRE' :: (a -> RE b) -> RE a -> RE b
mapRE' a -> RE b
f (REConcat [RE a]
xs) = [RE b] -> RE b
forall a. [RE a] -> RE a
REConcat ((RE a -> RE b) -> [RE a] -> [RE b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> RE b) -> RE a -> RE b
forall a b. (a -> RE b) -> RE a -> RE b
mapRE' a -> RE b
f) [RE a]
xs)
mapRE' a -> RE b
f (REUnion [RE a]
xs) = [RE b] -> RE b
forall a. [RE a] -> RE a
REUnion ((RE a -> RE b) -> [RE a] -> [RE b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> RE b) -> RE a -> RE b
forall a b. (a -> RE b) -> RE a -> RE b
mapRE' a -> RE b
f) [RE a]
xs)
mapRE' a -> RE b
f (RERepeat RE a
x) = RE b -> RE b
forall a. RE a -> RE a
RERepeat ((a -> RE b) -> RE a -> RE b
forall a b. (a -> RE b) -> RE a -> RE b
mapRE' a -> RE b
f RE a
x)
mapRE' a -> RE b
f (RESymbol a
s) = a -> RE b
f a
s

joinRE :: RE (RE a) -> RE a
joinRE :: RE (RE a) -> RE a
joinRE (REConcat [RE (RE a)]
xs) = [RE a] -> RE a
forall a. [RE a] -> RE a
REConcat ((RE (RE a) -> RE a) -> [RE (RE a)] -> [RE a]
forall a b. (a -> b) -> [a] -> [b]
map RE (RE a) -> RE a
forall a. RE (RE a) -> RE a
joinRE [RE (RE a)]
xs)
joinRE (REUnion [RE (RE a)]
xs) = [RE a] -> RE a
forall a. [RE a] -> RE a
REUnion ((RE (RE a) -> RE a) -> [RE (RE a)] -> [RE a]
forall a b. (a -> b) -> [a] -> [b]
map RE (RE a) -> RE a
forall a. RE (RE a) -> RE a
joinRE [RE (RE a)]
xs)
joinRE (RERepeat RE (RE a)
xs) = RE a -> RE a
forall a. RE a -> RE a
RERepeat (RE (RE a) -> RE a
forall a. RE (RE a) -> RE a
joinRE RE (RE a)
xs)
joinRE (RESymbol RE a
ss) = RE a
ss

symbolsRE :: RE a -> [a]
symbolsRE :: RE a -> [a]
symbolsRE (REConcat [RE a]
xs) = (RE a -> [a]) -> [RE a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RE a -> [a]
forall a. RE a -> [a]
symbolsRE [RE a]
xs
symbolsRE (REUnion [RE a]
xs) = (RE a -> [a]) -> [RE a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RE a -> [a]
forall a. RE a -> [a]
symbolsRE [RE a]
xs
symbolsRE (RERepeat RE a
x) = RE a -> [a]
forall a. RE a -> [a]
symbolsRE RE a
x
symbolsRE (RESymbol a
x) = [a
x]

-- Debugging

prRE :: (a -> String) -> RE a -> String
prRE :: (a -> String) -> RE a -> String
prRE = Int -> (a -> String) -> RE a -> String
forall a. Int -> (a -> String) -> RE a -> String
prRE' Int
0

prRE' :: Int -> (a -> String) -> RE a -> String
prRE' :: Int -> (a -> String) -> RE a -> String
prRE' Int
_ a -> String
_ (REUnion []) = String
"<NULL>"
prRE' Int
n a -> String
f (REUnion [RE a]
xs) = Int -> Int -> ShowS
forall a. Ord a => a -> a -> ShowS
p Int
n Int
1 ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
" | " ((RE a -> String) -> [RE a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> (a -> String) -> RE a -> String
forall a. Int -> (a -> String) -> RE a -> String
prRE' Int
1 a -> String
f) [RE a]
xs)))
prRE' Int
n a -> String
f (REConcat [RE a]
xs) = Int -> Int -> ShowS
forall a. Ord a => a -> a -> ShowS
p Int
n Int
2 ([String] -> String
unwords ((RE a -> String) -> [RE a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> (a -> String) -> RE a -> String
forall a. Int -> (a -> String) -> RE a -> String
prRE' Int
2 a -> String
f) [RE a]
xs))
prRE' Int
n a -> String
f (RERepeat RE a
x) = Int -> Int -> ShowS
forall a. Ord a => a -> a -> ShowS
p Int
n Int
3 (Int -> (a -> String) -> RE a -> String
forall a. Int -> (a -> String) -> RE a -> String
prRE' Int
3 a -> String
f RE a
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"*"
prRE' Int
_ a -> String
f (RESymbol a
s) = a -> String
f a
s

p :: a -> a -> ShowS
p a
n a
m String
s | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
m = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
        | Bool
True = String
s