module Text.Regex.TDFA.CorePattern(Q(..),P(..),WhichTest(..),Wanted(..)
,TestInfo,OP(..),SetTestInfo(..),NullView
,patternToQ,cleanNullView,cannotAccept,mustAccept) where
import Control.Monad (liftM2, forM, replicateM)
import Control.Monad.RWS (RWS, runRWS, ask, local, listens, tell, get, put)
import Data.Array.IArray(Array,(!),accumArray,listArray)
import Data.Either (partitionEithers, rights)
import Data.List(sort)
import Data.IntMap.EnumMap2(EnumMap)
import qualified Data.IntMap.EnumMap2 as Map(singleton,null,assocs,keysSet)
import Data.IntSet.EnumSet2(EnumSet)
import qualified Data.IntSet.EnumSet2 as Set(singleton,toList,isSubsetOf)
import Data.Semigroup as Sem
import Text.Regex.TDFA.Common
import Text.Regex.TDFA.Pattern(Pattern(..),starTrans)
data P = Empty
| Or [Q]
| Seq Q Q
| Star { P -> Maybe GroupIndex
getOrbit :: Maybe Tag
, P -> [GroupIndex]
resetOrbits :: [Tag]
, P -> Bool
firstNull :: Bool
, P -> Q
unStar :: Q}
| Test TestInfo
| OneChar Pattern
| NonEmpty Q
deriving (GroupIndex -> P -> ShowS
[P] -> ShowS
P -> String
(GroupIndex -> P -> ShowS)
-> (P -> String) -> ([P] -> ShowS) -> Show P
forall a.
(GroupIndex -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: GroupIndex -> P -> ShowS
showsPrec :: GroupIndex -> P -> ShowS
$cshow :: P -> String
show :: P -> String
$cshowList :: [P] -> ShowS
showList :: [P] -> ShowS
Show,P -> P -> Bool
(P -> P -> Bool) -> (P -> P -> Bool) -> Eq P
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: P -> P -> Bool
== :: P -> P -> Bool
$c/= :: P -> P -> Bool
/= :: P -> P -> Bool
Eq)
data Q = Q {Q -> NullView
nullQ :: NullView
,Q -> (GroupIndex, Maybe GroupIndex)
takes :: (Position,Maybe Position)
,Q -> [GroupIndex]
preReset :: [Tag]
,Q -> [GroupIndex]
postSet :: [Tag]
,Q -> Maybe GroupIndex
preTag,Q -> Maybe GroupIndex
postTag :: Maybe Tag
,Q -> Bool
tagged :: Bool
,Q -> Bool
childGroups :: Bool
,Q -> Wanted
wants :: Wanted
,Q -> P
unQ :: P} deriving (Q -> Q -> Bool
(Q -> Q -> Bool) -> (Q -> Q -> Bool) -> Eq Q
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Q -> Q -> Bool
== :: Q -> Q -> Bool
$c/= :: Q -> Q -> Bool
/= :: Q -> Q -> Bool
Eq)
type TestInfo = (WhichTest,DoPa)
newtype SetTestInfo = SetTestInfo {SetTestInfo -> EnumMap WhichTest (EnumSet DoPa)
getTests :: EnumMap WhichTest (EnumSet DoPa)} deriving (SetTestInfo -> SetTestInfo -> Bool
(SetTestInfo -> SetTestInfo -> Bool)
-> (SetTestInfo -> SetTestInfo -> Bool) -> Eq SetTestInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SetTestInfo -> SetTestInfo -> Bool
== :: SetTestInfo -> SetTestInfo -> Bool
$c/= :: SetTestInfo -> SetTestInfo -> Bool
/= :: SetTestInfo -> SetTestInfo -> Bool
Eq)
instance Semigroup SetTestInfo where
SetTestInfo EnumMap WhichTest (EnumSet DoPa)
x <> :: SetTestInfo -> SetTestInfo -> SetTestInfo
<> SetTestInfo EnumMap WhichTest (EnumSet DoPa)
y = EnumMap WhichTest (EnumSet DoPa) -> SetTestInfo
SetTestInfo (EnumMap WhichTest (EnumSet DoPa)
x EnumMap WhichTest (EnumSet DoPa)
-> EnumMap WhichTest (EnumSet DoPa)
-> EnumMap WhichTest (EnumSet DoPa)
forall a. Semigroup a => a -> a -> a
Sem.<> EnumMap WhichTest (EnumSet DoPa)
y)
instance Monoid SetTestInfo where
mempty :: SetTestInfo
mempty = EnumMap WhichTest (EnumSet DoPa) -> SetTestInfo
SetTestInfo EnumMap WhichTest (EnumSet DoPa)
forall a. Monoid a => a
mempty
mappend :: SetTestInfo -> SetTestInfo -> SetTestInfo
mappend = SetTestInfo -> SetTestInfo -> SetTestInfo
forall a. Semigroup a => a -> a -> a
(Sem.<>)
instance Show SetTestInfo where
show :: SetTestInfo -> String
show (SetTestInfo EnumMap WhichTest (EnumSet DoPa)
sti) = String
"SetTestInfo "String -> ShowS
forall a. [a] -> [a] -> [a]
++[(WhichTest, [DoPa])] -> String
forall a. Show a => a -> String
show ((EnumSet DoPa -> [DoPa])
-> [(WhichTest, EnumSet DoPa)] -> [(WhichTest, [DoPa])]
forall (f :: * -> *) t1 t2 t.
Functor f =>
(t1 -> t2) -> f (t, t1) -> f (t, t2)
mapSnd (EnumSet DoPa -> [DoPa]
forall e. Enum e => EnumSet e -> [e]
Set.toList) ([(WhichTest, EnumSet DoPa)] -> [(WhichTest, [DoPa])])
-> [(WhichTest, EnumSet DoPa)] -> [(WhichTest, [DoPa])]
forall a b. (a -> b) -> a -> b
$ EnumMap WhichTest (EnumSet DoPa) -> [(WhichTest, EnumSet DoPa)]
forall key a. Enum key => EnumMap key a -> [(key, a)]
Map.assocs EnumMap WhichTest (EnumSet DoPa)
sti)
type NullView = [(SetTestInfo,TagList)]
data HandleTag = NoTag
| Advice Tag
| Apply Tag
deriving (GroupIndex -> HandleTag -> ShowS
[HandleTag] -> ShowS
HandleTag -> String
(GroupIndex -> HandleTag -> ShowS)
-> (HandleTag -> String)
-> ([HandleTag] -> ShowS)
-> Show HandleTag
forall a.
(GroupIndex -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: GroupIndex -> HandleTag -> ShowS
showsPrec :: GroupIndex -> HandleTag -> ShowS
$cshow :: HandleTag -> String
show :: HandleTag -> String
$cshowList :: [HandleTag] -> ShowS
showList :: [HandleTag] -> ShowS
Show)
data Wanted = WantsQNFA | WantsQT | WantsBoth | WantsEither deriving (Wanted -> Wanted -> Bool
(Wanted -> Wanted -> Bool)
-> (Wanted -> Wanted -> Bool) -> Eq Wanted
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Wanted -> Wanted -> Bool
== :: Wanted -> Wanted -> Bool
$c/= :: Wanted -> Wanted -> Bool
/= :: Wanted -> Wanted -> Bool
Eq,GroupIndex -> Wanted -> ShowS
[Wanted] -> ShowS
Wanted -> String
(GroupIndex -> Wanted -> ShowS)
-> (Wanted -> String) -> ([Wanted] -> ShowS) -> Show Wanted
forall a.
(GroupIndex -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: GroupIndex -> Wanted -> ShowS
showsPrec :: GroupIndex -> Wanted -> ShowS
$cshow :: Wanted -> String
show :: Wanted -> String
$cshowList :: [Wanted] -> ShowS
showList :: [Wanted] -> ShowS
Show)
instance Show Q where
show :: Q -> String
show = Q -> String
showQ
showQ :: Q -> String
showQ :: Q -> String
showQ Q
q = String
"Q { nullQ = "String -> ShowS
forall a. [a] -> [a] -> [a]
++NullView -> String
forall a. Show a => a -> String
show (Q -> NullView
nullQ Q
q)String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"\n , takes = "String -> ShowS
forall a. [a] -> [a] -> [a]
++(GroupIndex, Maybe GroupIndex) -> String
forall a. Show a => a -> String
show (Q -> (GroupIndex, Maybe GroupIndex)
takes Q
q)String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"\n , preReset = "String -> ShowS
forall a. [a] -> [a] -> [a]
++[GroupIndex] -> String
forall a. Show a => a -> String
show (Q -> [GroupIndex]
preReset Q
q)String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"\n , postSet = "String -> ShowS
forall a. [a] -> [a] -> [a]
++[GroupIndex] -> String
forall a. Show a => a -> String
show (Q -> [GroupIndex]
postSet Q
q)String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"\n , preTag = "String -> ShowS
forall a. [a] -> [a] -> [a]
++Maybe GroupIndex -> String
forall a. Show a => a -> String
show (Q -> Maybe GroupIndex
preTag Q
q)String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"\n , postTag = "String -> ShowS
forall a. [a] -> [a] -> [a]
++Maybe GroupIndex -> String
forall a. Show a => a -> String
show (Q -> Maybe GroupIndex
postTag Q
q)String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"\n , tagged = "String -> ShowS
forall a. [a] -> [a] -> [a]
++Bool -> String
forall a. Show a => a -> String
show (Q -> Bool
tagged Q
q)String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"\n , wants = "String -> ShowS
forall a. [a] -> [a] -> [a]
++Wanted -> String
forall a. Show a => a -> String
show (Q -> Wanted
wants Q
q)String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"\n , unQ = "String -> ShowS
forall a. [a] -> [a] -> [a]
++ P -> String
indent' (Q -> P
unQ Q
q)String -> ShowS
forall a. [a] -> [a] -> [a]
++String
" }"
where indent' :: P -> String
indent' = [String] -> String
unlines ([String] -> String) -> (P -> [String]) -> P -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\[String]
s -> case [String]
s of
[] -> []
(String
h:[String]
t) -> String
h String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
spaces String -> ShowS
forall a. [a] -> [a] -> [a]
++) [String]
t)) ([String] -> [String]) -> (P -> [String]) -> P -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> [String]) -> (P -> String) -> P -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. P -> String
forall a. Show a => a -> String
show
spaces :: String
spaces = GroupIndex -> Char -> String
forall a. GroupIndex -> a -> [a]
replicate GroupIndex
10 Char
' '
notNull :: NullView
notNull :: NullView
notNull = []
promotePreTag :: HandleTag -> TagList
promotePreTag :: HandleTag -> TagList
promotePreTag = TagList -> (GroupIndex -> TagList) -> Maybe GroupIndex -> TagList
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\GroupIndex
x -> [(GroupIndex
x,TagTask -> TagUpdate
PreUpdate TagTask
TagTask)]) (Maybe GroupIndex -> TagList)
-> (HandleTag -> Maybe GroupIndex) -> HandleTag -> TagList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandleTag -> Maybe GroupIndex
apply
makeEmptyNullView :: HandleTag -> HandleTag -> NullView
makeEmptyNullView :: HandleTag -> HandleTag -> NullView
makeEmptyNullView HandleTag
a HandleTag
b = [(SetTestInfo
forall a. Monoid a => a
mempty, HandleTag -> TagList
promotePreTag HandleTag
a TagList -> TagList -> TagList
forall a. [a] -> [a] -> [a]
++ HandleTag -> TagList
promotePreTag HandleTag
b)]
makeTestNullView :: TestInfo -> HandleTag -> HandleTag -> NullView
makeTestNullView :: TestInfo -> HandleTag -> HandleTag -> NullView
makeTestNullView (WhichTest
w,DoPa
d) HandleTag
a HandleTag
b = [(EnumMap WhichTest (EnumSet DoPa) -> SetTestInfo
SetTestInfo (WhichTest -> EnumSet DoPa -> EnumMap WhichTest (EnumSet DoPa)
forall key a. Enum key => key -> a -> EnumMap key a
Map.singleton WhichTest
w (DoPa -> EnumSet DoPa
forall e. Enum e => e -> EnumSet e
Set.singleton DoPa
d)), HandleTag -> TagList
promotePreTag HandleTag
a TagList -> TagList -> TagList
forall a. [a] -> [a] -> [a]
++ HandleTag -> TagList
promotePreTag HandleTag
b)]
tagWrapNullView :: HandleTag -> HandleTag -> NullView -> NullView
tagWrapNullView :: HandleTag -> HandleTag -> NullView -> NullView
tagWrapNullView HandleTag
a HandleTag
b NullView
oldNV =
case (HandleTag -> TagList
promotePreTag HandleTag
a, HandleTag -> TagList
promotePreTag HandleTag
b) of
([],[]) -> NullView
oldNV
(TagList
pre,TagList
post) -> do
(SetTestInfo
oldTests,TagList
oldTasks) <- NullView
oldNV
(SetTestInfo, TagList) -> NullView
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (SetTestInfo
oldTests,TagList
preTagList -> TagList -> TagList
forall a. [a] -> [a] -> [a]
++TagList
oldTasksTagList -> TagList -> TagList
forall a. [a] -> [a] -> [a]
++TagList
post)
addGroupResetsToNullView :: [Tag] -> Tag -> NullView -> NullView
addGroupResetsToNullView :: [GroupIndex] -> GroupIndex -> NullView -> NullView
addGroupResetsToNullView [GroupIndex]
groupResets GroupIndex
groupSet NullView
nv = [ (SetTestInfo
test, TagList -> TagList
prepend (TagList -> TagList
append TagList
tags) ) | (SetTestInfo
test,TagList
tags) <- NullView
nv ]
where prepend :: TagList -> TagList
prepend = ((GroupIndex, TagUpdate)
-> (TagList -> TagList) -> TagList -> TagList)
-> (TagList -> TagList) -> TagList -> TagList -> TagList
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(GroupIndex, TagUpdate)
h TagList -> TagList
t -> ((GroupIndex, TagUpdate)
h(GroupIndex, TagUpdate) -> TagList -> TagList
forall a. a -> [a] -> [a]
:)(TagList -> TagList) -> (TagList -> TagList) -> TagList -> TagList
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TagList -> TagList
t) TagList -> TagList
forall a. a -> a
id (TagList -> TagList -> TagList)
-> ([GroupIndex] -> TagList) -> [GroupIndex] -> TagList -> TagList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GroupIndex -> (GroupIndex, TagUpdate)) -> [GroupIndex] -> TagList
forall a b. (a -> b) -> [a] -> [b]
map (\GroupIndex
tag->(GroupIndex
tag,TagTask -> TagUpdate
PreUpdate TagTask
ResetGroupStopTask)) ([GroupIndex] -> TagList -> TagList)
-> [GroupIndex] -> TagList -> TagList
forall a b. (a -> b) -> a -> b
$ [GroupIndex]
groupResets
append :: TagList -> TagList
append = (TagList -> TagList -> TagList
forall a. [a] -> [a] -> [a]
++[(GroupIndex
groupSet,TagTask -> TagUpdate
PreUpdate TagTask
SetGroupStopTask)])
orbitWrapNullView :: Maybe Tag -> [Tag] -> NullView -> NullView
orbitWrapNullView :: Maybe GroupIndex -> [GroupIndex] -> NullView -> NullView
orbitWrapNullView Maybe GroupIndex
mOrbit [GroupIndex]
orbitResets NullView
oldNV =
case (Maybe GroupIndex
mOrbit,[GroupIndex]
orbitResets) of
(Maybe GroupIndex
Nothing,[]) -> NullView
oldNV
(Maybe GroupIndex
Nothing,[GroupIndex]
_) -> do (SetTestInfo
oldTests,TagList
oldTasks) <- NullView
oldNV
(SetTestInfo, TagList) -> NullView
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (SetTestInfo
oldTests,TagList -> TagList
prepend TagList
oldTasks)
(Just GroupIndex
o,[GroupIndex]
_) -> do (SetTestInfo
oldTests,TagList
oldTasks) <- NullView
oldNV
(SetTestInfo, TagList) -> NullView
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (SetTestInfo
oldTests,TagList -> TagList
prepend (TagList -> TagList) -> TagList -> TagList
forall a b. (a -> b) -> a -> b
$ [(GroupIndex
o,TagTask -> TagUpdate
PreUpdate TagTask
EnterOrbitTask)] TagList -> TagList -> TagList
forall a. [a] -> [a] -> [a]
++ TagList
oldTasks TagList -> TagList -> TagList
forall a. [a] -> [a] -> [a]
++ [(GroupIndex
o,TagTask -> TagUpdate
PreUpdate TagTask
LeaveOrbitTask)])
where prepend :: TagList -> TagList
prepend = ((GroupIndex, TagUpdate)
-> (TagList -> TagList) -> TagList -> TagList)
-> (TagList -> TagList) -> TagList -> TagList -> TagList
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(GroupIndex, TagUpdate)
h TagList -> TagList
t -> ((GroupIndex, TagUpdate)
h(GroupIndex, TagUpdate) -> TagList -> TagList
forall a. a -> [a] -> [a]
:)(TagList -> TagList) -> (TagList -> TagList) -> TagList -> TagList
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TagList -> TagList
t) TagList -> TagList
forall a. a -> a
id (TagList -> TagList -> TagList)
-> ([GroupIndex] -> TagList) -> [GroupIndex] -> TagList -> TagList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GroupIndex -> (GroupIndex, TagUpdate)) -> [GroupIndex] -> TagList
forall a b. (a -> b) -> [a] -> [b]
map (\GroupIndex
tag->(GroupIndex
tag,TagTask -> TagUpdate
PreUpdate TagTask
ResetOrbitTask)) ([GroupIndex] -> TagList -> TagList)
-> [GroupIndex] -> TagList -> TagList
forall a b. (a -> b) -> a -> b
$ [GroupIndex]
orbitResets
cleanNullView :: NullView -> NullView
cleanNullView :: NullView -> NullView
cleanNullView [] = []
cleanNullView (first :: (SetTestInfo, TagList)
first@(SetTestInfo EnumMap WhichTest (EnumSet DoPa)
sti,TagList
_):NullView
rest) | EnumMap WhichTest (EnumSet DoPa) -> Bool
forall key a. Enum key => EnumMap key a -> Bool
Map.null EnumMap WhichTest (EnumSet DoPa)
sti = (SetTestInfo, TagList)
first (SetTestInfo, TagList) -> NullView -> NullView
forall a. a -> [a] -> [a]
: []
| Bool
otherwise =
(SetTestInfo, TagList)
first (SetTestInfo, TagList) -> NullView -> NullView
forall a. a -> [a] -> [a]
: NullView -> NullView
cleanNullView (((SetTestInfo, TagList) -> Bool) -> NullView -> NullView
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((SetTestInfo, TagList) -> Bool)
-> (SetTestInfo, TagList)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumSet WhichTest
setTI EnumSet WhichTest -> EnumSet WhichTest -> Bool
forall e. Enum e => EnumSet e -> EnumSet e -> Bool
`Set.isSubsetOf`) (EnumSet WhichTest -> Bool)
-> ((SetTestInfo, TagList) -> EnumSet WhichTest)
-> (SetTestInfo, TagList)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap WhichTest (EnumSet DoPa) -> EnumSet WhichTest
forall key a. Enum key => EnumMap key a -> EnumSet key
Map.keysSet (EnumMap WhichTest (EnumSet DoPa) -> EnumSet WhichTest)
-> ((SetTestInfo, TagList) -> EnumMap WhichTest (EnumSet DoPa))
-> (SetTestInfo, TagList)
-> EnumSet WhichTest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SetTestInfo -> EnumMap WhichTest (EnumSet DoPa)
getTests (SetTestInfo -> EnumMap WhichTest (EnumSet DoPa))
-> ((SetTestInfo, TagList) -> SetTestInfo)
-> (SetTestInfo, TagList)
-> EnumMap WhichTest (EnumSet DoPa)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SetTestInfo, TagList) -> SetTestInfo
forall a b. (a, b) -> a
fst) NullView
rest)
where setTI :: EnumSet WhichTest
setTI = EnumMap WhichTest (EnumSet DoPa) -> EnumSet WhichTest
forall key a. Enum key => EnumMap key a -> EnumSet key
Map.keysSet EnumMap WhichTest (EnumSet DoPa)
sti
mergeNullViews :: NullView -> NullView -> NullView
mergeNullViews :: NullView -> NullView -> NullView
mergeNullViews NullView
s1 NullView
s2 = NullView -> NullView
cleanNullView (NullView -> NullView) -> NullView -> NullView
forall a b. (a -> b) -> a -> b
$ do
(SetTestInfo
test1,TagList
tag1) <- NullView
s1
(SetTestInfo
test2,TagList
tag2) <- NullView
s2
(SetTestInfo, TagList) -> NullView
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (SetTestInfo -> SetTestInfo -> SetTestInfo
forall a. Monoid a => a -> a -> a
mappend SetTestInfo
test1 SetTestInfo
test2,TagList -> TagList -> TagList
forall a. Monoid a => a -> a -> a
mappend TagList
tag1 TagList
tag2)
seqTake :: (Int, Maybe Int) -> (Int, Maybe Int) -> (Int, Maybe Int)
seqTake :: (GroupIndex, Maybe GroupIndex)
-> (GroupIndex, Maybe GroupIndex) -> (GroupIndex, Maybe GroupIndex)
seqTake (GroupIndex
x1,Maybe GroupIndex
y1) (GroupIndex
x2,Maybe GroupIndex
y2) = (GroupIndex
x1GroupIndex -> GroupIndex -> GroupIndex
forall a. Num a => a -> a -> a
+GroupIndex
x2,(GroupIndex -> GroupIndex -> GroupIndex)
-> Maybe GroupIndex -> Maybe GroupIndex -> Maybe GroupIndex
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 GroupIndex -> GroupIndex -> GroupIndex
forall a. Num a => a -> a -> a
(+) Maybe GroupIndex
y1 Maybe GroupIndex
y2)
orTakes :: [(Int, Maybe Int)] -> (Int,Maybe Int)
orTakes :: [(GroupIndex, Maybe GroupIndex)] -> (GroupIndex, Maybe GroupIndex)
orTakes [] = (GroupIndex
0,GroupIndex -> Maybe GroupIndex
forall a. a -> Maybe a
Just GroupIndex
0)
orTakes [(GroupIndex, Maybe GroupIndex)]
ts = let ([GroupIndex]
xs,[Maybe GroupIndex]
ys) = [(GroupIndex, Maybe GroupIndex)]
-> ([GroupIndex], [Maybe GroupIndex])
forall a b. [(a, b)] -> ([a], [b])
unzip [(GroupIndex, Maybe GroupIndex)]
ts
in ([GroupIndex] -> GroupIndex
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [GroupIndex]
xs, (Maybe GroupIndex -> Maybe GroupIndex -> Maybe GroupIndex)
-> [Maybe GroupIndex] -> Maybe GroupIndex
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 ((GroupIndex -> GroupIndex -> GroupIndex)
-> Maybe GroupIndex -> Maybe GroupIndex -> Maybe GroupIndex
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 GroupIndex -> GroupIndex -> GroupIndex
forall a. Ord a => a -> a -> a
max) [Maybe GroupIndex]
ys)
apply :: HandleTag -> Maybe Tag
apply :: HandleTag -> Maybe GroupIndex
apply (Apply GroupIndex
tag) = GroupIndex -> Maybe GroupIndex
forall a. a -> Maybe a
Just GroupIndex
tag
apply HandleTag
_ = Maybe GroupIndex
forall a. Maybe a
Nothing
toAdvice :: HandleTag -> HandleTag
toAdvice :: HandleTag -> HandleTag
toAdvice (Apply GroupIndex
tag) = GroupIndex -> HandleTag
Advice GroupIndex
tag
toAdvice HandleTag
s = HandleTag
s
noTag :: HandleTag -> Bool
noTag :: HandleTag -> Bool
noTag HandleTag
NoTag = Bool
True
noTag HandleTag
_ = Bool
False
fromHandleTag :: HandleTag -> Tag
fromHandleTag :: HandleTag -> GroupIndex
fromHandleTag (Apply GroupIndex
tag) = GroupIndex
tag
fromHandleTag (Advice GroupIndex
tag) = GroupIndex
tag
fromHandleTag HandleTag
_ = String -> GroupIndex
forall a. HasCallStack => String -> a
error String
"fromHandleTag"
varies :: Q -> Bool
varies :: Q -> Bool
varies Q {takes :: Q -> (GroupIndex, Maybe GroupIndex)
takes = (GroupIndex
_,Maybe GroupIndex
Nothing)} = Bool
True
varies Q {takes :: Q -> (GroupIndex, Maybe GroupIndex)
takes = (GroupIndex
x,Just GroupIndex
y)} = GroupIndex
xGroupIndex -> GroupIndex -> Bool
forall a. Eq a => a -> a -> Bool
/=GroupIndex
y
mustAccept :: Q -> Bool
mustAccept :: Q -> Bool
mustAccept Q
q = (GroupIndex
0GroupIndex -> GroupIndex -> Bool
forall a. Eq a => a -> a -> Bool
/=) (GroupIndex -> Bool) -> (Q -> GroupIndex) -> Q -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GroupIndex, Maybe GroupIndex) -> GroupIndex
forall a b. (a, b) -> a
fst ((GroupIndex, Maybe GroupIndex) -> GroupIndex)
-> (Q -> (GroupIndex, Maybe GroupIndex)) -> Q -> GroupIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q -> (GroupIndex, Maybe GroupIndex)
takes (Q -> Bool) -> Q -> Bool
forall a b. (a -> b) -> a -> b
$ Q
q
canAccept :: Q -> Bool
canAccept :: Q -> Bool
canAccept Q
q = Bool -> (GroupIndex -> Bool) -> Maybe GroupIndex -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (GroupIndex
0GroupIndex -> GroupIndex -> Bool
forall a. Eq a => a -> a -> Bool
/=) (Maybe GroupIndex -> Bool) -> Maybe GroupIndex -> Bool
forall a b. (a -> b) -> a -> b
$ (GroupIndex, Maybe GroupIndex) -> Maybe GroupIndex
forall a b. (a, b) -> b
snd ((GroupIndex, Maybe GroupIndex) -> Maybe GroupIndex)
-> (Q -> (GroupIndex, Maybe GroupIndex)) -> Q -> Maybe GroupIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q -> (GroupIndex, Maybe GroupIndex)
takes (Q -> Maybe GroupIndex) -> Q -> Maybe GroupIndex
forall a b. (a -> b) -> a -> b
$ Q
q
cannotAccept :: Q -> Bool
cannotAccept :: Q -> Bool
cannotAccept Q
q = Bool -> (GroupIndex -> Bool) -> Maybe GroupIndex -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (GroupIndex
0GroupIndex -> GroupIndex -> Bool
forall a. Eq a => a -> a -> Bool
==) (Maybe GroupIndex -> Bool) -> Maybe GroupIndex -> Bool
forall a b. (a -> b) -> a -> b
$ (GroupIndex, Maybe GroupIndex) -> Maybe GroupIndex
forall a b. (a, b) -> b
snd ((GroupIndex, Maybe GroupIndex) -> Maybe GroupIndex)
-> (Q -> (GroupIndex, Maybe GroupIndex)) -> Q -> Maybe GroupIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q -> (GroupIndex, Maybe GroupIndex)
takes (Q -> Maybe GroupIndex) -> Q -> Maybe GroupIndex
forall a b. (a -> b) -> a -> b
$ Q
q
type PM = RWS (Maybe GroupIndex) [Either Tag GroupInfo] ([OP]->[OP],Tag)
type HHQ = HandleTag
-> HandleTag
-> PM Q
makeGroupArray :: GroupIndex -> [GroupInfo] -> Array GroupIndex [GroupInfo]
makeGroupArray :: GroupIndex -> [GroupInfo] -> Array GroupIndex [GroupInfo]
makeGroupArray GroupIndex
maxGroupIndex [GroupInfo]
groups = ([GroupInfo] -> GroupInfo -> [GroupInfo])
-> [GroupInfo]
-> (GroupIndex, GroupIndex)
-> [(GroupIndex, GroupInfo)]
-> Array GroupIndex [GroupInfo]
forall (a :: * -> * -> *) e i e'.
(IArray a e, Ix i) =>
(e -> e' -> e) -> e -> (i, i) -> [(i, e')] -> a i e
accumArray (\[GroupInfo]
earlier GroupInfo
later -> GroupInfo
laterGroupInfo -> [GroupInfo] -> [GroupInfo]
forall a. a -> [a] -> [a]
:[GroupInfo]
earlier) [] (GroupIndex
1,GroupIndex
maxGroupIndex) [(GroupIndex, GroupInfo)]
filler
where filler :: [(GroupIndex, GroupInfo)]
filler = (GroupInfo -> (GroupIndex, GroupInfo))
-> [GroupInfo] -> [(GroupIndex, GroupInfo)]
forall a b. (a -> b) -> [a] -> [b]
map (\GroupInfo
gi -> (GroupInfo -> GroupIndex
thisIndex GroupInfo
gi,GroupInfo
gi)) [GroupInfo]
groups
patternToQ :: CompOption -> (Pattern,(GroupIndex,DoPa)) -> (Q,Array Tag OP,Array GroupIndex [GroupInfo])
patternToQ :: CompOption
-> (Pattern, (GroupIndex, DoPa))
-> (Q, Array GroupIndex OP, Array GroupIndex [GroupInfo])
patternToQ CompOption
compOpt (Pattern
pOrig,(GroupIndex
maxGroupIndex,DoPa
_)) = (Q
tnfa,Array GroupIndex OP
aTags,Array GroupIndex [GroupInfo]
aGroups) where
(Q
tnfa,([OP] -> [OP]
tag_dlist,GroupIndex
nextTag),[Either GroupIndex GroupInfo]
groups) = RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
-> Maybe GroupIndex
-> ([OP] -> [OP], GroupIndex)
-> (Q, ([OP] -> [OP], GroupIndex), [Either GroupIndex GroupInfo])
forall r w s a. RWS r w s a -> r -> s -> (a, s, w)
runRWS RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
monad Maybe GroupIndex
startReader ([OP] -> [OP], GroupIndex)
startState
aTags :: Array GroupIndex OP
aTags = (GroupIndex, GroupIndex) -> [OP] -> Array GroupIndex OP
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (GroupIndex
0,GroupIndex -> GroupIndex
forall a. Enum a => a -> a
pred GroupIndex
nextTag) ([OP] -> [OP]
tag_dlist [])
aGroups :: Array GroupIndex [GroupInfo]
aGroups = GroupIndex -> [GroupInfo] -> Array GroupIndex [GroupInfo]
makeGroupArray GroupIndex
maxGroupIndex ([Either GroupIndex GroupInfo] -> [GroupInfo]
forall a b. [Either a b] -> [b]
rights [Either GroupIndex GroupInfo]
groups)
monad :: RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
monad = Pattern -> HHQ
go (Pattern -> Pattern
starTrans Pattern
pOrig) (GroupIndex -> HandleTag
Advice GroupIndex
0) (GroupIndex -> HandleTag
Advice GroupIndex
1)
startReader :: Maybe GroupIndex
startReader :: Maybe GroupIndex
startReader = GroupIndex -> Maybe GroupIndex
forall a. a -> Maybe a
Just GroupIndex
0
startState :: ([OP]->[OP],Tag)
startState :: ([OP] -> [OP], GroupIndex)
startState = ( (OP
MinimizeOP -> [OP] -> [OP]
forall a. a -> [a] -> [a]
:) ([OP] -> [OP]) -> ([OP] -> [OP]) -> [OP] -> [OP]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OP
MaximizeOP -> [OP] -> [OP]
forall a. a -> [a] -> [a]
:) , GroupIndex
2)
{-# INLINE uniq #-}
uniq :: String -> PM HandleTag
uniq :: String -> PM HandleTag
uniq String
_msg = (GroupIndex -> HandleTag)
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
GroupIndex
-> PM HandleTag
forall a b.
(a -> b)
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GroupIndex -> HandleTag
Apply (OP
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
GroupIndex
uniq' OP
Maximize)
ignore :: String -> PM Tag
ignore :: String
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
GroupIndex
ignore String
_msg = OP
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
GroupIndex
uniq' OP
Ignore
{-# NOINLINE uniq' #-}
uniq' :: OP -> PM Tag
uniq' :: OP
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
GroupIndex
uniq' OP
newOp = do
([OP] -> [OP]
op,GroupIndex
s) <- RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
([OP] -> [OP], GroupIndex)
forall s (m :: * -> *). MonadState s m => m s
get
let op' :: [OP] -> [OP]
op' = [OP] -> [OP]
op ([OP] -> [OP]) -> ([OP] -> [OP]) -> [OP] -> [OP]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OP
newOpOP -> [OP] -> [OP]
forall a. a -> [a] -> [a]
:)
s' :: GroupIndex
s' = GroupIndex -> GroupIndex
forall a. Enum a => a -> a
succ GroupIndex
s
([OP] -> [OP], GroupIndex)
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (([OP] -> [OP], GroupIndex)
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
())
-> ([OP] -> [OP], GroupIndex)
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
()
forall a b. (a -> b) -> a -> b
$! ([OP] -> [OP]
op',GroupIndex
s')
GroupIndex
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
GroupIndex
forall a.
a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
forall (m :: * -> *) a. Monad m => a -> m a
return GroupIndex
s
{-# INLINE makeOrbit #-}
makeOrbit :: PM (Maybe Tag)
makeOrbit :: PM (Maybe GroupIndex)
makeOrbit = do GroupIndex
x <- OP
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
GroupIndex
uniq' OP
Orbit
[Either GroupIndex GroupInfo]
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [GroupIndex -> Either GroupIndex GroupInfo
forall a b. a -> Either a b
Left GroupIndex
x]
Maybe GroupIndex -> PM (Maybe GroupIndex)
forall a.
a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
forall (m :: * -> *) a. Monad m => a -> m a
return (GroupIndex -> Maybe GroupIndex
forall a. a -> Maybe a
Just GroupIndex
x)
{-# INLINE withOrbit #-}
withOrbit :: PM a -> PM (a,[Tag])
withOrbit :: forall a. PM a -> PM (a, [GroupIndex])
withOrbit = ([Either GroupIndex GroupInfo] -> [GroupIndex])
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
(a, [GroupIndex])
forall w (m :: * -> *) b a.
MonadWriter w m =>
(w -> b) -> m a -> m (a, b)
listens (([Either GroupIndex GroupInfo] -> [GroupIndex])
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
(a, [GroupIndex]))
-> ([Either GroupIndex GroupInfo] -> [GroupIndex])
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
(a, [GroupIndex])
forall a b. (a -> b) -> a -> b
$ ([GroupIndex], [GroupInfo]) -> [GroupIndex]
forall a b. (a, b) -> a
fst (([GroupIndex], [GroupInfo]) -> [GroupIndex])
-> ([Either GroupIndex GroupInfo] -> ([GroupIndex], [GroupInfo]))
-> [Either GroupIndex GroupInfo]
-> [GroupIndex]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either GroupIndex GroupInfo] -> ([GroupIndex], [GroupInfo])
forall a b. [Either a b] -> ([a], [b])
partitionEithers
{-# INLINE makeGroup #-}
makeGroup :: GroupInfo -> PM ()
makeGroup :: GroupInfo
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
()
makeGroup = [Either GroupIndex GroupInfo]
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([Either GroupIndex GroupInfo]
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
())
-> (GroupInfo -> [Either GroupIndex GroupInfo])
-> GroupInfo
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either GroupIndex GroupInfo
-> [Either GroupIndex GroupInfo] -> [Either GroupIndex GroupInfo]
forall a. a -> [a] -> [a]
:[]) (Either GroupIndex GroupInfo -> [Either GroupIndex GroupInfo])
-> (GroupInfo -> Either GroupIndex GroupInfo)
-> GroupInfo
-> [Either GroupIndex GroupInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GroupInfo -> Either GroupIndex GroupInfo
forall a b. b -> Either a b
Right
{-# INLINE getParentIndex #-}
getParentIndex :: PM (Maybe GroupIndex)
getParentIndex :: PM (Maybe GroupIndex)
getParentIndex = PM (Maybe GroupIndex)
forall r (m :: * -> *). MonadReader r m => m r
ask
{-# INLINE nonCapture #-}
nonCapture :: PM a -> PM a
nonCapture :: forall a. PM a -> PM a
nonCapture = (Maybe GroupIndex -> Maybe GroupIndex)
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
forall a.
(Maybe GroupIndex -> Maybe GroupIndex)
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (Maybe GroupIndex -> Maybe GroupIndex -> Maybe GroupIndex
forall a b. a -> b -> a
const Maybe GroupIndex
forall a. Maybe a
Nothing)
withParent :: GroupIndex -> PM a -> PM (a,[Tag])
withParent :: forall a. GroupIndex -> PM a -> PM (a, [GroupIndex])
withParent GroupIndex
this = (Maybe GroupIndex -> Maybe GroupIndex)
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
(a, [GroupIndex])
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
(a, [GroupIndex])
forall a.
(Maybe GroupIndex -> Maybe GroupIndex)
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (Maybe GroupIndex -> Maybe GroupIndex -> Maybe GroupIndex
forall a b. a -> b -> a
const (GroupIndex -> Maybe GroupIndex
forall a. a -> Maybe a
Just GroupIndex
this)) (RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
(a, [GroupIndex])
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
(a, [GroupIndex]))
-> (PM a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
(a, [GroupIndex]))
-> PM a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
(a, [GroupIndex])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Either GroupIndex GroupInfo] -> [GroupIndex])
-> PM a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
(a, [GroupIndex])
forall w (m :: * -> *) b a.
MonadWriter w m =>
(w -> b) -> m a -> m (a, b)
listens [Either GroupIndex GroupInfo] -> [GroupIndex]
forall {a}. [Either a GroupInfo] -> [GroupIndex]
childGroupInfo
where childGroupInfo :: [Either a GroupInfo] -> [GroupIndex]
childGroupInfo [Either a GroupInfo]
x =
let gs :: [GroupInfo]
gs = ([a], [GroupInfo]) -> [GroupInfo]
forall a b. (a, b) -> b
snd (([a], [GroupInfo]) -> [GroupInfo])
-> ([a], [GroupInfo]) -> [GroupInfo]
forall a b. (a -> b) -> a -> b
$ [Either a GroupInfo] -> ([a], [GroupInfo])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either a GroupInfo]
x
children :: [GroupIndex]
children :: [GroupIndex]
children = [GroupIndex] -> [GroupIndex]
forall a. Eq a => [a] -> [a]
norep ([GroupIndex] -> [GroupIndex])
-> ([GroupInfo] -> [GroupIndex]) -> [GroupInfo] -> [GroupIndex]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GroupIndex] -> [GroupIndex]
forall a. Ord a => [a] -> [a]
sort ([GroupIndex] -> [GroupIndex])
-> ([GroupInfo] -> [GroupIndex]) -> [GroupInfo] -> [GroupIndex]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GroupInfo -> GroupIndex) -> [GroupInfo] -> [GroupIndex]
forall a b. (a -> b) -> [a] -> [b]
map GroupInfo -> GroupIndex
thisIndex
([GroupInfo] -> [GroupIndex])
-> ([GroupInfo] -> [GroupInfo]) -> [GroupInfo] -> [GroupIndex]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GroupInfo -> Bool) -> [GroupInfo] -> [GroupInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter ((GroupIndex
thisGroupIndex -> GroupIndex -> Bool
forall a. Eq a => a -> a -> Bool
==)(GroupIndex -> Bool)
-> (GroupInfo -> GroupIndex) -> GroupInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.GroupInfo -> GroupIndex
parentIndex) ([GroupInfo] -> [GroupIndex]) -> [GroupInfo] -> [GroupIndex]
forall a b. (a -> b) -> a -> b
$ [GroupInfo]
gs
in (GroupIndex -> [GroupIndex]) -> [GroupIndex] -> [GroupIndex]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((GroupInfo -> GroupIndex) -> [GroupInfo] -> [GroupIndex]
forall a b. (a -> b) -> [a] -> [b]
map GroupInfo -> GroupIndex
flagTag ([GroupInfo] -> [GroupIndex])
-> (GroupIndex -> [GroupInfo]) -> GroupIndex -> [GroupIndex]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Array GroupIndex [GroupInfo]
aGroupsArray GroupIndex [GroupInfo] -> GroupIndex -> [GroupInfo]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!)) (GroupIndex
thisGroupIndex -> [GroupIndex] -> [GroupIndex]
forall a. a -> [a] -> [a]
:[GroupIndex]
children)
combineConcat :: [Pattern] -> HHQ
combineConcat :: [Pattern] -> HHQ
combineConcat | CompOption -> Bool
rightAssoc CompOption
compOpt = (HHQ -> HHQ -> HHQ) -> [HHQ] -> HHQ
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 HHQ -> HHQ -> HHQ
combineSeq ([HHQ] -> HHQ) -> ([Pattern] -> [HHQ]) -> [Pattern] -> HHQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pattern -> HHQ) -> [Pattern] -> [HHQ]
forall a b. (a -> b) -> [a] -> [b]
map Pattern -> HHQ
go
| Bool
otherwise = (HHQ -> HHQ -> HHQ) -> [HHQ] -> HHQ
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 HHQ -> HHQ -> HHQ
combineSeq ([HHQ] -> HHQ) -> ([Pattern] -> [HHQ]) -> [Pattern] -> HHQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pattern -> HHQ) -> [Pattern] -> [HHQ]
forall a b. (a -> b) -> [a] -> [b]
map Pattern -> HHQ
go
where {-# INLINE front'end #-}
front'end :: RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a1
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a2
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
(a1, a2)
front'end | CompOption -> Bool
rightAssoc CompOption
compOpt = (a1 -> a2 -> (a1, a2))
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a1
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a2
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
(a1, a2)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,)
| Bool
otherwise = (RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a2
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a1
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
(a1, a2))
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a1
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a2
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
(a1, a2)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a2 -> a1 -> (a1, a2))
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a2
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a1
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
(a1, a2)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 ((a1 -> a2 -> (a1, a2)) -> a2 -> a1 -> (a1, a2)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,)))
combineSeq :: HHQ -> HHQ -> HHQ
combineSeq :: HHQ -> HHQ -> HHQ
combineSeq HHQ
pFront HHQ
pEnd = (\ HandleTag
m1 HandleTag
m2 -> mdo
let bothVary :: Bool
bothVary = Q -> Bool
varies Q
qFront Bool -> Bool -> Bool
&& Q -> Bool
varies Q
qEnd
HandleTag
a <- if HandleTag -> Bool
noTag HandleTag
m1 Bool -> Bool -> Bool
&& Bool
bothVary then String -> PM HandleTag
uniq String
"combineSeq start" else HandleTag -> PM HandleTag
forall a.
a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
forall (m :: * -> *) a. Monad m => a -> m a
return HandleTag
m1
HandleTag
b <- if HandleTag -> Bool
noTag HandleTag
m2 Bool -> Bool -> Bool
&& Bool
bothVary then String -> PM HandleTag
uniq String
"combineSeq stop" else HandleTag -> PM HandleTag
forall a.
a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
forall (m :: * -> *) a. Monad m => a -> m a
return HandleTag
m2
HandleTag
mid <- case (HandleTag -> Bool
noTag HandleTag
a,Q -> Bool
canAccept Q
qFront,HandleTag -> Bool
noTag HandleTag
b,Q -> Bool
canAccept Q
qEnd) of
(Bool
False,Bool
False,Bool
_,Bool
_) -> HandleTag -> PM HandleTag
forall a.
a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
forall (m :: * -> *) a. Monad m => a -> m a
return (HandleTag -> HandleTag
toAdvice HandleTag
a)
(Bool
_,Bool
_,Bool
False,Bool
False) -> HandleTag -> PM HandleTag
forall a.
a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
forall (m :: * -> *) a. Monad m => a -> m a
return (HandleTag -> HandleTag
toAdvice HandleTag
b)
(Bool, Bool, Bool, Bool)
_ -> if Q -> Bool
tagged Q
qFront Bool -> Bool -> Bool
|| Q -> Bool
tagged Q
qEnd then String -> PM HandleTag
uniq String
"combineSeq mid" else HandleTag -> PM HandleTag
forall a.
a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
forall (m :: * -> *) a. Monad m => a -> m a
return HandleTag
NoTag
(Q
qFront,Q
qEnd) <- RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
-> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
(Q, Q)
forall {a1} {a2}.
RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a1
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a2
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
(a1, a2)
front'end (HHQ
pFront HandleTag
a HandleTag
mid) (HHQ
pEnd (HandleTag -> HandleTag
toAdvice HandleTag
mid) HandleTag
b)
let wanted :: Wanted
wanted = if Wanted
WantsEither Wanted -> Wanted -> Bool
forall a. Eq a => a -> a -> Bool
== Q -> Wanted
wants Q
qEnd then Q -> Wanted
wants Q
qFront else Q -> Wanted
wants Q
qEnd
Q
-> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
forall a.
a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
forall (m :: * -> *) a. Monad m => a -> m a
return (Q
-> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q)
-> Q
-> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
forall a b. (a -> b) -> a -> b
$ Q { nullQ :: NullView
nullQ = NullView -> NullView -> NullView
mergeNullViews (Q -> NullView
nullQ Q
qFront) (Q -> NullView
nullQ Q
qEnd)
, takes :: (GroupIndex, Maybe GroupIndex)
takes = (GroupIndex, Maybe GroupIndex)
-> (GroupIndex, Maybe GroupIndex) -> (GroupIndex, Maybe GroupIndex)
seqTake (Q -> (GroupIndex, Maybe GroupIndex)
takes Q
qFront) (Q -> (GroupIndex, Maybe GroupIndex)
takes Q
qEnd)
, preReset :: [GroupIndex]
preReset = [], postSet :: [GroupIndex]
postSet = [], preTag :: Maybe GroupIndex
preTag = Maybe GroupIndex
forall a. Maybe a
Nothing, postTag :: Maybe GroupIndex
postTag = Maybe GroupIndex
forall a. Maybe a
Nothing
, tagged :: Bool
tagged = Bool
bothVary
, childGroups :: Bool
childGroups = Q -> Bool
childGroups Q
qFront Bool -> Bool -> Bool
|| Q -> Bool
childGroups Q
qEnd
, wants :: Wanted
wants = Wanted
wanted
, unQ :: P
unQ = Q -> Q -> P
Seq Q
qFront Q
qEnd }
)
go :: Pattern -> HHQ
go :: Pattern -> HHQ
go Pattern
pIn HandleTag
m1 HandleTag
m2 =
let die :: a
die = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"patternToQ cannot handle "String -> ShowS
forall a. [a] -> [a] -> [a]
++Pattern -> String
forall a. Show a => a -> String
show Pattern
pIn
nil :: RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
nil = Q
-> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
forall a.
a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
forall (m :: * -> *) a. Monad m => a -> m a
return (Q
-> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q)
-> Q
-> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
forall a b. (a -> b) -> a -> b
$ Q {nullQ :: NullView
nullQ=HandleTag -> HandleTag -> NullView
makeEmptyNullView HandleTag
m1 HandleTag
m2
,takes :: (GroupIndex, Maybe GroupIndex)
takes=(GroupIndex
0,GroupIndex -> Maybe GroupIndex
forall a. a -> Maybe a
Just GroupIndex
0)
,preReset :: [GroupIndex]
preReset=[],postSet :: [GroupIndex]
postSet=[],preTag :: Maybe GroupIndex
preTag=HandleTag -> Maybe GroupIndex
apply HandleTag
m1,postTag :: Maybe GroupIndex
postTag=HandleTag -> Maybe GroupIndex
apply HandleTag
m2
,tagged :: Bool
tagged=Bool
False,childGroups :: Bool
childGroups=Bool
False,wants :: Wanted
wants=Wanted
WantsEither
,unQ :: P
unQ=P
Empty}
one :: RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
one = Q
-> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
forall a.
a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
forall (m :: * -> *) a. Monad m => a -> m a
return (Q
-> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q)
-> Q
-> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
forall a b. (a -> b) -> a -> b
$ Q {nullQ :: NullView
nullQ=NullView
notNull
,takes :: (GroupIndex, Maybe GroupIndex)
takes=(GroupIndex
1,GroupIndex -> Maybe GroupIndex
forall a. a -> Maybe a
Just GroupIndex
1)
,preReset :: [GroupIndex]
preReset=[],postSet :: [GroupIndex]
postSet=[],preTag :: Maybe GroupIndex
preTag=HandleTag -> Maybe GroupIndex
apply HandleTag
m1,postTag :: Maybe GroupIndex
postTag=HandleTag -> Maybe GroupIndex
apply HandleTag
m2
,tagged :: Bool
tagged=Bool
False,childGroups :: Bool
childGroups=Bool
False,wants :: Wanted
wants=Wanted
WantsQNFA
,unQ :: P
unQ = Pattern -> P
OneChar Pattern
pIn}
test :: TestInfo -> m Q
test TestInfo
myTest = Q -> m Q
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Q -> m Q) -> Q -> m Q
forall a b. (a -> b) -> a -> b
$ Q {nullQ :: NullView
nullQ=TestInfo -> HandleTag -> HandleTag -> NullView
makeTestNullView TestInfo
myTest HandleTag
m1 HandleTag
m2
,takes :: (GroupIndex, Maybe GroupIndex)
takes=(GroupIndex
0,GroupIndex -> Maybe GroupIndex
forall a. a -> Maybe a
Just GroupIndex
0)
,preReset :: [GroupIndex]
preReset=[],postSet :: [GroupIndex]
postSet=[],preTag :: Maybe GroupIndex
preTag=HandleTag -> Maybe GroupIndex
apply HandleTag
m1,postTag :: Maybe GroupIndex
postTag=HandleTag -> Maybe GroupIndex
apply HandleTag
m2
,tagged :: Bool
tagged=Bool
False,childGroups :: Bool
childGroups=Bool
False,wants :: Wanted
wants=Wanted
WantsQT
,unQ :: P
unQ=TestInfo -> P
Test TestInfo
myTest }
xtra :: Bool
xtra = CompOption -> Bool
newSyntax CompOption
compOpt
in case Pattern
pIn of
Pattern
PEmpty -> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
nil
POr [] -> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
nil
POr [Pattern
branch] -> Pattern -> HHQ
go Pattern
branch HandleTag
m1 HandleTag
m2
POr [Pattern]
branches -> mdo
let needUniqTags :: Bool
needUniqTags = Q -> Bool
childGroups Q
ans
let needTags :: Bool
needTags = Q -> Bool
varies Q
ans Bool -> Bool -> Bool
|| Q -> Bool
childGroups Q
ans
HandleTag
a <- if HandleTag -> Bool
noTag HandleTag
m1 Bool -> Bool -> Bool
&& Bool
needTags then String -> PM HandleTag
uniq String
"POr start" else HandleTag -> PM HandleTag
forall a.
a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
forall (m :: * -> *) a. Monad m => a -> m a
return HandleTag
m1
HandleTag
b <- if HandleTag -> Bool
noTag HandleTag
m2 Bool -> Bool -> Bool
&& Bool
needTags then String -> PM HandleTag
uniq String
"POr stop" else HandleTag -> PM HandleTag
forall a.
a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
forall (m :: * -> *) a. Monad m => a -> m a
return HandleTag
m2
let aAdvice :: HandleTag
aAdvice = HandleTag -> HandleTag
toAdvice HandleTag
a
bAdvice :: HandleTag
bAdvice = HandleTag -> HandleTag
toAdvice HandleTag
b
newUniq :: PM HandleTag
newUniq = if Bool
needUniqTags then String -> PM HandleTag
uniq String
"POr branch" else HandleTag -> PM HandleTag
forall a.
a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
forall (m :: * -> *) a. Monad m => a -> m a
return HandleTag
bAdvice
[HandleTag]
bs <- ([HandleTag] -> [HandleTag])
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
[HandleTag]
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
[HandleTag]
forall a b.
(a -> b)
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([HandleTag] -> [HandleTag] -> [HandleTag]
forall a. [a] -> [a] -> [a]
++[HandleTag
bAdvice]) (RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
[HandleTag]
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
[HandleTag])
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
[HandleTag]
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
[HandleTag]
forall a b. (a -> b) -> a -> b
$ GroupIndex
-> PM HandleTag
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
[HandleTag]
forall (m :: * -> *) a. Applicative m => GroupIndex -> m a -> m [a]
replicateM (GroupIndex -> GroupIndex
forall a. Enum a => a -> a
pred (GroupIndex -> GroupIndex) -> GroupIndex -> GroupIndex
forall a b. (a -> b) -> a -> b
$ [Pattern] -> GroupIndex
forall a. [a] -> GroupIndex
forall (t :: * -> *) a. Foldable t => t a -> GroupIndex
length [Pattern]
branches) PM HandleTag
newUniq
[Q]
qs <- [(Pattern, HandleTag)]
-> ((Pattern, HandleTag)
-> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q)
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
[Q]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([Pattern] -> [HandleTag] -> [(Pattern, HandleTag)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Pattern]
branches [HandleTag]
bs) (\(Pattern
branch,HandleTag
bTag) -> (Pattern -> HHQ
go Pattern
branch HandleTag
aAdvice HandleTag
bTag))
let wqs :: [Wanted]
wqs = (Q -> Wanted) -> [Q] -> [Wanted]
forall a b. (a -> b) -> [a] -> [b]
map Q -> Wanted
wants [Q]
qs
wanted :: Wanted
wanted = if (Wanted -> Bool) -> [Wanted] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Wanted
WantsBothWanted -> Wanted -> Bool
forall a. Eq a => a -> a -> Bool
==) [Wanted]
wqs then Wanted
WantsBoth
else case ((Wanted -> Bool) -> [Wanted] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Wanted
WantsQNFAWanted -> Wanted -> Bool
forall a. Eq a => a -> a -> Bool
==) [Wanted]
wqs,(Wanted -> Bool) -> [Wanted] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Wanted
WantsQTWanted -> Wanted -> Bool
forall a. Eq a => a -> a -> Bool
==) [Wanted]
wqs) of
(Bool
True,Bool
True) -> Wanted
WantsBoth
(Bool
True,Bool
False) -> Wanted
WantsQNFA
(Bool
False,Bool
True) -> Wanted
WantsQT
(Bool
False,Bool
False) -> Wanted
WantsEither
nullView :: NullView
nullView = NullView -> NullView
cleanNullView (NullView -> NullView) -> ([Q] -> NullView) -> [Q] -> NullView
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandleTag -> HandleTag -> NullView -> NullView
tagWrapNullView HandleTag
a HandleTag
b (NullView -> NullView) -> ([Q] -> NullView) -> [Q] -> NullView
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Q -> NullView) -> [Q] -> NullView
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Q -> NullView
nullQ ([Q] -> NullView) -> [Q] -> NullView
forall a b. (a -> b) -> a -> b
$ [Q]
qs
let ans :: Q
ans = Q { nullQ :: NullView
nullQ = NullView
nullView
, takes :: (GroupIndex, Maybe GroupIndex)
takes = [(GroupIndex, Maybe GroupIndex)] -> (GroupIndex, Maybe GroupIndex)
orTakes ([(GroupIndex, Maybe GroupIndex)]
-> (GroupIndex, Maybe GroupIndex))
-> ([Q] -> [(GroupIndex, Maybe GroupIndex)])
-> [Q]
-> (GroupIndex, Maybe GroupIndex)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Q -> (GroupIndex, Maybe GroupIndex))
-> [Q] -> [(GroupIndex, Maybe GroupIndex)]
forall a b. (a -> b) -> [a] -> [b]
map Q -> (GroupIndex, Maybe GroupIndex)
takes ([Q] -> (GroupIndex, Maybe GroupIndex))
-> [Q] -> (GroupIndex, Maybe GroupIndex)
forall a b. (a -> b) -> a -> b
$ [Q]
qs
, preReset :: [GroupIndex]
preReset = [], postSet :: [GroupIndex]
postSet = []
, preTag :: Maybe GroupIndex
preTag = HandleTag -> Maybe GroupIndex
apply HandleTag
a, postTag :: Maybe GroupIndex
postTag = HandleTag -> Maybe GroupIndex
apply HandleTag
b
, tagged :: Bool
tagged = Bool
needTags
, childGroups :: Bool
childGroups = (Q -> Bool) -> [Q] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Q -> Bool
childGroups [Q]
qs
, wants :: Wanted
wants = Wanted
wanted
, unQ :: P
unQ = [Q] -> P
Or [Q]
qs }
Q
-> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
forall a.
a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
forall (m :: * -> *) a. Monad m => a -> m a
return Q
ans
PConcat [] -> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
nil
PConcat [Pattern]
ps -> [Pattern] -> HHQ
combineConcat [Pattern]
ps HandleTag
m1 HandleTag
m2
PStar Bool
mayFirstBeNull Pattern
p -> mdo
let accepts :: Bool
accepts = Q -> Bool
canAccept Q
q
needsOrbit :: Bool
needsOrbit = Q -> Bool
varies Q
q Bool -> Bool -> Bool
&& Q -> Bool
childGroups Q
q
needsTags :: Bool
needsTags = Bool
needsOrbit Bool -> Bool -> Bool
|| Bool
accepts
HandleTag
a <- if HandleTag -> Bool
noTag HandleTag
m1 Bool -> Bool -> Bool
&& Bool
needsTags then String -> PM HandleTag
uniq String
"PStar start" else HandleTag -> PM HandleTag
forall a.
a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
forall (m :: * -> *) a. Monad m => a -> m a
return HandleTag
m1
HandleTag
b <- if HandleTag -> Bool
noTag HandleTag
m2 Bool -> Bool -> Bool
&& Bool
needsTags then String -> PM HandleTag
uniq String
"PStar stop" else HandleTag -> PM HandleTag
forall a.
a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
forall (m :: * -> *) a. Monad m => a -> m a
return HandleTag
m2
Maybe GroupIndex
mOrbit <- if Bool
needsOrbit then PM (Maybe GroupIndex)
makeOrbit else Maybe GroupIndex -> PM (Maybe GroupIndex)
forall a.
a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GroupIndex
forall a. Maybe a
Nothing
(Q
q,[GroupIndex]
resetOrbitTags) <- RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
-> PM (Q, [GroupIndex])
forall a. PM a -> PM (a, [GroupIndex])
withOrbit (Pattern -> HHQ
go Pattern
p HandleTag
NoTag (HandleTag -> HandleTag
toAdvice HandleTag
b))
let nullView :: NullView
nullView | Bool
mayFirstBeNull = NullView -> NullView
cleanNullView (NullView -> NullView) -> NullView -> NullView
forall a b. (a -> b) -> a -> b
$ NullView
childViews NullView -> NullView -> NullView
forall a. [a] -> [a] -> [a]
++ NullView
skipView
| Bool
otherwise = NullView
skipView
where childViews :: NullView
childViews = HandleTag -> HandleTag -> NullView -> NullView
tagWrapNullView HandleTag
a HandleTag
b (NullView -> NullView)
-> (NullView -> NullView) -> NullView -> NullView
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe GroupIndex -> [GroupIndex] -> NullView -> NullView
orbitWrapNullView Maybe GroupIndex
mOrbit [GroupIndex]
resetOrbitTags (NullView -> NullView) -> NullView -> NullView
forall a b. (a -> b) -> a -> b
$ Q -> NullView
nullQ Q
q
skipView :: NullView
skipView = HandleTag -> HandleTag -> NullView
makeEmptyNullView HandleTag
a HandleTag
b
Q
-> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
forall a.
a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
forall (m :: * -> *) a. Monad m => a -> m a
return (Q
-> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q)
-> Q
-> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
forall a b. (a -> b) -> a -> b
$ Q { nullQ :: NullView
nullQ = NullView
nullView
, takes :: (GroupIndex, Maybe GroupIndex)
takes = (GroupIndex
0,if Bool
accepts then Maybe GroupIndex
forall a. Maybe a
Nothing else (GroupIndex -> Maybe GroupIndex
forall a. a -> Maybe a
Just GroupIndex
0))
, preReset :: [GroupIndex]
preReset = [], postSet :: [GroupIndex]
postSet = []
, preTag :: Maybe GroupIndex
preTag = HandleTag -> Maybe GroupIndex
apply HandleTag
a, postTag :: Maybe GroupIndex
postTag = HandleTag -> Maybe GroupIndex
apply HandleTag
b
, tagged :: Bool
tagged = Bool
needsTags
, childGroups :: Bool
childGroups = Q -> Bool
childGroups Q
q
, wants :: Wanted
wants = Wanted
WantsQT
, unQ :: P
unQ =Star { getOrbit :: Maybe GroupIndex
getOrbit = Maybe GroupIndex
mOrbit
, resetOrbits :: [GroupIndex]
resetOrbits = [GroupIndex]
resetOrbitTags
, firstNull :: Bool
firstNull = Bool
mayFirstBeNull
, unStar :: Q
unStar = Q
q } }
PCarat DoPa
dopa -> TestInfo
-> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
forall {m :: * -> *}. Monad m => TestInfo -> m Q
test (WhichTest
Test_BOL,DoPa
dopa)
PDollar DoPa
dopa -> TestInfo
-> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
forall {m :: * -> *}. Monad m => TestInfo -> m Q
test (WhichTest
Test_EOL,DoPa
dopa)
PChar {} -> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
one
PDot {} -> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
one
PAny {} -> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
one
PAnyNot {} -> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
one
PEscape DoPa
dopa Char
'`' | Bool
xtra -> TestInfo
-> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
forall {m :: * -> *}. Monad m => TestInfo -> m Q
test (WhichTest
Test_BOB,DoPa
dopa)
PEscape DoPa
dopa Char
'\'' | Bool
xtra -> TestInfo
-> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
forall {m :: * -> *}. Monad m => TestInfo -> m Q
test (WhichTest
Test_EOB,DoPa
dopa)
PEscape DoPa
dopa Char
'<' | Bool
xtra -> TestInfo
-> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
forall {m :: * -> *}. Monad m => TestInfo -> m Q
test (WhichTest
Test_BOW,DoPa
dopa)
PEscape DoPa
dopa Char
'>' | Bool
xtra -> TestInfo
-> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
forall {m :: * -> *}. Monad m => TestInfo -> m Q
test (WhichTest
Test_EOW,DoPa
dopa)
PEscape DoPa
dopa Char
'b' | Bool
xtra -> TestInfo
-> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
forall {m :: * -> *}. Monad m => TestInfo -> m Q
test (WhichTest
Test_EdgeWord,DoPa
dopa)
PEscape DoPa
dopa Char
'B' | Bool
xtra -> TestInfo
-> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
forall {m :: * -> *}. Monad m => TestInfo -> m Q
test (WhichTest
Test_NotEdgeWord,DoPa
dopa)
PEscape {} -> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
one
PGroup Maybe GroupIndex
Nothing Pattern
p -> Pattern -> HHQ
go Pattern
p HandleTag
m1 HandleTag
m2
PGroup (Just GroupIndex
this) Pattern
p -> do
Maybe GroupIndex
mParent <- PM (Maybe GroupIndex)
getParentIndex
case Maybe GroupIndex
mParent of
Maybe GroupIndex
Nothing -> Pattern -> HHQ
go Pattern
p HandleTag
m1 HandleTag
m2
Just GroupIndex
parent -> do
HandleTag
a <- if HandleTag -> Bool
noTag HandleTag
m1 then String -> PM HandleTag
uniq String
"PGroup start" else HandleTag -> PM HandleTag
forall a.
a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
forall (m :: * -> *) a. Monad m => a -> m a
return HandleTag
m1
HandleTag
b <- if HandleTag -> Bool
noTag HandleTag
m2 then String -> PM HandleTag
uniq String
"PGroup stop" else HandleTag -> PM HandleTag
forall a.
a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
forall (m :: * -> *) a. Monad m => a -> m a
return HandleTag
m2
GroupIndex
flag <- String
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
GroupIndex
ignore String
"PGroup ignore"
(Q
q,[GroupIndex]
resetGroupTags) <- GroupIndex
-> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
-> PM (Q, [GroupIndex])
forall a. GroupIndex -> PM a -> PM (a, [GroupIndex])
withParent GroupIndex
this (Pattern -> HHQ
go Pattern
p HandleTag
a HandleTag
b)
GroupInfo
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
()
makeGroup (GroupIndex
-> GroupIndex
-> GroupIndex
-> GroupIndex
-> GroupIndex
-> GroupInfo
GroupInfo GroupIndex
this GroupIndex
parent (HandleTag -> GroupIndex
fromHandleTag HandleTag
a) (HandleTag -> GroupIndex
fromHandleTag HandleTag
b) GroupIndex
flag)
Q
-> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
forall a.
a
-> RWST
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Identity
a
forall (m :: * -> *) a. Monad m => a -> m a
return (Q
-> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q)
-> Q
-> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
forall a b. (a -> b) -> a -> b
$ Q
q { nullQ = addGroupResetsToNullView resetGroupTags flag (nullQ q)
, tagged = True
, childGroups = True
, preReset = resetGroupTags `mappend` (preReset q)
, postSet = (postSet q) `mappend` [flag]
}
PNonCapture Pattern
p -> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
-> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
forall a. PM a -> PM a
nonCapture (Pattern -> HHQ
go Pattern
p HandleTag
m1 HandleTag
m2)
PPlus {} -> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
forall {a}. a
die
PQuest {} -> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
forall {a}. a
die
PBound {} -> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
forall {a}. a
die
PNonEmpty {} -> RWS
(Maybe GroupIndex)
[Either GroupIndex GroupInfo]
([OP] -> [OP], GroupIndex)
Q
forall {a}. a
die