-- | This is the non-capturing form of Text.Regex.TDFA.NewDFA.String
module Text.Regex.TDFA.NewDFA.Engine_NC(execMatch) where

import Control.Monad(when,join,filterM)
import Data.Array.Base(unsafeRead,unsafeWrite)
import Prelude hiding ((!!))

import Data.Array.MArray(MArray(..))
import Data.Array.Unsafe(unsafeFreeze)
import Data.Array.IArray(Ix)
import Data.Array.ST(STArray,STUArray)
import qualified Data.IntMap.CharMap2 as CMap(findWithDefault)
import qualified Data.IntMap as IMap(null,toList,keys,member)
import qualified Data.IntSet as ISet(toAscList)
import Data.STRef(STRef,newSTRef,readSTRef,writeSTRef)
import qualified Control.Monad.ST.Lazy as L(runST,strictToLazyST)
import qualified Control.Monad.ST.Strict as S(ST)
import Data.Sequence(Seq)
import qualified Data.ByteString.Char8 as SBS(ByteString)
import qualified Data.ByteString.Lazy.Char8 as LBS(ByteString)

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 Debug.Trace

-- trace :: String -> a -> a
-- trace _ a = a

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_NC"  [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 -> Int -> ST s e
(!!) = a i e -> Int -> ST s e
forall i. Ix i => a i e -> Int -> ST s e
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> 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 -> Int -> e -> ST s ()
set = a i e -> Int -> e -> ST s ()
forall i. Ix i => a i e -> Int -> e -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> 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] #-}
execMatch :: Uncons text => Regex -> Position -> Char -> text -> [MatchArray]
execMatch :: forall text.
Uncons text =>
Regex -> Int -> Char -> text -> [MatchArray]
execMatch (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 -> Int
regex_init = Int
startState
                 , regex_b_index :: Regex -> (Int, Int)
regex_b_index = (Int, Int)
b_index
                 , regex_trie :: Regex -> TrieSet DFA
regex_trie = TrieSet DFA
trie
                 , regex_compOptions :: Regex -> CompOption
regex_compOptions = CompOption { multiline :: CompOption -> Bool
multiline = Bool
newline } } )
          Int
offsetIn Char
prevIn text
inputIn = (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 where

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

  runCaptureGroup :: 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 []
                    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 STRef s (ST s [MatchArray])
storeNext = {-# SCC "goNext" #-} do
    (SScratch s1In s2In winQ) <- (Int, Int) -> ST s (SScratch s)
forall s. (Int, Int) -> ST s (SScratch s)
newScratch (Int, Int)
b_index
    set s1In startState offsetIn
    writeSTRef storeNext (err "obtainNext called while goNext is running!")
    eliminatedStateFlag <- newSTRef False
    let next a i Int
s1 a i Int
s2 SetIndex
did DT
dt Int
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 -> Int -> Char -> text -> Bool
test WhichTest
wt Int
offset Char
prev text
input
                then a i Int
-> a i Int
-> SetIndex
-> DT
-> Int
-> Char
-> text
-> ST s [MatchArray]
next a i Int
s1 a i Int
s2 SetIndex
did DT
a Int
offset Char
prev text
input
                else a i Int
-> a i Int
-> SetIndex
-> DT
-> Int
-> Char
-> text
-> ST s [MatchArray]
next a i Int
s1 a i Int
s2 SetIndex
did DT
b Int
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') -> do
                      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} ->
                          a i Int
-> a i Int
-> SetIndex
-> DT
-> DTrans
-> Int
-> Char
-> text
-> ST s [MatchArray]
findTrans a i Int
s1 a i Int
s2 SetIndex
did' DT
dt' DTrans
dtrans Int
offset Char
c text
input'
              | Bool
otherwise -> do
                  (did',dt') <- a i Int
-> SetIndex
-> DT
-> IntMap Instructions
-> Int
-> ST s (SetIndex, DT)
forall {a :: * -> * -> *} {i} {a}.
(MArray a Int (ST s), Ix i) =>
a i Int -> SetIndex -> DT -> IntMap a -> Int -> ST s (SetIndex, DT)
processWinner a i Int
s1 SetIndex
did DT
dt IntMap Instructions
w Int
offset
                  next' s1 s2 did' dt' offset prev input

        next' a i Int
s1 a i Int
s2 SetIndex
did DT
dt Int
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 -> Int -> Char -> text -> Bool
test WhichTest
wt Int
offset Char
prev text
input
                then a i Int
-> a i Int
-> SetIndex
-> DT
-> Int
-> Char
-> text
-> ST s [MatchArray]
next' a i Int
s1 a i Int
s2 SetIndex
did DT
a Int
offset Char
prev text
input
                else a i Int
-> a i Int
-> SetIndex
-> DT
-> Int
-> Char
-> text
-> ST s [MatchArray]
next' a i Int
s1 a i Int
s2 SetIndex
did DT
b Int
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') -> do
                  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} ->
                      a i Int
