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

import Control.Monad(unless)
import Prelude hiding ((!!))

import Data.Array.MArray(MArray(..))
import Data.Array.Unsafe(unsafeFreeze)
import Data.Array.ST(STArray)
import qualified Data.IntMap.CharMap2 as CMap(findWithDefault)
import qualified Data.IntMap as IMap(null)
import qualified Data.IntSet as ISet(null)
import qualified Data.Array.MArray()
import Data.STRef(newSTRef,readSTRef,writeSTRef)
import qualified Control.Monad.ST.Strict as S(ST,runST)
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 Text.Regex.TDFA.Common hiding (indent)
import Text.Regex.TDFA.NewDFA.Uncons(Uncons(uncons))
import Text.Regex.TDFA.NewDFA.MakeTest(test_singleline)

--import Debug.Trace

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

{-# 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 -> Position -> Char -> text -> [MatchArray]
execMatch (Regex { regex_dfa :: Regex -> DFA
regex_dfa = DFA {d_dt :: DFA -> DT
d_dt=DT
dtIn} })
          Position
offsetIn Char
_prevIn text
inputIn = forall a. (forall s. ST s a) -> a
S.runST forall {s}. ST s [MatchArray]
goNext where

  test :: WhichTest -> Position -> text -> Bool
test WhichTest
wt Position
off text
input = forall text.
Uncons text =>
WhichTest -> Position -> Char -> text -> Bool
test_singleline WhichTest
wt Position
off Char
'\n' text
input

  goNext :: ST s [MatchArray]
goNext = {-# SCC "goNext" #-} do
    STRef s (Maybe Position)
winQ <- forall a s. a -> ST s (STRef s a)
newSTRef forall a. Maybe a
Nothing
    let next :: DT -> Position -> a -> ST s [MatchArray]
next DT
dt Position
offset a
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 forall {text}. Uncons text => WhichTest -> Position -> text -> Bool
test WhichTest
wt Position
offset a
input
                then DT -> Position -> a -> ST s [MatchArray]
next DT
a Position
offset a
input
                else DT -> Position -> a -> ST s [MatchArray]
next DT
b Position
offset a
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} -> do
              forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. IntMap a -> Bool
IMap.null IntMap Instructions
w) forall a b. (a -> b) -> a -> b
$
                forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (Maybe Position)
winQ (forall a. a -> Maybe a
Just Position
offset)
              case forall a. Uncons a => a -> Maybe (Char, a)
uncons a
input of
                Maybe (Char, a)
Nothing -> ST s [MatchArray]
finalizeWinner
                Just (Char
c,a
input') -> do
                  case forall a. a -> Char -> CharMap a -> a
CMap.findWithDefault Transition
o Char
c CharMap Transition
t of
                    Transition {trans_single :: Transition -> DFA
trans_single=DFA {d_id :: DFA -> SetIndex
d_id=SetIndex
did',d_dt :: DFA -> DT
d_dt=DT
dt'}}
                      | SetIndex -> Bool
ISet.null SetIndex
did' -> ST s [MatchArray]
finalizeWinner
                      | Bool
otherwise ->
                          let offset' :: Position
offset' = forall a. Enum a => a -> a
succ Position
offset
                          in seq :: forall a b. a -> b -> b
seq Position
offset' forall a b. (a -> b) -> a -> b
$ DT -> Position -> a -> ST s [MatchArray]
next DT
dt' Position
offset' a
input'

        finalizeWinner :: ST s [MatchArray]
finalizeWinner = do
          Maybe Position
mWinner <- forall s a. STRef s a -> ST s a
readSTRef STRef s (Maybe Position)
winQ
          case Maybe Position
mWinner of
            Maybe Position
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
            Just Position
winner -> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall s. Position -> Position -> ST s MatchArray
makeGroup Position
offsetIn) [Position
winner]

    forall {a}. Uncons a => DT -> Position -> a -> ST s [MatchArray]
next DT
dtIn Position
offsetIn text
inputIn

----

{- CONVERT WINNERS TO MATCHARRAY -}

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