-- | 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 s. ST s [MatchArray]) -> [MatchArray]
forall a. (forall s. ST s a) -> a
S.runST ST s [MatchArray]
forall s. ST s [MatchArray]
goNext where

  test :: WhichTest -> Position -> text -> Bool
test WhichTest
wt Position
off text
input = WhichTest -> Position -> Char -> text -> Bool
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 <- Maybe Position -> ST s (STRef s (Maybe Position))
forall a s. a -> ST s (STRef s a)
newSTRef Maybe Position
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 WhichTest -> Position -> a -> Bool
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
              Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (IntMap Instructions -> Bool
forall a. IntMap a -> Bool
IMap.null IntMap Instructions
w) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
                STRef s (Maybe Position) -> Maybe Position -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (Maybe Position)
winQ (Position -> Maybe Position
forall a. a -> Maybe a
Just Position
offset)
              case a -> Maybe (Char, a)
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 Transition -> Char -> CharMap Transition -> Transition
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' = Position -> Position
forall a. Enum a => a -> a
succ Position
offset
                          in Position -> ST s [MatchArray] -> ST s [MatchArray]
forall a b. a -> b -> b
seq Position
offset' (ST s [MatchArray] -> ST s [MatchArray])
-> ST s [MatchArray] -> ST s [MatchArray]
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 <- STRef s (Maybe Position) -> ST s (Maybe Position)
forall s a. STRef s a -> ST s a
readSTRef STRef s (Maybe Position)
winQ
          case Maybe Position
mWinner of
            Maybe Position
Nothing -> [MatchArray] -> ST s [MatchArray]
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return []
            Just Position
winner -> (Position -> ST s MatchArray) -> [Position] -> ST s [MatchArray]
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 -> Position -> ST s MatchArray
forall s. Position -> Position -> ST s MatchArray
makeGroup Position
offsetIn) [Position
winner]

    DT -> Position -> text -> ST s [MatchArray]
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 <- (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
0) (Position
start,Position
stopPosition -> Position -> Position
forall a. Num a => a -> a -> a
-Position
start)  :: S.ST s (STArray s Int (MatchOffset,MatchLength))
  STArray s Position (Position, Position) -> ST s MatchArray
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