-> a i Int
-> SetIndex
-> DT
-> DTrans
-> Int
-> Char
-> text
-> ST s [MatchArray]
findTrans a i Int
s1 a i Int
s2 SetIndex
did' DT
dt' DTrans
dtrans Int
offset Char
c text
input'

        findTrans a i Int
s1 a i Int
s2 SetIndex
did' DT
dt' DTrans
dtrans Int
offset Char
prev' text
input' =  {-# SCC "goNext.findTrans" #-} do
          --
          let findTransTo :: (Int, IntMap a) -> ST s Int
findTransTo (Int
destIndex,IntMap a
sources) = do
                val <- if IntMap a -> Bool
forall a. IntMap a -> Bool
IMap.null IntMap a
sources then Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int
forall a. Enum a => a -> a
succ Int
offset)
                         else Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ST s Int) -> ([Int] -> Int) -> [Int] -> ST s Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Int] -> ST s Int) -> ST s [Int] -> ST s Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Int -> ST s Int) -> [Int] -> ST s [Int]
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 (a i Int
s1 a i Int -> Int -> ST s Int
forall (a :: * -> * -> *) e s i.
(MArray a e (ST s), Ix i) =>
a i e -> Int -> ST s e
!!) (IntMap a -> [Int]
forall a. IntMap a -> [Int]
IMap.keys IntMap a
sources)
                set s2 destIndex val
                return val
          earlyStart <- ([Int] -> Int) -> ST s [Int] -> ST s Int
forall a b. (a -> b) -> ST s a -> ST s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (ST s [Int] -> ST s Int) -> ST s [Int] -> ST s Int
forall a b. (a -> b) -> a -> b
$ ((Int, IntMap (DoPa, Instructions)) -> ST s Int)
-> [(Int, IntMap (DoPa, Instructions))] -> ST s [Int]
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 (Int, IntMap (DoPa, Instructions)) -> ST s Int
forall {s} {a}.
(MArray a Int (ST s), MArray a Int (ST s)) =>
(Int, IntMap a) -> ST s Int
findTransTo (DTrans -> [(Int, IntMap (DoPa, Instructions))]
forall a. IntMap a -> [(Int, a)]
IMap.toList DTrans
dtrans)
          --
          earlyWin <- readSTRef (mq_earliest winQ)
          if earlyWin < earlyStart
            then do
              winnersR <- getMQ earlyStart winQ
              writeSTRef storeNext (next s2 s1 did' dt' (succ offset) prev' input')
              mapM wsToGroup (reverse winnersR)
            else do
              let offset' = Int -> Int
forall a. Enum a => a -> a
succ Int
offset in seq offset' $ next s2 s1 did' dt' offset' prev' input'

        processWinner a i Int
