1-- | This is the non-capturing form of Text.Regex.TDFA.NewDFA.String
2module Text.Regex.TDFA.NewDFA.Engine_NC_FA(execMatch) where
3
4import Control.Monad(unless)
5import Prelude hiding ((!!))
6
7import Data.Array.MArray(MArray(..))
8import Data.Array.Unsafe(unsafeFreeze)
9import Data.Array.ST(STArray)
10import qualified Data.IntMap.CharMap2 as CMap(findWithDefault)
11import qualified Data.IntMap as IMap(null)
12import qualified Data.IntSet as ISet(null)
13import qualified Data.Array.MArray()
14import Data.STRef(newSTRef,readSTRef,writeSTRef)
15import qualified Control.Monad.ST.Strict as S(ST,runST)
16import Data.Sequence(Seq)
17import qualified Data.ByteString.Char8 as SBS(ByteString)
18import qualified Data.ByteString.Lazy.Char8 as LBS(ByteString)
19
20import Text.Regex.Base(MatchArray,MatchOffset,MatchLength)
21import Text.Regex.TDFA.Common hiding (indent)
22import Text.Regex.TDFA.NewDFA.Uncons(Uncons(uncons))
23import Text.Regex.TDFA.NewDFA.MakeTest(test_singleline)
24
25--import Debug.Trace
26
27-- trace :: String -> a -> a
28-- trace _ a = a
29
30{-# SPECIALIZE execMatch :: Regex -> Position -> Char -> ([] Char) -> [MatchArray] #-}
31{-# SPECIALIZE execMatch :: Regex -> Position -> Char -> (Seq Char) -> [MatchArray] #-}
32{-# SPECIALIZE execMatch :: Regex -> Position -> Char -> SBS.ByteString -> [MatchArray] #-}
33{-# SPECIALIZE execMatch :: Regex -> Position -> Char -> LBS.ByteString -> [MatchArray] #-}
34execMatch :: Uncons text => Regex -> Position -> Char -> text -> [MatchArray]
35execMatch (Regex { regex_dfa = DFA {d_dt=dtIn} })
36          offsetIn _prevIn inputIn = S.runST goNext where
37
38  test wt off input = test_singleline wt off '\n' input
39
40  goNext = {-# SCC "goNext" #-} do
41    winQ <- newSTRef Nothing
42    let next dt offset input = {-# SCC "goNext.next" #-}
43          case dt of
44            Testing' {dt_test=wt,dt_a=a,dt_b=b} ->
45              if test wt offset input
46                then next a offset input
47                else next b offset input
48            Simple' {dt_win=w,dt_trans=t, dt_other=o} -> do
49              unless (IMap.null w) $
50                writeSTRef winQ (Just offset)
51              case uncons input of
52                Nothing -> finalizeWinner
53                Just (c,input') -> do
54                  case CMap.findWithDefault o c t of
55                    Transition {trans_single=DFA {d_id=did',d_dt=dt'}}
56                      | ISet.null did' -> finalizeWinner
57                      | otherwise ->
58                          let offset' = succ offset
59                          in seq offset' $ next dt' offset' input'
60
61        finalizeWinner = do
62          mWinner <- readSTRef winQ
63          case mWinner of
64            Nothing -> return []
65            Just winner -> mapM (makeGroup offsetIn) [winner]
66
67    next dtIn offsetIn inputIn
68
69----
70
71{- CONVERT WINNERS TO MATCHARRAY -}
72
73makeGroup :: Position -> Position -> S.ST s MatchArray
74makeGroup start stop = do
75  ma <- newArray (0,0) (start,stop-start)  :: S.ST s (STArray s Int (MatchOffset,MatchLength))
76  unsafeFreeze ma
77