    -- | The CorePattern module deconstructs the Pattern tree created by
    -- ReadRegex.parseRegex and returns a simpler Q\/P tree with
    -- annotations at each Q node.  This will be converted by the TNFA
    -- module into a QNFA finite automata.
    --
    -- Of particular note, this Pattern to Q\/P conversion creates and
    -- assigns all the internal Tags that will be used during the matching
    -- process, and associates the captures groups with the tags that
    -- represent their starting and ending locations and with their
    -- immediate parent group.
    --
    -- Each Maximize and Minimize tag is held as either a preTag or a
    -- postTag by one and only one location in the Q\/P tree.  The Orbit
    -- tags are each held by one and only one Star node.  Tags that stop a
    -- Group are also held in perhaps numerous preReset lists.
    --
    -- The additional nullQ::nullView field of Q records the potentially
    -- complex information about what tests and tags must be used if the
    -- pattern unQ::P matches 0 zero characters.  There can be redundancy
    -- in nullView, which is eliminated by cleanNullView.
    --
    -- Uses recursive do notation.
    --
    -- 2009 XXX TODO: we can avoid needing tags in the part of the pattern
    -- after the last capturing group (when right-associative).  This is
    -- flipped for left-associative where the front of the pattern before
    -- the first capturing group needs no tags.  The edge of these regions
    -- is subtle: both case needs a Maximize tag.  One ought to be able to
    -- check the Pattern: if the root is PConcat then a scan from the end
    -- (start) looking for the first with an embedded PGroup can be found
    -- and the PGroup free elements can be wrapped in some new PNOTAG
    -- semantic indicator.
    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.Maybe(isNothing)
    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 {- all -}
    import Text.Regex.TDFA.Pattern(Pattern(..),starTrans)
    -- import Debug.Trace

    {- By Chris Kuklewicz, 2007. BSD License, see the LICENSE file. -}

    --err :: String -> a
    --err = common_error "Text.Regex.TDFA.CorePattern"

    --debug :: (Show a) => a -> b -> b
    --debug _ = id

    -- Core Pattern Language
    data P = Empty                       -- Could be replaced by (Test Nothing)??
           | Or [Q]
           | Seq Q Q
           | Star { P -> Maybe GroupIndex
    getOrbit :: Maybe Tag -- tag to prioritize the need to keep track of length of each pass though q
                  , P -> [GroupIndex]
    resetOrbits :: [Tag]  -- child star's orbits to reset (ResetOrbitTask) at all depths
                  , P -> Bool
    firstNull :: Bool     -- Usually True to mean the first pass may match 0 characters
                  , P -> Q
    unStar :: Q}
           | Test TestInfo               -- Require the test to be true (merge with empty as (Test (Maybe TestInfo)) ??)
           | OneChar Pattern             -- Bring the Pattern element that accepts a character
           | NonEmpty Q                  -- Don't let the Q pattern match nothing
             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)

    -- The diagnostics about the pattern.  Note that when unQ is 'Seq' the
    -- the preTag and postTag are Nothing but the preReset might have tags
    -- from PGroup injecting them.
    data Q = Q {Q -> NullView
    nullQ :: NullView                  -- Ordered list of nullable views
               ,Q -> (GroupIndex, Maybe GroupIndex)
    takes :: (Position,Maybe Position) -- Range of number of accepted characters
               ,Q -> [GroupIndex]
    preReset :: [Tag]                  -- Tags to "reset" (ResetGroupStopTask) (Only immediate children for efficiency)
               ,Q -> [GroupIndex]
    postSet :: [Tag]                   -- Tags to "set" (SetGroupStopTask)
               ,Q -> Maybe GroupIndex
    preTag,Q -> Maybe GroupIndex
    postTag :: Maybe Tag        -- Tags assigned around this pattern (TagTask)
               ,Q -> Bool
    tagged :: Bool                     -- Whether this node should be tagged -- patternToQ use only
               ,Q -> Bool
    childGroups :: Bool                -- Whether unQ has any PGroups -- patternToQ use only
               ,Q -> Wanted
    wants :: Wanted                    -- What kind of continuation is used by this pattern
               ,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)

    -- This is newtype'd to allow control over class instances
    -- This is a set of WhichTest where each test has associated pattern location information
    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)

    -- There may be several distinct ways for a subtree to conditionally
    -- (i.e. with a Test) or unconditionally accept 0 characters.  These
    -- are in the list in order of preference, with most preferred listed
    -- first.
    type NullView = [(SetTestInfo,TagList)]  -- Ordered list of null views, each is a set of tests and tags

    -- During the depth first traversal, children are told about tags by the parent.
    -- They may change Apply to Advice and they may generate new tags.
    data HandleTag = NoTag             -- No tag at this boundary
                   | Advice Tag        -- tag at this boundary, applied at higher level in tree
                   | Apply Tag         -- tag at this boundary, may be applied at this node or passed to one child
                     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)

    -- Nodes in the tree are labeled by the type kind of continuation they
    -- prefer to be passed when processing.  This makes it possible to
    -- create a smaller number of QNFA states and avoid creating wasteful
    -- QNFA states that won't be reachable in the final automata.
    --
    -- In practice WantsBoth is treated identically to WantsQNFA and
    -- WantsBoth could be removed.
    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
    ' '

    -- Smart constructors for NullView
    notNull :: NullView
    notNull :: NullView
    notNull = []

    -- Shorthand for combining a preTag and a postTag
    -- preTags :: Maybe Tag -> Maybe Tag -> TagList
    -- preTags a b = promote a `mappend` promote b
    --   where promote = maybe [] (\x -> [(x,PreUpdate TagTask)])

    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
          (oldTests,oldTasks) <- NullView
    oldNV
          return (oldTests,pre++oldTasks++post)

    -- For PGroup, need to prepend reset tasks before others in nullView
    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)])

    -- For PStar, need to put in the orbit TagTasks
    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 (oldTests,oldTasks) <- NullView
    oldNV
                          return (oldTests,prepend oldTasks)
        (Just GroupIndex
    o,[GroupIndex]
    _) -> do (oldTests,oldTasks) <- NullView
    oldNV
                         return (oldTests,prepend $ [(o,PreUpdate EnterOrbitTask)] ++ oldTasks ++ [(o,PreUpdate 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

    -- The NullViews are ordered, and later test sets that contain the
    -- tests from any earlier entry will never be chosen.  This function
    -- returns a list with these redundant elements removed.  Note that
    -- the first unconditional entry in the list will be the last entry of
    -- the returned list since the empty set is a subset of any other set.
    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]
    : []  -- optimization
                                                   | 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

    -- Ordered Sequence of two NullViews: all ordered combinations of tests and tags.
    -- Order of <- s1 and <- s2 is deliberately chosen to maintain preference priority
    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
      (test1,tag1) <- NullView
    s1
      (test2,tag2) <- s2
      return (mappend test1 test2,mappend tag1 tag2)
    -- mergeNullViews = cleanNullView $ liftM2 (mappend *** mappend)

    -- Concatenated two ranges of number of accepted characters
    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)

    -- Parallel combination of list of ranges of number of accepted characters
    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)

    -- Invariant: apply (toAdvice _ ) == mempty
    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"

    -- Predicates on the range of number of accepted  characters
    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

    -- This converts then input Pattern to an analyzed Q structure with
    -- the tags assigned.
    --
    -- The analysis is filled in by a depth first search and the tags are
    -- created top down and passed to children.  Thus information flows up
    -- from the dfs of the children and simultaneously down in the form of
    -- pre and post HandleTag data.  This bidirectional flow is handled
    -- declaratively by using the MonadFix (i.e. mdo).
    --
    -- Invariant: A tag should exist in Q in exactly one place (and will
    -- be in a preTag,postTag, or getOrbit field).  This is partly because
    -- PGroup needs to know the tags are around precisely the expression
    -- that it wants to record.  If the same tag were in other branches
    -- then this would no longer be true.  The tag may or may not also
    -- show up in one or more preReset list or resetOrbits list.
    --
    -- This invariant is enforced by each node either taking
    -- responsibility (apply) for a passed in / created tag or sending it
    -- to exactly one child node.  Other child nodes need to receive it
    -- via toAdvice.  Leaf nodes are forced to apply any passed tags.
    --
    -- There is a final "qwin of Q {postTag=ISet.singleton 1}" and an
    -- implied initial index tag of 0.
    --
    -- favoring pushing Apply into the child postTag makes PGroup happier

    type PM = RWS (Maybe GroupIndex) [Either Tag GroupInfo] ([OP]->[OP],Tag)
    type HHQ = HandleTag  -- m1 : info about left boundary / preTag
            -> HandleTag  -- m2 : info about right boundary / postTag
            -> PM Q

    -- There is no group 0 here, since it is always the whole match and has no parent of its own
    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

    -- Partial function: assumes starTrans has been run on the Pattern
    -- Note that the lazy dependency chain for this very zigzag:
    --   varies information is sent up the tree
    --   handle tags depend on that and sends m1 m2 down the tree
    --     makeGroup sends some tags to the writer (Right _)
    --     withParent listens to children send group info to writer
    --       and lazily looks resetGroupTags from aGroups, the result of all writer (Right _)
    --       preReset stores the resetGroupTags result of the lookup in the tree
    --     makeOrbit sends some tags to the writer (Left _)
    --     withOrbit listens to children send orbit info to writer for resetOrbitTags
    --   nullQ depends m1 m2 and resetOrbitTags and resetGroupTags and is sent up the tree
    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)

      -- implicitly inside a PGroup 0 converted into a GroupInfo 0 undefined 0 1
      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 is accessed by getParentIndex and changed by nonCapture and withParent
      startReader :: Maybe GroupIndex
      startReader :: Maybe GroupIndex
    startReader = GroupIndex -> Maybe GroupIndex
    forall a. a -> Maybe a
    Just GroupIndex
    0                           -- start inside group 0, capturing enabled
      -- The startState is only acted upon in the "uniq" command
      -- Tag 0 is Minimized and Tag 1 is maximized, next tag has value of 2
      -- This is regardless of right or left associativity
      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)

      -- uniq uses MonadState and always returns an "Apply _" tag
      {-# 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)
    --  uniq _msg = do x <- fmap Apply (uniq' Maximize)
    --                trace ('\n':msg ++ " Maximize "++show x) $ return x
    --                return x

      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
    --  ignore _msg = do x <- uniq' Ignore
    --                  trace ('\n':msg ++ " Ignore "++show x) $ return x
    --                  return x

      {-# NOINLINE uniq' #-}
      uniq' :: OP -> PM Tag
      uniq' :: OP
    -> RWST
         (Maybe GroupIndex)
         [Either GroupIndex GroupInfo]
         ([OP] -> [OP], GroupIndex)
         Identity
         GroupIndex
    uniq' OP
    newOp = do
        (op,s) <- RWST
      (Maybe GroupIndex)
      [Either GroupIndex GroupInfo]
      ([OP] -> [OP], GroupIndex)
      Identity
      ([OP] -> [OP], GroupIndex)
    forall s (m :: * -> *). MonadState s m => m s
    get                -- generate the next tag with bias newOp
        let 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 -> GroupIndex
    forall a. Enum a => a -> a
    succ GroupIndex
    s
        put $! (op',s')
        return s

      {-# INLINE makeOrbit #-}
      -- Specialize the monad operations and give more meaningful names
      -- makeOrbit uses MonadState(uniq) and MonadWriter(tell/Left)
      makeOrbit :: PM (Maybe Tag)
      makeOrbit :: PM (Maybe GroupIndex)
    makeOrbit = do x <- OP
    -> RWST
         (Maybe GroupIndex)
         [Either GroupIndex GroupInfo]
         ([OP] -> [OP], GroupIndex)
         Identity
         GroupIndex
    uniq' OP
    Orbit
    --                 trace ('\n':"PStar Orbit "++show x) $ do
                     tell [Left x]
                     return (Just x)

      {-# INLINE withOrbit #-}
      -- withOrbit uses MonadWriter(listens to makeOrbit/Left), collects
      -- children at all depths
      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 usesMonadWriter(tell/Right)
      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 uses MonadReader(ask)
      getParentIndex :: PM (Maybe GroupIndex)
      getParentIndex :: PM (Maybe GroupIndex)
    getParentIndex = PM (Maybe GroupIndex)
    forall r (m :: * -> *). MonadReader r m => m r
    ask

      {-# INLINE nonCapture #-}
      -- nonCapture uses MonadReader(local) to suppress getParentIndex to return Nothing
      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 uses MonadReader(local) to set getParentIndex to return (Just this)
      -- withParent uses MonadWriter(listens to makeGroup/Right) to return contained group indices (stopTag)
      -- withParent is only safe if getParentIndex has been checked to be not equal to Nothing (see PGroup below)
      -- Note use of laziness: the immediate children's group index is used to look up all copies of the
      -- group in aGroups, including copies that are not immediate children.
      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
                               -- filter to get only immediate children (efficiency)
                               ([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 is a partial function: Must not pass in an empty list
      -- Policy choices:
      --  * pass tags to apply to children and have no preTag or postTag here (so none added to nullQ)
      --  * middle 'mid' tag: give to left/front child as postTag so a Group there might claim it as a stopTag
      --  * if parent is Group then preReset will become non-empty
      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 -- libtre default
        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 = Q -> Bool
    varies Q
    qFront Bool -> Bool -> Bool
    && Q -> Bool
    varies Q
    qEnd
                a <- if noTag m1 && bothVary then uniq "combineSeq start" else return m1
                b <- if noTag m2 && bothVary then uniq "combineSeq stop" else return m2
                mid <- case (noTag a,canAccept qFront,noTag b,canAccept 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
          --      qFront <- pFront a mid
          --      qEnd <- pEnd (toAdvice mid) b
                (qFront,qEnd) <- front'end (pFront a mid) (pEnd (toAdvice mid) b)
                -- XXX: Perhaps a "produces" should be created to compliment "wants",
                -- then "produces qEnd" could be compared to "wants qFront"
                let 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
                return $ Q { nullQ = mergeNullViews (nullQ qFront) (nullQ qEnd)
                                 , takes = seqTake (takes qFront) (takes qEnd)
                                 , preReset = [], postSet = [], preTag = Nothing, postTag = Nothing
                                 , tagged = bothVary
                                 , childGroups = childGroups qFront || childGroups qEnd
                                 , wants = wanted
                                 , unQ = Seq qFront 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
               -- 2009 : The PNonEmpty p as POr [PEmpty,p] takes no branch tracking tag.
               --        I claim this is because only accepting branches need tags,
               --        and the last accepting branch does not need a tag.
               --        Non-accepting possibilities can all commute to the front and
               --        become part of the nullQ.  The accepting bits then need prioritizing.
               --    Does the above require changes in POr handling in TNFA?  Yes.
               --    Have to always use nullQ instead of "recapitulating" it.
               --    Could also create a constant-writing tag instead of many index tags.
               -- Exasperation: This POr recursive mdo is very easy to make loop and lockup the program
               -- if needTags is False then there is no way to disambiguate branches so fewer tags are needed
               let needUniqTags = Q -> Bool
    childGroups Q
    ans
               let needTags = Q -> Bool
    varies Q
    ans Bool -> Bool -> Bool
    || Q -> Bool
    childGroups Q
    ans -- childGroups detects that "abc|a(b)c" needs tags
               a <- if noTag m1 && needTags then uniq "POr start" else return m1 -- whole POr
               b <- if noTag m2 && needTags then uniq "POr stop" else return m2 -- whole POr
               let aAdvice = HandleTag -> HandleTag
    toAdvice HandleTag
    a -- all branches share 'aAdvice'
                   bAdvice = HandleTag -> HandleTag
    toAdvice HandleTag
    b -- last branch gets 'bAdvice', others may get own tag
                   -- Due to the recursive-do, it seems that I have to put the if needTags into the op'
                   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
    --           trace ("\nPOr sub "++show aAdvice++" "++show bAdvice++"needsTags is "++show needTags) $ return ()
               -- The "bs" values are allocated in left-to-right order before the children in "qs"
               -- optimization: low priority for last branch is implicit, do not create separate tag here.
               bs <- fmap (++[bAdvice]) $ replicateM (pred $ length branches) newUniq -- 2 <= length ps
               -- create all the child branches in left-to-right order after the "bs"
               qs <- forM (zip branches bs) (\(Pattern
    branch,HandleTag
    bTag) ->  (Pattern -> HHQ
    go Pattern
    branch HandleTag
    aAdvice HandleTag
    bTag))
               let wqs = (Q -> Wanted) -> [Q] -> [Wanted]
    forall a b. (a -> b) -> [a] -> [b]
    map Q -> Wanted
    wants [Q]
    qs
                   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
    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
                   -- The nullView computed above takes the nullQ of the branches and combines them.  This
                   -- assumes that the pre/post tags of the children are also part of the nullQ values.  So
                   -- for consistency, POr must then add its own pre/post tags to its nullQ value.  Note that
                   -- concatMap sets the left-to-right preference when choosing the null views.
               let 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 }
               return ans
             PConcat [] -> RWS
      (Maybe GroupIndex)
      [Either GroupIndex GroupInfo]
      ([OP] -> [OP], GroupIndex)
      Q
    nil -- fatal to pass [] to combineConcat
             PConcat [Pattern]
    ps -> [Pattern] -> HHQ
    combineConcat [Pattern]
    ps HandleTag
    m1 HandleTag
    m2
             PStar Bool
    mayFirstBeNull Pattern
    p -> mdo
               let accepts    = Q -> Bool
    canAccept Q
    q
                   -- if needsOrbit is False then there is no need to disambiguate captures on each orbit
                   -- Both checks are useful because (varies q) of True does not imply (childGroups q) of True when under PNonCapture
                   needsOrbit = Q -> Bool
    varies Q
    q Bool -> Bool -> Bool
    && Q -> Bool
    childGroups Q
    q
                   -- if needsOrbit then must check start/stop before the Orbit tag
                   -- if accepts then must check start/stop of whole pattern
                   needsTags  = Bool
    needsOrbit Bool -> Bool -> Bool
    || Bool
    accepts       -- important that needsOrbit implies needsTags
               a <- if noTag m1 && needsTags then uniq "PStar start" else return m1
               b <- if noTag m2 && needsTags then uniq "PStar stop" else return m2
               mOrbit <- if needsOrbit then makeOrbit else return Nothing -- any Orbit tag is created after the pre and post tags
    --           test1 <- if tagged q then uniq "not-TEST1" Minimize else return NoTag
    -- XXX XXX 1.1.5 testing second NoTag replaced with (toAdvice b)
               (q,resetOrbitTags) <- withOrbit (go p NoTag (toAdvice b)) -- all contained orbit tags get listened to (not including this one).
               let 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
               return $ Q { nullQ = nullView
                          , takes = (0,if accepts then Nothing else (Just 0))
                          , preReset = [], postSet = []
                          , preTag = apply a, postTag = apply b
                          , tagged = needsTags
                          , childGroups = childGroups q
                          , wants = WantsQT
                          , unQ =Star { getOrbit = mOrbit
                                      , resetOrbits = resetOrbitTags
                                      , firstNull = mayFirstBeNull
                                      , unStar = 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
             -- CompOption's newSyntax enables these escaped anchors
             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)
             -- otherwise escape codes are just the escaped character
             PEscape {} -> RWS
      (Maybe GroupIndex)
      [Either GroupIndex GroupInfo]
      ([OP] -> [OP], GroupIndex)
      Q
    one

             -- A PGroup node in the Pattern tree does not become a node
             -- in the Q/P tree. A PGroup can share and pass along a
             -- preTag (with Advice) with other branches, but will pass
             -- down an Apply postTag.
             --
             -- If the parent index is Nothing then this is part of a
             -- non-capturing subtree and ignored.  This is a lazy and
             -- efficient alternative to rebuilding the tree with PGroup
             -- Nothing replacing PGroup (Just _).
             --
             -- Guarded by the getParentIndex /= Nothing check is the
             -- withParent command.
             --
             PGroup Maybe GroupIndex
    Nothing Pattern
    p -> Pattern -> HHQ
    go Pattern
    p HandleTag
    m1 HandleTag
    m2
             PGroup (Just GroupIndex
    this) Pattern
    p -> do
               mParent <- PM (Maybe GroupIndex)
    getParentIndex
               case mParent of
                 Maybe GroupIndex
    Nothing -> Pattern -> HHQ
    go Pattern
    p HandleTag
    m1 HandleTag
    m2 -- just like PGroup Nothing p
                 Just GroupIndex
    parent -> do
                   -- 'a' may be Advice or Apply from parent or Apply created here
                   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
                   b <- if noTag m2 then uniq "PGroup stop" else return m2
                   flag <- ignore "PGroup ignore"
    {-
                   -- 'b' may be Apply from parent or Apply created here
                   b <- if isNothing (apply m2) then uniq "PGroup" else return m2
    -}
                   (q,resetGroupTags) <- withParent this (go p a b)  -- all immediate child groups stop tags get listened to.
                   -- 2009: makeGroup performs a tell, why after withParent? I am no longer sure.
                   makeGroup (GroupInfo this parent (fromHandleTag a) (fromHandleTag b) flag)
                   return $ q { nullQ = addGroupResetsToNullView resetGroupTags flag (nullQ q)
                              , tagged = True
                              , childGroups = True
                              , preReset = resetGroupTags `mappend` (preReset q)
                              , postSet = (postSet q) `mappend` [flag]
                              }

             -- A PNonCapture node in the Pattern tree does not become a
             -- node in the Q/P tree.  It sets the parent to Nothing while
             -- processing the sub-tree.
             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)

             -- these are here for completeness of the case branches, currently starTrans replaces them all
             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 is deprecated, and not produced in Pattern by starTrans anymore
             PNonEmpty {} -> RWS
      (Maybe GroupIndex)
      [Either GroupIndex GroupInfo]
      ([OP] -> [OP], GroupIndex)
      Q
    forall {a}. a
    die

    {-
    Similar to change in WinTags for QT/QNFA:
    Change the NullView to use a tasktags instead of wintags since they are all PreUpdate

             -- PNonEmpty means the child pattern p can be skipped by
             -- bypassing the pattern.  This is only used in the case p
             -- can accept 0 and can accept more than zero characters
             -- (thus the assertions, enforced by CorePattern.starTrans).
             -- The important thing about this case is intercept the
             -- "accept 0" possibility and replace with "skip".
             PNonEmpty p -> mdo
               let needsTags = canAccept q
               a <- if noTag m1 && needsTags then uniq Minimize else return m1
               b <- if noTag m2 && needsTags then uniq Maximize else return m2
               q <- go p (toAdvice a) (toAdvice b)
               when (not needsTags) (err $ "PNonEmpty could not accept characters: "++show (p,pOrig))
               when (mustAccept q) (err $ "patternToQ : PNonEmpty provided with a *mustAccept* pattern: "++show (p,pOrig))
               return $ Q { nullQ = emptyNull (preTags (apply a) (apply b)) -- The meaning of NonEmpty
                          , takes = (0,snd (takes q))                       -- like Or, drop lower bound to 0
                          , preReset = []
                          , preTag = apply a, postTag = apply b             -- own the closing tag so it will not end a PGroup
                          , tagged = needsTags
                          , childGroups = childGroups q
                          , wants = wants q  -- the test case is "x" =~ "(.|$){1,3}"
                          , unQ = NonEmpty q }

    -}
    {-
    emptyNull :: TagList -> NullView
    emptyNull tags = (mempty, tags) : []

    testNull :: TestInfo -> TagList -> NullView
    testNull (w,d) tags = (SetTestInfo (Map.singleton w (Set.singleton d)), tags) : []

    -- Prepend tags to nullView
    addTagsToNullView :: TagList -> NullView -> NullView
    addTagsToNullView [] oldNV = oldNV
    addTagsToNullView tags oldNV= do
      (oldTest,oldTags) <- oldNV
      return (oldTest,tags `mappend` oldTags)

    -}

    -- xxx todo
    --
    -- see of PNonEmpty -> NonEmpty -> TNFA is really smarter than POr about tags