    {-# LANGUAGE CPP #-}

    #if __GLASGOW_HASKELL__ >= 902
    {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
    #endif

    -- | This is the code for the main engine.  This captures the posix subexpressions. This 'execMatch'
    -- also dispatches to "Engine_NC", "Engine_FA", and "Engine_FC_NA"
    --
    -- It is polymorphic over the internal Uncons type class, and specialized to produce the needed
    -- variants.
    module Text.Regex.TDFA.NewDFA.Engine(execMatch) where

    import Control.Monad(when,forM,forM_,liftM2,foldM,join,filterM)
    import Data.Array.Base(unsafeRead,unsafeWrite,STUArray(..))
    -- #ifdef __GLASGOW_HASKELL__
    import GHC.Arr(STArray(..))
    import GHC.ST(ST(..))
    import GHC.Exts(MutableByteArray#,RealWorld,Int#,getSizeofMutableByteArray#,State#)
    import Unsafe.Coerce (unsafeCoerce)
    {-
    -- #else
    import Control.Monad.ST(ST)
    import Data.Array.ST(STArray)
    -- #endif
    -}
    import Prelude hiding ((!!))

    import Data.Array.MArray(MArray(..))
    import Data.Array.Unsafe(unsafeFreeze)
    import Data.Array.IArray(Array,bounds,assocs,Ix(rangeSize,range))
    import qualified Data.IntMap.CharMap2 as CMap(findWithDefault)
    import Data.IntMap(IntMap)
    import qualified Data.IntMap as IMap(null,toList,lookup,insert)
    import Data.Maybe(catMaybes)
    import Data.Monoid as Mon(Monoid(..))
    import qualified Data.IntSet as ISet(toAscList)
    import Data.Array.IArray((!))
    import Data.List(partition,sort,sortBy,groupBy)
    import qualified Data.List as List
    import Data.STRef(STRef,newSTRef,readSTRef,writeSTRef)
    import qualified Control.Monad.ST.Lazy as L(ST,runST,strictToLazyST)
    import qualified Control.Monad.ST.Strict as S(ST)
    import Data.Sequence(Seq,ViewL(..),viewl)
    import qualified Data.Sequence as Seq(null)
    import qualified Data.ByteString.Char8 as SBS(ByteString)
    import qualified Data.ByteString.Lazy.Char8 as LBS(ByteString)
    import qualified Data.Text as T
    import qualified Data.Text.Lazy as TL
    import Foreign.Ptr(Ptr)

    import Text.Regex.Base(MatchArray,MatchOffset,MatchLength)
    import qualified Text.Regex.TDFA.IntArrTrieSet as Trie(lookupAsc)
    import Text.Regex.TDFA.Common hiding (indent)
    import Text.Regex.TDFA.NewDFA.Uncons(Uncons(uncons))
    import Text.Regex.TDFA.NewDFA.MakeTest(test_singleline,test_multiline)
    import qualified Text.Regex.TDFA.NewDFA.Engine_FA as FA(execMatch)
    import qualified Text.Regex.TDFA.NewDFA.Engine_NC as NC(execMatch)
    import qualified Text.Regex.TDFA.NewDFA.Engine_NC_FA as NC_FA(execMatch)

    --import Debug.Trace

    -- trace :: String -> a -> a
    -- trace _ a = a
    {-
    see :: (Show x, Monad m) => String ->  x -> m a -> m a
    see _ _ m = m
    --see msg s m = trace ("\nsee: "++msg++" : "++show s) m

    sees :: (Monad m) => String ->  String -> m a -> m a
    sees _ _ m = m
    --sees msg s m = trace ("\nsee: "++msg++" :\n"++s) m
    -}
    err :: String -> a
    err :: forall a. [Char] -> a
    err [Char]
    s = [Char] -> [Char] -> a
    forall a. [Char] -> [Char] -> a
    common_error [Char]
    "Text.Regex.TDFA.NewDFA.Engine"  [Char]
    s

    {-# INLINE (!!) #-}
    (!!) :: (MArray a e (S.ST s),Ix i) => a i e -> Int -> S.ST s e
    !! :: forall (a :: * -> * -> *) e s i.
    (MArray a e (ST s), Ix i) =>
    a i e -> Position -> ST s e
    (!!) = a i e -> Position -> ST s e
    forall i. Ix i => a i e -> Position -> ST s e
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> Position -> m e
    unsafeRead
    {-# INLINE set #-}
    set :: (MArray a e (S.ST s),Ix i) => a i e -> Int -> e -> S.ST s ()
    set :: forall (a :: * -> * -> *) e s i.
    (MArray a e (ST s), Ix i) =>
    a i e -> Position -> e -> ST s ()
    set = a i e -> Position -> e -> ST s ()
    forall i. Ix i => a i e -> Position -> e -> ST s ()
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> Position -> e -> m ()
    unsafeWrite

    {-# SPECIALIZE execMatch :: Regex -> Position -> Char -> ([] Char) -> [MatchArray] #-}
    {-# SPECIALIZE execMatch :: Regex -> Position -> Char -> (Seq Char) -> [MatchArray] #-}
    {-# SPECIALIZE execMatch :: Regex -> Position -> Char -> SBS.ByteString -> [MatchArray] #-}
    {-# SPECIALIZE execMatch :: Regex -> Position -> Char -> LBS.ByteString -> [MatchArray] #-}
    {-# SPECIALIZE execMatch :: Regex -> Position -> Char -> T.Text -> [MatchArray] #-}
    {-# SPECIALIZE execMatch :: Regex -> Position -> Char -> TL.Text -> [MatchArray] #-}
    execMatch :: Uncons text => Regex -> Position -> Char -> text -> [MatchArray]
    execMatch :: forall text.
    Uncons text =>
    Regex -> Position -> Char -> text -> [MatchArray]
    execMatch r :: Regex
    r@(Regex { regex_dfa :: Regex -> DFA
    regex_dfa = DFA {d_id :: DFA -> SetIndex
    d_id=SetIndex
    didIn,d_dt :: DFA -> DT
    d_dt=DT
    dtIn}
                       , regex_init :: Regex -> Position
    regex_init = Position
    startState
                       , regex_b_index :: Regex -> (Position, Position)
    regex_b_index = (Position, Position)
    b_index
                       , regex_b_tags :: Regex -> (Position, Position)
    regex_b_tags = (Position, Position)
    b_tags_all
                       , regex_trie :: Regex -> TrieSet DFA
    regex_trie = TrieSet DFA
    trie
                       , regex_tags :: Regex -> Array Position OP
    regex_tags = Array Position OP
    aTags
                       , regex_groups :: Regex -> Array Position [GroupInfo]
    regex_groups = Array Position [GroupInfo]
    aGroups
                       , regex_isFrontAnchored :: Regex -> Bool
    regex_isFrontAnchored = Bool
    frontAnchored
                       , regex_compOptions :: Regex -> CompOption
    regex_compOptions = CompOption { multiline :: CompOption -> Bool
    multiline = Bool
    newline }
                       , regex_execOptions :: Regex -> ExecOption
    regex_execOptions = ExecOption { captureGroups :: ExecOption -> Bool
    captureGroups = Bool
    capture }})
              Position
    offsetIn Char
    prevIn text
    inputIn = case (Bool
    subCapture,Bool
    frontAnchored) of
                                          (Bool
    True  ,Bool
    False) -> (forall s. ST s [MatchArray]) -> [MatchArray]
    forall a. (forall s. ST s a) -> a
    L.runST ST s [MatchArray]
    forall s. ST s [MatchArray]
    runCaptureGroup
                                          (Bool
    True  ,Bool
    True)  -> Regex -> Position -> Char -> text -> [MatchArray]
    forall text.
    Uncons text =>
    Regex -> Position -> Char -> text -> [MatchArray]
    FA.execMatch Regex
    r Position
    offsetIn Char
    prevIn text
    inputIn
                                          (Bool
    False ,Bool
    False) -> Regex -> Position -> Char -> text -> [MatchArray]
    forall text.
    Uncons text =>
    Regex -> Position -> Char -> text -> [MatchArray]
    NC.execMatch Regex
    r Position
    offsetIn Char
    prevIn text
    inputIn
                                          (Bool
    False ,Bool
    True)  -> Regex -> Position -> Char -> text -> [MatchArray]
    forall text.
    Uncons text =>
    Regex -> Position -> Char -> text -> [MatchArray]
    NC_FA.execMatch Regex
    r Position
    offsetIn Char
    prevIn text
    inputIn
     where
      subCapture :: Bool
      subCapture :: Bool
    subCapture = Bool
    capture Bool -> Bool -> Bool
    && (Position
    1Position -> Position -> Bool
    forall a. Ord a => a -> a -> Bool
    <=(Position, Position) -> Position
    forall a. Ix a => (a, a) -> Position
    rangeSize (Array Position [GroupInfo] -> (Position, Position)
    forall i. Ix i => Array i [GroupInfo] -> (i, i)
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> (i, i)
    bounds Array Position [GroupInfo]
    aGroups))

      b_tags :: (Tag,Tag)
      !b_tags :: (Position, Position)
    b_tags = (Position, Position)
    b_tags_all

      orbitTags :: [Tag]
      !orbitTags :: [Position]
    orbitTags = ((Position, OP) -> Position) -> [(Position, OP)] -> [Position]
    forall a b. (a -> b) -> [a] -> [b]
    map (Position, OP) -> Position
    forall a b. (a, b) -> a
    fst ([(Position, OP)] -> [Position])
    -> (Array Position OP -> [(Position, OP)])
    -> Array Position OP
    -> [Position]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Position, OP) -> Bool) -> [(Position, OP)] -> [(Position, OP)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((OP
    OrbitOP -> OP -> Bool
    forall a. Eq a => a -> a -> Bool
    ==)(OP -> Bool) -> ((Position, OP) -> OP) -> (Position, OP) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(Position, OP) -> OP
    forall a b. (a, b) -> b
    snd) ([(Position, OP)] -> [(Position, OP)])
    -> (Array Position OP -> [(Position, OP)])
    -> Array Position OP
    -> [(Position, OP)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Array Position OP -> [(Position, OP)]
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> [(i, e)]
    assocs (Array Position OP -> [Position])
    -> Array Position OP -> [Position]
    forall a b. (a -> b) -> a -> b
    $ Array Position OP
    aTags

      !test :: WhichTest -> Position -> Char -> text -> Bool
    test = Bool -> WhichTest -> Position -> Char -> text -> Bool
    forall text.
    Uncons text =>
    Bool -> WhichTest -> Position -> Char -> text -> Bool
    mkTest Bool
    newline

      comp :: C s
      comp :: forall s. C s
    comp = {-# SCC "matchHere.comp" #-} Array Position OP -> C s
    forall s. Array Position OP -> C s
    ditzyComp'3 Array Position OP
    aTags

      runCaptureGroup :: L.ST s [MatchArray]
      runCaptureGroup :: forall s. ST s [MatchArray]
    runCaptureGroup = {-# SCC "runCaptureGroup" #-} do
        obtainNext <- ST s (ST s [MatchArray]) -> ST s (ST s [MatchArray])
    forall s a. ST s a -> ST s a
    L.strictToLazyST ST s (ST s [MatchArray])
    forall s. ST s (ST s [MatchArray])
    constructNewEngine
        let loop = do vals <- ST s [MatchArray] -> ST s [MatchArray]
    forall s a. ST s a -> ST s a
    L.strictToLazyST ST s [MatchArray]
    obtainNext
                      if null vals -- force vals before defining valsRest
                        then return [] -- end of capturing
                        else do valsRest <- loop
                                return (vals ++ valsRest)
        loop

      constructNewEngine :: S.ST s (S.ST s [MatchArray])
      constructNewEngine :: forall s. ST s (ST s [MatchArray])
    constructNewEngine =  {-# SCC "constructNewEngine" #-} do
        storeNext <- ST s [MatchArray] -> ST s (STRef s (ST s [MatchArray]))
    forall a s. a -> ST s (STRef s a)
    newSTRef ST s [MatchArray]
    forall a. HasCallStack => a
    undefined
        writeSTRef storeNext (goNext storeNext)
        let obtainNext = ST s (ST s [MatchArray]) -> ST s [MatchArray]
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (STRef s (ST s [MatchArray]) -> ST s (ST s [MatchArray])
    forall s a. STRef s a -> ST s a
    readSTRef STRef s (ST s [MatchArray])
    storeNext)
        return obtainNext

      goNext :: STRef s (ST s [MatchArray]) -> ST s [MatchArray]
      goNext :: forall s. STRef s (ST s [MatchArray]) -> ST s [MatchArray]
    goNext STRef s (ST s [MatchArray])
    storeNext = {-# SCC "goNext" #-} do
        (SScratch s1In s2In (winQ,blank,which)) <- (Position, Position) -> (Position, Position) -> ST s (SScratch s)
    forall s.
    (Position, Position) -> (Position, Position) -> ST s (SScratch s)
    newScratch (Position, Position)
    b_index (Position, Position)
    b_tags
        _ <- spawnStart b_tags blank startState s1In offsetIn
        eliminatedStateFlag <- newSTRef False
        eliminatedRespawnFlag <- newSTRef False
        let next MScratch s
    s1 MScratch s
    s2 SetIndex
    did DT
    dt Position
    offset Char
    prev text
    input = {-# SCC "goNext.next" #-}
              case DT
    dt of
                Testing' {dt_test :: DT -> WhichTest
    dt_test=WhichTest
    wt,dt_a :: DT -> DT
    dt_a=DT
    a,dt_b :: DT -> DT
    dt_b=DT
    b} ->
                  if WhichTest -> Position -> Char -> text -> Bool
    test WhichTest
    wt Position
    offset Char
    prev text
    input
                    then MScratch s
    -> MScratch s
    -> SetIndex
    -> DT
    -> Position
    -> Char
    -> text
    -> ST s [MatchArray]
    next MScratch s
    s1 MScratch s
    s2 SetIndex
    did DT
    a Position
    offset Char
    prev text
    input
                    else MScratch s
    -> MScratch s
    -> SetIndex
    -> DT
    -> Position
    -> Char
    -> text
    -> ST s [MatchArray]
    next MScratch s
    s1 MScratch s
    s2 SetIndex
    did DT
    b Position
    offset Char
    prev text
    input
                Simple' {dt_win :: DT -> IntMap Instructions
    dt_win=IntMap Instructions
    w,dt_trans :: DT -> CharMap Transition
    dt_trans=CharMap Transition
    t, dt_other :: DT -> Transition
    dt_other=Transition
    o}
                  | IntMap Instructions -> Bool
    forall a. IntMap a -> Bool
    IMap.null IntMap Instructions
    w ->
                      case text -> Maybe (Char, text)
    forall a. Uncons a => a -> Maybe (Char, a)
    uncons text
    input of
                        Maybe (Char, text)
    Nothing -> ST s [MatchArray]
    finalizeWinners
                        Just (Char
    c,text
    input') ->
                          case Transition -> Char -> CharMap Transition -> Transition
    forall a. a -> Char -> CharMap a -> a
    CMap.findWithDefault Transition
    o Char
    c CharMap Transition
    t of
                            Transition {trans_many :: Transition -> DFA
    trans_many=DFA {d_id :: DFA -> SetIndex
    d_id=SetIndex
    did',d_dt :: DFA -> DT
    d_dt=DT
    dt'},trans_how :: Transition -> DTrans
    trans_how=DTrans
    dtrans} ->
                              MScratch s
    -> MScratch s
    -> SetIndex
    -> SetIndex
    -> DT
    -> DTrans
    -> Position
    -> Char
    -> text
    -> ST s [MatchArray]
    findTrans MScratch s
    s1 MScratch s
    s2 SetIndex
    did SetIndex
    did' DT
    dt' DTrans
    dtrans Position
    offset Char
    c text
    input'
                  | Bool
    otherwise -> do
                      (did',dt') <- MScratch s
    -> SetIndex
    -> DT
    -> IntMap Instructions
    -> Position
    -> ST s (SetIndex, DT)
    processWinner MScratch s
    s1 SetIndex
    did DT
    dt IntMap Instructions
    w Position
    offset
                      next' s1 s2 did' dt' offset prev input

            next' MScratch s
    s1 MScratch s
    s2 SetIndex
    did DT
    dt Position
    offset Char
    prev text
    input = {-# SCC "goNext.next'" #-}
              case DT
    dt of
                Testing' {dt_test :: DT -> WhichTest
    dt_test=WhichTest
    wt,dt_a :: DT -> DT
    dt_a=DT
    a,dt_b :: DT -> DT
    dt_b=DT
    b} ->
                  if WhichTest -> Position -> Char -> text -> Bool
    test WhichTest
    wt Position
    offset Char
    prev text
    input
                    then MScratch s
    -> MScratch s
    -> SetIndex
    -> DT
    -> Position
    -> Char
    -> text
    -> ST s [MatchArray]
    next' MScratch s
    s1 MScratch s
    s2 SetIndex
    did DT
    a Position
    offset Char
    prev text
    input
                    else MScratch s
    -> MScratch s
    -> SetIndex
    -> DT
    -> Position
    -> Char
    -> text
    -> ST s [MatchArray]
    next' MScratch s
    s1 MScratch s
    s2 SetIndex
    did DT
    b Position
    offset Char
    prev text
    input
                Simple' {dt_trans :: DT -> CharMap Transition
    dt_trans=CharMap Transition
    t, dt_other :: DT -> Transition
    dt_other=Transition
    o} ->
                  case text -> Maybe (Char, text)
    forall a. Uncons a => a -> Maybe (Char, a)
    uncons text
    input of
                    Maybe (Char, text)
    Nothing -> ST s [MatchArray]
    finalizeWinners
                    Just (Char
    c,text
    input') ->
                      case Transition -> Char -> CharMap Transition -> Transition
    forall a. a -> Char -> CharMap a -> a
    CMap.findWithDefault Transition
    o Char
    c CharMap Transition
    t of
                        Transition {trans_many :: Transition -> DFA
    trans_many=DFA {d_id :: DFA -> SetIndex
    d_id=SetIndex
    did',d_dt :: DFA -> DT
    d_dt=DT
    dt'},trans_how :: Transition -> DTrans
    trans_how=DTrans
    dtrans} ->
                          MScratch s
    -> MScratch s
    -> SetIndex
    -> SetIndex
    -> DT
    -> DTrans
    -> Position
    -> Char
    -> text
    -> ST s [MatchArray]
    findTrans MScratch s
    s1 MScratch s
    s2 SetIndex
    did SetIndex
    did' DT
    dt' DTrans
    dtrans Position
    offset Char
    c text
    input'

    -- compressOrbits gets all the current Tag-0 start information from
    -- the NFA states; then it loops through all the Orbit tags with
    -- compressOrbit.
    --
    -- compressOrbit on such a Tag loops through all the NFS states'
    -- m_orbit record, discarding ones that are Nothing and discarding
    -- ones that are too new to care about (after the cutoff value).
    --
    -- compressOrbit then groups the Orbits records by the Tag-0 start
    -- position and the basePos position.  Entries in different groups
    -- will never be comparable in the future so they can be processed
    -- separately.  Groups could probably be even more finely
    -- distinguished, as a further optimization, but the justification will
    -- be tricky.
    --
    -- Current Tag-0 values are at most offset and all newly spawned
    -- groups will have Tag-0 of at least (succ offset) so the current
    -- groups are closed to those spawned in the future.  The basePos may
    -- be as large as offset and may be overwritten later with values of
    -- offset or larger (and this will also involve deleting the Orbits
    -- record).  Thus there could be a future collision between a current
    -- group with basePos==offset and an updated record that acquires
    -- basePos==offset.  By excluding groups with basePos before the
    -- current offset the collision between existing and future records
    -- is avoided.
    --
    -- An entry in a group can only collide with that group's
    -- descendants. compressOrbit sends each group to the compressGroup
    -- command.
    --
    -- compressGroup on a single record checks whether it's Seq can be
    -- cleared and if so it will clear it (and set ordinal to Nothing but
    -- this this not particularly important).
    --
    -- compressGroup on many records sorts and groups the members and zips
    -- the groups with their new ordinal value.  The comparison is based
    -- on the old ordinal value, then the inOrbit value, and then the (Seq
    -- Position) data.
    --
    -- The old ordinals of the group will all be Nothing or all be Just,
    -- but this condition is neither checked nor violations detected.
    -- This comparison is justified because once records get different
    -- ordinals assigned they will never change places.
    --
    -- The inOrbit Bool is only different if one of them has set the stop
    -- position to at most (succ offset).  They will only be compared if
    -- the other one leaves, an its stop position will be at least offset.
    -- The previous sentence is justified by inspection of the "assemble"
    -- function in the TDFA module: there is no (PostUpdate
    -- LeaveOrbitTask) so the largest possible value for the stop Tag is
    -- (pred offset). Thus the record with inOrbit==False would beat (be
    -- GT than) the record with inOrbit==True.
    --
    -- The Seq comparison is safe because the largest existing Position
    -- value is (pred offset) and the smallest future Position value is
    -- offset.  The previous sentence is justified by inspection of the
    -- "assemble" function in the TDFA module: there is no (PostUpdate
    -- EnterOrbitTags) so the largest possible value in the Seq is (pred
    -- offset).
    --
    -- The updated Orbits get the new ordinal value and an empty (Seq
    -- Position).

            compressOrbits MScratch s
    s1 SetIndex
    did Position
    offset = do
              let getStart :: Position -> ST s (Position, Position)
    getStart Position
    state = do start <- ST s Position
    -> (STUArray s Position Position -> ST s Position)
    -> Maybe (STUArray s Position Position)
    -> ST s Position
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ([Char] -> ST s Position
    forall a. [Char] -> a
    err [Char]
    "compressOrbit,1") (STUArray s Position Position -> Position -> ST s Position
    forall (a :: * -> * -> *) e s i.
    (MArray a e (ST s), Ix i) =>
    a i e -> Position -> ST s e
    !! Position
    0) (Maybe (STUArray s Position Position) -> ST s Position)
    -> ST s (Maybe (STUArray s Position Position)) -> ST s Position
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< MScratch s
    -> STArray s Position (Maybe (STUArray s Position Position))
    forall s.
    MScratch s
    -> STArray s Position (Maybe (STUArray s Position Position))
    m_pos MScratch s
    s1 STArray s Position (Maybe (STUArray s Position Position))
    -> Position -> ST s (Maybe (STUArray s Position Position))
    forall (a :: * -> * -> *) e s i.
    (MArray a e (ST s), Ix i) =>
    a i e -> Position -> ST s e
    !! Position
    state
                                      return (state,start)
                  cutoff :: Position
    cutoff = Position
    offset Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - Position
    50 -- Require: cutoff <= offset, MAGIC TUNABLE CONSTANT 50
              ss <- (Position -> ST s (Position, Position))
    -> [Position] -> ST s [(Position, Position)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Position -> ST s (Position, Position)
    forall {s}.
    (MArray (STUArray s) Position (ST s),
     MArray
       (STArray s) (Maybe (STUArray s Position Position)) (ST s)) =>
    Position -> ST s (Position, Position)
    getStart (SetIndex -> [Position]
    ISet.toAscList SetIndex
    did)
              let compressOrbit Position
    tag = do
                    mos <- [(Position, Position)]
    -> ((Position, Position)
        -> ST s (Maybe ((Position, Position), Orbits)))
    -> ST s [Maybe ((Position, Position), Orbits)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [(Position, Position)]
    ss ( \ p :: (Position, Position)
    p@(Position
    state,Position
    _start) -> do
                                      mo <- (OrbitLog -> Maybe Orbits) -> ST s OrbitLog -> ST s (Maybe Orbits)
    forall a b. (a -> b) -> ST s a -> ST s b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Position -> OrbitLog -> Maybe Orbits
    forall a. Position -> IntMap a -> Maybe a
    IMap.lookup Position
    tag) (MScratch s -> STArray s Position OrbitLog
    forall s. MScratch s -> STArray s Position OrbitLog
    m_orbit MScratch s
    s1 STArray s Position OrbitLog -> Position -> ST s OrbitLog
    forall (a :: * -> * -> *) e s i.
    (MArray a e (ST s), Ix i) =>
    a i e -> Position -> ST s e
    !! Position
    state)
                                      case mo of
                                        Just Orbits
    orbits | Orbits -> Position
    basePos Orbits
    orbits Position -> Position -> Bool
    forall a. Ord a => a -> a -> Bool
    < Position
    cutoff -> Maybe ((Position, Position), Orbits)
    -> ST s (Maybe ((Position, Position), Orbits))
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (((Position, Position), Orbits)
    -> Maybe ((Position, Position), Orbits)
    forall a. a -> Maybe a
    Just ((Position, Position)
    p,Orbits
    orbits))
                                                    | Bool
    otherwise -> Maybe ((Position, Position), Orbits)
    -> ST s (Maybe ((Position, Position), Orbits))
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ((Position, Position), Orbits)
    forall a. Maybe a
    Nothing
                                        Maybe Orbits
    _ -> Maybe ((Position, Position), Orbits)
    -> ST s (Maybe ((Position, Position), Orbits))
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ((Position, Position), Orbits)
    forall a. Maybe a
    Nothing )
                    let compressGroup [((Position
    state,b
    _),Orbits
    orbit)] | Seq Position -> Bool
    forall a. Seq a -> Bool
    Seq.null (Orbits -> Seq Position
    getOrbits Orbits
    orbit) = () -> ST s ()
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                                                          | Bool
    otherwise =
                          STArray s Position OrbitLog -> Position -> OrbitLog -> ST s ()
    forall (a :: * -> * -> *) e s i.
    (MArray a e (ST s), Ix i) =>
    a i e -> Position -> e -> ST s ()
    set (MScratch s -> STArray s Position OrbitLog
    forall s. MScratch s -> STArray s Position OrbitLog
    m_orbit MScratch s
    s1) Position
    state
                          (OrbitLog -> ST s ())
    -> (OrbitLog -> OrbitLog) -> OrbitLog -> ST s ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Position -> Orbits -> OrbitLog -> OrbitLog
    forall a. Position -> a -> IntMap a -> IntMap a
    IMap.insert Position
    tag (Orbits -> OrbitLog -> OrbitLog) -> Orbits -> OrbitLog -> OrbitLog
    forall a b. (a -> b) -> a -> b
    $! (Orbits
    orbit { ordinal = Nothing, getOrbits = mempty}))
                          (OrbitLog -> ST s ()) -> ST s OrbitLog -> ST s ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< MScratch s -> STArray s Position OrbitLog
    forall s. MScratch s -> STArray s Position OrbitLog
    m_orbit MScratch s
    s1 STArray s Position OrbitLog -> Position -> ST s OrbitLog
    forall (a :: * -> * -> *) e s i.
    (MArray a e (ST s), Ix i) =>
    a i e -> Position -> ST s e
    !! Position
    state

                        compressGroup [((Position, b), Orbits)]
    gs = do
                          let sortPos :: (a, Orbits) -> (a, Orbits) -> Ordering
    sortPos (a
    _,Orbits
    b1) (a
    _,Orbits
    b2) = Maybe Position -> Maybe Position -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (Orbits -> Maybe Position
    ordinal Orbits
    b1) (Orbits -> Maybe Position
    ordinal Orbits
    b2) Ordering -> Ordering -> Ordering
    forall a. Monoid a => a -> a -> a
    `mappend`
                                                      Bool -> Bool -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (Orbits -> Bool
    inOrbit Orbits
    b2) (Orbits -> Bool
    inOrbit Orbits
    b1) Ordering -> Ordering -> Ordering
    forall a. Monoid a => a -> a -> a
    `mappend`
                                                      ViewL Position -> ViewL Position -> Ordering
    comparePos (Seq Position -> ViewL Position
    forall a. Seq a -> ViewL a
    viewl (Orbits -> Seq Position
    getOrbits Orbits
    b1)) (Seq Position -> ViewL Position
    forall a. Seq a -> ViewL a
    viewl (Orbits -> Seq Position
    getOrbits Orbits
    b2))
                              groupPos :: (a, Orbits) -> (a, Orbits) -> Bool
    groupPos (a
    _,Orbits
    b1) (a
    _,Orbits
    b2) = Orbits -> Maybe Position
    ordinal Orbits
    b1 Maybe Position -> Maybe Position -> Bool
    forall a. Eq a => a -> a -> Bool
    == Orbits -> Maybe Position
    ordinal Orbits
    b2 Bool -> Bool -> Bool
    && Orbits -> Seq Position
    getOrbits Orbits
    b1 Seq Position -> Seq Position -> Bool
    forall a. Eq a => a -> a -> Bool
    == Orbits -> Seq Position
    getOrbits Orbits
    b2
                              gs' :: [(Position, [((Position, b), Orbits)])]
    gs' = [Position]
    -> [[((Position, b), Orbits)]]
    -> [(Position, [((Position, b), Orbits)])]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [(Position
    1::Int)..] ((((Position, b), Orbits) -> ((Position, b), Orbits) -> Bool)
    -> [((Position, b), Orbits)] -> [[((Position, b), Orbits)]]
    forall a. (a -> a -> Bool) -> [a] -> [[a]]
    groupBy ((Position, b), Orbits) -> ((Position, b), Orbits) -> Bool
    forall {a} {a}. (a, Orbits) -> (a, Orbits) -> Bool
    groupPos ([((Position, b), Orbits)] -> [[((Position, b), Orbits)]])
    -> ([((Position, b), Orbits)] -> [((Position, b), Orbits)])
    -> [((Position, b), Orbits)]
    -> [[((Position, b), Orbits)]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (((Position, b), Orbits) -> ((Position, b), Orbits) -> Ordering)
    -> [((Position, b), Orbits)] -> [((Position, b), Orbits)]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy ((Position, b), Orbits) -> ((Position, b), Orbits) -> Ordering
    forall {a} {a}. (a, Orbits) -> (a, Orbits) -> Ordering
    sortPos ([((Position, b), Orbits)] -> [[((Position, b), Orbits)]])
    -> [((Position, b), Orbits)] -> [[((Position, b), Orbits)]]
    forall a b. (a -> b) -> a -> b
    $ [((Position, b), Orbits)]
    gs)
                          [(Position, [((Position, b), Orbits)])]
    -> ((Position, [((Position, b), Orbits)]) -> ST s ()) -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [(Position, [((Position, b), Orbits)])]
    gs' (((Position, [((Position, b), Orbits)]) -> ST s ()) -> ST s ())
    -> ((Position, [((Position, b), Orbits)]) -> ST s ()) -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ \ (!Position
    n,[((Position, b), Orbits)]
    eqs) -> do
                            [((Position, b), Orbits)]
    -> (((Position, b), Orbits) -> ST s ()) -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [((Position, b), Orbits)]
    eqs ((((Position, b), Orbits) -> ST s ()) -> ST s ())
    -> (((Position, b), Orbits) -> ST s ()) -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ \ ((Position
    state,b
    _),Orbits
    orbit) ->
                              STArray s Position OrbitLog -> Position -> OrbitLog -> ST s ()
    forall (a :: * -> * -> *) e s i.
    (MArray a e (ST s), Ix i) =>
    a i e -> Position -> e -> ST s ()
    set (MScratch s -> STArray s Position OrbitLog
    forall s. MScratch s -> STArray s Position OrbitLog
    m_orbit MScratch s
    s1) Position
    state
                               (OrbitLog -> ST s ())
    -> (OrbitLog -> OrbitLog) -> OrbitLog -> ST s ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Position -> Orbits -> OrbitLog -> OrbitLog
    forall a. Position -> a -> IntMap a -> IntMap a
    IMap.insert Position
    tag (Orbits -> OrbitLog -> OrbitLog) -> Orbits -> OrbitLog -> OrbitLog
    forall a b. (a -> b) -> a -> b
    $! (Orbits
    orbit { ordinal = Just n, getOrbits = mempty }))
                                (OrbitLog -> ST s ()) -> ST s OrbitLog -> ST s ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< MScratch s -> STArray s Position OrbitLog
    forall s. MScratch s -> STArray s Position OrbitLog
    m_orbit MScratch s
    s1 STArray s Position OrbitLog -> Position -> ST s OrbitLog
    forall (a :: * -> * -> *) e s i.
    (MArray a e (ST s), Ix i) =>
    a i e -> Position -> ST s e
    !! Position
    state
                    let sorter ((a
    _,a
    a1),Orbits
    b1) ((a
    _,a
    a2),Orbits
    b2) = a -> a -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare a
    a1 a
    a2 Ordering -> Ordering -> Ordering
    forall a. Monoid a => a -> a -> a
    `mappend` Position -> Position -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (Orbits -> Position
    basePos Orbits
    b1) (Orbits -> Position
    basePos Orbits
    b2)
                        grouper ((a
    _,a
    a1),Orbits
    b1) ((a
    _,a
    a2),Orbits
    b2) = a
    a1a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    ==a
    a2 Bool -> Bool -> Bool
    && Orbits -> Position
    basePos Orbits
    b1 Position -> Position -> Bool
    forall a. Eq a => a -> a -> Bool
    == Orbits -> Position
    basePos Orbits
    b2
                        orbitGroups = (((Position, Position), Orbits)
     -> ((Position, Position), Orbits) -> Bool)
    -> [((Position, Position), Orbits)]
    -> [[((Position, Position), Orbits)]]
    forall a. (a -> a -> Bool) -> [a] -> [[a]]
    groupBy ((Position, Position), Orbits)
    -> ((Position, Position), Orbits) -> Bool
    forall {a} {a} {a}.
    Eq a =>
    ((a, a), Orbits) -> ((a, a), Orbits) -> Bool
    grouper ([((Position, Position), Orbits)]
     -> [[((Position, Position), Orbits)]])
    -> ([Maybe ((Position, Position), Orbits)]
        -> [((Position, Position), Orbits)])
    -> [Maybe ((Position, Position), Orbits)]
    -> [[((Position, Position), Orbits)]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (((Position, Position), Orbits)
     -> ((Position, Position), Orbits) -> Ordering)
    -> [((Position, Position), Orbits)]
    -> [((Position, Position), Orbits)]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy ((Position, Position), Orbits)
    -> ((Position, Position), Orbits) -> Ordering
    forall {a} {a} {a}.
    Ord a =>
    ((a, a), Orbits) -> ((a, a), Orbits) -> Ordering
    sorter ([((Position, Position), Orbits)]
     -> [((Position, Position), Orbits)])
    -> ([Maybe ((Position, Position), Orbits)]
        -> [((Position, Position), Orbits)])
    -> [Maybe ((Position, Position), Orbits)]
    -> [((Position, Position), Orbits)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Maybe ((Position, Position), Orbits)]
    -> [((Position, Position), Orbits)]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe ((Position, Position), Orbits)]
     -> [[((Position, Position), Orbits)]])
    -> [Maybe ((Position, Position), Orbits)]
    -> [[((Position, Position), Orbits)]]
    forall a b. (a -> b) -> a -> b
    $ [Maybe ((Position, Position), Orbits)]
    mos
                    mapM_ compressGroup orbitGroups
              mapM_ compressOrbit orbitTags

    -- findTrans has to (part 1) decide, for each destination, "which" of
    -- zero or more source NFA states will be the chosen source.  Then it
    -- has to (part 2) perform the transition or spawn.  It keeps track of
    -- the starting index while doing so, and compares the earliest start
    -- with the stored winners.  (part 3) If some winners are ready to be
    -- released then the future continuation of the search is placed in
    -- "storeNext".  If no winners are ready to be released then the
    -- computation continues immediately.

            findTrans MScratch s
    s1 MScratch s
    s2 SetIndex
    did SetIndex
    did' DT
    dt' DTrans
    dtrans Position
    offset Char
    prev' text
    input' =  {-# SCC "goNext.findTrans" #-} do
              -- findTrans part 0
              -- MAGIC TUNABLE CONSTANT 100 (and 100-1). TODO: (offset .&. 127 == 127) instead?
              Bool -> ST s () -> ST s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not ([Position] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Position]
    orbitTags) Bool -> Bool -> Bool
    && (Position
    offset Position -> Position -> Position
    forall a. Integral a => a -> a -> a
    `rem` Position
    100 Position -> Position -> Bool
    forall a. Eq a => a -> a -> Bool
    == Position
    99)) (MScratch s -> SetIndex -> Position -> ST s ()
    forall {s} {s}.
    (MArray (STUArray s) Position (ST s),
     MArray (STArray s) (Maybe (STUArray s Position Position)) (ST s),
     MArray (STArray s) OrbitLog (ST s)) =>
    MScratch s -> SetIndex -> Position -> ST s ()
    compressOrbits MScratch s
    s1 SetIndex
    did Position
    offset)
              -- findTrans part 1
              let findTransTo :: (Position, IntMap (a, Instructions)) -> ST s ()
    findTransTo (Position
    destIndex,IntMap (a, Instructions)
    sources) | IntMap (a, Instructions) -> Bool
    forall a. IntMap a -> Bool
    IMap.null IntMap (a, Instructions)
    sources =
                    STArray
      s
      Position
      ((Position, Instructions), STUArray s Position Position, OrbitLog)
    -> Position
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> ST s ()
    forall (a :: * -> * -> *) e s i.
    (MArray a e (ST s), Ix i) =>
    a i e -> Position -> e -> ST s ()
    set STArray
      s
      Position
      ((Position, Instructions), STUArray s Position Position, OrbitLog)
    which Position
    destIndex ((-Position
    1,Instructions { newPos :: [(Position, Action)]
    newPos = [(Position
    0,Action
    SetPost)], newOrbits :: Maybe (Position -> OrbitLog -> OrbitLog)
    newOrbits = Maybe (Position -> OrbitLog -> OrbitLog)
    forall a. Maybe a
    Nothing })
                                        ,BlankScratch s -> STUArray s Position Position
    forall s. BlankScratch s -> STUArray s Position Position
    blank_pos BlankScratch s
    blank,OrbitLog
    forall a. Monoid a => a
    mempty)
                                                  | Bool
    otherwise = do
                    let prep :: (Position, (a, Instructions))
    -> ST
         s
         ((Position, Instructions), STUArray s Position Position, OrbitLog)
    prep (Position
    sourceIndex,(a
    _dopa,Instructions
    instructions)) = {-# SCC "goNext.findTrans.prep" #-} do
                          pos <- ST s (STUArray s Position Position)
    -> (STUArray s Position Position
        -> ST s (STUArray s Position Position))
    -> Maybe (STUArray s Position Position)
    -> ST s (STUArray s Position Position)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ([Char] -> ST s (STUArray s Position Position)
    forall a. [Char] -> a
    err ([Char] -> ST s (STUArray s Position Position))
    -> [Char] -> ST s (STUArray s Position Position)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "findTrans,1 : "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++(Position, Position, SetIndex) -> [Char]
    forall a. Show a => a -> [Char]
    show (Position
    sourceIndex,Position
    destIndex,SetIndex
    did')) STUArray s Position Position -> ST s (STUArray s Position Position)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
                                   (Maybe (STUArray s Position Position)
     -> ST s (STUArray s Position Position))
    -> ST s (Maybe (STUArray s Position Position))
    -> ST s (STUArray s Position Position)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< MScratch s
    -> STArray s Position (Maybe (STUArray s Position Position))
    forall s.
    MScratch s
    -> STArray s Position (Maybe (STUArray s Position Position))
    m_pos MScratch s
    s1 STArray s Position (Maybe (STUArray s Position Position))
    -> Position -> ST s (Maybe (STUArray s Position Position))
    forall (a :: * -> * -> *) e s i.
    (MArray a e (ST s), Ix i) =>
    a i e -> Position -> ST s e
    !! Position
    sourceIndex
                          orbit <- m_orbit s1 !! sourceIndex
                          let orbit' = OrbitLog
    -> ((Position -> OrbitLog -> OrbitLog) -> OrbitLog)
    -> Maybe (Position -> OrbitLog -> OrbitLog)
    -> OrbitLog
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe OrbitLog
    orbit (\ Position -> OrbitLog -> OrbitLog
    f -> Position -> OrbitLog -> OrbitLog
    f Position
    offset OrbitLog
    orbit) (Instructions -> Maybe (Position -> OrbitLog -> OrbitLog)
    newOrbits Instructions
    instructions)
                          return ((sourceIndex,instructions),pos,orbit')
                        challenge :: ((Position, Instructions), STUArray s Position Position, OrbitLog)
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> ST
         s
         ((Position, Instructions), STUArray s Position Position, OrbitLog)
    challenge x1 :: ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x1@((Position
    _si1,Instructions
    ins1),STUArray s Position Position
    _p1,OrbitLog
    _o1) x2 :: ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x2@((Position
    _si2,Instructions
    ins2),STUArray s Position Position
    _p2,OrbitLog
    _o2) = {-# SCC "goNext.findTrans.challenge" #-} do
                          check <- C s
    forall s. C s
    comp Position
    offset ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x1 (Instructions -> [(Position, Action)]
    newPos Instructions
    ins1) ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x2 (Instructions -> [(Position, Action)]
    newPos Instructions
    ins2)
                          if check==LT then return x2 else return x1
                    first_rest <- ((Position, (a, Instructions))
     -> ST
          s
          ((Position, Instructions), STUArray s Position Position, OrbitLog))
    -> [(Position, (a, Instructions))]
    -> ST
         s
         [((Position, Instructions), STUArray s Position Position,
           OrbitLog)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Position, (a, Instructions))
    -> ST
         s
         ((Position, Instructions), STUArray s Position Position, OrbitLog)
    forall {s} {a}.
    (MArray (STArray s) (Maybe (STUArray s Position Position)) (ST s),
     MArray (STArray s) OrbitLog (ST s)) =>
    (Position, (a, Instructions))
    -> ST
         s
         ((Position, Instructions), STUArray s Position Position, OrbitLog)
    prep (IntMap (a, Instructions) -> [(Position, (a, Instructions))]
    forall a. IntMap a -> [(Position, a)]
    IMap.toList IntMap (a, Instructions)
    sources)
                    let first:rest = first_rest
                    set which destIndex =<< foldM challenge first rest
              let dl :: [(Position, IntMap (DoPa, Instructions))]
    dl = DTrans -> [(Position, IntMap (DoPa, Instructions))]
    forall a. IntMap a -> [(Position, a)]
    IMap.toList DTrans
    dtrans
              ((Position, IntMap (DoPa, Instructions)) -> ST s ())
    -> [(Position, IntMap (DoPa, Instructions))] -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Position, IntMap (DoPa, Instructions)) -> ST s ()
    forall {a}. (Position, IntMap (a, Instructions)) -> ST s ()
    findTransTo [(Position, IntMap (DoPa, Instructions))]
    dl
              -- findTrans part 2
              let performTransTo :: (Position, b) -> ST s Position
    performTransTo (Position
    destIndex,b
    _) = {-# SCC "goNext.findTrans.performTransTo" #-} do
                    x@((sourceIndex,_instructions),_pos,_orbit') <- STArray
      s
      Position
      ((Position, Instructions), STUArray s Position Position, OrbitLog)
    which STArray
      s
      Position
      ((Position, Instructions), STUArray s Position Position, OrbitLog)
    -> Position
    -> ST
         s
         ((Position, Instructions), STUArray s Position Position, OrbitLog)
    forall (a :: * -> * -> *) e s i.
    (MArray a e (ST s), Ix i) =>
    a i e -> Position -> ST s e
    !! Position
    destIndex
                    if sourceIndex == (-1)
                      then spawnStart b_tags blank destIndex s2 (succ offset)
                      else updateCopy x offset s2 destIndex
              earlyStart <- ([Position] -> Position) -> ST s [Position] -> ST s Position
    forall a b. (a -> b) -> ST s a -> ST s b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Position] -> Position
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    minimum (ST s [Position] -> ST s Position)
    -> ST s [Position] -> ST s Position
    forall a b. (a -> b) -> a -> b
    $ ((Position, IntMap (DoPa, Instructions)) -> ST s Position)
    -> [(Position, IntMap (DoPa, Instructions))] -> ST s [Position]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Position, IntMap (DoPa, Instructions)) -> ST s Position
    forall {b}. (Position, b) -> ST s Position
    performTransTo [(Position, IntMap (DoPa, Instructions))]
    dl
              -- findTrans part 3
              earlyWin <- readSTRef (mq_earliest winQ)
              if earlyWin < earlyStart
                then do
                  winners <- fmap (List.foldl' (\ [WScratch s]
    rest WScratch s
    ws -> WScratch s
    ws WScratch s -> [WScratch s] -> [WScratch s]
    forall a. a -> [a] -> [a]
    : [WScratch s]
    rest) []) $
                               getMQ earlyStart winQ
                  writeSTRef storeNext (next s2 s1 did' dt' (succ offset) prev' input')
                  mapM (tagsToGroupsST aGroups) winners
                else do
                  let offset' = Position -> Position
    forall a. Enum a => a -> a
    succ Position
    offset in seq offset' $ next s2 s1 did' dt' offset' prev' input'

    -- The "newWinnerThenProceed" can find both a new non-empty winner and
    -- a new empty winner.  A new non-empty winner can cause some of the
    -- NFA states that comprise the DFA state to be eliminated, and if the
    -- startState is eliminated then it must then be respawned.  And
    -- imperative flag setting and resetting style is used.
    --
    -- A non-empty winner from the startState might obscure a potential
    -- empty winner (form the startState at the current offset).  This
    -- winEmpty possibility is also checked for. (unit test pattern ".*")
    -- (further test "(.+|.+.)*" on "aa\n")

            {-# INLINE processWinner #-}
            processWinner MScratch s
    s1 SetIndex
    did DT
    dt IntMap Instructions
    w Position
    offset = {-# SCC "goNext.newWinnerThenProceed" #-} do
              let prep :: (Position, Instructions)
    -> ST
         s
         (Position,
          ((Position, Instructions), STUArray s Position Position, OrbitLog))
    prep x :: (Position, Instructions)
    x@(Position
    sourceIndex,Instructions
    instructions) = {-# SCC "goNext.newWinnerThenProceed.prep" #-} do
                    pos <- ST s (STUArray s Position Position)
    -> (STUArray s Position Position
        -> ST s (STUArray s Position Position))
    -> Maybe (STUArray s Position Position)
    -> ST s (STUArray s Position Position)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ([Char] -> ST s (STUArray s Position Position)
    forall a. [Char] -> a
    err [Char]
    "newWinnerThenProceed,1") STUArray s Position Position -> ST s (STUArray s Position Position)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (STUArray s Position Position)
     -> ST s (STUArray s Position Position))
    -> ST s (Maybe (STUArray s Position Position))
    -> ST s (STUArray s Position Position)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< MScratch s
    -> STArray s Position (Maybe (STUArray s Position Position))
    forall s.
    MScratch s
    -> STArray s Position (Maybe (STUArray s Position Position))
    m_pos MScratch s
    s1 STArray s Position (Maybe (STUArray s Position Position))
    -> Position -> ST s (Maybe (STUArray s Position Position))
    forall (a :: * -> * -> *) e s i.
    (MArray a e (ST s), Ix i) =>
    a i e -> Position -> ST s e
    !! Position
    sourceIndex
                    startPos <- pos !! 0
                    orbit <- m_orbit s1 !! sourceIndex
                    let orbit' = OrbitLog
    -> ((Position -> OrbitLog -> OrbitLog) -> OrbitLog)
    -> Maybe (Position -> OrbitLog -> OrbitLog)
    -> OrbitLog
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe OrbitLog
    orbit (\ Position -> OrbitLog -> OrbitLog
    f -> Position -> OrbitLog -> OrbitLog
    f Position
    offset OrbitLog
    orbit) (Instructions -> Maybe (Position -> OrbitLog -> OrbitLog)
    newOrbits Instructions
    instructions)
                    return (startPos,(x,pos,orbit'))
                  challenge :: ((Position, Instructions), STUArray s Position Position, OrbitLog)
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> ST
         s
         ((Position, Instructions), STUArray s Position Position, OrbitLog)
    challenge x1 :: ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x1@((Position
    _si1,Instructions
    ins1),STUArray s Position Position
    _p1,OrbitLog
    _o1) x2 :: ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x2@((Position
    _si2,Instructions
    ins2),STUArray s Position Position
    _p2,OrbitLog
    _o2) = {-# SCC "goNext.newWinnerThenProceed.challenge" #-} do
                    check <- C s
    forall s. C s
    comp Position
    offset ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x1 (Instructions -> [(Position, Action)]
    newPos Instructions
    ins1) ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x2 (Instructions -> [(Position, Action)]
    newPos Instructions
    ins2)
                    if check==LT then return x2 else return x1
              prep'd <- ((Position, Instructions)
     -> ST
          s
          (Position,
           ((Position, Instructions), STUArray s Position Position,
            OrbitLog)))
    -> [(Position, Instructions)]
    -> ST
         s
         [(Position,
           ((Position, Instructions), STUArray s Position Position,
            OrbitLog))]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Position, Instructions)
    -> ST
         s
         (Position,
          ((Position, Instructions), STUArray s Position Position, OrbitLog))
    forall {s}.
    (MArray (STUArray s) Position (ST s),
     MArray (STArray s) (Maybe (STUArray s Position Position)) (ST s),
     MArray (STArray s) OrbitLog (ST s)) =>
    (Position, Instructions)
    -> ST
         s
         (Position,
          ((Position, Instructions), STUArray s Position Position, OrbitLog))
    prep (IntMap Instructions -> [(Position, Instructions)]
    forall a. IntMap a -> [(Position, a)]
    IMap.toList IntMap Instructions
    w)
              let (emptyFalse,emptyTrue) = partition ((offset >) . fst) prep'd
              mayID <- {-# SCC "goNext.newWinnerThenProceed.mayID" #-}
                       case map snd emptyFalse of
                        [] -> Maybe [Position] -> ST s (Maybe [Position])
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe [Position]
    forall a. Maybe a
    Nothing
                        (((Position, Instructions), STUArray s Position Position, OrbitLog)
    first:[((Position, Instructions), STUArray s Position Position,
      OrbitLog)]
    rest) -> do
                          best@((_sourceIndex,_instructions),bp,_orbit') <- (((Position, Instructions), STUArray s Position Position, OrbitLog)
     -> ((Position, Instructions), STUArray s Position Position,
         OrbitLog)
     -> ST
          s
          ((Position, Instructions), STUArray s Position Position, OrbitLog))
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [((Position, Instructions), STUArray s Position Position,
         OrbitLog)]
    -> ST
         s
         ((Position, Instructions), STUArray s Position Position, OrbitLog)
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM ((Position, Instructions), STUArray s Position Position, OrbitLog)
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> ST
         s
         ((Position, Instructions), STUArray s Position Position, OrbitLog)
    forall {s}.
    ((Position, Instructions), STUArray s Position Position, OrbitLog)
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> ST
         s
         ((Position, Instructions), STUArray s Position Position, OrbitLog)
    challenge ((Position, Instructions), STUArray s Position Position, OrbitLog)
    first [((Position, Instructions), STUArray s Position Position,
      OrbitLog)]
    rest
                          newWinner offset best
                          startWin <- bp !! 0
                          let states = SetIndex -> [Position]
    ISet.toAscList SetIndex
    did
                              keepState Position
    i1 = do
                                pos <- ST s (STUArray s Position Position)
    -> (STUArray s Position Position
        -> ST s (STUArray s Position Position))
    -> Maybe (STUArray s Position Position)
    -> ST s (STUArray s Position Position)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ([Char] -> ST s (STUArray s Position Position)
    forall a. [Char] -> a
    err [Char]
    "newWinnerThenProceed,2") STUArray s Position Position -> ST s (STUArray s Position Position)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (STUArray s Position Position)
     -> ST s (STUArray s Position Position))
    -> ST s (Maybe (STUArray s Position Position))
    -> ST s (STUArray s Position Position)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< MScratch s
    -> STArray s Position (Maybe (STUArray s Position Position))
    forall s.
    MScratch s
    -> STArray s Position (Maybe (STUArray s Position Position))
    m_pos MScratch s
    s1 STArray s Position (Maybe (STUArray s Position Position))
    -> Position -> ST s (Maybe (STUArray s Position Position))
    forall (a :: * -> * -> *) e s i.
    (MArray a e (ST s), Ix i) =>
    a i e -> Position -> ST s e
    !! Position
    i1
                                startsAt <- pos !! 0
                                let keep = (Position
    startsAt Position -> Position -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Position
    startWin) Bool -> Bool -> Bool
    || (Position
    offset Position -> Position -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Position
    startsAt)
                                when (not keep) $ do
                                  writeSTRef eliminatedStateFlag True
                                  when (i1 == startState) (writeSTRef eliminatedRespawnFlag True)
                                return keep
                          states' <- filterM keepState states
                          changed <- readSTRef eliminatedStateFlag
                          if changed then return (Just states') else return Nothing
              case emptyTrue of
                [] -> case Position -> IntMap Instructions -> Maybe Instructions
    forall a. Position -> IntMap a -> Maybe a
    IMap.lookup Position
    startState IntMap Instructions
    w of
                       Maybe Instructions
    Nothing -> () -> ST s ()
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                       Just Instructions
    ins -> Position -> Instructions -> ST s ()
    winEmpty Position
    offset Instructions
    ins
                [(Position,
     ((Position, Instructions), STUArray s Position Position, OrbitLog))
    first] -> Position
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> ST s ()
    forall {a} {c}.
    Position
    -> ((a, Instructions), STUArray s Position Position, c) -> ST s ()
    newWinner Position
    offset ((Position,
     ((Position, Instructions), STUArray s Position Position, OrbitLog))
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    forall a b. (a, b) -> b
    snd (Position,
     ((Position, Instructions), STUArray s Position Position, OrbitLog))
    first)
                [(Position,
      ((Position, Instructions), STUArray s Position Position,
       OrbitLog))]
    _ -> [Char] -> ST s ()
    forall a. [Char] -> a
    err [Char]
    "newWinnerThenProceed,3 : too many emptyTrue values"
              case mayID of
                Maybe [Position]
    Nothing -> (SetIndex, DT) -> ST s (SetIndex, DT)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SetIndex
    did,DT
    dt) -- proceedNow s1 s2 did dt offset prev input
                Just [Position]
    states' -> do
                  STRef s Bool -> Bool -> ST s ()
    forall s a. STRef s a -> a -> ST s ()
    writeSTRef STRef s Bool
    eliminatedStateFlag Bool
    False
                  respawn <- STRef s Bool -> ST s Bool
    forall s a. STRef s a -> ST s a
    readSTRef STRef s Bool
    eliminatedRespawnFlag
                  DFA {d_id=did',d_dt=dt'} <-
                    if respawn
                      then do
                        writeSTRef eliminatedRespawnFlag False
                        _ <- spawnStart b_tags blank startState s1 (succ offset)
                        return (Trie.lookupAsc trie (sort (states'++[startState])))
                      else return (Trie.lookupAsc trie states')
                  return (did',dt')

            winEmpty Position
    preTag Instructions
    winInstructions = {-# SCC "goNext.winEmpty" #-} do
              newerPos <- (Position, Position) -> ST s (STUArray s Position Position)
    forall s e.
    MArray (STUArray s) e (ST s) =>
    (Position, Position) -> ST s (STUArray s Position e)
    newA_ (Position, Position)
    b_tags
              copySTU (blank_pos blank) newerPos
              set newerPos 0 preTag
              doActions preTag newerPos (newPos winInstructions)
              putMQ (WScratch newerPos) winQ

            newWinner Position
    preTag ((a
    _sourceIndex,Instructions
    winInstructions),STUArray s Position Position
    oldPos,c
    _newOrbit) = {-# SCC "goNext.newWinner" #-} do
              newerPos <- (Position, Position) -> ST s (STUArray s Position Position)
    forall s e.
    MArray (STUArray s) e (ST s) =>
    (Position, Position) -> ST s (STUArray s Position e)
    newA_ (Position, Position)
    b_tags
              copySTU oldPos newerPos
              doActions preTag newerPos (newPos winInstructions)
              putMQ (WScratch newerPos) winQ

            finalizeWinners = do
              winners <- ([MQA s] -> [WScratch s]) -> ST s [MQA s] -> ST s [WScratch s]
    forall a b. (a -> b) -> ST s a -> ST s b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (([WScratch s] -> MQA s -> [WScratch s])
    -> [WScratch s] -> [MQA s] -> [WScratch s]
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    List.foldl' (\ [WScratch s]
    rest MQA s
    mqa -> MQA s -> WScratch s
    forall s. MQA s -> WScratch s
    mqa_ws MQA s
    mqa WScratch s -> [WScratch s] -> [WScratch s]
    forall a. a -> [a] -> [a]
    : [WScratch s]
    rest) []) (ST s [MQA s] -> ST s [WScratch s])
    -> ST s [MQA s] -> ST s [WScratch s]
    forall a b. (a -> b) -> a -> b
    $
                           STRef s [MQA s] -> ST s [MQA s]
    forall s a. STRef s a -> ST s a
    readSTRef (MQ s -> STRef s [MQA s]
    forall s. MQ s -> STRef s [MQA s]
    mq_list MQ s
    winQ) -- reverses the winner list
              resetMQ winQ
              writeSTRef storeNext (return [])
              mapM (tagsToGroupsST aGroups) winners

        -- goNext then ends with the next statement
        next s1In s2In didIn dtIn offsetIn prevIn inputIn

    {-# INLINE doActions #-}
    doActions :: Position -> STUArray s Tag Position -> [(Tag, Action)] -> ST s ()
    doActions :: forall s.
    Position
    -> STUArray s Position Position -> [(Position, Action)] -> ST s ()
    doActions Position
    preTag STUArray s Position Position
    pos [(Position, Action)]
    ins = ((Position, Action) -> ST s ()) -> [(Position, Action)] -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Position, Action) -> ST s ()
    forall {s}.
    MArray (STUArray s) Position (ST s) =>
    (Position, Action) -> ST s ()
    doAction [(Position, Action)]
    ins where
      postTag :: Position
    postTag = Position -> Position
    forall a. Enum a => a -> a
    succ Position
    preTag
      doAction :: (Position, Action) -> ST s ()
    doAction (Position
    tag,Action
    SetPre) = STUArray s Position Position -> Position -> Position -> ST s ()
    forall (a :: * -> * -> *) e s i.
    (MArray a e (ST s), Ix i) =>
    a i e -> Position -> e -> ST s ()
    set STUArray s Position Position
    pos Position
    tag Position
    preTag
      doAction (Position
    tag,Action
    SetPost) = STUArray s Position Position -> Position -> Position -> ST s ()
    forall (a :: * -> * -> *) e s i.
    (MArray a e (ST s), Ix i) =>
    a i e -> Position -> e -> ST s ()
    set STUArray s Position Position
    pos Position
    tag Position
    postTag
      doAction (Position
    tag,SetVal Position
    v) = STUArray s Position Position -> Position -> Position -> ST s ()
    forall (a :: * -> * -> *) e s i.
    (MArray a e (ST s), Ix i) =>
    a i e -> Position -> e -> ST s ()
    set STUArray s Position Position
    pos Position
    tag Position
    v

    ----

    {-# INLINE mkTest #-}
    mkTest :: Uncons text => Bool -> WhichTest -> Index -> Char -> text -> Bool
    mkTest :: forall text.
    Uncons text =>
    Bool -> WhichTest -> Position -> Char -> text -> Bool
    mkTest Bool
    isMultiline = if Bool
    isMultiline then WhichTest -> Position -> Char -> text -> Bool
    forall text.
    Uncons text =>
    WhichTest -> Position -> Char -> text -> Bool
    test_multiline else WhichTest -> Position -> Char -> text -> Bool
    forall text.
    Uncons text =>
    WhichTest -> Position -> Char -> text -> Bool
    test_singleline

    ----

    {- MUTABLE WINNER QUEUE -}

    data MQA s = MQA {forall s. MQA s -> Position
    mqa_start :: !Position, forall s. MQA s -> WScratch s
    mqa_ws :: !(WScratch s)}

    data MQ s = MQ { forall s. MQ s -> STRef s Position
    mq_earliest :: !(STRef s Position)
                   , forall s. MQ s -> STRef s [MQA s]
    mq_list :: !(STRef s [MQA s])
                   }

    newMQ :: S.ST s (MQ s)
    newMQ :: forall s. ST s (MQ s)
    newMQ = do
      earliest <- Position -> ST s (STRef s Position)
    forall a s. a -> ST s (STRef s a)
    newSTRef Position
    forall a. Bounded a => a
    maxBound
      list <- newSTRef []
      return (MQ earliest list)

    resetMQ :: MQ s -> S.ST s ()
    resetMQ :: forall s. MQ s -> ST s ()
    resetMQ (MQ {mq_earliest :: forall s. MQ s -> STRef s Position
    mq_earliest=STRef s Position
    earliest,mq_list :: forall s. MQ s -> STRef s [MQA s]
    mq_list=STRef s [MQA s]
    list}) = do
      STRef s Position -> Position -> ST s ()
    forall s a. STRef s a -> a -> ST s ()
    writeSTRef STRef s Position
    earliest Position
    forall a. Bounded a => a
    maxBound
      STRef s [MQA s] -> [MQA s] -> ST s ()
    forall s a. STRef s a -> a -> ST s ()
    writeSTRef STRef s [MQA s]
    list []

    putMQ :: WScratch s -> MQ s -> S.ST s ()
    putMQ :: forall s. WScratch s -> MQ s -> ST s ()
    putMQ WScratch s
    ws (MQ {mq_earliest :: forall s. MQ s -> STRef s Position
    mq_earliest=STRef s Position
    earliest,mq_list :: forall s. MQ s -> STRef s [MQA s]
    mq_list=STRef s [MQA s]
    list}) = do
      start <- WScratch s -> STUArray s Position Position
    forall s. WScratch s -> STUArray s Position Position
    w_pos WScratch s
    ws STUArray s Position Position -> Position -> ST s Position
    forall (a :: * -> * -> *) e s i.
    (MArray a e (ST s), Ix i) =>
    a i e -> Position -> ST s e
    !! Position
    0
      let mqa = Position -> WScratch s -> MQA s
    forall s. Position -> WScratch s -> MQA s
    MQA Position
    start WScratch s
    ws
      startE <- readSTRef earliest
      if start <= startE
        then writeSTRef earliest start >> writeSTRef list [mqa]
        else do
      old <- readSTRef list
      let !rest = (MQA s -> Bool) -> [MQA s] -> [MQA s]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (\ MQA s
    m -> Position
    start Position -> Position -> Bool
    forall a. Ord a => a -> a -> Bool
    <= MQA s -> Position
    forall s. MQA s -> Position
    mqa_start MQA s
    m) [MQA s]
    old
          !new = MQA s
    mqa MQA s -> [MQA s] -> [MQA s]
    forall a. a -> [a] -> [a]
    : [MQA s]
    rest
      writeSTRef list new

    getMQ :: Position -> MQ s -> ST s [WScratch s]
    getMQ :: forall s. Position -> MQ s -> ST s [WScratch s]
    getMQ Position
    pos (MQ {mq_earliest :: forall s. MQ s -> STRef s Position
    mq_earliest=STRef s Position
    earliest,mq_list :: forall s. MQ s -> STRef s [MQA s]
    mq_list=STRef s [MQA s]
    list}) = do
      old <- STRef s [MQA s] -> ST s [MQA s]
    forall s a. STRef s a -> ST s a
    readSTRef STRef s [MQA s]
    list
      case span (\MQA s
    m -> Position
    pos Position -> Position -> Bool
    forall a. Ord a => a -> a -> Bool
    <= MQA s -> Position
    forall s. MQA s -> Position
    mqa_start MQA s
    m) old of
        ([],[MQA s]
    ans) -> do
          STRef s Position -> Position -> ST s ()
    forall s a. STRef s a -> a -> ST s ()
    writeSTRef STRef s Position
    earliest Position
    forall a. Bounded a => a
    maxBound
          STRef s [MQA s] -> [MQA s] -> ST s ()
    forall s a. STRef s a -> a -> ST s ()
    writeSTRef STRef s [MQA s]
    list []
          [WScratch s] -> ST s [WScratch s]
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((MQA s -> WScratch s) -> [MQA s] -> [WScratch s]
    forall a b. (a -> b) -> [a] -> [b]
    map MQA s -> WScratch s
    forall s. MQA s -> WScratch s
    mqa_ws [MQA s]
    ans)
        ([MQA s]
    new,[MQA s]
    ans) -> do
          STRef s Position -> Position -> ST s ()
    forall s a. STRef s a -> a -> ST s ()
    writeSTRef STRef s Position
    earliest (MQA s -> Position
    forall s. MQA s -> Position
    mqa_start ([MQA s] -> MQA s
    forall a. HasCallStack => [a] -> a
    last [MQA s]
    new))
          STRef s [MQA s] -> [MQA s] -> ST s ()
    forall s a. STRef s a -> a -> ST s ()
    writeSTRef STRef s [MQA s]
    list [MQA s]
    new
          [WScratch s] -> ST s [WScratch s]
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((MQA s -> WScratch s) -> [MQA s] -> [WScratch s]
    forall a b. (a -> b) -> [a] -> [b]
    map MQA s -> WScratch s
    forall s. MQA s -> WScratch s
    mqa_ws [MQA s]
    ans)

    {- MUTABLE SCRATCH DATA STRUCTURES -}

    data SScratch s = SScratch { forall s. SScratch s -> MScratch s
    _s_1 :: !(MScratch s)
                               , forall s. SScratch s -> MScratch s
    _s_2 :: !(MScratch s)
                               , forall s.
    SScratch s
    -> (MQ s, BlankScratch s,
        STArray
          s
          Position
          ((Position, Instructions), STUArray s Position Position, OrbitLog))
    _s_rest :: !( MQ s
                                            , BlankScratch s
                                            , STArray s Index ((Index,Instructions),STUArray s Tag Position,OrbitLog)
                                            )
                               }
    data MScratch s = MScratch { forall s.
    MScratch s
    -> STArray s Position (Maybe (STUArray s Position Position))
    m_pos :: !(STArray s Index (Maybe (STUArray s Tag Position)))
                               , forall s. MScratch s -> STArray s Position OrbitLog
    m_orbit :: !(STArray s Index OrbitLog)
                               }
    newtype BlankScratch s = BlankScratch { forall s. BlankScratch s -> STUArray s Position Position
    blank_pos :: (STUArray s Tag Position)
                                          }
    newtype WScratch s = WScratch { forall s. WScratch s -> STUArray s Position Position
    w_pos :: (STUArray s Tag Position)
                                  }

    {- DEBUGGING HELPERS -}

    {-
    indent :: String -> String
    indent xs = ' ':' ':xs

    showMS :: MScratch s -> Index -> ST s String
    showMS s i = do
      ma <- m_pos s !! i
      mc <- m_orbit s !! i
      a <- case ma of
            Nothing -> return "No pos"
            Just pos -> fmap show (getAssocs pos)
      let c = show mc
      return $ unlines [ "MScratch, index = "++show i
                       , indent a
                       , indent c]

    showMS2 :: MScratch s -> ST s String
    showMS2 s = do
      (lo,hi) <- getBounds (m_pos s)
      strings <- forM [lo..hi] (showMS s)
      return (unlines strings)

    showWS :: WScratch s -> ST s String
    showWS (WScratch pos) = do
      a <- getAssocs pos
      return $ unlines [ "WScratch"
                       , indent (show a)]
    -}
    {- CREATING INITIAL MUTABLE SCRATCH DATA STRUCTURES -}

    {-# INLINE newA #-}
    newA :: (MArray (STUArray s) e (ST s)) => (Tag,Tag) -> e -> S.ST s (STUArray s Tag e)
    newA :: forall s e.
    MArray (STUArray s) e (ST s) =>
    (Position, Position) -> e -> ST s (STUArray s Position e)
    newA (Position, Position)
    b_tags e
    initial = (Position, Position) -> e -> ST s (STUArray s Position e)
    forall i. Ix i => (i, i) -> e -> ST s (STUArray s i e)
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    (i, i) -> e -> m (a i e)
    newArray (Position, Position)
    b_tags e
    initial

    {-# INLINE newA_ #-}
    newA_ :: (MArray (STUArray s) e (ST s)) => (Tag,Tag) -> S.ST s (STUArray s Tag e)
    newA_ :: forall s e.
    MArray (STUArray s) e (ST s) =>
    (Position, Position) -> ST s (STUArray s Position e)
    newA_ (Position, Position)
    b_tags = (Position, Position) -> ST s (STUArray s Position e)
    forall i. Ix i => (i, i) -> ST s (STUArray s i e)
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    (i, i) -> m (a i e)
    newArray_ (Position, Position)
    b_tags

    newScratch :: (Index,Index) -> (Tag,Tag) -> S.ST s (SScratch s)
    newScratch :: forall s.
    (Position, Position) -> (Position, Position) -> ST s (SScratch s)
    newScratch (Position, Position)
    b_index (Position, Position)
    b_tags = do
      s1 <- (Position, Position) -> ST s (MScratch s)
    forall s. (Position, Position) -> ST s (MScratch s)
    newMScratch (Position, Position)
    b_index
      s2 <- newMScratch b_index
      winQ <- newMQ
      blank <- fmap BlankScratch (newA b_tags (-1))
      which <- (newArray b_index ((-1,err "newScratch which 1"),err "newScratch which 2",err "newScratch which 3"))
      return (SScratch s1 s2 (winQ,blank,which))

    newMScratch :: (Index,Index) -> S.ST s (MScratch s)
    newMScratch :: forall s. (Position, Position) -> ST s (MScratch s)
    newMScratch (Position, Position)
    b_index = do
      pos's <- (Position, Position)
    -> Maybe (STUArray s Position Position)
    -> ST s (STArray s Position (Maybe (STUArray s Position Position)))
    forall i.
    Ix i =>
    (i, i)
    -> Maybe (STUArray s Position Position)
    -> ST s (STArray s i (Maybe (STUArray s Position Position)))
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    (i, i) -> e -> m (a i e)
    newArray (Position, Position)
    b_index Maybe (STUArray s Position Position)
    forall a. Maybe a
    Nothing
      orbit's <- newArray b_index Mon.mempty
      return (MScratch pos's orbit's)

    {- COMPOSE A FUNCTION CLOSURE TO COMPARE TAG VALUES -}

    newtype F s = F ([F s] -> C s)
    type C s = Position
            -> ((Int, Instructions), STUArray s Tag Position, IntMap Orbits)
            -> [(Int, Action)]
            -> ((Int, Instructions), STUArray s Tag Position, IntMap Orbits)
            -> [(Int, Action)]
            -> ST s Ordering

    {-# INLINE orderOf #-}
    orderOf :: Action -> Action -> Ordering
    orderOf :: Action -> Action -> Ordering
    orderOf Action
    post1 Action
    post2 =
      case (Action
    post1,Action
    post2) of
        (Action
    SetPre,Action
    SetPre) -> Ordering
    EQ
        (Action
    SetPost,Action
    SetPost) -> Ordering
    EQ
        (Action
    SetPre,Action
    SetPost) -> Ordering
    LT
        (Action
    SetPost,Action
    SetPre) -> Ordering
    GT
        (SetVal Position
    v1,SetVal Position
    v2) -> Position -> Position -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare Position
    v1 Position
    v2
        (Action, Action)
    _ -> [Char] -> Ordering
    forall a. [Char] -> a
    err ([Char] -> Ordering) -> [Char] -> Ordering
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "bestTrans.compareWith.choose sees incomparable "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++(Action, Action) -> [Char]
    forall a. Show a => a -> [Char]
    show (Action
    post1,Action
    post2)

    ditzyComp'3 :: forall s. Array Tag OP -> C s
    ditzyComp'3 :: forall s. Array Position OP -> C s
    ditzyComp'3 Array Position OP
    aTagOP = C s
    comp0 where
      (F [F s] -> C s
    comp1:[F s]
    compsRest) = Position -> [F s]
    allcomps Position
    1

      comp0 :: C s
      comp0 :: C s
    comp0 Position
    preTag x1 :: ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x1@((Position, Instructions)
    _state1,STUArray s Position Position
    pos1,OrbitLog
    _orbit1') [(Position, Action)]
    np1 x2 :: ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x2@((Position, Instructions)
    _state2,STUArray s Position Position
    pos2,OrbitLog
    _orbit2') [(Position, Action)]
    np2 = do
        c <- (Position -> Position -> Ordering)
    -> ST s Position -> ST s Position -> ST s Ordering
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 Position -> Position -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (STUArray s Position Position
    pos2STUArray s Position Position -> Position -> ST s Position
    forall (a :: * -> * -> *) e s i.
    (MArray a e (ST s), Ix i) =>
    a i e -> Position -> ST s e
    !!Position
    0) (STUArray s Position Position
    pos1STUArray s Position Position -> Position -> ST s Position
    forall (a :: * -> * -> *) e s i.
    (MArray a e (ST s), Ix i) =>
    a i e -> Position -> ST s e
    !!Position
    0) -- reversed since Minimize
        case c of
          Ordering
    EQ -> [F s] -> C s
    comp1 [F s]
    compsRest Position
    preTag ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x1 [(Position, Action)]
    np1 ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x2 [(Position, Action)]
    np2
          Ordering
    answer -> Ordering -> ST s Ordering
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Ordering
    answer

      allcomps :: Tag -> [F s]
      allcomps :: Position -> [F s]
    allcomps Position
    tag | Position
    tag Position -> Position -> Bool
    forall a. Ord a => a -> a -> Bool
    > Position
    top = [([F s] -> C s) -> F s
    forall s. ([F s] -> C s) -> F s
    F (\ [F s]
    _ Position
    _ ((Position, Instructions), STUArray s Position Position, OrbitLog)
    _ [(Position, Action)]
    _ ((Position, Instructions), STUArray s Position Position, OrbitLog)
    _ [(Position, Action)]
    _ -> Ordering -> ST s Ordering
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Ordering
    EQ)]
                   | Bool
    otherwise =
        case Array Position OP
    aTagOP Array Position OP -> Position -> OP
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> i -> e
    ! Position
    tag of
          OP
    Orbit -> ([F s] -> C s) -> F s
    forall s. ([F s] -> C s) -> F s
    F (Position -> [F s] -> C s
    forall {s}.
    Position
    -> [F s]
    -> Position
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ST s Ordering
    challenge_Orb Position
    tag) F s -> [F s] -> [F s]
    forall a. a -> [a] -> [a]
    : Position -> [F s]
    allcomps (Position -> Position
    forall a. Enum a => a -> a
    succ Position
    tag)
          OP
    Maximize -> ([F s] -> C s) -> F s
    forall s. ([F s] -> C s) -> F s
    F (Position -> [F s] -> C s
    forall {s}.
    Position
    -> [F s]
    -> Position
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ST s Ordering
    challenge_Max Position
    tag) F s -> [F s] -> [F s]
    forall a. a -> [a] -> [a]
    : Position -> [F s]
    allcomps (Position -> Position
    forall a. Enum a => a -> a
    succ Position
    tag)
          OP
    Ignore -> ([F s] -> C s) -> F s
    forall s. ([F s] -> C s) -> F s
    F (Position -> [F s] -> C s
    forall {s}.
    Position
    -> [F s]
    -> Position
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ST s Ordering
    challenge_Ignore Position
    tag) F s -> [F s] -> [F s]
    forall a. a -> [a] -> [a]
    : Position -> [F s]
    allcomps (Position -> Position
    forall a. Enum a => a -> a
    succ Position
    tag)
          OP
    Minimize -> [Char] -> [F s]
    forall a. [Char] -> a
    err [Char]
    "allcomps Minimize"
       where top :: Position
    top = (Position, Position) -> Position
    forall a b. (a, b) -> b
    snd (Array Position OP -> (Position, Position)
    forall i. Ix i => Array i OP -> (i, i)
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> (i, i)
    bounds Array Position OP
    aTagOP)

      challenge_Ignore :: Position
    -> [F s]
    -> Position
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ST s Ordering
    challenge_Ignore !Position
    tag (F [F s]
    -> Position
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ST s Ordering
    next:[F s]
    comps) Position
    preTag ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x1 [(Position, Action)]
    np1 ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x2 [(Position, Action)]
    np2 =
        case [(Position, Action)]
    np1 of
          ((Position
    t1,Action
    _):[(Position, Action)]
    rest1) | Position
    t1Position -> Position -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Position
    tag ->
            case [(Position, Action)]
    np2 of
              ((Position
    t2,Action
    _):[(Position, Action)]
    rest2) | Position
    t2Position -> Position -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Position
    tag -> [F s]
    -> Position
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ST s Ordering
    next [F s]
    comps Position
    preTag ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x1 [(Position, Action)]
    rest1 ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x2 [(Position, Action)]
    rest2
              [(Position, Action)]
    _ -> [F s]
    -> Position
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ST s Ordering
    next [F s]
    comps Position
    preTag ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x1 [(Position, Action)]
    rest1 ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x2 [(Position, Action)]
    np2
          [(Position, Action)]
    _ -> do
            case [(Position, Action)]
    np2 of
              ((Position
    t2,Action
    _):[(Position, Action)]
    rest2) | Position
    t2Position -> Position -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Position
    tag -> [F s]
    -> Position
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ST s Ordering
    next [F s]
    comps Position
    preTag ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x1 [(Position, Action)]
    np1 ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x2 [(Position, Action)]
    rest2
              [(Position, Action)]
    _ ->  [F s]
    -> Position
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ST s Ordering
    next [F s]
    comps Position
    preTag ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x1 [(Position, Action)]
    np1 ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x2 [(Position, Action)]
    np2
      challenge_Ignore Position
    _ [] Position
    _ ((Position, Instructions), STUArray s Position Position, OrbitLog)
    _ [(Position, Action)]
    _ ((Position, Instructions), STUArray s Position Position, OrbitLog)
    _ [(Position, Action)]
    _ = [Char] -> ST s Ordering
    forall a. [Char] -> a
    err [Char]
    "impossible 2347867"

      challenge_Max :: Position
    -> [F s]
    -> Position
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ST s Ordering
    challenge_Max !Position
    tag (F [F s]
    -> Position
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ST s Ordering
    next:[F s]
    comps) Position
    preTag x1 :: ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x1@((Position, Instructions)
    _state1,STUArray s Position Position
    pos1,OrbitLog
    _orbit1') [(Position, Action)]
    np1 x2 :: ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x2@((Position, Instructions)
    _state2,STUArray s Position Position
    pos2,OrbitLog
    _orbit2') [(Position, Action)]
    np2 =
        case [(Position, Action)]
    np1 of
          ((Position
    t1,Action
    b1):[(Position, Action)]
    rest1) | Position
    t1Position -> Position -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Position
    tag ->
            case [(Position, Action)]
    np2 of
              ((Position
    t2,Action
    b2):[(Position, Action)]
    rest2) | Position
    t2Position -> Position -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Position
    tag ->
                if Action
    b1Action -> Action -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Action
    b2 then [F s]
    -> Position
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ST s Ordering
    next [F s]
    comps Position
    preTag ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x1 [(Position, Action)]
    rest1 ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x2 [(Position, Action)]
    rest2
                  else Ordering -> ST s Ordering
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Action -> Action -> Ordering
    orderOf Action
    b1 Action
    b2)
              [(Position, Action)]
    _ -> do
                p2 <- STUArray s Position Position
    pos2 STUArray s Position Position -> Position -> ST s Position
    forall (a :: * -> * -> *) e s i.
    (MArray a e (ST s), Ix i) =>
    a i e -> Position -> ST s e
    !! Position
    tag
                let p1 = case Action
    b1 of Action
    SetPre -> Position
    preTag
                                    Action
    SetPost -> Position -> Position
    forall a. Enum a => a -> a
    succ Position
    preTag
                                    SetVal Position
    v -> Position
    v
                if p1==p2 then next comps preTag x1 rest1 x2 np2
                  else return (compare p1 p2)
          [(Position, Action)]
    _ -> do
            p1 <- STUArray s Position Position
    pos1 STUArray s Position Position -> Position -> ST s Position
    forall (a :: * -> * -> *) e s i.
    (MArray a e (ST s), Ix i) =>
    a i e -> Position -> ST s e
    !! Position
    tag
            case np2 of
              ((Position
    t2,Action
    b2):[(Position, Action)]
    rest2) | Position
    t2Position -> Position -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Position
    tag -> do
                let p2 :: Position
    p2 = case Action
    b2 of Action
    SetPre -> Position
    preTag
                                    Action
    SetPost -> Position -> Position
    forall a. Enum a => a -> a
    succ Position
    preTag
                                    SetVal Position
    v -> Position
    v
                if Position
    p1Position -> Position -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Position
    p2 then [F s]
    -> Position
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ST s Ordering
    next [F s]
    comps Position
    preTag ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x1 [(Position, Action)]
    np1 ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x2 [(Position, Action)]
    rest2
                  else Ordering -> ST s Ordering
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Position -> Position -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare Position
    p1 Position
    p2)
              [(Position, Action)]
    _ -> do
                p2 <- STUArray s Position Position
    pos2 STUArray s Position Position -> Position -> ST s Position
    forall (a :: * -> * -> *) e s i.
    (MArray a e (ST s), Ix i) =>
    a i e -> Position -> ST s e
    !! Position
    tag
                if p1==p2 then next comps preTag x1 np1 x2 np2
                  else return (compare p1 p2)
      challenge_Max Position
    _ [] Position
    _ ((Position, Instructions), STUArray s Position Position, OrbitLog)
    _ [(Position, Action)]
    _ ((Position, Instructions), STUArray s Position Position, OrbitLog)
    _ [(Position, Action)]
    _ = [Char] -> ST s Ordering
    forall a. [Char] -> a
    err [Char]
    "impossible 9384324"

      challenge_Orb :: Position
    -> [F s]
    -> Position
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ST s Ordering
    challenge_Orb !Position
    tag (F [F s]
    -> Position
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ST s Ordering
    next:[F s]
    comps) Position
    preTag x1 :: ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x1@((Position, Instructions)
    _state1,STUArray s Position Position
    _pos1,OrbitLog
    orbit1') [(Position, Action)]
    np1 x2 :: ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x2@((Position, Instructions)
    _state2,STUArray s Position Position
    _pos2,OrbitLog
    orbit2') [(Position, Action)]
    np2 =
        let s1 :: Maybe Orbits
    s1 = Position -> OrbitLog -> Maybe Orbits
    forall a. Position -> IntMap a -> Maybe a
    IMap.lookup Position
    tag OrbitLog
    orbit1'
            s2 :: Maybe Orbits
    s2 = Position -> OrbitLog -> Maybe Orbits
    forall a. Position -> IntMap a -> Maybe a
    IMap.lookup Position
    tag OrbitLog
    orbit2'
        in case (Maybe Orbits
    s1,Maybe Orbits
    s2) of
             (Maybe Orbits
    Nothing,Maybe Orbits
    Nothing) -> [F s]
    -> Position
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ST s Ordering
    next [F s]
    comps Position
    preTag ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x1 [(Position, Action)]
    np1 ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x2 [(Position, Action)]
    np2
             (Just Orbits
    o1,Just Orbits
    o2) | Orbits -> Bool
    inOrbit Orbits
    o1 Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Orbits -> Bool
    inOrbit Orbits
    o2 ->
                case Maybe Position -> Maybe Position -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (Orbits -> Maybe Position
    ordinal Orbits
    o1) (Orbits -> Maybe Position
    ordinal Orbits
    o2) Ordering -> Ordering -> Ordering
    forall a. Monoid a => a -> a -> a
    `mappend`
                     ViewL Position -> ViewL Position -> Ordering
    comparePos (Seq Position -> ViewL Position
    forall a. Seq a -> ViewL a
    viewl (Orbits -> Seq Position
    getOrbits Orbits
    o1)) (Seq Position -> ViewL Position
    forall a. Seq a -> ViewL a
    viewl (Orbits -> Seq Position
    getOrbits Orbits
    o2)) of
                  Ordering
    EQ -> [F s]
    -> Position
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ((Position, Instructions), STUArray s Position Position,
        OrbitLog)
    -> [(Position, Action)]
    -> ST s Ordering
    next [F s]
    comps Position
    preTag ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x1 [(Position, Action)]
    np1 ((Position, Instructions), STUArray s Position Position, OrbitLog)
    x2 [(Position, Action)]
    np2
                  Ordering
    answer -> Ordering -> ST s Ordering
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Ordering
    answer
             (Maybe Orbits, Maybe Orbits)
    _ -> [Char] -> ST s Ordering
    forall a. [Char] -> a
    err ([Char] -> ST s Ordering) -> [Char] -> ST s Ordering
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unlines [ [Char]
    "challenge_Orb is too stupid to handle mismatched orbit data :"
                               , (Position, Position, [(Position, Action)], [(Position, Action)])
    -> [Char]
    forall a. Show a => a -> [Char]
    show(Position
    tag,Position
    preTag,[(Position, Action)]
    np1,[(Position, Action)]
    np2)
                               , Maybe Orbits -> [Char]
    forall a. Show a => a -> [Char]
    show Maybe Orbits
    s1
                               , Maybe Orbits -> [Char]
    forall a. Show a => a -> [Char]
    show Maybe Orbits
    s2
                               ]
      challenge_Orb Position
    _ [] Position
    _ ((Position, Instructions), STUArray s Position Position, OrbitLog)
    _ [(Position, Action)]
    _ ((Position, Instructions), STUArray s Position Position, OrbitLog)
    _ [(Position, Action)]
    _ = [Char] -> ST s Ordering
    forall a. [Char] -> a
    err [Char]
    "impossible 0298347"

    comparePos :: (ViewL Position) -> (ViewL Position) -> Ordering
    comparePos :: ViewL Position -> ViewL Position -> Ordering
    comparePos ViewL Position
    EmptyL ViewL Position
    EmptyL = Ordering
    EQ
    comparePos ViewL Position
    EmptyL ViewL Position
    _      = Ordering
    GT
    comparePos ViewL Position
    _      ViewL Position
    EmptyL = Ordering
    LT
    comparePos (Position
    p1 :< Seq Position
    ps1) (Position
    p2 :< Seq Position
    ps2) =
      Position -> Position -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare Position
    p1 Position
    p2 Ordering -> Ordering -> Ordering
    forall a. Monoid a => a -> a -> a
    `mappend` ViewL Position -> ViewL Position -> Ordering
    comparePos (Seq Position -> ViewL Position
    forall a. Seq a -> ViewL a
    viewl Seq Position
    ps1) (Seq Position -> ViewL Position
    forall a. Seq a -> ViewL a
    viewl Seq Position
    ps2)

    {- CONVERT WINNERS TO MATCHARRAY -}
    tagsToGroupsST :: forall s. Array GroupIndex [GroupInfo] -> WScratch s -> S.ST s MatchArray
    tagsToGroupsST :: forall s.
    Array Position [GroupInfo] -> WScratch s -> ST s MatchArray
    tagsToGroupsST Array Position [GroupInfo]
    aGroups (WScratch {w_pos :: forall s. WScratch s -> STUArray s Position Position
    w_pos=STUArray s Position Position
    pos})= do
      let b_max :: Position
    b_max = (Position, Position) -> Position
    forall a b. (a, b) -> b
    snd (Array Position [GroupInfo] -> (Position, Position)
    forall i. Ix i => Array i [GroupInfo] -> (i, i)
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> (i, i)
    bounds (Array Position [GroupInfo]
    aGroups))
      ma <- (Position, Position)
    -> (Position, Position)
    -> ST s (STArray s Position (Position, Position))
    forall i.
    Ix i =>
    (i, i)
    -> (Position, Position) -> ST s (STArray s i (Position, Position))
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    (i, i) -> e -> m (a i e)
    newArray (Position
    0,Position
    b_max) (-Position
    1,Position
    0) :: ST s (STArray s Int (MatchOffset,MatchLength))
      startPos0 <- pos !! 0
      stopPos0 <- pos !! 1
      set ma 0 (startPos0,stopPos0-startPos0)
      let act Position
    _this_index [] = () -> ST s ()
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          act Position
    this_index ((GroupInfo Position
    _ Position
    parent Position
    start Position
    stop Position
    flagtag):[GroupInfo]
    gs) = do
            flagVal <- STUArray s Position Position
    pos STUArray s Position Position -> Position -> ST s Position
    forall (a :: * -> * -> *) e s i.
    (MArray a e (ST s), Ix i) =>
    a i e -> Position -> ST s e
    !! Position
    flagtag
            if (-1) == flagVal then act this_index gs
              else do
            startPos <- pos !! start
            stopPos <- pos !! stop
            (startParent,lengthParent) <- ma !! parent
            let ok = (Position
    0 Position -> Position -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Position
    startParent Bool -> Bool -> Bool
    &&
                      Position
    0 Position -> Position -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Position
    lengthParent Bool -> Bool -> Bool
    &&
                      Position
    startParent Position -> Position -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Position
    startPos Bool -> Bool -> Bool
    &&
                      Position
    stopPos Position -> Position -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Position
    startPos Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Position
    lengthParent)
            if not ok then act this_index gs
              else set ma this_index (startPos,stopPos-startPos)
      forM_ (range (1,b_max)) $ (\Position
    i -> Position -> [GroupInfo] -> ST s ()
    forall {s}.
    (MArray (STUArray s) Position (ST s),
     MArray (STArray s) (Position, Position) (ST s)) =>
    Position -> [GroupInfo] -> ST s ()
    act Position
    i (Array Position [GroupInfo]
    aGroupsArray Position [GroupInfo] -> Position -> [GroupInfo]
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> i -> e
    !Position
    i))
      unsafeFreeze ma

    {- MUTABLE TAGGED TRANSITION (returning Tag-0 value) -}

    {-# INLINE spawnStart #-}
    -- Reset the entry at "Index", or allocate such an entry.
    -- set tag 0 to the "Position"
    spawnStart :: (Tag,Tag) -> BlankScratch s -> Index -> MScratch s -> Position -> S.ST s Position
    spawnStart :: forall s.
    (Position, Position)
    -> BlankScratch s
    -> Position
    -> MScratch s
    -> Position
    -> ST s Position
    spawnStart (Position, Position)
    b_tags (BlankScratch STUArray s Position Position
    blankPos) Position
    i MScratch s
    s1 Position
    thisPos = do
      oldPos <- MScratch s
    -> STArray s Position (Maybe (STUArray s Position Position))
    forall s.
    MScratch s
    -> STArray s Position (Maybe (STUArray s Position Position))
    m_pos MScratch s
    s1 STArray s Position (Maybe (STUArray s Position Position))
    -> Position -> ST s (Maybe (STUArray s Position Position))
    forall (a :: * -> * -> *) e s i.
    (MArray a e (ST s), Ix i) =>
    a i e -> Position -> ST s e
    !! Position
    i
      pos <- case oldPos of
               Maybe (STUArray s Position Position)
    Nothing -> do
                 pos' <- (Position, Position) -> ST s (STUArray s Position Position)
    forall s e.
    MArray (STUArray s) e (ST s) =>
    (Position, Position) -> ST s (STUArray s Position e)
    newA_ (Position, Position)
    b_tags
                 set (m_pos s1) i (Just pos')
                 return pos'
               Just STUArray s Position Position
    pos -> STUArray s Position Position -> ST s (STUArray s Position Position)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return STUArray s Position Position
    pos
      copySTU blankPos pos
      set (m_orbit s1) i $! mempty
      set pos 0 thisPos
      return thisPos

    {-# INLINE updateCopy #-}
    updateCopy :: ((Index, Instructions), STUArray s Tag Position, OrbitLog)
               -> Index
               -> MScratch s
               -> Int
               -> ST s Position
    updateCopy :: forall s.
    ((Position, Instructions), STUArray s Position Position, OrbitLog)
    -> Position -> MScratch s -> Position -> ST s Position
    updateCopy ((Position
    _i1,Instructions
    instructions),STUArray s Position Position
    oldPos,OrbitLog
    newOrbit) Position
    preTag MScratch s
    s2 Position
    i2 = do
      b_tags <- STUArray s Position Position -> ST s (Position, Position)
    forall i. Ix i => STUArray s i Position -> ST s (i, i)
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    a i e -> m (i, i)
    getBounds STUArray s Position Position
    oldPos
      newerPos <- maybe (do
        a <- newA_ b_tags
        set (m_pos s2) i2 (Just a)
        return a) return =<< m_pos s2 !! i2
      copySTU oldPos newerPos
      doActions preTag newerPos (newPos instructions)
      set (m_orbit s2) i2 $! newOrbit
      newerPos !! 0

    {- USING memcpy TO COPY STUARRAY DATA -}

    -- #ifdef __GLASGOW_HASKELL__
    foreign import ccall unsafe "memcpy"
        memcpyIO :: MutableByteArray# RealWorld -> MutableByteArray# RealWorld -> Int# -> IO (Ptr a)

    memcpyST :: MutableByteArray# s -> MutableByteArray# s -> Int# -> State# s -> (# State# s, Ptr a #)
    memcpyST :: forall s a.
    MutableByteArray# s
    -> MutableByteArray# s -> Int# -> State# s -> (# State# s, Ptr a #)
    memcpyST = (MutableByteArray# RealWorld
     -> MutableByteArray# RealWorld -> Int# -> IO (Ptr (ZonkAny 0)))
    -> MutableByteArray# s
    -> MutableByteArray# s
    -> Int#
    -> State# s
    -> (# State# s, Ptr a #)
    forall a b. a -> b
    unsafeCoerce MutableByteArray# RealWorld
    -> MutableByteArray# RealWorld -> Int# -> IO (Ptr (ZonkAny 0))
    forall a.
    MutableByteArray# RealWorld
    -> MutableByteArray# RealWorld -> Int# -> IO (Ptr a)
    memcpyIO

    {-
    Prelude Data.Array.Base> :i STUArray
    data STUArray s i e
      = STUArray !i !i !Int (GHC.Prim.MutableByteArray# s)
      -- Defined in Data.Array.Base
    -}
    -- This has been updated for ghc 6.8.3 and still works with ghc 6.10.1
    {-# INLINE copySTU #-}
    copySTU :: (Show i,Ix i,MArray (STUArray s) e (S.ST s)) => STUArray s i e -> STUArray s i e -> S.ST s () -- (STUArray s i e)
    copySTU :: forall i s e.
    (Show i, Ix i, MArray (STUArray s) e (ST s)) =>
    STUArray s i e -> STUArray s i e -> ST s ()
    copySTU _source :: STUArray s i e
    _source@(STUArray i
    _ i
    _ Position
    _ MutableByteArray# s
    msource) _destination :: STUArray s i e
    _destination@(STUArray i
    _ i
    _ Position
    _ MutableByteArray# s
    mdest) =
    -- do b1 <- getBounds s1
    --  b2 <- getBounds s2
    --  when (b1/=b2) (error ("\n\nWTF copySTU: "++show (b1,b2)))
      STRep s () -> ST s ()
    forall s a. STRep s a -> ST s a
    ST (STRep s () -> ST s ()) -> STRep s () -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ \State# s
    s1# ->
        case MutableByteArray# s -> State# s -> (# State# s, Int# #)
    forall d. MutableByteArray# d -> State# d -> (# State# d, Int# #)
    getSizeofMutableByteArray# MutableByteArray# s
    msource State# s
    s1# of { (# State# s
    s1'#, Int#
    n# #) ->
        case MutableByteArray# s
    -> MutableByteArray# s
    -> Int#
    -> State# s
    -> (# State# s, Ptr (ZonkAny 1) #)
    forall s a.
    MutableByteArray# s
    -> MutableByteArray# s -> Int# -> State# s -> (# State# s, Ptr a #)
    memcpyST MutableByteArray# s
    mdest MutableByteArray# s
    msource Int#
    n# State# s
    s1'# of { (# State# s
    s2#, Ptr (ZonkAny 1)
    _ #) ->
        (# State# s
    s2#, () #) }}
    {-
    -- #else /* !__GLASGOW_HASKELL__ */

    copySTU :: (MArray (STUArray s) e (S.ST s))=> STUArray s Tag e -> STUArray s Tag e -> S.ST s (STUArray s i e)
    copySTU source destination = do
      b@(start,stop) <- getBounds source
      b' <- getBounds destination
      -- traceCopy ("> copySTArray "++show b) $ do
      when (b/=b') (fail $ "Text.Regex.TDFA.RunMutState copySTUArray bounds mismatch"++show (b,b'))
      forM_ (range b) $ \index ->
        set destination index =<< source !! index
      return destination
    -- #endif /* !__GLASGOW_HASKELL__ */
    -}