s1 SetIndex
did DT
dt IntMap a
w Int
offset = {-# SCC "goNext.newWinnerThenProceed" #-} do
          let getStart :: (Int, b) -> ST s Int
getStart (Int
sourceIndex,b
_) = a i Int
s1 a i Int -> Int -> ST s Int
forall (a :: * -> * -> *) e s i.
(MArray a e (ST s), Ix i) =>
a i e -> Int -> ST s e
!! Int
sourceIndex
          vals <- ((Int, a) -> ST s Int) -> [(Int, a)] -> ST s [Int]
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 (Int, a) -> ST s Int
forall {s} {b}. MArray a Int (ST s) => (Int, b) -> ST s Int
getStart (IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
IMap.toList IntMap a
w)
          let low = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Int]
vals   -- perhaps a non-empty winner
              high = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
vals  -- perhaps an empty winner
          if low < offset
            then do
              putMQ (WScratch low offset) winQ
              when (high==offset || IMap.member startState w) $
                putMQ (WScratch offset offset) winQ
              let keepState Int
i1 = do
                    startsAt <- a i Int
s1 a i Int -> Int -> ST s Int
forall (a :: * -> * -> *) e s i.
(MArray a e (ST s), Ix i) =>
a i e -> Int -> ST s e
!! Int
i1
                    let keep = (Int
startsAt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
low) Bool -> Bool -> Bool
|| (Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
startsAt)
                    if keep
                      then return True
                      else if i1 == startState
                             then {- check for additional empty winner -}
                                  set s1 i1 (succ offset) >> return True
                             else writeSTRef eliminatedStateFlag True >> return False
              states' <- filterM keepState (ISet.toAscList did)
              flag <- readSTRef eliminatedStateFlag
              if flag
                then do
                  writeSTRef eliminatedStateFlag False
                  let DFA {d_id=did',d_dt=dt'} = Trie.lookupAsc trie states'
                  return (did',dt')
                else do
                  return (did,dt)
            else do
               -- offset == low == minimum vals == maximum vals == high; vals == [offset]
               putMQ (WScratch offset offset) winQ
               return (did,dt)

        finalizeWinners = do
          winnersR <- STRef s [WScratch] -> ST s [WScratch]
forall s a. STRef s a -> ST s a
readSTRef (MQ s -> STRef s [WScratch]
forall s. MQ s -> STRef s [WScratch]
mq_list MQ s
winQ)
          resetMQ winQ
          writeSTRef storeNext (return [])
          mapM wsToGroup (reverse winnersR)

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

----

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

----

{- MUTABLE WINNER QUEUE -}

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

newMQ :: S.ST s (MQ s)
newMQ :: forall s. ST s (MQ s)
newMQ = do
  earliest <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef Int
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 Int
mq_earliest=STRef s Int
earliest,mq_list :: forall s. MQ s -> STRef s [WScratch]
mq_list=STRef s [WScratch]
list}) = do
  STRef s Int -> Int -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Int
earliest Int
forall a. Bounded a => a
maxBound
  STRef s [WScratch] -> [WScratch] -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s [WScratch]
list []

putMQ :: WScratch -> MQ s -> S.ST s ()
putMQ :: forall s. WScratch -> MQ s -> ST s ()
putMQ ws :: WScratch
ws@(WScratch {ws_start :: WScratch -> Int
ws_start=Int
start}) (MQ {mq_earliest :: forall s. MQ s -> STRef s Int
mq_earliest=STRef s Int
earliest,mq_list :: forall s. MQ s -> STRef s [WScratch]
mq_list=STRef s [WScratch]
list}) = do
  startE <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
earliest
  if start <= startE
    then writeSTRef earliest start >> writeSTRef list [ws]
    else do
      old <- readSTRef list
      let !rest = (WScratch -> Bool) -> [WScratch] -> [WScratch]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\ WScratch
w -> Int
start Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= WScratch -> Int
ws_start WScratch
w) [WScratch]
old
          !new = WScratch
ws WScratch -> [WScratch] -> [WScratch]
forall a. a -> [a] -> [a]
: [WScratch]
rest
      writeSTRef list new

getMQ :: Position -> MQ s -> S.ST s [WScratch]
getMQ :: forall s. Int -> MQ s -> ST s [WScratch]
getMQ Int
pos (MQ {mq_earliest :: forall s. MQ s -> STRef s Int
mq_earliest=STRef s Int
earliest,mq_list :: forall s. MQ s -> STRef s [WScratch]
mq_list=STRef s [WScratch]
list}) = do
  old <- STRef s [WScratch] -> ST s [WScratch]
