    -- XXX design uncertainty:  should preResets be inserted into nullView?
    -- if not, why not? ADDED

    -- XXX design uncertainty: what does act -> actNullable ->
    -- actNullableTagless not use nullQ and same for inStar, etc?
    -- TODO : try rewriting whole qToNFA in terms of "act"
    -- (That will require re-organizing the continuation data a bit)

    -- | "Text.Regex.TDFA.TNFA" converts the CorePattern Q\/P data (and its
    -- Pattern leaves) to a QNFA tagged non-deterministic finite automata.
    --
    -- This holds every possible way to follow one state by another, while
    -- in the DFA these will be reduced by picking a single best
    -- transition for each (source,destination) pair.  The transitions are
    -- heavily and often redundantly annotated with tasks to perform, and
    -- this redundancy is reduced when picking the best transition.  So
    -- far, keeping all this information has helped fix bugs in both the
    -- design and implementation.
    --
    -- The QNFA for a Pattern with a starTraned Q\/P form with N one
    -- character accepting leaves has at most N+1 nodes.  These nodes
    -- represent the future choices after accepting a leaf.  The processing
    -- of Or nodes often reduces this number by sharing at the end of the
    -- different paths.  Turning off capturing while compiling the pattern
    -- may (future extension) reduce this further for some patterns by
    -- processing Star with optimizations.  This compact design also means
    -- that tags are assigned not just to be updated before taking a
    -- transition (PreUpdate) but also after the transition (PostUpdate).
    --
    -- Uses recursive do notation.

    module Text.Regex.TDFA.TNFA
      ( patternToNFA
      , QNFA(..), QT(..), QTrans, TagUpdate(..)
      ) where

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

    import Control.Monad(when)
    import Control.Monad.State(State,runState,execState,get,put,modify)
    import Data.Array.IArray(Array,array)
    import Data.Char(toLower,toUpper,isAlpha,ord)
    import qualified Data.List as List
    import Data.IntMap (IntMap)
    import qualified Data.IntMap as IMap(toAscList,null,unionWith,singleton,fromList,fromDistinctAscList)
    import Data.IntMap.CharMap2(CharMap(..))
    import qualified Data.IntMap.CharMap2 as Map(null,singleton,map)
    import qualified Data.IntMap.EnumMap2 as EMap(null,keysSet,assocs)
    import Data.IntSet.EnumSet2(EnumSet)
    import qualified Data.IntSet.EnumSet2 as Set(singleton,toList,insert)
    import Data.Maybe(catMaybes,isNothing)
    import Data.Monoid as Mon(Monoid(..))
    import qualified Data.Set as S (insert, toAscList)

    import Text.Regex.TDFA.Common(QT(..),QNFA(..),QTrans,TagTask(..),TagUpdate(..),DoPa(..)
                                 ,CompOption(..)
                                 ,Tag,TagTasks,TagList,Index,WinTags,GroupIndex,GroupInfo(..)
                                 ,common_error,noWin,snd3,mapSnd)
    import Text.Regex.TDFA.CorePattern(Q(..),P(..),OP(..),WhichTest,cleanNullView,NullView
                                      ,SetTestInfo(..),Wanted(..),TestInfo
                                      ,mustAccept,cannotAccept,patternToQ)
    import Text.Regex.TDFA.Pattern (Pattern(..), decodePatternSet)

    ecart :: String -> a -> a
    ecart :: forall a. [Char] -> a -> a
    ecart [Char]
    _ = a -> a
    forall a. a -> a
    id

    err :: String -> a
    err :: forall a. [Char] -> a
    err [Char]
    t = [Char] -> [Char] -> a
    forall a. [Char] -> [Char] -> a
    common_error [Char]
    "Text.Regex.TDFA.TNFA" [Char]
    t

    debug :: (Show a) => a -> s -> s
    debug :: forall a s. Show a => a -> s -> s
    debug a
    _ s
    s = s
    s

    qtwin,qtlose :: QT
    -- qtwin is the continuation after matching the whole pattern.  It has
    -- no further transitions and sets tag #1 to the current position.
    qtwin :: QT
    qtwin = Simple {qt_win :: WinTags
    qt_win=[(Key
    1,TagTask -> TagUpdate
    PreUpdate TagTask
    TagTask)],qt_trans :: CharMap QTrans
    qt_trans=CharMap QTrans
    forall a. Monoid a => a
    mempty,qt_other :: QTrans
    qt_other=QTrans
    forall a. Monoid a => a
    mempty}
    -- qtlose is the continuation to nothing, used when ^ or $ tests fail.
    qtlose :: QT
    qtlose = Simple {qt_win :: WinTags
    qt_win=WinTags
    forall a. Monoid a => a
    mempty,qt_trans :: CharMap QTrans
    qt_trans=CharMap QTrans
    forall a. Monoid a => a
    mempty,qt_other :: QTrans
    qt_other=QTrans
    forall a. Monoid a => a
    mempty}

    patternToNFA :: CompOption
                 -> (Pattern,(GroupIndex, DoPa))
                 -> ((Index,Array Index QNFA)
                    ,Array Tag OP
                    ,Array GroupIndex [GroupInfo])
    patternToNFA :: CompOption
    -> (Pattern, (Key, DoPa))
    -> ((Key, Array Key QNFA), Array Key OP, Array Key [GroupInfo])
    patternToNFA CompOption
    compOpt (Pattern, (Key, DoPa))
    pattern =
      let (Q
    q,Array Key OP
    tags,Array Key [GroupInfo]
    groups) = CompOption
    -> (Pattern, (Key, DoPa))
    -> (Q, Array Key OP, Array Key [GroupInfo])
    patternToQ CompOption
    compOpt (Pattern, (Key, DoPa))
    pattern
          msg :: [Char]
    msg = [[Char]] -> [Char]
    unlines [ Q -> [Char]
    forall a. Show a => a -> [Char]
    show Q
    q ]
      in [Char]
    -> ((Key, Array Key QNFA), Array Key OP, Array Key [GroupInfo])
    -> ((Key, Array Key QNFA), Array Key OP, Array Key [GroupInfo])
    forall a s. Show a => a -> s -> s
    debug [Char]
    msg (CompOption -> Q -> (Key, Array Key QNFA)
    qToNFA CompOption
    compOpt Q
    q,Array Key OP
    tags,Array Key [GroupInfo]
    groups)

    -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- ==
    -- Query function on Q

    nullable :: Q -> Bool
    nullable :: Q -> Bool
    nullable = Bool -> Bool
    not (Bool -> Bool) -> (Q -> Bool) -> Q -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(SetTestInfo, WinTags)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([(SetTestInfo, WinTags)] -> Bool)
    -> (Q -> [(SetTestInfo, WinTags)]) -> Q -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Q -> [(SetTestInfo, WinTags)]
    nullQ

    notNullable :: Q -> Bool
    notNullable :: Q -> Bool
    notNullable = [(SetTestInfo, WinTags)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([(SetTestInfo, WinTags)] -> Bool)
    -> (Q -> [(SetTestInfo, WinTags)]) -> Q -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Q -> [(SetTestInfo, WinTags)]
    nullQ

    -- This asks if the preferred (i.e. first) NullView has no tests.
    maybeOnlyEmpty :: Q -> Maybe WinTags
    maybeOnlyEmpty :: Q -> Maybe WinTags
    maybeOnlyEmpty (Q {nullQ :: Q -> [(SetTestInfo, WinTags)]
    nullQ = ((SetTestInfo EnumMap WhichTest (EnumSet DoPa)
    sti,WinTags
    tags):[(SetTestInfo, WinTags)]
    _)}) = if EnumMap WhichTest (EnumSet DoPa) -> Bool
    forall key a. Enum key => EnumMap key a -> Bool
    EMap.null EnumMap WhichTest (EnumSet DoPa)
    sti then WinTags -> Maybe WinTags
    forall a. a -> Maybe a
    Just WinTags
    tags else Maybe WinTags
    forall a. Maybe a
    Nothing
    maybeOnlyEmpty Q
    _ = Maybe WinTags
    forall a. Maybe a
    Nothing

    usesQNFA :: Q -> Bool
    usesQNFA :: Q -> Bool
    usesQNFA (Q {wants :: Q -> Wanted
    wants=Wanted
    WantsBoth}) = Bool
    True
    usesQNFA (Q {wants :: Q -> Wanted
    wants=Wanted
    WantsQNFA}) = Bool
    True
    usesQNFA Q
    _ = Bool
    False

    -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- ==
    -- Functions related to QT

    -- dumb smart constructor used by qToQNFA
    -- Possible: Go through the qt and keep only the best tagged transition(s) to each state to make simple NFA?
    mkQNFA :: Index -> QT -> QNFA
    mkQNFA :: Key -> QT -> QNFA
    mkQNFA Key
    i QT
    qt = [Char] -> QNFA -> QNFA
    forall a s. Show a => a -> s -> s
    debug ([Char]
    "\n>QNFA id="[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++Key -> [Char]
    forall a. Show a => a -> [Char]
    show Key
    i) (QNFA -> QNFA) -> QNFA -> QNFA
    forall a b. (a -> b) -> a -> b
    $
      Key -> QT -> QNFA
    QNFA Key
    i ([Char] -> QT -> QT
    forall a s. Show a => a -> s -> s
    debug ([Char]
    "\ngetting QT for "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++Key -> [Char]
    forall a. Show a => a -> [Char]
    show Key
    i) QT
    qt)

    -- This uses the Eq QT instance above
    -- ZZZ
    mkTesting :: QT -> QT
    mkTesting :: QT -> QT
    mkTesting t :: QT
    t@(Testing {qt_a :: QT -> QT
    qt_a=QT
    a,qt_b :: QT -> QT
    qt_b=QT
    b}) = if QT
    aQT -> QT -> Bool
    forall a. Eq a => a -> a -> Bool
    ==QT
    b then QT
    a else QT
    t -- Move to nfsToDFA XXX
    mkTesting QT
    t = QT
    t

    nullQT :: QT -> Bool
    nullQT :: QT -> Bool
    nullQT (Simple {qt_win :: QT -> WinTags
    qt_win=WinTags
    w,qt_trans :: QT -> CharMap QTrans
    qt_trans=CharMap QTrans
    t,qt_other :: QT -> QTrans
    qt_other=QTrans
    o}) = WinTags -> Bool
    noWin WinTags
    w Bool -> Bool -> Bool
    && CharMap QTrans -> Bool
    forall a. CharMap a -> Bool
    Map.null CharMap QTrans
    t Bool -> Bool -> Bool
    && QTrans -> Bool
    forall a. IntMap a -> Bool
    IMap.null QTrans
    o
    nullQT QT
    _ = Bool
    False

    -- This reconstructs the set of tests checked in processing QT, adding
    -- them to the passed set.
    listTestInfo :: QT -> EnumSet WhichTest -> EnumSet WhichTest
    listTestInfo :: QT -> EnumSet WhichTest -> EnumSet WhichTest
    listTestInfo QT
    qt EnumSet WhichTest
    s = State (EnumSet WhichTest) ()
    -> EnumSet WhichTest -> EnumSet WhichTest
    forall s a. State s a -> s -> s
    execState (QT -> State (EnumSet WhichTest) ()
    forall {m :: * -> *}.
    MonadState (EnumSet WhichTest) m =>
    QT -> m ()
    helper QT
    qt) EnumSet WhichTest
    s
      where helper :: QT -> m ()
    helper (Simple {}) = () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            helper (Testing {qt_test :: QT -> WhichTest
    qt_test = WhichTest
    wt, qt_a :: QT -> QT
    qt_a = QT
    a, qt_b :: QT -> QT
    qt_b = QT
    b}) = do
              (EnumSet WhichTest -> EnumSet WhichTest) -> m ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (WhichTest -> EnumSet WhichTest -> EnumSet WhichTest
    forall e. Enum e => e -> EnumSet e -> EnumSet e
    Set.insert WhichTest
    wt)
              QT -> m ()
    helper QT
    a
              QT -> m ()
    helper QT
    b

    -- This is used to view "win" only through NullView, and is used in
    -- processing Or.
    applyNullViews :: NullView -> QT -> QT
    applyNullViews :: [(SetTestInfo, WinTags)] -> QT -> QT
    applyNullViews [] QT
    win = QT
    win
    applyNullViews [(SetTestInfo, WinTags)]
    nvs QT
    win = (QT -> (SetTestInfo, WinTags) -> QT)
    -> QT -> [(SetTestInfo, WinTags)] -> QT
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    List.foldl' (QT -> QT -> (SetTestInfo, WinTags) -> QT
    dominate QT
    win) QT
    qtlose ([(SetTestInfo, WinTags)] -> [(SetTestInfo, WinTags)]
    forall a. [a] -> [a]
    reverse ([(SetTestInfo, WinTags)] -> [(SetTestInfo, WinTags)])
    -> [(SetTestInfo, WinTags)] -> [(SetTestInfo, WinTags)]
    forall a b. (a -> b) -> a -> b
    $ [(SetTestInfo, WinTags)] -> [(SetTestInfo, WinTags)]
    cleanNullView [(SetTestInfo, WinTags)]
    nvs)

    -- This is used to prefer to view "win" through NullView.  Losing is
    -- replaced by the plain win.  This is employed by Star patterns to
    -- express that the first iteration is allowed to match null, but
    -- skipping the NullView occurs if the match fails.
    preferNullViews :: NullView -> QT -> QT
    preferNullViews :: [(SetTestInfo, WinTags)] -> QT -> QT
    preferNullViews [] QT
    win = QT
    win
    preferNullViews [(SetTestInfo, WinTags)]
    nvs QT
    win = (QT -> (SetTestInfo, WinTags) -> QT)
    -> QT -> [(SetTestInfo, WinTags)] -> QT
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    List.foldl' (QT -> QT -> (SetTestInfo, WinTags) -> QT
    dominate QT
    win) QT
    win ([(SetTestInfo, WinTags)] -> [(SetTestInfo, WinTags)]
    forall a. [a] -> [a]
    reverse ([(SetTestInfo, WinTags)] -> [(SetTestInfo, WinTags)])
    -> [(SetTestInfo, WinTags)] -> [(SetTestInfo, WinTags)]
    forall a b. (a -> b) -> a -> b
    $ [(SetTestInfo, WinTags)] -> [(SetTestInfo, WinTags)]
    cleanNullView [(SetTestInfo, WinTags)]
    nvs)

    {-
    dominate is common to applyNullViews and preferNullViews above.

    Even I no longer understand it without study.

    Oversimplified: The last argument has a new set of tests "sti" that
    must be satisfied to then apply the new "tags" and reach the "win" QT.
    Failing any of this set of tests leads to the "lose" QT.

    Closer: The "win" may already have some other set of tests leading to
    various branches, this set is cached in winTests.  And the "lose" may
    already have some other set of tests leading to various branches.  The
    combination of "win" and "lose" and "sti" must check the union of
    these tests, which is "allTests".

    Detail: The merging is done by useTest, where the tests in sti divert
    losing to a branch of "lose" and winning to a branch of "win".  Tests
    not in sti are unchanged (but the losing DoPa index might be added).
    -}
    dominate :: QT -> QT -> (SetTestInfo,WinTags) -> QT
    dominate :: QT -> QT -> (SetTestInfo, WinTags) -> QT
    dominate QT
    win QT
    lose x :: (SetTestInfo, WinTags)
    x@(SetTestInfo EnumMap WhichTest (EnumSet DoPa)
    sti,WinTags
    tags) = [Char] -> QT -> QT
    forall a s. Show a => a -> s -> s
    debug ([Char]
    "dominate "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++(SetTestInfo, WinTags) -> [Char]
    forall a. Show a => a -> [Char]
    show (SetTestInfo, WinTags)
    x) (QT -> QT) -> QT -> QT
    forall a b. (a -> b) -> a -> b
    $
      let -- The winning states are reached through the SetTag
          win' :: QT
    win' = WinTags -> QT -> QT
    prependTags' WinTags
    tags QT
    win
          -- get the SetTestInfo
          winTests :: EnumSet WhichTest
    winTests = QT -> EnumSet WhichTest -> EnumSet WhichTest
    listTestInfo QT
    win (EnumSet WhichTest -> EnumSet WhichTest)
    -> EnumSet WhichTest -> EnumSet WhichTest
    forall a b. (a -> b) -> a -> b
    $ EnumSet WhichTest
    forall a. Monoid a => a
    mempty
          allTests :: EnumSet WhichTest
    allTests = (QT -> EnumSet WhichTest -> EnumSet WhichTest
    listTestInfo QT
    lose (EnumSet WhichTest -> EnumSet WhichTest)
    -> EnumSet WhichTest -> EnumSet WhichTest
    forall a b. (a -> b) -> a -> b
    $ EnumSet WhichTest
    winTests) EnumSet WhichTest -> EnumSet WhichTest -> EnumSet WhichTest
    forall a. Monoid a => a -> a -> a
    `mappend` (EnumMap WhichTest (EnumSet DoPa) -> EnumSet WhichTest
    forall key a. Enum key => EnumMap key a -> EnumSet key
    EMap.keysSet EnumMap WhichTest (EnumSet DoPa)
    sti)
          -- The first and second arguments of useTest are sorted
          -- At all times the second argument of useTest is a subset of the first
          useTest :: [WhichTest] -> [(WhichTest, EnumSet DoPa)] -> QT -> QT -> QT
    useTest [WhichTest]
    _ [] QT
    w QT
    _ = QT
    w -- no more dominating tests to fail to choose lose, so just choose win
          useTest (WhichTest
    aTest:[WhichTest]
    tests) allD :: [(WhichTest, EnumSet DoPa)]
    allD@((WhichTest
    dTest,EnumSet DoPa
    dopas):[(WhichTest, EnumSet DoPa)]
    ds) QT
    w QT
    l =
            let (QT
    wA,QT
    wB,EnumSet DoPa
    wD) = QT -> (QT, QT, EnumSet DoPa)
    branches QT
    w
                (QT
    lA,QT
    lB,EnumSet DoPa
    lD) = QT -> (QT, QT, EnumSet DoPa)
    branches QT
    l
                branches :: QT -> (QT, QT, EnumSet DoPa)
    branches qt :: QT
    qt@(Testing {}) | WhichTest
    aTestWhichTest -> WhichTest -> Bool
    forall a. Eq a => a -> a -> Bool
    ==QT -> WhichTest
    qt_test QT
    qt = (QT -> QT
    qt_a QT
    qt,QT -> QT
    qt_b QT
    qt,QT -> EnumSet DoPa
    qt_dopas QT
    qt)
                branches QT
    qt = (QT
    qt,QT
    qt,EnumSet DoPa
    forall a. Monoid a => a
    mempty)
            in if WhichTest
    aTest WhichTest -> WhichTest -> Bool
    forall a. Eq a => a -> a -> Bool
    == WhichTest
    dTest
                 then Testing {qt_test :: WhichTest
    qt_test = WhichTest
    aTest
                              ,qt_dopas :: EnumSet DoPa
    qt_dopas = (EnumSet DoPa
    dopas EnumSet DoPa -> EnumSet DoPa -> EnumSet DoPa
    forall a. Monoid a => a -> a -> a
    `mappend` EnumSet DoPa
    wD) EnumSet DoPa -> EnumSet DoPa -> EnumSet DoPa
    forall a. Monoid a => a -> a -> a
    `mappend` EnumSet DoPa
    lD
                              ,qt_a :: QT
    qt_a = [WhichTest] -> [(WhichTest, EnumSet DoPa)] -> QT -> QT -> QT
    useTest [WhichTest]
    tests [(WhichTest, EnumSet DoPa)]
    ds QT
    wA QT
    lA
                              ,qt_b :: QT
    qt_b = QT
    lB}
                 else Testing {qt_test :: WhichTest
    qt_test = WhichTest
    aTest
                              ,qt_dopas :: EnumSet DoPa
    qt_dopas = EnumSet DoPa
    wD EnumSet DoPa -> EnumSet DoPa -> EnumSet DoPa
    forall a. Monoid a => a -> a -> a
    `mappend` EnumSet DoPa
    lD
                              ,qt_a :: QT
    qt_a = [WhichTest] -> [(WhichTest, EnumSet DoPa)] -> QT -> QT -> QT
    useTest [WhichTest]
    tests [(WhichTest, EnumSet DoPa)]
    allD QT
    wA QT
    lA
                              ,qt_b :: QT
    qt_b = [WhichTest] -> [(WhichTest, EnumSet DoPa)] -> QT -> QT -> QT
    useTest [WhichTest]
    tests [(WhichTest, EnumSet DoPa)]
    allD QT
    wB QT
    lB}
          useTest [] [(WhichTest, EnumSet DoPa)]
    _ QT
    _  QT
    _ = [Char] -> QT
    forall a. [Char] -> a
    err [Char]
    "This case in dominate.useText cannot happen: second argument would have to have been null and that is checked before this case"
      in [WhichTest] -> [(WhichTest, EnumSet DoPa)] -> QT -> QT -> QT
    useTest (EnumSet WhichTest -> [WhichTest]
    forall e. Enum e => EnumSet e -> [e]
    Set.toList EnumSet WhichTest
    allTests) (EnumMap WhichTest (EnumSet DoPa) -> [(WhichTest, EnumSet DoPa)]
    forall key a. Enum key => EnumMap key a -> [(key, a)]
    EMap.assocs EnumMap WhichTest (EnumSet DoPa)
    sti) QT
    win' QT
    lose

    -- 'applyTest' is only used by addTest
    -- 2009: maybe need to keep track of whether a change is actually made
    -- (beyond DoPa tracking) to the QT.
    applyTest :: TestInfo -> QT -> QT
    applyTest :: TestInfo -> QT -> QT
    applyTest (WhichTest
    wt,DoPa
    dopa) QT
    qt | QT -> Bool
    nullQT QT
    qt = QT
    qt
                           | Bool
    otherwise = QT -> QT
    applyTest' QT
    qt where
      applyTest' :: QT -> QT
      applyTest' :: QT -> QT
    applyTest' q :: QT
    q@(Simple {}) =
        QT -> QT
    mkTesting (QT -> QT) -> QT -> QT
    forall a b. (a -> b) -> a -> b
    $ Testing {qt_test :: WhichTest
    qt_test = WhichTest
    wt
                            ,qt_dopas :: EnumSet DoPa
    qt_dopas = DoPa -> EnumSet DoPa
    forall e. Enum e => e -> EnumSet e
    Set.singleton DoPa
    dopa
                            ,qt_a :: QT
    qt_a = QT
    q
                            ,qt_b :: QT
    qt_b = QT
    qtlose}
      applyTest' q :: QT
    q@(Testing {qt_test :: QT -> WhichTest
    qt_test=WhichTest
    wt'}) =
        case WhichTest -> WhichTest -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare WhichTest
    wt WhichTest
    wt' of
          Ordering
    LT -> Testing {qt_test :: WhichTest
    qt_test = WhichTest
    wt
                        ,qt_dopas :: EnumSet DoPa
    qt_dopas = DoPa -> EnumSet DoPa
    forall e. Enum e => e -> EnumSet e
    Set.singleton DoPa
    dopa
                        ,qt_a :: QT
    qt_a = QT
    q
                        ,qt_b :: QT
    qt_b = QT
    qtlose}
          Ordering
    EQ -> QT
    q {qt_dopas = Set.insert dopa (qt_dopas q)
                  ,qt_b = qtlose}
          Ordering
    GT -> QT
    q {qt_a = applyTest' (qt_a q)
                  ,qt_b = applyTest' (qt_b q)}

    -- Three ways to merge a pair of QT's varying how winning transitions
    -- are handled.
    --
    -- mergeQT_2nd is used by the NonEmpty case and always discards the
    -- first argument's win and uses the second argument's win.
    --
    -- mergeAltQT is used by the Or cases and is biased to the first
    -- argument's winning transition, if present.
    --
    -- mergeQT is used by Star and mergeE and combines the winning
    -- transitions (concatenating the instructions).
    mergeQT_2nd,mergeAltQT,mergeQT :: QT -> QT -> QT
    mergeQT_2nd :: QT -> QT -> QT
    mergeQT_2nd QT
    q1 QT
    q2 | QT -> Bool
    nullQT QT
    q1 = QT
    q2
                      | Bool
    otherwise = (WinTags -> WinTags -> WinTags) -> QT -> QT -> QT
    mergeQTWith (\WinTags
    _ WinTags
    w2 -> WinTags
    w2) QT
    q1 QT
    q2

    mergeAltQT :: QT -> QT -> QT
    mergeAltQT QT
    q1 QT
    q2 | QT -> Bool
    nullQT QT
    q1 = QT
    q2  -- prefer winning with w1 then with w2
                     | Bool
    otherwise = (WinTags -> WinTags -> WinTags) -> QT -> QT -> QT
    mergeQTWith (\WinTags
    w1 WinTags
    w2 -> if WinTags -> Bool
    noWin WinTags
    w1 then WinTags
    w2 else WinTags
    w1) QT
    q1 QT
    q2
    mergeQT :: QT -> QT -> QT
    mergeQT QT
    q1 QT
    q2 | QT -> Bool
    nullQT QT
    q1 = QT
    q2  -- union wins
                  | QT -> Bool
    nullQT QT
    q2 = QT
    q1  -- union wins
                  | Bool
    otherwise = (WinTags -> WinTags -> WinTags) -> QT -> QT -> QT
    mergeQTWith WinTags -> WinTags -> WinTags
    forall a. Monoid a => a -> a -> a
    mappend QT
    q1 QT
    q2 -- no preference, win with combined SetTag XXX is the wrong thing! "(.?)*"

    -- This takes a function which implements a policy on merging
    -- winning transitions and then merges all the transitions.  It opens
    -- the CharMap newtype for more efficient operation, then rewraps it.
    mergeQTWith :: (WinTags -> WinTags -> WinTags) -> QT -> QT -> QT
    mergeQTWith :: (WinTags -> WinTags -> WinTags) -> QT -> QT -> QT
    mergeQTWith WinTags -> WinTags -> WinTags
    mergeWins = QT -> QT -> QT
    merge where
      merge :: QT -> QT -> QT
      merge :: QT -> QT -> QT
    merge (Simple WinTags
    w1 CharMap QTrans
    t1 QTrans
    o1) (Simple WinTags
    w2 CharMap QTrans
    t2 QTrans
    o2) =
        let w' :: WinTags
    w' = WinTags -> WinTags -> WinTags
    mergeWins WinTags
    w1 WinTags
    w2
            t' :: CharMap QTrans
    t' = CharMap QTrans
    -> QTrans -> CharMap QTrans -> QTrans -> CharMap QTrans
    fuseQTrans CharMap QTrans
    t1 QTrans
    o1 CharMap QTrans
    t2 QTrans
    o2
            o' :: QTrans
    o' = QTrans -> QTrans -> QTrans
    mergeQTrans QTrans
    o1 QTrans
    o2
        in WinTags -> CharMap QTrans -> QTrans -> QT
    Simple WinTags
    w' CharMap QTrans
    t' QTrans
    o'
      merge t1 :: QT
    t1@(Testing WhichTest
    _ EnumSet DoPa
    _ QT
    a1 QT
    b1) s2 :: QT
    s2@(Simple {}) = QT -> QT
    mkTesting (QT -> QT) -> QT -> QT
    forall a b. (a -> b) -> a -> b
    $
        QT
    t1 {qt_a=(merge a1 s2), qt_b=(merge b1 s2)}
      merge s1 :: QT
    s1@(Simple {}) t2 :: QT
    t2@(Testing WhichTest
    _ EnumSet DoPa
    _ QT
    a2 QT
    b2) = QT -> QT
    mkTesting (QT -> QT) -> QT -> QT
    forall a b. (a -> b) -> a -> b
    $
        QT
    t2 {qt_a=(merge s1 a2), qt_b=(merge s1 b2)}
      merge t1 :: QT
    t1@(Testing WhichTest
    wt1 EnumSet DoPa
    ds1 QT
    a1 QT
    b1) t2 :: QT
    t2@(Testing WhichTest
    wt2 EnumSet DoPa
    ds2 QT
    a2 QT
    b2) = QT -> QT
    mkTesting (QT -> QT) -> QT -> QT
    forall a b. (a -> b) -> a -> b
    $
        case WhichTest -> WhichTest -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare WhichTest
    wt1 WhichTest
    wt2 of
          Ordering
    LT -> QT
    t1 {qt_a=(merge a1 t2), qt_b=(merge b1 t2)}
          Ordering
    EQ -> Testing {qt_test :: WhichTest
    qt_test = WhichTest
    wt1 -- same as wt2
                        ,qt_dopas :: EnumSet DoPa
    qt_dopas = EnumSet DoPa -> EnumSet DoPa -> EnumSet DoPa
    forall a. Monoid a => a -> a -> a
    mappend EnumSet DoPa
    ds1 EnumSet DoPa
    ds2
                        ,qt_a :: QT
    qt_a = QT -> QT -> QT
    merge QT
    a1 QT
    a2
                        ,qt_b :: QT
    qt_b = QT -> QT -> QT
    merge QT
    b1 QT
    b2}
          Ordering
    GT -> QT
    t2 {qt_a=(merge t1 a2), qt_b=(merge t1 b2)}

      fuseQTrans :: (CharMap QTrans) -> QTrans
                 -> (CharMap QTrans) -> QTrans
                 -> CharMap QTrans
      fuseQTrans :: CharMap QTrans
    -> QTrans -> CharMap QTrans -> QTrans -> CharMap QTrans
    fuseQTrans (CharMap IntMap QTrans
    t1) QTrans
    o1 (CharMap IntMap QTrans
    t2) QTrans
    o2 = IntMap QTrans -> CharMap QTrans
    forall a. IntMap a -> CharMap a
    CharMap ([(Key, QTrans)] -> IntMap QTrans
    forall a. [(Key, a)] -> IntMap a
    IMap.fromDistinctAscList ([(Key, QTrans)] -> [(Key, QTrans)] -> [(Key, QTrans)]
    forall {a}.
    Ord a =>
    [(a, QTrans)] -> [(a, QTrans)] -> [(a, QTrans)]
    fuse [(Key, QTrans)]
    l1 [(Key, QTrans)]
    l2)) where
        l1 :: [(Key, QTrans)]
    l1 = IntMap QTrans -> [(Key, QTrans)]
    forall a. IntMap a -> [(Key, a)]
    IMap.toAscList IntMap QTrans
    t1
        l2 :: [(Key, QTrans)]
    l2 = IntMap QTrans -> [(Key, QTrans)]
    forall a. IntMap a -> [(Key, a)]
    IMap.toAscList IntMap QTrans
    t2
        fuse :: [(a, QTrans)] -> [(a, QTrans)] -> [(a, QTrans)]
    fuse [] [(a, QTrans)]
    y  = (QTrans -> QTrans) -> [(a, QTrans)] -> [(a, QTrans)]
    forall (f :: * -> *) t1 t2 t.
    Functor f =>
    (t1 -> t2) -> f (t, t1) -> f (t, t2)
    mapSnd (QTrans -> QTrans -> QTrans
    mergeQTrans QTrans
    o1) [(a, QTrans)]
    y
        fuse [(a, QTrans)]
    x  [] = (QTrans -> QTrans) -> [(a, QTrans)] -> [(a, QTrans)]
    forall (f :: * -> *) t1 t2 t.
    Functor f =>
    (t1 -> t2) -> f (t, t1) -> f (t, t2)
    mapSnd (QTrans -> QTrans -> QTrans
    mergeQTrans QTrans
    o2) [(a, QTrans)]
    x
        fuse x :: [(a, QTrans)]
    x@((a
    xc,QTrans
    xa):[(a, QTrans)]
    xs) y :: [(a, QTrans)]
    y@((a
    yc,QTrans
    ya):[(a, QTrans)]
    ys) =
          case a -> a -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare a
    xc a
    yc of
            Ordering
    LT -> (a
    xc,QTrans -> QTrans -> QTrans
    mergeQTrans QTrans
    xa QTrans
    o2) (a, QTrans) -> [(a, QTrans)] -> [(a, QTrans)]
    forall a. a -> [a] -> [a]
    : [(a, QTrans)] -> [(a, QTrans)] -> [(a, QTrans)]
    fuse [(a, QTrans)]
    xs [(a, QTrans)]
    y
            Ordering
    EQ -> (a
    xc,QTrans -> QTrans -> QTrans
    mergeQTrans QTrans
    xa QTrans
    ya) (a, QTrans) -> [(a, QTrans)] -> [(a, QTrans)]
    forall a. a -> [a] -> [a]
    : [(a, QTrans)] -> [(a, QTrans)] -> [(a, QTrans)]
    fuse [(a, QTrans)]
    xs [(a, QTrans)]
    ys
            Ordering
    GT -> (a
    yc,QTrans -> QTrans -> QTrans
    mergeQTrans QTrans
    o1 QTrans
    ya) (a, QTrans) -> [(a, QTrans)] -> [(a, QTrans)]
    forall a. a -> [a] -> [a]
    : [(a, QTrans)] -> [(a, QTrans)] -> [(a, QTrans)]
    fuse [(a, QTrans)]
    x  [(a, QTrans)]
    ys

      mergeQTrans :: QTrans -> QTrans -> QTrans
      mergeQTrans :: QTrans -> QTrans -> QTrans
    mergeQTrans = ([TagCommand] -> [TagCommand] -> [TagCommand])
    -> QTrans -> QTrans -> QTrans
    forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
    IMap.unionWith [TagCommand] -> [TagCommand] -> [TagCommand]
    forall a. Monoid a => a -> a -> a
    mappend

    -- Note: There are no append* operations. There are only these
    -- prepend* operations because things are only prepended to the future
    -- continuation.  And the ordering is significant.

    -- This is only used in inStar/nullable
    prependPreTag :: Maybe Tag -> QT -> QT
    prependPreTag :: Maybe Key -> QT -> QT
    prependPreTag Maybe Key
    Nothing QT
    qt = QT
    qt
    prependPreTag (Just Key
    tag) QT
    qt = WinTags -> QT -> QT
    prependTags' [(Key
    tag,TagTask -> TagUpdate
    PreUpdate TagTask
    TagTask)] QT
    qt

    prependGroupResets :: [Tag] -> QT -> QT
    prependGroupResets :: [Key] -> QT -> QT
    prependGroupResets [] QT
    qt = QT
    qt
    prependGroupResets [Key]
    tags QT
    qt = WinTags -> QT -> QT
    prependTags' [(Key
    tag,TagTask -> TagUpdate
    PreUpdate TagTask
    ResetGroupStopTask)|Key
    tag<-[Key]
    tags] QT
    qt

    prependTags' :: TagList -> QT -> QT
    prependTags' :: WinTags -> QT -> QT
    prependTags' []  QT
    qt = QT
    qt
    prependTags' WinTags
    tcs' qt :: QT
    qt@(Testing {}) = QT
    qt { qt_a = prependTags' tcs' (qt_a qt)
                                           , qt_b = prependTags' tcs' (qt_b qt) }
    prependTags' WinTags
    tcs' (Simple {qt_win :: QT -> WinTags
    qt_win=WinTags
    w,qt_trans :: QT -> CharMap QTrans
    qt_trans=CharMap QTrans
    t,qt_other :: QT -> QTrans
    qt_other=QTrans
    o}) =
      Simple { qt_win :: WinTags
    qt_win = if WinTags -> Bool
    noWin WinTags
    w then WinTags
    w else WinTags
    tcs' WinTags -> WinTags -> WinTags
    forall a. Monoid a => a -> a -> a
    `mappend` WinTags
    w
             , qt_trans :: CharMap QTrans
    qt_trans = (QTrans -> QTrans) -> CharMap QTrans -> CharMap QTrans
    forall a b. (a -> b) -> CharMap a -> CharMap b
    Map.map QTrans -> QTrans
    forall {a}. IntMap [(a, WinTags)] -> IntMap [(a, WinTags)]
    prependQTrans CharMap QTrans
    t
             , qt_other :: QTrans
    qt_other = QTrans -> QTrans
    forall {a}. IntMap [(a, WinTags)] -> IntMap [(a, WinTags)]
    prependQTrans QTrans
    o }
      where prependQTrans :: IntMap [(a, WinTags)] -> IntMap [(a, WinTags)]
    prependQTrans = ([(a, WinTags)] -> [(a, WinTags)])
    -> IntMap [(a, WinTags)] -> IntMap [(a, WinTags)]
    forall a b. (a -> b) -> IntMap a -> IntMap b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (((a, WinTags) -> (a, WinTags)) -> [(a, WinTags)] -> [(a, WinTags)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(a
    d,WinTags
    tcs) -> (a
    d,WinTags
    tcs' WinTags -> WinTags -> WinTags
    forall a. Monoid a => a -> a -> a
    `mappend` WinTags
    tcs)))

    -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- ==
    -- define type S which is a State monad, this allows the creation of the uniq QNFA ids and storing the QNFA
    -- in an ascending order difference list for later placement in an array.

    -- Type of State monad used inside qToNFA
    type S = State (Index                             -- Next available QNFA index
                   ,[(Index,QNFA)]->[(Index,QNFA)])    -- DList of previous QNFAs

    -- Type of continuation of the NFA, not much more complicated
    type E = (TagTasks            -- Things to do before the Either QNFA QT
                                  -- with OneChar these become PostUpdate otherwise they become PreUpdate
             ,Either QNFA QT)     -- The future, packaged in the best way

    -- See documentation below before the 'act' function.  This is for use inside a Star pattern.
    type ActCont = ( E                      -- The eLoop is the dangerous recursive reference to continuation
                                            -- future that loops while accepting zero more characters
                   , Maybe E                -- This holds the safe non-zero-character accepting continuation
                   , Maybe (TagTasks,QNFA)) -- optimized merger of the above, used only inside act, to avoid orphan QNFA id values

    -- newQNFA is the only operation that actually uses the monad get and put operations
    newQNFA :: String -> QT -> S QNFA
    newQNFA :: [Char] -> QT -> S QNFA
    newQNFA [Char]
    s QT
    qt = do
      (thisI,oldQs) <- StateT
      (Key, [(Key, QNFA)] -> [(Key, QNFA)])
      Identity
      (Key, [(Key, QNFA)] -> [(Key, QNFA)])
    forall s (m :: * -> *). MonadState s m => m s
    get
      let futureI = Key -> Key
    forall a. Enum a => a -> a
    succ Key
    thisI in seq futureI $ debug (">newQNFA< "++s++" : "++show thisI) $ do
      let qnfa = Key -> QT -> QNFA
    mkQNFA Key
    thisI QT
    qt -- (strictQT qt) -- making strictQNFA kills test (1,11) ZZZ
      put $! (futureI, oldQs . ((thisI,qnfa):))
      return qnfa

    -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- ==
    -- E related functions

    fromQNFA :: QNFA -> E
    fromQNFA :: QNFA -> E
    fromQNFA QNFA
    qnfa = (TagTasks
    forall a. Monoid a => a
    mempty,QNFA -> Either QNFA QT
    forall a b. a -> Either a b
    Left QNFA
    qnfa)

    fromQT :: QT -> E
    fromQT :: QT -> E
    fromQT QT
    qt = (TagTasks
    forall a. Monoid a => a
    mempty,QT -> Either QNFA QT
    forall a b. b -> Either a b
    Right QT
    qt)

    -- Promises the output will match (_,Left _), used by Or cases when any branch wants a QNFA continuation
    asQNFA :: String -> E -> S E
    asQNFA :: [Char] -> E -> S E
    asQNFA [Char]
    _ x :: E
    x@(TagTasks
    _,Left QNFA
    _) = E -> S E
    forall a.
    a -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return E
    x
    asQNFA [Char]
    s (TagTasks
    tags,Right QT
    qt) = do qnfa <- [Char] -> QT -> S QNFA
    newQNFA [Char]
    s QT
    qt      -- YYY Policy choice: leave the tags
                                  return (tags, Left qnfa)

    -- Convert continuation E into a QNFA, only done at "top level" by qToNFA to get unique start state
    getQNFA :: String -> E -> S QNFA
    getQNFA :: [Char] -> E -> S QNFA
    getQNFA [Char]
    _ ([],Left QNFA
    qnfa) = QNFA -> S QNFA
    forall a.
    a -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return QNFA
    qnfa
    getQNFA [Char]
    s (TagTasks
    tags,Left QNFA
    qnfa) = [Char] -> QT -> S QNFA
    newQNFA [Char]
    s (WinTags -> QT -> QT
    prependTags' ((TagTask -> TagUpdate) -> TagTasks -> WinTags
    promoteTasks TagTask -> TagUpdate
    PreUpdate TagTasks
    tags) (QNFA -> QT
    q_qt QNFA
    qnfa))
    getQNFA [Char]
    s (TagTasks
    tags,Right QT
    qt) = [Char] -> QT -> S QNFA
    newQNFA [Char]
    s (WinTags -> QT -> QT
    prependTags' ((TagTask -> TagUpdate) -> TagTasks -> WinTags
    promoteTasks TagTask -> TagUpdate
    PreUpdate TagTasks
    tags) QT
    qt)

    -- Extract the QT from the E
    getQT :: E -> QT
    getQT :: E -> QT
    getQT (TagTasks
    tags,Either QNFA QT
    cont) = WinTags -> QT -> QT
    prependTags' ((TagTask -> TagUpdate) -> TagTasks -> WinTags
    promoteTasks TagTask -> TagUpdate
    PreUpdate TagTasks
    tags) ((QNFA -> QT) -> (QT -> QT) -> Either QNFA QT -> QT
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either QNFA -> QT
    q_qt QT -> QT
    forall a. a -> a
    id Either QNFA QT
    cont)

    -- 2009: This looks realllly dodgy, since it can convert a QNFA/Testing to a QT/Testing
    -- without actually achieving anything except adding a DoPa to the Testing.  A diagnostic
    -- series of runs might be needed to decide if this ever creates orphan id numbers.
    -- Then applyTest might need to keep track of whether it actually changes anything.
    addTest :: TestInfo -> E -> E
    addTest :: TestInfo -> E -> E
    addTest TestInfo
    ti (TagTasks
    tags,Either QNFA QT
    cont) = (TagTasks
    tags, QT -> Either QNFA QT
    forall a b. b -> Either a b
    Right (QT -> Either QNFA QT)
    -> (Either QNFA QT -> QT) -> Either QNFA QT -> Either QNFA QT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TestInfo -> QT -> QT
    applyTest TestInfo
    ti (QT -> QT) -> (Either QNFA QT -> QT) -> Either QNFA QT -> QT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (QNFA -> QT) -> (QT -> QT) -> Either QNFA QT -> QT
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either QNFA -> QT
    q_qt QT -> QT
    forall a. a -> a
    id (Either QNFA QT -> Either QNFA QT)
    -> Either QNFA QT -> Either QNFA QT
    forall a b. (a -> b) -> a -> b
    $ Either QNFA QT
    cont)

    -- This is used only with PreUpdate and PostUpdate as the first argument.
    promoteTasks :: (TagTask->TagUpdate) -> TagTasks -> TagList
    promoteTasks :: (TagTask -> TagUpdate) -> TagTasks -> WinTags
    promoteTasks TagTask -> TagUpdate
    promote TagTasks
    tags = ((Key, TagTask) -> (Key, TagUpdate)) -> TagTasks -> WinTags
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Key
    tag,TagTask
    task) -> (Key
    tag,TagTask -> TagUpdate
    promote TagTask
    task)) TagTasks
    tags

    -- only used in addWinTags
    demoteTags :: TagList -> TagTasks
    demoteTags :: WinTags -> TagTasks
    demoteTags = ((Key, TagUpdate) -> (Key, TagTask)) -> WinTags -> TagTasks
    forall a b. (a -> b) -> [a] -> [b]
    map (Key, TagUpdate) -> (Key, TagTask)
    forall {a}. (a, TagUpdate) -> (a, TagTask)
    helper
      where helper :: (a, TagUpdate) -> (a, TagTask)
    helper (a
    tag,PreUpdate TagTask
    tt) = (a
    tag,TagTask
    tt)
            helper (a
    tag,PostUpdate TagTask
    tt) = (a
    tag,TagTask
    tt)

    -- This is polymorphic so addWinTags can be cute below
    {-# INLINE addWinTags #-}
    addWinTags :: WinTags -> (TagTasks,a) -> (TagTasks,a)
    addWinTags :: forall a. WinTags -> (TagTasks, a) -> (TagTasks, a)
    addWinTags WinTags
    wtags (TagTasks
    tags,a
    cont) = (WinTags -> TagTasks
    demoteTags WinTags
    wtags TagTasks -> TagTasks -> TagTasks
    forall a. Monoid a => a -> a -> a
    `mappend` TagTasks
    tags
                                   ,a
    cont)

    {-# INLINE addTag' #-}
    -- This is polymorphic so addTagAC can be cute below
    addTag' :: Tag -> (TagTasks,a) -> (TagTasks,a)
    addTag' :: forall a. Key -> (TagTasks, a) -> (TagTasks, a)
    addTag' Key
    tag (TagTasks
    tags,a
    cont) = ((Key
    tag,TagTask
    TagTask)(Key, TagTask) -> TagTasks -> TagTasks
    forall a. a -> [a] -> [a]
    :TagTasks
    tags
                              ,a
    cont)

    -- a Maybe version of addTag' above, specializing 'a' to Either QNFA QT
    addTag :: Maybe Tag -> E -> E
    addTag :: Maybe Key -> E -> E
    addTag Maybe Key
    Nothing E
    e = E
    e
    addTag (Just Key
    tag) E
    e = Key -> E -> E
    forall a. Key -> (TagTasks, a) -> (TagTasks, a)
    addTag' Key
    tag E
    e

    {-# INLINE addGroupResets #-}
    -- This is polymorphic so addGroupResetsAC can be cute below
    addGroupResets :: (Show a) => [Tag] -> (TagTasks,a) -> (TagTasks,a)
    addGroupResets :: forall a. Show a => [Key] -> (TagTasks, a) -> (TagTasks, a)
    addGroupResets [] (TagTasks, a)
    x = (TagTasks, a)
    x
    addGroupResets [Key]
    tags (TagTasks
    tags',a
    cont) = (((Key, TagTask) -> TagTasks -> TagTasks)
    -> TagTasks -> TagTasks -> TagTasks
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (:) TagTasks
    tags' (TagTasks -> TagTasks) -> ([Key] -> TagTasks) -> [Key] -> TagTasks
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Key -> (Key, TagTask)) -> [Key] -> TagTasks
    forall a b. (a -> b) -> [a] -> [b]
    map (\Key
    tag -> (Key
    tag,TagTask
    ResetGroupStopTask)) ([Key] -> TagTasks) -> [Key] -> TagTasks
    forall a b. (a -> b) -> a -> b
    $ [Key]
    tags
                                       ,a
    cont)

    addGroupSets :: (Show a) => [Tag] -> (TagTasks,a) -> (TagTasks,a)
    addGroupSets :: forall a. Show a => [Key] -> (TagTasks, a) -> (TagTasks, a)
    addGroupSets [] (TagTasks, a)
    x = (TagTasks, a)
    x
    addGroupSets [Key]
    tags (TagTasks
    tags',a
    cont) = (((Key, TagTask) -> TagTasks -> TagTasks)
    -> TagTasks -> TagTasks -> TagTasks
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (:) TagTasks
    tags' (TagTasks -> TagTasks) -> ([Key] -> TagTasks) -> [Key] -> TagTasks
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Key -> (Key, TagTask)) -> [Key] -> TagTasks
    forall a b. (a -> b) -> [a] -> [b]
    map (\Key
    tag -> (Key
    tag,TagTask
    SetGroupStopTask)) ([Key] -> TagTasks) -> [Key] -> TagTasks
    forall a b. (a -> b) -> a -> b
    $ [Key]
    tags
                                     ,a
    cont)

    -- Consume an ActCont.  Uses the mergeQT form to combine non-accepting
    -- and accepting view of the continuation.
    getE :: ActCont -> E
    getE :: ActCont -> E
    getE (E
    _,Maybe E
    _,Just (TagTasks
    tags,QNFA
    qnfa)) = (TagTasks
    tags, QNFA -> Either QNFA QT
    forall a b. a -> Either a b
    Left QNFA
    qnfa)  -- consume optimized mQNFA value returned by Star
    getE (E
    eLoop,Just E
    accepting,Maybe (TagTasks, QNFA)
    _) = QT -> E
    fromQT (QT -> QT -> QT
    mergeQT (E -> QT
    getQT E
    eLoop) (E -> QT
    getQT E
    accepting))
    getE (E
    eLoop,Maybe E
    Nothing,Maybe (TagTasks, QNFA)
    _) = E
    eLoop

    -- 2009: See comment for addTest.  Here is a case where the third component might be a (Just qnfa) and it
    -- is being lost even though the added test might be redundant.
    addTestAC :: TestInfo -> ActCont -> ActCont
    addTestAC :: TestInfo -> ActCont -> ActCont
    addTestAC TestInfo
    ti (E
    e,Maybe E
    mE,Maybe (TagTasks, QNFA)
    _) = (TestInfo -> E -> E
    addTest TestInfo
    ti E
    e
                            ,(E -> E) -> Maybe E -> Maybe E
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (TestInfo -> E -> E
    addTest TestInfo
    ti) Maybe E
    mE
                            ,Maybe (TagTasks, QNFA)
    forall a. Maybe a
    Nothing)

    -- These are AC versions of the add functions on E

    addTagAC :: Maybe Tag -> ActCont -> ActCont
    addTagAC :: Maybe Key -> ActCont -> ActCont
    addTagAC Maybe Key
    Nothing ActCont
    ac = ActCont
    ac
    addTagAC (Just Key
    tag) (E
    e,Maybe E
    mE,Maybe (TagTasks, QNFA)
    mQNFA) = (Key -> E -> E
    forall a. Key -> (TagTasks, a) -> (TagTasks, a)
    addTag' Key
    tag E
    e
                                       ,(E -> E) -> Maybe E -> Maybe E
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Key -> E -> E
    forall a. Key -> (TagTasks, a) -> (TagTasks, a)
    addTag' Key
    tag) Maybe E
    mE
                                       ,((TagTasks, QNFA) -> (TagTasks, QNFA))
    -> Maybe (TagTasks, QNFA) -> Maybe (TagTasks, QNFA)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Key -> (TagTasks, QNFA) -> (TagTasks, QNFA)
    forall a. Key -> (TagTasks, a) -> (TagTasks, a)
    addTag' Key
    tag) Maybe (TagTasks, QNFA)
    mQNFA)

    addGroupResetsAC :: [Tag] -> ActCont -> ActCont
    addGroupResetsAC :: [Key] -> ActCont -> ActCont
    addGroupResetsAC [] ActCont
    ac = ActCont
    ac
    addGroupResetsAC [Key]
    tags (E
    e,Maybe E
    mE,Maybe (TagTasks, QNFA)
    mQNFA) = ([Key] -> E -> E
    forall a. Show a => [Key] -> (TagTasks, a) -> (TagTasks, a)
    addGroupResets [Key]
    tags E
    e
                                         ,(E -> E) -> Maybe E -> Maybe E
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([Key] -> E -> E
    forall a. Show a => [Key] -> (TagTasks, a) -> (TagTasks, a)
    addGroupResets [Key]
    tags) Maybe E
    mE
                                         ,((TagTasks, QNFA) -> (TagTasks, QNFA))
    -> Maybe (TagTasks, QNFA) -> Maybe (TagTasks, QNFA)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([Key] -> (TagTasks, QNFA) -> (TagTasks, QNFA)
    forall a. Show a => [Key] -> (TagTasks, a) -> (TagTasks, a)
    addGroupResets [Key]
    tags) Maybe (TagTasks, QNFA)
    mQNFA)

    addGroupSetsAC :: [Tag] -> ActCont -> ActCont
    addGroupSetsAC :: [Key] -> ActCont -> ActCont
    addGroupSetsAC [] ActCont
    ac = ActCont
    ac
    addGroupSetsAC [Key]
    tags (E
    e,Maybe E
    mE,Maybe (TagTasks, QNFA)
    mQNFA) = ([Key] -> E -> E
    forall a. Show a => [Key] -> (TagTasks, a) -> (TagTasks, a)
    addGroupSets [Key]
    tags E
    e
                                       ,(E -> E) -> Maybe E -> Maybe E
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([Key] -> E -> E
    forall a. Show a => [Key] -> (TagTasks, a) -> (TagTasks, a)
    addGroupSets [Key]
    tags) Maybe E
    mE
                                       ,((TagTasks, QNFA) -> (TagTasks, QNFA))
    -> Maybe (TagTasks, QNFA) -> Maybe (TagTasks, QNFA)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([Key] -> (TagTasks, QNFA) -> (TagTasks, QNFA)
    forall a. Show a => [Key] -> (TagTasks, a) -> (TagTasks, a)
    addGroupSets [Key]
    tags) Maybe (TagTasks, QNFA)
    mQNFA)

    addWinTagsAC :: WinTags -> ActCont -> ActCont
    addWinTagsAC :: WinTags -> ActCont -> ActCont
    addWinTagsAC WinTags
    wtags (E
    e,Maybe E
    mE,Maybe (TagTasks, QNFA)
    mQNFA) = (WinTags -> E -> E
    forall a. WinTags -> (TagTasks, a) -> (TagTasks, a)
    addWinTags WinTags
    wtags E
    e
                                      ,(E -> E) -> Maybe E -> Maybe E
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (WinTags -> E -> E
    forall a. WinTags -> (TagTasks, a) -> (TagTasks, a)
    addWinTags WinTags
    wtags) Maybe E
    mE
                                      ,((TagTasks, QNFA) -> (TagTasks, QNFA))
    -> Maybe (TagTasks, QNFA) -> Maybe (TagTasks, QNFA)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (WinTags -> (TagTasks, QNFA) -> (TagTasks, QNFA)
    forall a. WinTags -> (TagTasks, a) -> (TagTasks, a)
    addWinTags WinTags
    wtags) Maybe (TagTasks, QNFA)
    mQNFA)
    -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- == -- ==

    -- Initial preTag of 0th tag is implied. No other general pre-tags would be expected.
    -- The qtwin contains the preTag of the 1st tag and is only set when a match is completed.
    -- The fst Index is the index of the unique starting QNFA state.
    -- The snd (Array Index QNFA) is all the QNFA states.
    --
    -- In the cases below, Empty is handled much like a Test with no TestInfo.
    qToNFA :: CompOption -> Q -> (Index,Array Index QNFA)
    qToNFA :: CompOption -> Q -> (Key, Array Key QNFA)
    qToNFA CompOption
    compOpt Q
    qTop = (QNFA -> Key
    q_id QNFA
    startingQNFA
                          ,(Key, Key) -> [(Key, QNFA)] -> Array Key QNFA
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    (i, i) -> [(i, e)] -> a i e
    array (Key
    0,Key -> Key
    forall a. Enum a => a -> a
    pred Key
    lastIndex) ([(Key, QNFA)] -> [(Key, QNFA)]
    table [])) where
      -- Result startingQNFA is the top level's index
      -- State pair: fst 0 is the next state number (not yet used) going in, and lastIndex coming out (succ of last used)
      --             snd id is the difference list of states going in, and the finished list coming out
      (QNFA
    startingQNFA,(Key
    lastIndex,[(Key, QNFA)] -> [(Key, QNFA)]
    table)) =
        S QNFA
    -> (Key, [(Key, QNFA)] -> [(Key, QNFA)])
    -> (QNFA, (Key, [(Key, QNFA)] -> [(Key, QNFA)]))
    forall s a. State s a -> s -> (a, s)
    runState (Q -> E -> S E
    getTrans Q
    qTop (QT -> E
    fromQT (QT -> E) -> QT -> E
    forall a b. (a -> b) -> a -> b
    $ QT
    qtwin) S E -> (E -> S QNFA) -> S QNFA
    forall a b.
    StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity a
    -> (a -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity b)
    -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [Char] -> E -> S QNFA
    getQNFA [Char]
    "top level") (Key, [(Key, QNFA)] -> [(Key, QNFA)])
    forall {a}. (Key, a -> a)
    startState
      startState :: (Key, a -> a)
    startState = (Key
    0,a -> a
    forall a. a -> a
    id)

      getTrans,getTransTagless :: Q -> E -> S E
      getTrans :: Q -> E -> S E
    getTrans qIn :: Q
    qIn@(Q {preReset :: Q -> [Key]
    preReset=[Key]
    resets,postSet :: Q -> [Key]
    postSet=[Key]
    sets,preTag :: Q -> Maybe Key
    preTag=Maybe Key
    pre,postTag :: Q -> Maybe Key
    postTag=Maybe Key
    post,unQ :: Q -> P
    unQ=P
    pIn}) E
    e = [Char] -> S E -> S E
    forall a s. Show a => a -> s -> s
    debug ([Char]
    ">< getTrans "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++Q -> [Char]
    forall a. Show a => a -> [Char]
    show Q
    qIn[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    " <>") (S E -> S E) -> S E -> S E
    forall a b. (a -> b) -> a -> b
    $
        case P
    pIn of
          -- The case below is the ultimate consumer of every single OneChar in the input and the only caller of
          -- newTrans/acceptTrans which is the sole source of QT/Simple nodes.
          OneChar Pattern
    pat -> [Char] -> [Key] -> Maybe Key -> Pattern -> E -> S E
    newTrans [Char]
    "getTrans/OneChar" [Key]
    resets Maybe Key
    pre Pattern
    pat (E -> S E) -> (E -> E) -> E -> S E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Key -> E -> E
    addTag Maybe Key
    post (E -> E) -> (E -> E) -> E -> E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Key] -> E -> E
    forall a. Show a => [Key] -> (TagTasks, a) -> (TagTasks, a)
    addGroupSets [Key]
    sets (E -> S E) -> E -> S E
    forall a b. (a -> b) -> a -> b
    $ E
    e
          P
    Empty -> E -> S E
    forall a.
    a -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (E -> S E) -> (E -> E) -> E -> S E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Key] -> E -> E
    forall a. Show a => [Key] -> (TagTasks, a) -> (TagTasks, a)
    addGroupResets [Key]
    resets (E -> E) -> (E -> E) -> E -> E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Key -> E -> E
    addTag Maybe Key
    pre (E -> E) -> (E -> E) -> E -> E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Key -> E -> E
    addTag Maybe Key
    post (E -> E) -> (E -> E) -> E -> E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Key] -> E -> E
    forall a. Show a => [Key] -> (TagTasks, a) -> (TagTasks, a)
    addGroupSets [Key]
    sets (E -> S E) -> E -> S E
    forall a b. (a -> b) -> a -> b
    $ E
    e
          Test TestInfo
    ti -> E -> S E
    forall a.
    a -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (E -> S E) -> (E -> E) -> E -> S E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Key] -> E -> E
    forall a. Show a => [Key] -> (TagTasks, a) -> (TagTasks, a)
    addGroupResets [Key]
    resets (E -> E) -> (E -> E) -> E -> E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Key -> E -> E
    addTag Maybe Key
    pre (E -> E) -> (E -> E) -> E -> E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TestInfo -> E -> E
    addTest TestInfo
    ti (E -> E) -> (E -> E) -> E -> E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Key -> E -> E
    addTag Maybe Key
    post (E -> E) -> (E -> E) -> E -> E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Key] -> E -> E
    forall a. Show a => [Key] -> (TagTasks, a) -> (TagTasks, a)
    addGroupSets [Key]
    sets (E -> S E) -> E -> S E
    forall a b. (a -> b) -> a -> b
    $ E
    e
          P
    _ -> E -> S E
    forall a.
    a -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (E -> S E) -> (E -> E) -> E -> S E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Key] -> E -> E
    forall a. Show a => [Key] -> (TagTasks, a) -> (TagTasks, a)
    addGroupResets [Key]
    resets (E -> E) -> (E -> E) -> E -> E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Key -> E -> E
    addTag Maybe Key
    pre (E -> S E) -> S E -> S E
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Q -> E -> S E
    getTransTagless Q
    qIn (Maybe Key -> E -> E
    addTag Maybe Key
    post (E -> E) -> (E -> E) -> E -> E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Key] -> E -> E
    forall a. Show a => [Key] -> (TagTasks, a) -> (TagTasks, a)
    addGroupSets [Key]
    sets (E -> E) -> E -> E
    forall a b. (a -> b) -> a -> b
    $ E
    e)

      getTransTagless :: Q -> E -> S E
    getTransTagless Q
    qIn E
    e = [Char] -> S E -> S E
    forall a s. Show a => a -> s -> s
    debug ([Char]
    ">< getTransTagless "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++Q -> [Char]
    forall a. Show a => a -> [Char]
    show Q
    qIn[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    " <>") (S E -> S E) -> S E -> S E
    forall a b. (a -> b) -> a -> b
    $
        case Q -> P
    unQ Q
    qIn of
          Seq Q
    q1 Q
    q2 -> Q -> E -> S E
    getTrans Q
    q1 (E -> S E) -> S E -> S E
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Q -> E -> S E
    getTrans Q
    q2 E
    e
          Or [] -> E -> S E
    forall a.
    a -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return E
    e
          Or [Q
    q] -> Q -> E -> S E
    getTrans Q
    q E
    e
          Or [Q]
    qs -> do
            eqts <- if Q -> Bool
    usesQNFA Q
    qIn
                      then do
                        eQNFA <- [Char] -> E -> S E
    asQNFA [Char]
    "getTransTagless/Or/usesQNFA" E
    e
                        sequence [ getTrans q eQNFA | q <- qs ]
                      else [S E] -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity [E]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [ Q -> E -> S E
    getTrans Q
    q E
    e | Q
    q <- [Q]
    qs ]
            let qts = (E -> QT) -> [E] -> [QT]
    forall a b. (a -> b) -> [a] -> [b]
    map E -> QT
    getQT [E]
    eqts
            return (fromQT (foldr1 mergeAltQT qts))

          Star Maybe Key
    mOrbit [Key]
    resetTheseOrbits Bool
    mayFirstBeNull Q
    q ->
            -- mOrbit of Just implies varies q and childGroups q
            let (E
    e',Bool
    clear) = -- debug ("\n>"++show e++"\n"++show q++"\n<") $
                  if Q -> Bool
    notNullable Q
    q then (E
    e,Bool
    True)  -- subpattern cannot be null
                    else if [Key] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Key]
    resetTheseOrbits Bool -> Bool -> Bool
    && Maybe Key -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe Key
    mOrbit
                           then case Q -> Maybe WinTags
    maybeOnlyEmpty Q
    q of
                                  Just [] -> (E
    e,Bool
    True)    -- True because null of subpattern is same as skipping subpattern
                                  Just WinTags
    tagList -> (WinTags -> E -> E
    forall a. WinTags -> (TagTasks, a) -> (TagTasks, a)
    addWinTags WinTags
    tagList E
    e,Bool
    False) -- null of subpattern NOT same as skipping
                                  Maybe WinTags
    _ -> (QT -> E
    fromQT (QT -> E) -> (E -> QT) -> E -> E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(SetTestInfo, WinTags)] -> QT -> QT
    preferNullViews (Q -> [(SetTestInfo, WinTags)]
    nullQ Q
    q) (QT -> QT) -> (E -> QT) -> E -> QT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . E -> QT
    getQT (E -> E) -> E -> E
    forall a b. (a -> b) -> a -> b
    $ E
    e,Bool
    False)  -- is NOT same as skipping
                           else (QT -> E
    fromQT (QT -> E) -> (E -> QT) -> E -> E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Key] -> QT -> QT
    resetOrbitsQT [Key]
    resetTheseOrbits (QT -> QT) -> (E -> QT) -> E -> QT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Key -> QT -> QT
    enterOrbitQT Maybe Key
    mOrbit -- resetOrbitsQT and enterOrbitQT commute
                                 (QT -> QT) -> (E -> QT) -> E -> QT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(SetTestInfo, WinTags)] -> QT -> QT
    preferNullViews (Q -> [(SetTestInfo, WinTags)]
    nullQ Q
    q) (QT -> QT) -> (E -> QT) -> E -> QT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . E -> QT
    getQT (E -> QT) -> (E -> E) -> E -> QT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Key -> E -> E
    leaveOrbit Maybe Key
    mOrbit (E -> E) -> E -> E
    forall a b. (a -> b) -> a -> b
    $ E
    e,Bool
    False)  -- perform resets when accepting 0 characters
            in if Q -> Bool
    cannotAccept Q
    q then E -> S E
    forall a.
    a -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return E
    e' else mdo
            mqt <- inStar q this
            (this,ans) <- case mqt of
                            Maybe QT
    Nothing -> [Char]
    -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity (E, E)
    forall a. [Char] -> a
    err ([Char]
    "Weird pattern in getTransTagless/Star: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ (Q, Q) -> [Char]
    forall a. Show a => a -> [Char]
    show (Q
    qTop,Q
    qIn))
                            Just QT
    qt -> do
                              let qt' :: QT
    qt' = [Key] -> QT -> QT
    resetOrbitsQT [Key]
    resetTheseOrbits (QT -> QT) -> (QT -> QT) -> QT -> QT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Key -> QT -> QT
    enterOrbitQT Maybe Key
    mOrbit (QT -> QT) -> QT -> QT
    forall a b. (a -> b) -> a -> b
    $ QT
    qt -- resetOrbitsQT and enterOrbitQT commute
                                  thisQT :: QT
    thisQT = QT -> QT -> QT
    mergeQT QT
    qt' (QT -> QT) -> (E -> QT) -> E -> QT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . E -> QT
    getQT (E -> QT) -> (E -> E) -> E -> QT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Key -> E -> E
    leaveOrbit Maybe Key
    mOrbit (E -> QT) -> E -> QT
    forall a b. (a -> b) -> a -> b
    $ E
    e -- capture of subpattern or leave via next pattern (avoid null of subpattern on way out)
                                  ansE :: E
    ansE = QT -> E
    fromQT (QT -> E) -> (E -> QT) -> E -> E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QT -> QT -> QT
    mergeQT QT
    qt' (QT -> QT) -> (E -> QT) -> E -> QT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . E -> QT
    getQT (E -> E) -> E -> E
    forall a b. (a -> b) -> a -> b
    $ E
    e' -- capture of subpattern or leave via null of subpattern
                              thisE <- if Q -> Bool
    usesQNFA Q
    q
                                      then E -> S E
    forall a.
    a -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (E -> S E) -> (QNFA -> E) -> QNFA -> S E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QNFA -> E
    fromQNFA (QNFA -> S E) -> S QNFA -> S E
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< [Char] -> QT -> S QNFA
    newQNFA [Char]
    "getTransTagless/Star" QT
    thisQT
                                      else E -> S E
    forall a.
    a -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (E -> S E) -> (QT -> E) -> QT -> S E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QT -> E
    fromQT (QT -> S E) -> QT -> S E
    forall a b. (a -> b) -> a -> b
    $ QT
    thisQT
                              return (thisE,ansE)
            return (if mayFirstBeNull then (if clear then this  -- optimization to possibly preserve QNFA
                                                     else ans)
                      else this)

          {- NonEmpty is like actNullable (Or [Empty,q]) without the extra tag to prefer the first Empty branch -}
          NonEmpty Q
    q -> [Char] -> S E -> S E
    forall a. [Char] -> a -> a
    ecart ([Char]
    "\n> getTransTagless/NonEmpty"[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++Q -> [Char]
    forall a. Show a => a -> [Char]
    show Q
    qIn)  (S E -> S E) -> S E -> S E
    forall a b. (a -> b) -> a -> b
    $ do
            -- Assertion to check than Pattern.starTrans did its job right:
            Bool
    -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity ()
    -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Q -> Bool
    cannotAccept Q
    q) ([Char] -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity ()
    forall a. [Char] -> a
    err ([Char]
     -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity ())
    -> [Char]
    -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "getTransTagless/NonEmpty : provided with a *cannotAccept* pattern: "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++(Q, Q) -> [Char]
    forall a. Show a => a -> [Char]
    show (Q
    qTop,Q
    qIn))
            Bool
    -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity ()
    -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Q -> Bool
    mustAccept Q
    q) ([Char] -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity ()
    forall a. [Char] -> a
    err ([Char]
     -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity ())
    -> [Char]
    -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "getTransTagless/NonEmpty : provided with a *mustAccept* pattern: "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++(Q, Q) -> [Char]
    forall a. Show a => a -> [Char]
    show (Q
    qTop,Q
    qIn))
            let e' :: E
    e' = case Q -> Maybe WinTags
    maybeOnlyEmpty Q
    qIn of
                       Just [] -> E
    e
                       Just WinTags
    _wtags -> E
    e -- addWinTags wtags e  XXX was duplicating tags
                       Maybe WinTags
    Nothing -> [Char] -> E
    forall a. [Char] -> a
    err ([Char] -> E) -> [Char] -> E
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "getTransTagless/NonEmpty is supposed to have an emptyNull nullView : "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++Q -> [Char]
    forall a. Show a => a -> [Char]
    show Q
    qIn
            mqt <- Q -> E -> S (Maybe QT)
    inStar Q
    q E
    e
            return $ case mqt of
                       Maybe QT
    Nothing -> [Char] -> E
    forall a. [Char] -> a
    err ([Char]
    "Weird pattern in getTransTagless/NonEmpty: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ (Q, Q) -> [Char]
    forall a. Show a => a -> [Char]
    show (Q
    qTop,Q
    qIn))
                       Just QT
    qt -> QT -> E
    fromQT (QT -> E) -> (E -> QT) -> E -> E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QT -> QT -> QT
    mergeQT_2nd QT
    qt (QT -> QT) -> (E -> QT) -> E -> QT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . E -> QT
    getQT (E -> E) -> E -> E
    forall a b. (a -> b) -> a -> b
    $ E
    e' -- ...and then this sets qt_win to exactly that of e'
          P
    _ -> [Char] -> S E
    forall a. [Char] -> a
    err ([Char]
    "This case in Text.Regex.TNFA.TNFA.getTransTagless cannot happen" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ (Q, Q) -> [Char]
    forall a. Show a => a -> [Char]
    show (Q
    qTop,Q
    qIn))

      inStar,inStarNullableTagless :: Q -> E -> S (Maybe QT)
      inStar :: Q -> E -> S (Maybe QT)
    inStar qIn :: Q
    qIn@(Q {preReset :: Q -> [Key]
    preReset=[Key]
    resets,postSet :: Q -> [Key]
    postSet=[Key]
    sets,preTag :: Q -> Maybe Key
    preTag=Maybe Key
    pre,postTag :: Q -> Maybe Key
    postTag=Maybe Key
    post}) E
    eLoop | Q -> Bool
    notNullable Q
    qIn =
        [Char] -> S (Maybe QT) -> S (Maybe QT)
    forall a s. Show a => a -> s -> s
    debug ([Char]
    ">< inStar/1 "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++Q -> [Char]
    forall a. Show a => a -> [Char]
    show Q
    qIn[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    " <>") (S (Maybe QT) -> S (Maybe QT)) -> S (Maybe QT) -> S (Maybe QT)
    forall a b. (a -> b) -> a -> b
    $
        Maybe QT -> S (Maybe QT)
    forall a.
    a -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe QT -> S (Maybe QT)) -> (E -> Maybe QT) -> E -> S (Maybe QT)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QT -> Maybe QT
    forall a. a -> Maybe a
    Just (QT -> Maybe QT) -> (E -> QT) -> E -> Maybe QT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . E -> QT
    getQT (E -> S (Maybe QT)) -> S E -> S (Maybe QT)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Q -> E -> S E
    getTrans Q
    qIn E
    eLoop
                                                                     | Bool
    otherwise =
        [Char] -> S (Maybe QT) -> S (Maybe QT)
    forall a s. Show a => a -> s -> s
    debug ([Char]
    ">< inStar/2 "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++Q -> [Char]
    forall a. Show a => a -> [Char]
    show Q
    qIn[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    " <>") (S (Maybe QT) -> S (Maybe QT)) -> S (Maybe QT) -> S (Maybe QT)
    forall a b. (a -> b) -> a -> b
    $
        Maybe QT -> S (Maybe QT)
    forall a.
    a -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe QT -> S (Maybe QT))
    -> (Maybe QT -> Maybe QT) -> Maybe QT -> S (Maybe QT)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (QT -> QT) -> Maybe QT -> Maybe QT
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([Key] -> QT -> QT
    prependGroupResets [Key]
    resets (QT -> QT) -> (QT -> QT) -> QT -> QT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Key -> QT -> QT
    prependPreTag Maybe Key
    pre) (Maybe QT -> S (Maybe QT)) -> S (Maybe QT) -> S (Maybe QT)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Q -> E -> S (Maybe QT)
    inStarNullableTagless Q
    qIn (Maybe Key -> E -> E
    addTag Maybe Key
    post (E -> E) -> (E -> E) -> E -> E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Key] -> E -> E
    forall a. Show a => [Key] -> (TagTasks, a) -> (TagTasks, a)
    addGroupSets [Key]
    sets (E -> E) -> E -> E
    forall a b. (a -> b) -> a -> b
    $ E
    eLoop)

      inStarNullableTagless :: Q -> E -> S (Maybe QT)
    inStarNullableTagless Q
    qIn E
    eLoop = [Char] -> S (Maybe QT) -> S (Maybe QT)
    forall a s. Show a => a -> s -> s
    debug ([Char]
    ">< inStarNullableTagless "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++Q -> [Char]
    forall a. Show a => a -> [Char]
    show Q
    qIn[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    " <>") (S (Maybe QT) -> S (Maybe QT)) -> S (Maybe QT) -> S (Maybe QT)
    forall a b. (a -> b) -> a -> b
    $ do
        case Q -> P
    unQ Q
    qIn of
          P
    Empty -> Maybe QT -> S (Maybe QT)
    forall a.
    a -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe QT
    forall a. Maybe a
    Nothing -- with Or this discards () branch in "(^|foo|())*"
          Or [] -> Maybe QT -> S (Maybe QT)
    forall a.
    a -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe QT
    forall a. Maybe a
    Nothing
          Or [Q
    q] -> Q -> E -> S (Maybe QT)
    inStar Q
    q E
    eLoop
          Or [Q]
    qs -> do
            mqts <- if Q -> Bool
    usesQNFA Q
    qIn
                      then do eQNFA <- [Char] -> E -> S E
    asQNFA [Char]
    "inStarNullableTagless/Or/usesQNFA" E
    eLoop
                              sequence [ inStar q eQNFA | q <- qs ]
                      else [S (Maybe QT)]
    -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity [Maybe QT]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [Q -> E -> S (Maybe QT)
    inStar Q
    q E
    eLoop | Q
    q <- [Q]
    qs ]
            let qts = [Maybe QT] -> [QT]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe QT]
    mqts
                mqt = if [QT] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [QT]
    qts then Maybe QT
    forall a. Maybe a
    Nothing else QT -> Maybe QT
    forall a. a -> Maybe a
    Just ((QT -> QT -> QT) -> [QT] -> QT
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 QT -> QT -> QT
    mergeAltQT [QT]
    qts)
            return mqt
          -- Calls to act are inlined by hand to actNullable.  This returns only cases where q1 or q2 or both
          -- accepted characters.  The zero-character case is handled by the tag wrapping by inStar.
          -- 2009: Does this look dodgy and repetitios of tags?  Seq by policy has no preTag or postTag.
          -- though it can have prependGroupResets, but those are not repeated in children so it is okay.
          Seq Q
    q1 Q
    q2 -> do (_,meAcceptingOut,_) <- Q -> ActCont -> S ActCont
    actNullable Q
    q1 (ActCont -> S ActCont) -> S ActCont -> S ActCont
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Q -> ActCont -> S ActCont
    actNullable Q
    q2 (E
    eLoop,Maybe E
    forall a. Maybe a
    Nothing,Maybe (TagTasks, QNFA)
    forall a. Maybe a
    Nothing)
                          return (fmap getQT meAcceptingOut)
          -- Calls to act are inlined by hand and are we losing the tags?
          Star {} -> do (_,meAcceptingOut,_) <- Q -> ActCont -> S ActCont
    actNullableTagless Q
    qIn (E
    eLoop,Maybe E
    forall a. Maybe a
    Nothing,Maybe (TagTasks, QNFA)
    forall a. Maybe a
    Nothing)
                        return (fmap getQT meAcceptingOut)
          NonEmpty {} -> [Char] -> S (Maybe QT) -> S (Maybe QT)
    forall a. [Char] -> a -> a
    ecart ([Char]
    "\n> inStarNullableTagless/NonEmpty"[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++Q -> [Char]
    forall a. Show a => a -> [Char]
    show Q
    qIn) (S (Maybe QT) -> S (Maybe QT)) -> S (Maybe QT) -> S (Maybe QT)
    forall a b. (a -> b) -> a -> b
    $
                         do (_,meAcceptingOut,_) <- Q -> ActCont -> S ActCont
    actNullableTagless Q
    qIn (E
    eLoop,Maybe E
    forall a. Maybe a
    Nothing,Maybe (TagTasks, QNFA)
    forall a. Maybe a
    Nothing)
                            return (fmap getQT meAcceptingOut)
          Test {} -> Maybe QT -> S (Maybe QT)
    forall a.
    a -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe QT
    forall a. Maybe a
    Nothing -- with Or this discards ^ branch in "(^|foo|())*"
          OneChar {} -> [Char] -> S (Maybe QT)
    forall a. [Char] -> a
    err ([Char]
    "OneChar cannot have nullable True")

      {- act* functions

      These have a very complicated state that they receive and return as
      "the continuation".

       (E, Maybe E,Maybe (SetTag,QNFA))

      The first E is the source of the danger that must be avoided.  It
      starts out a reference to the QNFA/QT state that will be created by
      the most recent parent Star node.  Thus it is a recursive reference
      from the MonadFix machinery.  In particular, this value cannot be
      returned to the parent Star to be included in itself or we get a "let
      x = y; y=x" style infinite loop.

      As act* progresses the first E is actually modified to be the parent
      QNFA/QT as "seen" when all the elements to the right have accepted 0
      characters.  Thus it acquires tags and tests+tags (the NullView data
      is used for this purpose).

      The second item in the 3-tuple is a Maybe E.  This will be used as the
      source of the QT for this contents of the Star QNFA/QT.  It will be
      merged with the Star's own continuation data.  It starts out Nothing
      and stays that way as long as there are no accepting transitions in
      the Star's pattern.  This is value (via getQT) returned by inStar.

      The third item is a special optimization I added to remove a source
      of orphaned QNFAs.  A Star within Act will often have to create a
      QNFA node.  This cannot go into the second Maybe E item as Just
      (SetTag,Left QNFA) because this QNFA can have pulled values from the
      recursive parent Star's QNFA/QT in the first E value.  Thus pulling
      with getQT from the QNFA and using that as the Maybe E would likely
      cause an infinite loop.  This extra QNFA is stored in the thd3
      location for use by getE. To improve it further it can accumulate
      Tag information after being formed.

      When a non nullable Q is handled by act it checks to see if the
      third value is there, in which case it uses that QNFA as the total
      continuation (subsumed in getE).  Otherwise it merges the first E
      with any (Just E) in the second value to form the continuation.

      -}

      act :: Q -> ActCont -> S (Maybe E)
      act :: Q -> ActCont -> S (Maybe E)
    act Q
    qIn ActCont
    c | Q -> Bool
    nullable Q
    qIn = (ActCont -> Maybe E) -> S ActCont -> S (Maybe E)
    forall a b.
    (a -> b)
    -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity a
    -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ActCont -> Maybe E
    forall a b c. (a, b, c) -> b
    snd3 (S ActCont -> S (Maybe E)) -> S ActCont -> S (Maybe E)
    forall a b. (a -> b) -> a -> b
    $ Q -> ActCont -> S ActCont
    actNullable Q
    qIn ActCont
    c
                | Bool
    otherwise = [Char] -> S (Maybe E) -> S (Maybe E)
    forall a s. Show a => a -> s -> s
    debug ([Char]
    ">< act "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++Q -> [Char]
    forall a. Show a => a -> [Char]
    show Q
    qIn[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    " <>") (S (Maybe E) -> S (Maybe E)) -> S (Maybe E) -> S (Maybe E)
    forall a b. (a -> b) -> a -> b
    $ do
        mqt <- Maybe E -> S (Maybe E)
    forall a.
    a -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe E -> S (Maybe E)) -> (E -> Maybe E) -> E -> S (Maybe E)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . E -> Maybe E
    forall a. a -> Maybe a
    Just (E -> S (Maybe E)) -> S E -> S (Maybe E)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Q -> E -> S E
    getTrans Q
    qIn ( ActCont -> E
    getE (ActCont -> E) -> ActCont -> E
    forall a b. (a -> b) -> a -> b
    $ ActCont
    c )
        return mqt  -- or "return (fromQT qtlose,mqt,Nothing)"

      actNullable,actNullableTagless :: Q -> ActCont -> S ActCont
      actNullable :: Q -> ActCont -> S ActCont
    actNullable qIn :: Q
    qIn@(Q {preReset :: Q -> [Key]
    preReset=[Key]
    resets,postSet :: Q -> [Key]
    postSet=[Key]
    sets,preTag :: Q -> Maybe Key
    preTag=Maybe Key
    pre,postTag :: Q -> Maybe Key
    postTag=Maybe Key
    post,unQ :: Q -> P
    unQ=P
    pIn}) ActCont
    ac =
        [Char] -> S ActCont -> S ActCont
    forall a s. Show a => a -> s -> s
    debug ([Char]
    ">< actNullable "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++Q -> [Char]
    forall a. Show a => a -> [Char]
    show Q
    qIn[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    " <>") (S ActCont -> S ActCont) -> S ActCont -> S ActCont
    forall a b. (a -> b) -> a -> b
    $ do
        case P
    pIn of
          P
    Empty -> ActCont -> S ActCont
    forall a.
    a -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ActCont -> S ActCont)
    -> (ActCont -> ActCont) -> ActCont -> S ActCont
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Key] -> ActCont -> ActCont
    addGroupResetsAC [Key]
    resets (ActCont -> ActCont) -> (ActCont -> ActCont) -> ActCont -> ActCont
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Key -> ActCont -> ActCont
    addTagAC Maybe Key
    pre (ActCont -> ActCont) -> (ActCont -> ActCont) -> ActCont -> ActCont
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Key -> ActCont -> ActCont
    addTagAC Maybe Key
    post (ActCont -> ActCont) -> (ActCont -> ActCont) -> ActCont -> ActCont
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Key] -> ActCont -> ActCont
    addGroupSetsAC [Key]
    sets (ActCont -> S ActCont) -> ActCont -> S ActCont
    forall a b. (a -> b) -> a -> b
    $ ActCont
    ac
          Test TestInfo
    ti -> ActCont -> S ActCont
    forall a.
    a -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ActCont -> S ActCont)
    -> (ActCont -> ActCont) -> ActCont -> S ActCont
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Key] -> ActCont -> ActCont
    addGroupResetsAC [Key]
    resets (ActCont -> ActCont) -> (ActCont -> ActCont) -> ActCont -> ActCont
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Key -> ActCont -> ActCont
    addTagAC Maybe Key
    pre (ActCont -> ActCont) -> (ActCont -> ActCont) -> ActCont -> ActCont
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TestInfo -> ActCont -> ActCont
    addTestAC TestInfo
    ti (ActCont -> ActCont) -> (ActCont -> ActCont) -> ActCont -> ActCont
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Key -> ActCont -> ActCont
    addTagAC Maybe Key
    post (ActCont -> ActCont) -> (ActCont -> ActCont) -> ActCont -> ActCont
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Key] -> ActCont -> ActCont
    addGroupSetsAC [Key]
    sets (ActCont -> S ActCont) -> ActCont -> S ActCont
    forall a b. (a -> b) -> a -> b
    $ ActCont
    ac
          OneChar {} -> [Char] -> S ActCont
    forall a. [Char] -> a
    err ([Char]
    "OneChar cannot have nullable True ")
          P
    _ -> ActCont -> S ActCont
    forall a.
    a -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ActCont -> S ActCont)
    -> (ActCont -> ActCont) -> ActCont -> S ActCont
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Key] -> ActCont -> ActCont
    addGroupResetsAC [Key]
    resets (ActCont -> ActCont) -> (ActCont -> ActCont) -> ActCont -> ActCont
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Key -> ActCont -> ActCont
    addTagAC Maybe Key
    pre (ActCont -> S ActCont) -> S ActCont -> S ActCont
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Q -> ActCont -> S ActCont
    actNullableTagless Q
    qIn ( Maybe Key -> ActCont -> ActCont
    addTagAC Maybe Key
    post (ActCont -> ActCont) -> (ActCont -> ActCont) -> ActCont -> ActCont
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Key] -> ActCont -> ActCont
    addGroupSetsAC [Key]
    sets (ActCont -> ActCont) -> ActCont -> ActCont
    forall a b. (a -> b) -> a -> b
    $ ActCont
    ac )

      actNullableTagless :: Q -> ActCont -> S ActCont
    actNullableTagless Q
    qIn ac :: ActCont
    ac@(E
    eLoop,Maybe E
    mAccepting,Maybe (TagTasks, QNFA)
    mQNFA) = [Char] -> S ActCont -> S ActCont
    forall a s. Show a => a -> s -> s
    debug ([Char]
    ">< actNullableTagless "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++Q -> [Char]
    forall a. Show a => a -> [Char]
    show (Q
    qIn)[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    " <>") (S ActCont -> S ActCont) -> S ActCont -> S ActCont
    forall a b. (a -> b) -> a -> b
    $ do
        case Q -> P
    unQ Q
    qIn of
          Seq Q
    q1 Q
    q2 -> Q -> ActCont -> S ActCont
    actNullable Q
    q1 (ActCont -> S ActCont) -> S ActCont -> S ActCont
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Q -> ActCont -> S ActCont
    actNullable Q
    q2 ActCont
    ac   -- We know q1 and q2 are nullable

          Or [] -> ActCont -> S ActCont
    forall a.
    a -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ActCont
    ac
          Or [Q
    q] -> Q -> ActCont -> S ActCont
    actNullableTagless Q
    q ActCont
    ac
          Or [Q]
    qs -> do
            cqts <- do
              if (Q -> Bool) -> [Q] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Q -> Bool
    nullable [Q]
    qs
                then [S (Maybe E)]
    -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity [Maybe E]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [(ActCont -> Maybe E) -> S ActCont -> S (Maybe E)
    forall a b.
    (a -> b)
    -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity a
    -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ActCont -> Maybe E
    forall a b c. (a, b, c) -> b
    snd3 (S ActCont -> S (Maybe E)) -> S ActCont -> S (Maybe E)
    forall a b. (a -> b) -> a -> b
    $ Q -> ActCont -> S ActCont
    actNullable Q
    q ActCont
    ac | Q
    q <- [Q]
    qs]
                else do
                  e' <- [Char] -> E -> S E
    asQNFA [Char]
    "qToNFA/actNullableTagless/Or" (E -> S E) -> (ActCont -> E) -> ActCont -> S E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ActCont -> E
    getE (ActCont -> S E) -> ActCont -> S E
    forall a b. (a -> b) -> a -> b
    $ ActCont
    ac
                  let act' :: Q -> S (Maybe E)
                      act' Q
    q = Maybe E -> S (Maybe E)
    forall a.
    a -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe E -> S (Maybe E)) -> (E -> Maybe E) -> E -> S (Maybe E)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . E -> Maybe E
    forall a. a -> Maybe a
    Just (E -> S (Maybe E)) -> S E -> S (Maybe E)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Q -> E -> S E
    getTrans Q
    q E
    e'
                  sequence [ if nullable q then fmap snd3 $ actNullable q ac else act' q | q <- qs ]
            let qts = (E -> QT) -> [E] -> [QT]
    forall a b. (a -> b) -> [a] -> [b]
    map E -> QT
    getQT ([Maybe E] -> [E]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe E]
    cqts)
                eLoop' = case Q -> Maybe WinTags
    maybeOnlyEmpty Q
    qIn of
                           Just WinTags
    wtags -> WinTags -> E -> E
    forall a. WinTags -> (TagTasks, a) -> (TagTasks, a)
    addWinTags WinTags
    wtags E
    eLoop -- nullable without tests; avoid getQT
                           Maybe WinTags
    Nothing -> QT -> E
    fromQT (QT -> E) -> QT -> E
    forall a b. (a -> b) -> a -> b
    $ [(SetTestInfo, WinTags)] -> QT -> QT
    applyNullViews (Q -> [(SetTestInfo, WinTags)]
    nullQ Q
    qIn) (E -> QT
    getQT E
    eLoop) -- suspect this of duplicating some tags with nullQ qIn
                mAccepting' = if [QT] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [QT]
    qts
                                then (E -> E) -> Maybe E -> Maybe E
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (QT -> E
    fromQT (QT -> E) -> (E -> QT) -> E -> E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(SetTestInfo, WinTags)] -> QT -> QT
    applyNullViews (Q -> [(SetTestInfo, WinTags)]
    nullQ Q
    qIn) (QT -> QT) -> (E -> QT) -> E -> QT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . E -> QT
    getQT) Maybe E
    mAccepting -- suspect this of duplicating some tags with nullQ qIn
                                else E -> Maybe E
    forall a. a -> Maybe a
    Just (QT -> E
    fromQT (QT -> E) -> QT -> E
    forall a b. (a -> b) -> a -> b
    $ (QT -> QT -> QT) -> [QT] -> QT
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 QT -> QT -> QT
    mergeAltQT [QT]
    qts)
                mQNFA' = if [QT] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [QT]
    qts
                           then case Q -> Maybe WinTags
    maybeOnlyEmpty Q
    qIn of
                                  Just WinTags
    wtags -> ((TagTasks, QNFA) -> (TagTasks, QNFA))
    -> Maybe (TagTasks, QNFA) -> Maybe (TagTasks, QNFA)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (WinTags -> (TagTasks, QNFA) -> (TagTasks, QNFA)
    forall a. WinTags -> (TagTasks, a) -> (TagTasks, a)
    addWinTags WinTags
    wtags) Maybe (TagTasks, QNFA)
    mQNFA
                                  Maybe WinTags
    Nothing -> Maybe (TagTasks, QNFA)
    forall a. Maybe a
    Nothing
                           else Maybe (TagTasks, QNFA)
    forall a. Maybe a
    Nothing
            return (eLoop',mAccepting',mQNFA')

          Star Maybe Key
    mOrbit [Key]
    resetTheseOrbits Bool
    mayFirstBeNull Q
    q -> do
            let (ac0 :: ActCont
    ac0@(E
    _,Maybe E
    mAccepting0,Maybe (TagTasks, QNFA)
    _),Bool
    clear) =
                  if Q -> Bool
    notNullable Q
    q
                    then (ActCont
    ac,Bool
    True)
                    else if [Key] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Key]
    resetTheseOrbits Bool -> Bool -> Bool
    && Maybe Key -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe Key
    mOrbit
                           then case Q -> Maybe WinTags
    maybeOnlyEmpty Q
    q of
                                  Just [] -> (ActCont
    ac,Bool
    True)
                                  Just WinTags
    wtags -> (WinTags -> ActCont -> ActCont
    addWinTagsAC WinTags
    wtags ActCont
    ac,Bool
    False)
                                  Maybe WinTags
    _ -> let nQ :: E -> E
    nQ = QT -> E
    fromQT (QT -> E) -> (E -> QT) -> E -> E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(SetTestInfo, WinTags)] -> QT -> QT
    preferNullViews (Q -> [(SetTestInfo, WinTags)]
    nullQ Q
    q) (QT -> QT) -> (E -> QT) -> E -> QT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . E -> QT
    getQT
                                       in ((E -> E
    nQ E
    eLoop,(E -> E) -> Maybe E -> Maybe E
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap E -> E
    nQ Maybe E
    mAccepting,Maybe (TagTasks, QNFA)
    forall a. Maybe a
    Nothing),Bool
    False)
                           else let nQ :: E -> E
    nQ = QT -> E
    fromQT (QT -> E) -> (E -> QT) -> E -> E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Key] -> QT -> QT
    resetOrbitsQT [Key]
    resetTheseOrbits (QT -> QT) -> (E -> QT) -> E -> QT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Key -> QT -> QT
    enterOrbitQT Maybe Key
    mOrbit
                                         (QT -> QT) -> (E -> QT) -> E -> QT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(SetTestInfo, WinTags)] -> QT -> QT
    preferNullViews (Q -> [(SetTestInfo, WinTags)]
    nullQ Q
    q) (QT -> QT) -> (E -> QT) -> E -> QT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . E -> QT
    getQT (E -> QT) -> (E -> E) -> E -> QT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Key -> E -> E
    leaveOrbit Maybe Key
    mOrbit
                                in ((E -> E
    nQ E
    eLoop,(E -> E) -> Maybe E -> Maybe E
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap E -> E
    nQ Maybe E
    mAccepting,Maybe (TagTasks, QNFA)
    forall a. Maybe a
    Nothing),Bool
    False)
            if Q -> Bool
    cannotAccept Q
    q then ActCont -> S ActCont
    forall a.
    a -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ActCont
    ac0 else mdo
              mChildAccepting <- act q (this,Nothing,Nothing)
              (thisAC@(this,_,_),ansAC) <-
                case mChildAccepting of
                  Maybe E
    Nothing -> [Char]
    -> StateT
         (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity (ActCont, ActCont)
    forall a. [Char] -> a
    err ([Char]
     -> StateT
          (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity (ActCont, ActCont))
    -> [Char]
    -> StateT
         (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity (ActCont, ActCont)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Weird pattern in getTransTagless/Star: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ (Q, Q) -> [Char]
    forall a. Show a => a -> [Char]
    show (Q
    qTop,Q
    qIn)
                  Just E
    childAccepting -> do
                    let childQT :: QT
    childQT = [Key] -> QT -> QT
    resetOrbitsQT [Key]
    resetTheseOrbits (QT -> QT) -> (E -> QT) -> E -> QT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Key -> QT -> QT
    enterOrbitQT Maybe Key
    mOrbit (QT -> QT) -> (E -> QT) -> E -> QT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . E -> QT
    getQT (E -> QT) -> E -> QT
    forall a b. (a -> b) -> a -> b
    $ E
    childAccepting
                        thisQT :: QT
    thisQT = QT -> QT -> QT
    mergeQT QT
    childQT (QT -> QT) -> (ActCont -> QT) -> ActCont -> QT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . E -> QT
    getQT (E -> QT) -> (ActCont -> E) -> ActCont -> QT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Key -> E -> E
    leaveOrbit Maybe Key
    mOrbit (E -> E) -> (ActCont -> E) -> ActCont -> E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ActCont -> E
    getE (ActCont -> QT) -> ActCont -> QT
    forall a b. (a -> b) -> a -> b
    $ ActCont
    ac
                        thisAccepting :: Maybe E
    thisAccepting =
                          case Maybe E
    mAccepting of
                            Just E
    futureAccepting -> E -> Maybe E
    forall a. a -> Maybe a
    Just (E -> Maybe E) -> (E -> E) -> E -> Maybe E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QT -> E
    fromQT (QT -> E) -> (E -> QT) -> E -> E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QT -> QT -> QT
    mergeQT QT
    childQT (QT -> QT) -> (E -> QT) -> E -> QT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . E -> QT
    getQT (E -> Maybe E) -> E -> Maybe E
    forall a b. (a -> b) -> a -> b
    $ E
    futureAccepting
                            Maybe E
    Nothing -> E -> Maybe E
    forall a. a -> Maybe a
    Just (E -> Maybe E) -> (QT -> E) -> QT -> Maybe E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QT -> E
    fromQT (QT -> Maybe E) -> QT -> Maybe E
    forall a b. (a -> b) -> a -> b
    $ QT
    childQT
                    thisAll <- if Q -> Bool
    usesQNFA Q
    q
                                 then do thisQNFA <- [Char] -> QT -> S QNFA
    newQNFA [Char]
    "actNullableTagless/Star" QT
    thisQT
                                         return (fromQNFA thisQNFA, thisAccepting, Just (mempty,thisQNFA))
                                 else ActCont -> S ActCont
    forall a.
    a -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (QT -> E
    fromQT QT
    thisQT, Maybe E
    thisAccepting, Maybe (TagTasks, QNFA)
    forall a. Maybe a
    Nothing)
                    let skipQT = QT -> QT -> QT
    mergeQT QT
    childQT (QT -> QT) -> (ActCont -> QT) -> ActCont -> QT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . E -> QT
    getQT (E -> QT) -> (ActCont -> E) -> ActCont -> QT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ActCont -> E
    getE (ActCont -> QT) -> ActCont -> QT
    forall a b. (a -> b) -> a -> b
    $ ActCont
    ac0  -- for first iteration the continuation uses NullView
                        skipAccepting =
                          case Maybe E
    mAccepting0 of
                            Just E
    futureAccepting0 -> E -> Maybe E
    forall a. a -> Maybe a
    Just (E -> Maybe E) -> (E -> E) -> E -> Maybe E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QT -> E
    fromQT (QT -> E) -> (E -> QT) -> E -> E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QT -> QT -> QT
    mergeQT QT
    childQT (QT -> QT) -> (E -> QT) -> E -> QT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . E -> QT
    getQT (E -> Maybe E) -> E -> Maybe E
    forall a b. (a -> b) -> a -> b
    $ E
    futureAccepting0
                            Maybe E
    Nothing -> E -> Maybe E
    forall a. a -> Maybe a
    Just (E -> Maybe E) -> (QT -> E) -> QT -> Maybe E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QT -> E
    fromQT (QT -> Maybe E) -> QT -> Maybe E
    forall a b. (a -> b) -> a -> b
    $ QT
    childQT
                        ansAll = (QT -> E
    fromQT QT
    skipQT, Maybe E
    skipAccepting, Maybe a
    forall a. Maybe a
    Nothing)
                    return (thisAll,ansAll)
              return (if mayFirstBeNull then (if clear then thisAC else ansAC)
                        else thisAC)
          NonEmpty Q
    q -> [Char] -> S ActCont -> S ActCont
    forall a. [Char] -> a -> a
    ecart ([Char]
    "\n> actNullableTagless/NonEmpty"[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++Q -> [Char]
    forall a. Show a => a -> [Char]
    show Q
    qIn) (S ActCont -> S ActCont) -> S ActCont -> S ActCont
    forall a b. (a -> b) -> a -> b
    $ do
            -- We *know* that q is nullable from Pattern and CorePattern checks, but assert here anyway
            Bool
    -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity ()
    -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Q -> Bool
    mustAccept Q
    q) ([Char] -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity ()
    forall a. [Char] -> a
    err ([Char]
     -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity ())
    -> [Char]
    -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "actNullableTagless/NonEmpty : provided with a *mustAccept* pattern: "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++(Q, Q) -> [Char]
    forall a. Show a => a -> [Char]
    show (Q
    qTop,Q
    qIn))
            Bool
    -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity ()
    -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Q -> Bool
    cannotAccept Q
    q) ([Char] -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity ()
    forall a. [Char] -> a
    err ([Char]
     -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity ())
    -> [Char]
    -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "actNullableTagless/NonEmpty : provided with a *cannotAccept* pattern: "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++(Q, Q) -> [Char]
    forall a. Show a => a -> [Char]
    show (Q
    qTop,Q
    qIn))

            {- This is like actNullable (Or [Empty,q]) without the extra tag to prefer the first Empty branch -}
            let (E
    clearE,Maybe E
    _,Maybe (TagTasks, QNFA)
    _) = case Q -> Maybe WinTags
    maybeOnlyEmpty Q
    qIn of
                                 Just [] -> ActCont
    ac
                                 Just WinTags
    _wtags -> ActCont
    ac -- addWinTagsAC wtags ac XXX was duplicating tags
                                 Maybe WinTags
    Nothing -> [Char] -> ActCont
    forall a. [Char] -> a
    err ([Char] -> ActCont) -> [Char] -> ActCont
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "actNullableTagless/NonEmpty is supposed to have an emptyNull nullView : "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++(Q, Q) -> [Char]
    forall a. Show a => a -> [Char]
    show (Q
    qTop,Q
    qIn)
            (_,mChildAccepting,_) <- Q -> ActCont -> S ActCont
    actNullable Q
    q ActCont
    ac
            case mChildAccepting of
              Maybe E
    Nothing -> [Char] -> S ActCont
    forall a. [Char] -> a
    err  ([Char] -> S ActCont) -> [Char] -> S ActCont
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Weird pattern in actNullableTagless/NonEmpty: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ (Q, Q) -> [Char]
    forall a. Show a => a -> [Char]
    show (Q
    qTop,Q
    qIn)
                -- cannotAccept q checked for and excluded the above condition (and starTrans!)
              Just E
    childAccepting -> do
                let childQT :: QT
    childQT = E -> QT
    getQT E
    childAccepting
                    thisAccepting :: Maybe E
    thisAccepting = case Maybe E
    mAccepting of
                                      Maybe E
    Nothing -> E -> Maybe E
    forall a. a -> Maybe a
    Just (E -> Maybe E) -> (QT -> E) -> QT -> Maybe E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QT -> E
    fromQT (QT -> Maybe E) -> QT -> Maybe E
    forall a b. (a -> b) -> a -> b
    $ QT
    childQT
                                      Just E
    futureAcceptingE -> E -> Maybe E
    forall a. a -> Maybe a
    Just (E -> Maybe E) -> (E -> E) -> E -> Maybe E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QT -> E
    fromQT (QT -> E) -> (E -> QT) -> E -> E
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QT -> QT -> QT
    mergeQT QT
    childQT (QT -> QT) -> (E -> QT) -> E -> QT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . E -> QT
    getQT (E -> Maybe E) -> E -> Maybe E
    forall a b. (a -> b) -> a -> b
    $ E
    futureAcceptingE
                                      -- I _think_ there is no need for mergeQT_2nd in the above.
                ActCont -> S ActCont
    forall a.
    a -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (E
    clearE,Maybe E
    thisAccepting,Maybe (TagTasks, QNFA)
    forall a. Maybe a
    Nothing)
          P
    _ -> [Char] -> S ActCont
    forall a. [Char] -> a
    err ([Char] -> S ActCont) -> [Char] -> S ActCont
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "This case in Text.Regex.TNFA.TNFA.actNullableTagless cannot happen: "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++(Q, Q) -> [Char]
    forall a. Show a => a -> [Char]
    show (Q
    qTop,Q
    qIn)

      -- This is applied directly to any qt immediately before passing to mergeQT
      resetOrbitsQT :: [Tag] -> QT -> QT
      resetOrbitsQT :: [Key] -> QT -> QT
    resetOrbitsQT | CompOption -> Bool
    lastStarGreedy CompOption
    compOpt = (QT -> QT) -> [Key] -> QT -> QT
    forall a b. a -> b -> a
    const QT -> QT
    forall a. a -> a
    id
                    | Bool
    otherwise = (\[Key]
    tags -> WinTags -> QT -> QT
    prependTags' [(Key
    tag,TagTask -> TagUpdate
    PreUpdate TagTask
    ResetOrbitTask)|Key
    tag<-[Key]
    tags])

      enterOrbitQT :: Maybe Tag -> QT -> QT
      enterOrbitQT :: Maybe Key -> QT -> QT
    enterOrbitQT | CompOption -> Bool
    lastStarGreedy CompOption
    compOpt = (QT -> QT) -> Maybe Key -> QT -> QT
    forall a b. a -> b -> a
    const QT -> QT
    forall a. a -> a
    id
                   | Bool
    otherwise = (QT -> QT) -> (Key -> QT -> QT) -> Maybe Key -> QT -> QT
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe QT -> QT
    forall a. a -> a
    id (\Key
    tag->WinTags -> QT -> QT
    prependTags' [(Key
    tag,TagTask -> TagUpdate
    PreUpdate TagTask
    EnterOrbitTask)])

      leaveOrbit :: Maybe Tag -> E -> E
      leaveOrbit :: Maybe Key -> E -> E
    leaveOrbit | CompOption -> Bool
    lastStarGreedy CompOption
    compOpt = (E -> E) -> Maybe Key -> E -> E
    forall a b. a -> b -> a
    const E -> E
    forall a. a -> a
    id
                 | Bool
    otherwise = (E -> E) -> (Key -> E -> E) -> Maybe Key -> E -> E
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe E -> E
    forall a. a -> a
    id (\Key
    tag->(\(TagTasks
    tags,Either QNFA QT
    cont)->((Key
    tag,TagTask
    LeaveOrbitTask)(Key, TagTask) -> TagTasks -> TagTasks
    forall a. a -> [a] -> [a]
    :TagTasks
    tags,Either QNFA QT
    cont)))

      -- 'newTrans' is the only place where PostUpdate is used and is only called from getTrans/OneChar
      --  and is the only caller of 'acceptTrans' to make QT/Simple nodes.
      newTrans :: String    -- debugging string for when a newQNFA is allocated
               -> [Tag]     -- which tags get ResetGroupStopTask in this transition (PreUpdate)
               -> Maybe Tag -- maybe one TagTask to update before incrementing the offset (PreUpdate)
               -> Pattern   -- the one character accepting Pattern of this transition
               -> E         -- the continuation state, reified to a QNFA, of after this Pattern
                           -- The fst part of the E is consumed here as a TagTask (PostUpdate)
               -> S E       -- the continuation state, as a QT, of before this Pattern
      newTrans :: [Char] -> [Key] -> Maybe Key -> Pattern -> E -> S E
    newTrans [Char]
    s [Key]
    resets Maybe Key
    mPre Pattern
    pat (TagTasks
    tags,Either QNFA QT
    cont) = do
        i <- case Either QNFA QT
    cont of
               Left QNFA
    qnfa -> Key -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity Key
    forall a.
    a -> StateT (Key, [(Key, QNFA)] -> [(Key, QNFA)]) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (QNFA -> Key
    q_id QNFA
    qnfa)     -- strictQNFA ZZZ no help
               Right QT
    qt -> do qnfa <- [Char] -> QT -> S QNFA
    newQNFA [Char]
    s QT
    qt -- strictQT ZZZ no help
                              return (q_id qnfa)
        let post = (TagTask -> TagUpdate) -> TagTasks -> WinTags
    promoteTasks TagTask -> TagUpdate
    PostUpdate TagTasks
    tags
            pre  = (TagTask -> TagUpdate) -> TagTasks -> WinTags
    promoteTasks TagTask -> TagUpdate
    PreUpdate ([(Key
    tag,TagTask
    ResetGroupStopTask) | Key
    tag<-[Key]
    resets] TagTasks -> TagTasks -> TagTasks
    forall a. [a] -> [a] -> [a]
    ++ TagTasks -> (Key -> TagTasks) -> Maybe Key -> TagTasks
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] (\Key
    tag -> [(Key
    tag,TagTask
    TagTask)]) Maybe Key
    mPre)
        return . fromQT $ acceptTrans pre pat post i -- fromQT $ strictQT no help

      -- 'acceptTrans' is the sole creator of QT/Simple and is only called by getTrans/OneChar/newTrans
      acceptTrans :: TagList -> Pattern -> TagList -> Index -> QT
      acceptTrans :: WinTags -> Pattern -> WinTags -> Key -> QT
    acceptTrans WinTags
    pre Pattern
    pIn WinTags
    post Key
    i =
        let target :: QTrans
    target = Key -> [TagCommand] -> QTrans
    forall a. Key -> a -> IntMap a
    IMap.singleton Key
    i [(Pattern -> DoPa
    getDoPa Pattern
    pIn,WinTags
    preWinTags -> WinTags -> WinTags
    forall a. [a] -> [a] -> [a]
    ++WinTags
    post)]
        in case Pattern
    pIn of
             PChar DoPa
    _ Char
    char ->
               let trans :: CharMap QTrans
    trans = QTrans -> [Char] -> CharMap QTrans
    toMap QTrans
    target [Char
    char]
               in Simple { qt_win :: WinTags
    qt_win = WinTags
    forall a. Monoid a => a
    mempty, qt_trans :: CharMap QTrans
    qt_trans = CharMap QTrans
    trans, qt_other :: QTrans
    qt_other = QTrans
    forall a. Monoid a => a
    mempty }
             PEscape DoPa
    _ Char
    char ->
               let trans :: CharMap QTrans
    trans = QTrans -> [Char] -> CharMap QTrans
    toMap QTrans
    target [Char
    char]
               in Simple { qt_win :: WinTags
    qt_win = WinTags
    forall a. Monoid a => a
    mempty, qt_trans :: CharMap QTrans
    qt_trans = CharMap QTrans
    trans, qt_other :: QTrans
    qt_other = QTrans
    forall a. Monoid a => a
    mempty }
             PDot DoPa
    _ -> Simple { qt_win :: WinTags
    qt_win = WinTags
    forall a. Monoid a => a
    mempty, qt_trans :: CharMap QTrans
    qt_trans = CharMap QTrans
    dotTrans, qt_other :: QTrans
    qt_other = QTrans
    target }
             PAny DoPa
    _ PatternSet
    ps ->
               let trans :: CharMap QTrans
    trans = QTrans -> [Char] -> CharMap QTrans
    toMap QTrans
    target ([Char] -> CharMap QTrans)
    -> (PatternSet -> [Char]) -> PatternSet -> CharMap QTrans
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Set Char -> [Char]
    forall a. Set a -> [a]
    S.toAscList (Set Char -> [Char])
    -> (PatternSet -> Set Char) -> PatternSet -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PatternSet -> Set Char
    decodePatternSet (PatternSet -> CharMap QTrans) -> PatternSet -> CharMap QTrans
    forall a b. (a -> b) -> a -> b
    $ PatternSet
    ps
               in Simple { qt_win :: WinTags
    qt_win = WinTags
    forall a. Monoid a => a
    mempty, qt_trans :: CharMap QTrans
    qt_trans = CharMap QTrans
    trans, qt_other :: QTrans
    qt_other = QTrans
    forall a. Monoid a => a
    mempty }
             PAnyNot DoPa
    _ PatternSet
    ps ->
               let trans :: CharMap QTrans
    trans = QTrans -> [Char] -> CharMap QTrans
    toMap QTrans
    forall a. Monoid a => a
    mempty ([Char] -> CharMap QTrans)
    -> (PatternSet -> [Char]) -> PatternSet -> CharMap QTrans
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Set Char -> [Char]
    forall a. Set a -> [a]
    S.toAscList (Set Char -> [Char])
    -> (PatternSet -> Set Char) -> PatternSet -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Set Char -> Set Char
    addNewline (Set Char -> Set Char)
    -> (PatternSet -> Set Char) -> PatternSet -> Set Char
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PatternSet -> Set Char
    decodePatternSet (PatternSet -> CharMap QTrans) -> PatternSet -> CharMap QTrans
    forall a b. (a -> b) -> a -> b
    $ PatternSet
    ps
               in Simple { qt_win :: WinTags
    qt_win = WinTags
    forall a. Monoid a => a
    mempty, qt_trans :: CharMap QTrans
    qt_trans = CharMap QTrans
    trans, qt_other :: QTrans
    qt_other = QTrans
    target }
             Pattern
    _ -> [Char] -> QT
    forall a. [Char] -> a
    err ([Char]
    "Cannot acceptTrans pattern "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++(Q, Pattern) -> [Char]
    forall a. Show a => a -> [Char]
    show (Q
    qTop,Pattern
    pIn))
        where  -- Take a common destination and a sorted list of unique characters
               -- and create a map from those characters to the common destination
          toMap :: IntMap [(DoPa,[(Tag, TagUpdate)])] -> [Char]
                -> CharMap (IntMap [(DoPa,[(Tag, TagUpdate)])])
          toMap :: QTrans -> [Char] -> CharMap QTrans
    toMap QTrans
    dest | CompOption -> Bool
    caseSensitive CompOption
    compOpt = IntMap QTrans -> CharMap QTrans
    forall a. IntMap a -> CharMap a
    CharMap (IntMap QTrans -> CharMap QTrans)
    -> ([Char] -> IntMap QTrans) -> [Char] -> CharMap QTrans
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(Key, QTrans)] -> IntMap QTrans
    forall a. [(Key, a)] -> IntMap a
    IMap.fromDistinctAscList ([(Key, QTrans)] -> IntMap QTrans)
    -> ([Char] -> [(Key, QTrans)]) -> [Char] -> IntMap QTrans
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> (Key, QTrans)) -> [Char] -> [(Key, QTrans)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Char
    c -> (Char -> Key
    ord Char
    c,QTrans
    dest))
                     | Bool
    otherwise = IntMap QTrans -> CharMap QTrans
    forall a. IntMap a -> CharMap a
    CharMap (IntMap QTrans -> CharMap QTrans)
    -> ([Char] -> IntMap QTrans) -> [Char] -> CharMap QTrans
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(Key, QTrans)] -> IntMap QTrans
    forall a. [(Key, a)] -> IntMap a
    IMap.fromList ([(Key, QTrans)] -> IntMap QTrans)
    -> ([Char] -> [(Key, QTrans)]) -> [Char] -> IntMap QTrans
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([(Key, QTrans)] -> [(Key, QTrans)])
    -> [(Key, QTrans)] -> [(Key, QTrans)]
    forall a b. (a -> b) -> a -> b
    $ [])
                                   (([(Key, QTrans)] -> [(Key, QTrans)]) -> [(Key, QTrans)])
    -> ([Char] -> [(Key, QTrans)] -> [(Key, QTrans)])
    -> [Char]
    -> [(Key, QTrans)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char
     -> ([(Key, QTrans)] -> [(Key, QTrans)])
     -> [(Key, QTrans)]
     -> [(Key, QTrans)])
    -> ([(Key, QTrans)] -> [(Key, QTrans)])
    -> [Char]
    -> [(Key, QTrans)]
    -> [(Key, QTrans)]
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\Char
    c [(Key, QTrans)] -> [(Key, QTrans)]
    dl -> if Char -> Bool
    isAlpha Char
    c
                                                       then ([(Key, QTrans)] -> [(Key, QTrans)]
    dl([(Key, QTrans)] -> [(Key, QTrans)])
    -> ([(Key, QTrans)] -> [(Key, QTrans)])
    -> [(Key, QTrans)]
    -> [(Key, QTrans)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .((Char -> Key
    ord (Char -> Char
    toUpper Char
    c),QTrans
    dest)(Key, QTrans) -> [(Key, QTrans)] -> [(Key, QTrans)]
    forall a. a -> [a] -> [a]
    :)
                                                               ([(Key, QTrans)] -> [(Key, QTrans)])
    -> ([(Key, QTrans)] -> [(Key, QTrans)])
    -> [(Key, QTrans)]
    -> [(Key, QTrans)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .((Char -> Key
    ord (Char -> Char
    toLower Char
    c),QTrans
    dest)(Key, QTrans) -> [(Key, QTrans)] -> [(Key, QTrans)]
    forall a. a -> [a] -> [a]
    :)
                                                            )
                                                       else ([(Key, QTrans)] -> [(Key, QTrans)]
    dl([(Key, QTrans)] -> [(Key, QTrans)])
    -> ([(Key, QTrans)] -> [(Key, QTrans)])
    -> [(Key, QTrans)]
    -> [(Key, QTrans)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .((Char -> Key
    ord Char
    c,QTrans
    dest)(Key, QTrans) -> [(Key, QTrans)] -> [(Key, QTrans)]
    forall a. a -> [a] -> [a]
    :))
                                           ) [(Key, QTrans)] -> [(Key, QTrans)]
    forall a. a -> a
    id
          addNewline :: Set Char -> Set Char
    addNewline | CompOption -> Bool
    multiline CompOption
    compOpt = Char -> Set Char -> Set Char
    forall a. Ord a => a -> Set a -> Set a
    S.insert Char
    '\n'
                     | Bool
    otherwise = Set Char -> Set Char
    forall a. a -> a
    id
          dotTrans :: CharMap QTrans
    dotTrans | CompOption -> Bool
    multiline CompOption
    compOpt = Char -> QTrans -> CharMap QTrans
    forall a. Char -> a -> CharMap a
    Map.singleton Char
    '\n' QTrans
    forall a. Monoid a => a
    mempty
                   | Bool
    otherwise = CharMap QTrans
    forall a. Monoid a => a
    Mon.mempty

    {-

    prepend architecture becomes
    prependTags :: TagTask -> [Tag] -> QT -> QT
    which always uses PreUpdate and the same task for all the tags

    qt_win seems to only allow PreUpdate so why keep the same type?

    ADD ORPHAN ID check and make this a fatal error while testing

    -}