forall s a. STRef s a -> ST s a
readSTRef STRef s [WScratch]
list
  case span (\ WScratch
w -> Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= WScratch -> Int
ws_start WScratch
w) old of
    ([],[WScratch]
ans) -> do
      STRef s Int -> Int -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Int
earliest Int
forall a. Bounded a => a
maxBound
      STRef s [WScratch] -> [WScratch] -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s [WScratch]
list []
      [WScratch] -> ST s [WScratch]
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return [WScratch]
ans
    ([WScratch]
new,[WScratch]
ans) -> do
      STRef s Int -> Int -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Int
earliest (WScratch -> Int
ws_start ([WScratch] -> WScratch
forall a. HasCallStack => [a] -> a
last [WScratch]
new))
      STRef s [WScratch] -> [WScratch] -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s [WScratch]
list [WScratch]
new
      [WScratch] -> ST s [WScratch]
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return [WScratch]
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
_s_mq :: !(MQ s)
                           }
type MScratch s = STUArray s Index Position
data WScratch = WScratch {WScratch -> Int
ws_start,WScratch -> Int
_ws_stop :: !Position}
  deriving Int -> WScratch -> ShowS
[WScratch] -> ShowS
WScratch -> [Char]
(Int -> WScratch -> ShowS)
-> (WScratch -> [Char]) -> ([WScratch] -> ShowS) -> Show WScratch
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WScratch -> ShowS
showsPrec :: Int -> WScratch -> ShowS
$cshow :: WScratch -> [Char]
show :: WScratch -> [Char]
$cshowList :: [WScratch] -> ShowS
showList :: [WScratch] -> ShowS
Show

{- DEBUGGING HELPERS -}
{- CREATING INITIAL MUTABLE SCRATCH DATA STRUCTURES -}

{-# INLINE newA #-}
newA :: (MArray (STUArray s) e (S.ST s)) => (Tag,Tag) -> e -> S.ST s (STUArray s Tag e)
newA :: forall s e.
MArray (STUArray s) e (ST s) =>
(Int, Int) -> e -> ST s (STUArray s Int e)
newA (Int, Int)
b_tags e
initial = (Int, Int) -> e -> ST s (STUArray s Int 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 (Int, Int)
b_tags e
initial

newScratch :: (Index,Index) -> S.ST s (SScratch s)
newScratch :: forall s. (Int, Int) -> ST s (SScratch s)
newScratch (Int, Int)
b_index = do
  s1 <- (Int, Int) -> ST s (MScratch s)
forall s. (Int, Int) -> ST s (MScratch s)
newMScratch (Int, Int)
b_index
  s2 <- newMScratch b_index
  winQ <- newMQ
  return (SScratch s1 s2 winQ)

newMScratch :: (Index,Index) -> S.ST s (MScratch s)
newMScratch :: forall s. (Int, Int) -> ST s (MScratch s)
newMScratch (Int, Int)
b_index = (Int, Int) -> Int -> ST s (STUArray s Int Int)
forall s e.
MArray (STUArray s) e (ST s) =>
(Int, Int) -> e -> ST s (STUArray s Int e)
newA (Int, Int)
b_index (-Int
1)

{- CONVERT WINNERS TO MATCHARRAY -}

wsToGroup :: WScratch -> S.ST s MatchArray
wsToGroup :: forall s. WScratch -> ST s MatchArray
wsToGroup (WScratch Int
start Int
stop) = do
  ma <- (Int, Int) -> (Int, Int) -> ST s (STArray s Int (Int, Int))
forall i.
Ix i =>
(i, i) -> (Int, Int) -> ST s (STArray s i (Int, Int))
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
0,Int
0) (Int
start,Int
stopInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
start)  :: S.ST s (STArray s Int (MatchOffset,MatchLength))
  unsafeFreeze ma