{-# OPTIONS -funbox-strict-fields #-}

-- | Common provides simple functions to the backend.
-- It defines most of the data types.
-- All modules should call 'error' via the 'common_error' function below.

module Text.Regex.TDFA.Common where

import Text.Regex.Base(RegexOptions(..))

{- By Chris Kuklewicz, 2007-2009. BSD License, see the LICENSE file. -}
import Data.Array.IArray(Array)
import Data.IntSet.EnumSet2(EnumSet)
import qualified Data.IntSet.EnumSet2 as Set(toList)
import Data.IntMap.CharMap2(CharMap(..))
import Data.IntMap (IntMap)
import qualified Data.IntMap as IMap (findWithDefault,assocs,toList,null,size,toAscList)
import Data.IntSet(IntSet)
import qualified Data.IntMap.CharMap2 as Map (assocs,toAscList,null)
import Data.Sequence as S(Seq)
--import Debug.Trace

import Text.Regex.TDFA.IntArrTrieSet(TrieSet)

{-# INLINE look #-}
look :: Int -> IntMap a -> a
look :: forall a. Int -> IntMap a -> a
look Int
key IntMap a
imap = forall a. a -> Int -> IntMap a -> a
IMap.findWithDefault (forall a. String -> String -> a
common_error String
"Text.Regex.DFA.Common" (String
"key "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show Int
keyforall a. [a] -> [a] -> [a]
++String
" not found in look")) Int
key IntMap a
imap

common_error :: String -> String -> a
common_error :: forall a. String -> String -> a
common_error String
moduleName String
message =
  forall a. HasCallStack => String -> a
error (String
"Explict error in module "forall a. [a] -> [a] -> [a]
++String
moduleNameforall a. [a] -> [a] -> [a]
++String
" : "forall a. [a] -> [a] -> [a]
++String
message)

on :: (t1 -> t1 -> t2) -> (t -> t1) -> t -> t -> t2
t1 -> t1 -> t2
f on :: forall t1 t2 t. (t1 -> t1 -> t2) -> (t -> t1) -> t -> t -> t2
`on` t -> t1
g = (\t
x t
y -> (t -> t1
g t
x) t1 -> t1 -> t2
`f` (t -> t1
g t
y))

-- | After 'sort' or 'sortBy' the use of 'nub' or 'nubBy' can be replaced by 'norep' or 'norepBy'.
norep :: (Eq a) => [a]->[a]
norep :: forall a. Eq a => [a] -> [a]
norep [] = []
norep x :: [a]
x@[a
_] = [a]
x
norep (a
a:bs :: [a]
bs@(a
c:[a]
cs)) | a
aforall a. Eq a => a -> a -> Bool
==a
c = forall a. Eq a => [a] -> [a]
norep (a
aforall a. a -> [a] -> [a]
:[a]
cs)
                    | Bool
otherwise = a
aforall a. a -> [a] -> [a]
:forall a. Eq a => [a] -> [a]
norep [a]
bs

-- | After 'sort' or 'sortBy' the use of 'nub' or 'nubBy' can be replaced by 'norep' or 'norepBy'.
norepBy :: (a -> a -> Bool) -> [a] -> [a]
norepBy :: forall a. (a -> a -> Bool) -> [a] -> [a]
norepBy a -> a -> Bool
_ [] = []
norepBy a -> a -> Bool
_ x :: [a]
x@[a
_] = [a]
x
norepBy a -> a -> Bool
eqF (a
a:bs :: [a]
bs@(a
c:[a]
cs)) | a
a a -> a -> Bool
`eqF` a
c = forall a. (a -> a -> Bool) -> [a] -> [a]
norepBy a -> a -> Bool
eqF (a
aforall a. a -> [a] -> [a]
:[a]
cs)
                          | Bool
otherwise = a
aforall a. a -> [a] -> [a]
:forall a. (a -> a -> Bool) -> [a] -> [a]
norepBy a -> a -> Bool
eqF [a]
bs

mapFst :: (Functor f) => (t -> t2) -> f (t, t1) -> f (t2, t1)
mapFst :: forall (f :: * -> *) t t2 t1.
Functor f =>
(t -> t2) -> f (t, t1) -> f (t2, t1)
mapFst t -> t2
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ (t
a,t1
b) -> (t -> t2
f t
a,t1
b))

mapSnd :: (Functor f) => (t1 -> t2) -> f (t, t1) -> f (t, t2)
mapSnd :: forall (f :: * -> *) t1 t2 t.
Functor f =>
(t1 -> t2) -> f (t, t1) -> f (t, t2)
mapSnd t1 -> t2
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ (t
a,t1
b) -> (t
a,t1 -> t2
f t1
b))

fst3 :: (a,b,c) -> a
fst3 :: forall a b c. (a, b, c) -> a
fst3 (a
x,b
_,c
_) = a
x

snd3 :: (a,b,c) -> b
snd3 :: forall a b c. (a, b, c) -> b
snd3 (a
_,b
x,c
_) = b
x

thd3 :: (a,b,c) -> c
thd3 :: forall a b c. (a, b, c) -> c
thd3 (a
_,b
_,c
x) = c
x

flipOrder :: Ordering -> Ordering
flipOrder :: Ordering -> Ordering
flipOrder Ordering
GT = Ordering
LT
flipOrder Ordering
LT = Ordering
GT
flipOrder Ordering
EQ = Ordering
EQ

noWin :: WinTags -> Bool
noWin :: WinTags -> Bool
noWin = forall (t :: * -> *) a. Foldable t => t a -> Bool
null

-- | Used to track elements of the pattern that accept characters or are anchors.
newtype DoPa = DoPa {DoPa -> Int
dopaIndex :: Int} deriving (DoPa -> DoPa -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DoPa -> DoPa -> Bool
$c/= :: DoPa -> DoPa -> Bool
== :: DoPa -> DoPa -> Bool
$c== :: DoPa -> DoPa -> Bool
Eq,Eq DoPa
DoPa -> DoPa -> Bool
DoPa -> DoPa -> Ordering
DoPa -> DoPa -> DoPa
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DoPa -> DoPa -> DoPa
$cmin :: DoPa -> DoPa -> DoPa
max :: DoPa -> DoPa -> DoPa
$cmax :: DoPa -> DoPa -> DoPa
>= :: DoPa -> DoPa -> Bool
$c>= :: DoPa -> DoPa -> Bool
> :: DoPa -> DoPa -> Bool
$c> :: DoPa -> DoPa -> Bool
<= :: DoPa -> DoPa -> Bool
$c<= :: DoPa -> DoPa -> Bool
< :: DoPa -> DoPa -> Bool
$c< :: DoPa -> DoPa -> Bool
compare :: DoPa -> DoPa -> Ordering
$ccompare :: DoPa -> DoPa -> Ordering
Ord)

instance Enum DoPa where
  toEnum :: Int -> DoPa
toEnum = Int -> DoPa
DoPa
  fromEnum :: DoPa -> Int
fromEnum = DoPa -> Int
dopaIndex

instance Show DoPa where
  showsPrec :: Int -> DoPa -> ShowS
showsPrec Int
p (DoPa {dopaIndex :: DoPa -> Int
dopaIndex=Int
i}) = (Key
'#'forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
p Int
i

-- | Control whether the pattern is multiline or case-sensitive like Text.Regex and whether to
-- capture the subgroups (\\1, \\2, etc).  Controls enabling extra anchor syntax.
data CompOption = CompOption {
    CompOption -> Bool
caseSensitive :: Bool
      -- ^ True in 'blankCompOpt' and 'defaultCompOpt'.
  , CompOption -> Bool
multiline :: Bool
      -- ^ False in 'blankCompOpt', True in 'defaultCompOpt'.
      -- Compile for newline-sensitive matching.
      --
      -- From [regexp man page](https://www.tcl.tk/man/tcl8.4/TclCmd/regexp.html#M8):
      -- "By default, newline is a completely ordinary character with no special meaning in either REs or strings.
      -- With this flag, inverted bracket expressions @[^@ and @.@ never match newline,
      -- a @^@ anchor matches the null string after any newline in the string in addition to its normal function,
      -- and the @$@ anchor matches the null string before any newline in the string in addition to its normal function."
  , CompOption -> Bool
rightAssoc :: Bool
      -- ^ True (and therefore right associative) in 'blankCompOpt' and 'defaultCompOpt'.
  , CompOption -> Bool
newSyntax :: Bool
      -- ^ False in 'blankCompOpt', True in 'defaultCompOpt'.
      -- Enables the extended non-POSIX syntax described in "Text.Regex.TDFA" haddock documentation.
  , CompOption -> Bool
lastStarGreedy ::  Bool
      -- ^ False by default.  This is POSIX correct but it takes space and is slower.
      -- Setting this to True will improve performance, and should be done
      -- if you plan to set the 'captureGroups' 'ExecOption' to False.
  } deriving (ReadPrec [CompOption]
ReadPrec CompOption
Int -> ReadS CompOption
ReadS [CompOption]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompOption]
$creadListPrec :: ReadPrec [CompOption]
readPrec :: ReadPrec CompOption
$creadPrec :: ReadPrec CompOption
readList :: ReadS [CompOption]
$creadList :: ReadS [CompOption]
readsPrec :: Int -> ReadS CompOption
$creadsPrec :: Int -> ReadS CompOption
Read,Int -> CompOption -> ShowS
[CompOption] -> ShowS
CompOption -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompOption] -> ShowS
$cshowList :: [CompOption] -> ShowS
show :: CompOption -> String
$cshow :: CompOption -> String
showsPrec :: Int -> CompOption -> ShowS
$cshowsPrec :: Int -> CompOption -> ShowS
Show)

data ExecOption = ExecOption {
    ExecOption -> Bool
captureGroups :: Bool    -- ^ True by default.  Set to False to improve speed (and space).
  } deriving (ReadPrec [ExecOption]
ReadPrec ExecOption
Int -> ReadS ExecOption
ReadS [ExecOption]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExecOption]
$creadListPrec :: ReadPrec [ExecOption]
readPrec :: ReadPrec ExecOption
$creadPrec :: ReadPrec ExecOption
readList :: ReadS [ExecOption]
$creadList :: ReadS [ExecOption]
readsPrec :: Int -> ReadS ExecOption
$creadsPrec :: Int -> ReadS ExecOption
Read,Int -> ExecOption -> ShowS
[ExecOption] -> ShowS
ExecOption -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExecOption] -> ShowS
$cshowList :: [ExecOption] -> ShowS
show :: ExecOption -> String
$cshow :: ExecOption -> String
showsPrec :: Int -> ExecOption -> ShowS
$cshowsPrec :: Int -> ExecOption -> ShowS
Show)

-- | Used by implementation to name certain 'Postion's during
-- matching. Identity of 'Position' tag to set during a transition.
type Tag = Int

-- | Internal use to indicate type of tag and preference for larger or smaller 'Position's.
data OP = Maximize | Minimize | Orbit | Ignore deriving (OP -> OP -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OP -> OP -> Bool
$c/= :: OP -> OP -> Bool
== :: OP -> OP -> Bool
$c== :: OP -> OP -> Bool
Eq,Int -> OP -> ShowS
[OP] -> ShowS
OP -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OP] -> ShowS
$cshowList :: [OP] -> ShowS
show :: OP -> String
$cshow :: OP -> String
showsPrec :: Int -> OP -> ShowS
$cshowsPrec :: Int -> OP -> ShowS
Show)

-- | Internal NFA node identity number.
type Index = Int

-- | Internal DFA identity is this 'Set' of NFA 'Index'.
type SetIndex = IntSet {- Index -}

-- | Index into the text being searched.
type Position = Int

-- | 'GroupIndex' is for indexing submatches from capturing parenthesized groups ('PGroup' or 'Group').
type GroupIndex = Int

-- | 'GroupInfo' collects the parent and tag information for an instance of a group.
data GroupInfo = GroupInfo {
    GroupInfo -> Int
thisIndex, GroupInfo -> Int
parentIndex :: GroupIndex
  , GroupInfo -> Int
startTag, GroupInfo -> Int
stopTag, GroupInfo -> Int
flagTag :: Tag
  } deriving Int -> GroupInfo -> ShowS
[GroupInfo] -> ShowS
GroupInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupInfo] -> ShowS
$cshowList :: [GroupInfo] -> ShowS
show :: GroupInfo -> String
$cshow :: GroupInfo -> String
showsPrec :: Int -> GroupInfo -> ShowS
$cshowsPrec :: Int -> GroupInfo -> ShowS
Show

-- | The TDFA backend specific 'Regex' type, used by this module's 'RegexOptions' and 'RegexMaker'.
data Regex = Regex {
    Regex -> DFA
regex_dfa :: DFA                             -- ^ starting DFA state
  , Regex -> Int
regex_init :: Index                          -- ^ index of starting state
  , Regex -> (Int, Int)
regex_b_index :: (Index,Index)               -- ^ indexes of smallest and largest states
  , Regex -> (Int, Int)
regex_b_tags :: (Tag,Tag)                    -- ^ indexes of smallest and largest tags
  , Regex -> TrieSet DFA
regex_trie :: TrieSet DFA                    -- ^ All DFA states
  , Regex -> Array Int OP
regex_tags :: Array Tag OP                   -- ^ information about each tag
  , Regex -> Array Int [GroupInfo]
regex_groups :: Array GroupIndex [GroupInfo] -- ^ information about each group
  , Regex -> Bool
regex_isFrontAnchored :: Bool                -- ^ used for optimizing execution
  , Regex -> CompOption
regex_compOptions :: CompOption
  , Regex -> ExecOption
regex_execOptions :: ExecOption
  } -- no deriving at all, the DFA may be too big to ever traverse!


instance RegexOptions Regex CompOption ExecOption where
  blankCompOpt :: CompOption
blankCompOpt =  CompOption { caseSensitive :: Bool
caseSensitive = Bool
True
                             , multiline :: Bool
multiline = Bool
False
                             , rightAssoc :: Bool
rightAssoc = Bool
True
                             , newSyntax :: Bool
newSyntax = Bool
False
                             , lastStarGreedy :: Bool
lastStarGreedy = Bool
False
                             }
  blankExecOpt :: ExecOption
blankExecOpt =  ExecOption { captureGroups :: Bool
captureGroups = Bool
True }
  defaultCompOpt :: CompOption
defaultCompOpt = CompOption { caseSensitive :: Bool
caseSensitive = Bool
True
                              , multiline :: Bool
multiline = Bool
True
                              , rightAssoc :: Bool
rightAssoc = Bool
True
                              , newSyntax :: Bool
newSyntax = Bool
True
                              , lastStarGreedy :: Bool
lastStarGreedy = Bool
False
                              }
  defaultExecOpt :: ExecOption
defaultExecOpt =  ExecOption { captureGroups :: Bool
captureGroups = Bool
True }
  setExecOpts :: ExecOption -> Regex -> Regex
setExecOpts ExecOption
e Regex
r = Regex
r {regex_execOptions :: ExecOption
regex_execOptions=ExecOption
e}
  getExecOpts :: Regex -> ExecOption
getExecOpts Regex
r = Regex -> ExecOption
regex_execOptions Regex
r


data WinEmpty = WinEmpty Instructions
              | WinTest WhichTest (Maybe WinEmpty) (Maybe WinEmpty)
  deriving Int -> WinEmpty -> ShowS
[WinEmpty] -> ShowS
WinEmpty -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WinEmpty] -> ShowS
$cshowList :: [WinEmpty] -> ShowS
show :: WinEmpty -> String
$cshow :: WinEmpty -> String
showsPrec :: Int -> WinEmpty -> ShowS
$cshowsPrec :: Int -> WinEmpty -> ShowS
Show

-- | Internal NFA node type.
data QNFA = QNFA {QNFA -> Int
q_id :: Index, QNFA -> QT
q_qt :: QT}

-- | Internal to 'QNFA' type.
data QT = Simple { QT -> WinTags
qt_win :: WinTags -- ^ empty transitions to the virtual winning state
                 , QT -> CharMap QTrans
qt_trans :: CharMap QTrans -- ^ all ways to leave this QNFA to other or the same QNFA
                 , QT -> QTrans
qt_other :: QTrans -- ^ default ways to leave this QNFA to other or the same QNFA
                 }
        | Testing { QT -> WhichTest
qt_test :: WhichTest -- ^ The test to perform
                  , QT -> EnumSet DoPa
qt_dopas :: EnumSet DoPa  -- ^ location(s) of the anchor(s) in the original regexp
                  , QT -> QT
qt_a, QT -> QT
qt_b :: QT -- ^ use qt_a if test is True, else use qt_b
                  }

-- | Internal type to represent the tagged transition from one QNFA to
-- another (or itself).  The key is the Index of the destination QNFA.
type QTrans = IntMap {- Destination Index -} [TagCommand]

-- | Known predicates, just Beginning of Line (^) and End of Line ($).
-- Also support for GNU extensions is being added: \\\` beginning of
-- buffer, \\\' end of buffer, \\\< and \\\> for begin and end of words, \\b
-- and \\B for word boundary and not word boundary.
data WhichTest
  = Test_BOL          -- ^ @^@ (affected by multiline option)
  | Test_EOL          -- ^ @$@ (affected by multiline option)
  | Test_BOB          -- ^ @\\`@ beginning of buffer
  | Test_EOB          -- ^ @\\'@ end ofbuffer
  | Test_BOW          -- ^ @\\<@ beginning of word
  | Test_EOW          -- ^ @\\>@ end of word
  | Test_EdgeWord     -- ^ @\\b@ word boundary
  | Test_NotEdgeWord  -- ^ @\\B@ not word boundary
  deriving (Int -> WhichTest -> ShowS
[WhichTest] -> ShowS
WhichTest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WhichTest] -> ShowS
$cshowList :: [WhichTest] -> ShowS
show :: WhichTest -> String
$cshow :: WhichTest -> String
showsPrec :: Int -> WhichTest -> ShowS
$cshowsPrec :: Int -> WhichTest -> ShowS
Show,WhichTest -> WhichTest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WhichTest -> WhichTest -> Bool
$c/= :: WhichTest -> WhichTest -> Bool
== :: WhichTest -> WhichTest -> Bool
$c== :: WhichTest -> WhichTest -> Bool
Eq,Eq WhichTest
WhichTest -> WhichTest -> Bool
WhichTest -> WhichTest -> Ordering
WhichTest -> WhichTest -> WhichTest
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WhichTest -> WhichTest -> WhichTest
$cmin :: WhichTest -> WhichTest -> WhichTest
max :: WhichTest -> WhichTest -> WhichTest
$cmax :: WhichTest -> WhichTest -> WhichTest
>= :: WhichTest -> WhichTest -> Bool
$c>= :: WhichTest -> WhichTest -> Bool
> :: WhichTest -> WhichTest -> Bool
$c> :: WhichTest -> WhichTest -> Bool
<= :: WhichTest -> WhichTest -> Bool
$c<= :: WhichTest -> WhichTest -> Bool
< :: WhichTest -> WhichTest -> Bool
$c< :: WhichTest -> WhichTest -> Bool
compare :: WhichTest -> WhichTest -> Ordering
$ccompare :: WhichTest -> WhichTest -> Ordering
Ord,Int -> WhichTest
WhichTest -> Int
WhichTest -> [WhichTest]
WhichTest -> WhichTest
WhichTest -> WhichTest -> [WhichTest]
WhichTest -> WhichTest -> WhichTest -> [WhichTest]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: WhichTest -> WhichTest -> WhichTest -> [WhichTest]
$cenumFromThenTo :: WhichTest -> WhichTest -> WhichTest -> [WhichTest]
enumFromTo :: WhichTest -> WhichTest -> [WhichTest]
$cenumFromTo :: WhichTest -> WhichTest -> [WhichTest]
enumFromThen :: WhichTest -> WhichTest -> [WhichTest]
$cenumFromThen :: WhichTest -> WhichTest -> [WhichTest]
enumFrom :: WhichTest -> [WhichTest]
$cenumFrom :: WhichTest -> [WhichTest]
fromEnum :: WhichTest -> Int
$cfromEnum :: WhichTest -> Int
toEnum :: Int -> WhichTest
$ctoEnum :: Int -> WhichTest
pred :: WhichTest -> WhichTest
$cpred :: WhichTest -> WhichTest
succ :: WhichTest -> WhichTest
$csucc :: WhichTest -> WhichTest
Enum)

-- | The things that can be done with a Tag.  'TagTask' and
-- 'ResetGroupStopTask' are for tags with Maximize or Minimize OP
-- values.  'ResetOrbitTask' and 'EnterOrbitTask' and 'LeaveOrbitTask' are
-- for tags with Orbit OP value.
data TagTask = TagTask | ResetGroupStopTask | SetGroupStopTask
             | ResetOrbitTask | EnterOrbitTask | LeaveOrbitTask deriving (Int -> TagTask -> ShowS
[TagTask] -> ShowS
TagTask -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagTask] -> ShowS
$cshowList :: [TagTask] -> ShowS
show :: TagTask -> String
$cshow :: TagTask -> String
showsPrec :: Int -> TagTask -> ShowS
$cshowsPrec :: Int -> TagTask -> ShowS
Show,TagTask -> TagTask -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagTask -> TagTask -> Bool
$c/= :: TagTask -> TagTask -> Bool
== :: TagTask -> TagTask -> Bool
$c== :: TagTask -> TagTask -> Bool
Eq)

-- | Ordered list of tags and their associated Task.
type TagTasks = [(Tag,TagTask)]

-- | When attached to a QTrans the TagTask can be done before or after
-- accepting the character.
data TagUpdate = PreUpdate TagTask | PostUpdate TagTask deriving (Int -> TagUpdate -> ShowS
[TagUpdate] -> ShowS
TagUpdate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagUpdate] -> ShowS
$cshowList :: [TagUpdate] -> ShowS
show :: TagUpdate -> String
$cshow :: TagUpdate -> String
showsPrec :: Int -> TagUpdate -> ShowS
$cshowsPrec :: Int -> TagUpdate -> ShowS
Show,TagUpdate -> TagUpdate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagUpdate -> TagUpdate -> Bool
$c/= :: TagUpdate -> TagUpdate -> Bool
== :: TagUpdate -> TagUpdate -> Bool
$c== :: TagUpdate -> TagUpdate -> Bool
Eq)

-- | Ordered list of tags and their associated update operation.
type TagList = [(Tag,TagUpdate)]

-- | A TagList and the location of the item in the original pattern
-- that is being accepted.
type TagCommand = (DoPa,TagList)

-- | Ordered list of tags and their associated update operation to
-- perform on an empty transition to the virtual winning state.
type WinTags = TagList

-- | Internal DFA node, identified by the Set of indices of the QNFA
-- nodes it represents.
data DFA = DFA { DFA -> SetIndex
d_id :: SetIndex, DFA -> DT
d_dt :: DT } deriving(Int -> DFA -> ShowS
[DFA] -> ShowS
DFA -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DFA] -> ShowS
$cshowList :: [DFA] -> ShowS
show :: DFA -> String
$cshow :: DFA -> String
showsPrec :: Int -> DFA -> ShowS
$cshowsPrec :: Int -> DFA -> ShowS
Show)
data Transition = Transition { Transition -> DFA
trans_many :: DFA    -- ^ where to go (maximal), including respawning
                             , Transition -> DFA
trans_single :: DFA  -- ^ where to go, not including respawning
                             , Transition -> DTrans
trans_how :: DTrans    -- ^ how to go, including respawning
                             }
-- | Internal to the DFA node
data DT = Simple' { DT -> IntMap Instructions
dt_win :: IntMap {- Source Index -} Instructions -- ^ Actions to perform to win
                  , DT -> CharMap Transition
dt_trans :: CharMap Transition -- ^ Transition to accept Char
                  , DT -> Transition
dt_other :: Transition -- ^ default accepting transition
                  }
        | Testing' { DT -> WhichTest
dt_test :: WhichTest -- ^ The test to perform
                   , DT -> EnumSet DoPa
dt_dopas :: EnumSet DoPa -- ^ location(s) of the anchor(s) in the original regexp
                   , DT -> DT
dt_a,DT -> DT
dt_b :: DT      -- ^ use dt_a if test is True else use dt_b
                   }

-- | Internal type to represent the commands for the tagged transition.
-- The outer 'IntMap' is for the destination Index and the inner 'IntMap'
-- is for the Source Index.  This is convenient since all runtime data
-- going to the same destination must be compared to find the best.
--
-- A Destination 'IntMap' entry may have an empty Source 'IntMap' if and
-- only if the destination is the starting index and the NFA or DFA.
-- This instructs the matching engine to spawn a new entry starting at
-- the post-update position.
type DTrans = IntMap {- Index of Destination -} (IntMap {- Index of Source -} (DoPa,Instructions))
-- type DTrans = IntMap {- Index of Destination -} (IntMap {- Index of Source -} (DoPa,RunState ()))

-- | Internal convenience type for the text display code.
type DTrans' = [(Index, [(Index, (DoPa, ([(Tag, (Position,Bool))],[String])))])]

-- | Positions for which a @*@ was re-started while looping.  Need to
-- append locations at back but compare starting with front, so use
-- 'Seq' as a queue.  The initial position is saved in 'basePos' (and a
-- Maximize Tag), the middle positions in the 'Seq', and the final
-- position is NOT saved in the Orbits (only in a Maximize Tag).
data Orbits = Orbits
  { Orbits -> Bool
inOrbit :: !Bool        -- True if enterOrbit, False if LeaveOrbit
  , Orbits -> Int
basePos :: Position
  , Orbits -> Maybe Int
ordinal :: (Maybe Int)
  , Orbits -> Seq Int
getOrbits :: !(Seq Position)
  } deriving (Int -> Orbits -> ShowS
[Orbits] -> ShowS
Orbits -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Orbits] -> ShowS
$cshowList :: [Orbits] -> ShowS
show :: Orbits -> String
$cshow :: Orbits -> String
showsPrec :: Int -> Orbits -> ShowS
$cshowsPrec :: Int -> Orbits -> ShowS
Show)

-- | The 'newPos' and 'newFlags' lists in Instructions are sorted by, and unique in, the Tag values
data Instructions = Instructions
  { Instructions -> [(Int, Action)]
newPos :: ![(Tag,Action)] -- False is preUpdate, True is postUpdate (there are no Orbit tags here) -- 2009 : Change to enum from bool?
  , Instructions -> Maybe (Int -> OrbitTransformer)
newOrbits :: !(Maybe (Position -> OrbitTransformer))
  }

instance Show Instructions where
  showsPrec :: Int -> Instructions -> ShowS
showsPrec Int
p (Instructions [(Int, Action)]
pos Maybe (Int -> OrbitTransformer)
_)
    = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
>= Int
11) forall a b. (a -> b) -> a -> b
$
        String -> ShowS
showString String
"Instructions {" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> ShowS
showString String
"newPos = " forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 [(Int, Action)]
pos forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> ShowS
showString String
", " forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> ShowS
showString String
"newOrbits = " forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> ShowS
showString String
"<function>" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> ShowS
showString String
"}"

data Action = SetPre | SetPost | SetVal Int deriving (Int -> Action -> ShowS
[Action] -> ShowS
Action -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Action] -> ShowS
$cshowList :: [Action] -> ShowS
show :: Action -> String
$cshow :: Action -> String
showsPrec :: Int -> Action -> ShowS
$cshowsPrec :: Int -> Action -> ShowS
Show,Action -> Action -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Action -> Action -> Bool
$c/= :: Action -> Action -> Bool
== :: Action -> Action -> Bool
$c== :: Action -> Action -> Bool
Eq)
type OrbitTransformer = OrbitLog -> OrbitLog
type OrbitLog = IntMap Orbits

instance Show QNFA where
  show :: QNFA -> String
show (QNFA {q_id :: QNFA -> Int
q_id = Int
i, q_qt :: QNFA -> QT
q_qt = QT
qt}) = String
"QNFA {q_id = "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show Int
i
                                  forall a. [a] -> [a] -> [a]
++String
"\n     ,q_qt = "forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show QT
qt
                                  forall a. [a] -> [a] -> [a]
++String
"\n}"

instance Show QT where
  show :: QT -> String
show = QT -> String
showQT

showQT :: QT -> String
showQT :: QT -> String
showQT (Simple WinTags
win CharMap QTrans
trans QTrans
other) = String
"{qt_win=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show WinTags
win
                             forall a. [a] -> [a] -> [a]
++ String
"\n, qt_trans=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (CharMap QTrans -> [(Key, [(Int, [TagCommand])])]
foo CharMap QTrans
trans)
                             forall a. [a] -> [a] -> [a]
++ String
"\n, qt_other=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (QTrans -> [(Int, [TagCommand])]
foo' QTrans
other) forall a. [a] -> [a] -> [a]
++ String
"}"
  where foo :: CharMap QTrans -> [(Char,[(Index,[TagCommand])])]
        foo :: CharMap QTrans -> [(Key, [(Int, [TagCommand])])]
foo = forall (f :: * -> *) t1 t2 t.
Functor f =>
(t1 -> t2) -> f (t, t1) -> f (t, t2)
mapSnd QTrans -> [(Int, [TagCommand])]
foo' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CharMap a -> [(Key, a)]
Map.toAscList
        foo' :: QTrans -> [(Index,[TagCommand])]
        foo' :: QTrans -> [(Int, [TagCommand])]
foo' = forall a. IntMap a -> [(Int, a)]
IMap.toList
showQT (Testing WhichTest
test EnumSet DoPa
dopas QT
a QT
b) = String
"{Testing "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show WhichTest
testforall a. [a] -> [a] -> [a]
++String
" "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show (forall e. Enum e => EnumSet e -> [e]
Set.toList EnumSet DoPa
dopas)
                              forall a. [a] -> [a] -> [a]
++String
"\n"forall a. [a] -> [a] -> [a]
++QT -> String
indent' QT
a
                              forall a. [a] -> [a] -> [a]
++String
"\n"forall a. [a] -> [a] -> [a]
++QT -> String
indent' QT
bforall a. [a] -> [a] -> [a]
++String
"}"
    where indent' :: QT -> String
indent' = forall a. [a] -> [a]
init forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (String
spacesforall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines forall b c a. (b -> c) -> (a -> b) -> a -> c
. QT -> String
showQT
          spaces :: String
spaces = forall a. Int -> a -> [a]
replicate Int
9 Key
' '

instance Show DT where show :: DT -> String
show = DT -> String
showDT

indent :: [String] -> String
indent :: [String] -> String
indent = [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\String
x -> Key
' 'forall a. a -> [a] -> [a]
:Key
' 'forall a. a -> [a] -> [a]
:String
x)

showDT :: DT -> String
showDT :: DT -> String
showDT (Simple' IntMap Instructions
w CharMap Transition
t Transition
o) =
       String
"Simple' { dt_win = " forall a. [a] -> [a] -> [a]
++ String
seeWin1
  forall a. [a] -> [a] -> [a]
++ String
"\n        , dt_trans = " forall a. [a] -> [a] -> [a]
++ String
seeTrans1
  forall a. [a] -> [a] -> [a]
++ String
"\n        , dt_other = " forall a. [a] -> [a] -> [a]
++ Transition -> String
seeOther1 Transition
o
  forall a. [a] -> [a] -> [a]
++ String
"\n        }"
 where
  seeWin1 :: String
seeWin1 | forall a. IntMap a -> Bool
IMap.null IntMap Instructions
w = String
"No win"
          | Bool
otherwise = [String] -> String
indent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IntMap a -> [(Int, a)]
IMap.assocs forall a b. (a -> b) -> a -> b
$ IntMap Instructions
w

  seeTrans1 :: String
  seeTrans1 :: String
seeTrans1 | forall a. CharMap a -> Bool
Map.null CharMap Transition
t = String
"No (Char,Transition)"
            | Bool
otherwise = (Key
'\n'forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
indent forall a b. (a -> b) -> a -> b
$
     forall a b. (a -> b) -> [a] -> [b]
map (\(Key
char,Transition {trans_many :: Transition -> DFA
trans_many=DFA
dfa,trans_single :: Transition -> DFA
trans_single=DFA
dfa2,trans_how :: Transition -> DTrans
trans_how=DTrans
dtrans}) ->
                           forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"("
                                  ,forall a. Show a => a -> String
show Key
char
                                  ,String
", MANY "
                                  ,forall a. Show a => a -> String
show (DFA -> SetIndex
d_id DFA
dfa)
                                  ,String
", SINGLE "
                                  ,forall a. Show a => a -> String
show (DFA -> SetIndex
d_id DFA
dfa2)
                                  ,String
", \n"
                                  ,DTrans -> String
seeDTrans DTrans
dtrans
                                  ,String
")"]) (forall a. CharMap a -> [(Key, a)]
Map.assocs CharMap Transition
t)

  seeOther1 :: Transition -> String
seeOther1 (Transition {trans_many :: Transition -> DFA
trans_many=DFA
dfa,trans_single :: Transition -> DFA
trans_single=DFA
dfa2,trans_how :: Transition -> DTrans
trans_how=DTrans
dtrans}) =
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"(MANY "
           ,forall a. Show a => a -> String
show (DFA -> SetIndex
d_id DFA
dfa)
           ,String
", SINGLE "
           ,forall a. Show a => a -> String
show (DFA -> SetIndex
d_id DFA
dfa2)
           ,String
", \n"
           ,DTrans -> String
seeDTrans DTrans
dtrans
           ,String
")"]

showDT (Testing' WhichTest
wt EnumSet DoPa
d DT
a DT
b) = String
"Testing' { dt_test = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show WhichTest
wt
                          forall a. [a] -> [a] -> [a]
++ String
"\n         , dt_dopas = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show EnumSet DoPa
d
                          forall a. [a] -> [a] -> [a]
++ String
"\n         , dt_a = " forall a. [a] -> [a] -> [a]
++ DT -> String
indent' DT
a
                          forall a. [a] -> [a] -> [a]
++ String
"\n         , dt_b = " forall a. [a] -> [a] -> [a]
++ DT -> String
indent' DT
b
                          forall a. [a] -> [a] -> [a]
++ String
"\n         }"
 where indent' :: DT -> String
indent' = forall a. [a] -> [a]
init forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\[String]
s -> case [String]
s of
                                           [] -> []
                                           (String
h:[String]
t) -> String
h forall a. a -> [a] -> [a]
: (forall a b. (a -> b) -> [a] -> [b]
map (String
spaces forall a. [a] -> [a] -> [a]
++) [String]
t)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines forall b c a. (b -> c) -> (a -> b) -> a -> c
. DT -> String
showDT
       spaces :: String
spaces = forall a. Int -> a -> [a]
replicate Int
10 Key
' '


seeDTrans :: DTrans -> String
--seeDTrans x = concatMap (\(dest,y) -> unlines . map (\(source,ins) -> show (dest,source,ins) ) . IMap.assocs $ y) (IMap.assocs x)
seeDTrans :: DTrans -> String
seeDTrans DTrans
x | forall a. IntMap a -> Bool
IMap.null DTrans
x = String
"No DTrans"
seeDTrans DTrans
x = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a} {c}. (Show a, Show c) => (a, IntMap c) -> String
seeSource (forall a. IntMap a -> [(Int, a)]
IMap.assocs DTrans
x)
  where seeSource :: (a, IntMap c) -> String
seeSource (a
dest,IntMap c
srcMap) | forall a. IntMap a -> Bool
IMap.null IntMap c
srcMap = [String] -> String
indent [forall a. Show a => a -> String
show (a
dest,String
"SPAWN")]
                                | Bool
otherwise = [String] -> String
indent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(Int
source,c
ins) -> forall a. Show a => a -> String
show (a
dest,Int
source,c
ins) ) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IntMap a -> [(Int, a)]
IMap.assocs forall a b. (a -> b) -> a -> b
$ IntMap c
srcMap
--        spawnIns = Instructions { newPos = [(0,SetPost)], newOrbits = Nothing }


instance Eq QT where
  t1 :: QT
t1@(Testing {}) == :: QT -> QT -> Bool
== t2 :: QT
t2@(Testing {}) =
    (QT -> WhichTest
qt_test QT
t1) forall a. Eq a => a -> a -> Bool
== (QT -> WhichTest
qt_test QT
t2) Bool -> Bool -> Bool
&& (QT -> QT
qt_a QT
t1) forall a. Eq a => a -> a -> Bool
== (QT -> QT
qt_a QT
t2) Bool -> Bool -> Bool
&& (QT -> QT
qt_b QT
t1) forall a. Eq a => a -> a -> Bool
== (QT -> QT
qt_b QT
t2)
  (Simple WinTags
w1 (CharMap IntMap QTrans
t1) QTrans
o1) == (Simple WinTags
w2 (CharMap IntMap QTrans
t2) QTrans
o2) =
    WinTags
w1 forall a. Eq a => a -> a -> Bool
== WinTags
w2 Bool -> Bool -> Bool
&& Bool
eqTrans Bool -> Bool -> Bool
&& QTrans -> QTrans -> Bool
eqQTrans QTrans
o1 QTrans
o2
    where eqTrans :: Bool
          eqTrans :: Bool
eqTrans = (forall a. IntMap a -> Int
IMap.size IntMap QTrans
t1 forall a. Eq a => a -> a -> Bool
== forall a. IntMap a -> Int
IMap.size IntMap QTrans
t2)
                    Bool -> Bool -> Bool
&& forall (t :: * -> *). Foldable t => t Bool -> Bool
and (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a}. Eq a => (a, QTrans) -> (a, QTrans) -> Bool
together (forall a. IntMap a -> [(Int, a)]
IMap.toAscList IntMap QTrans
t1) (forall a. IntMap a -> [(Int, a)]
IMap.toAscList IntMap QTrans
t2))
            where together :: (a, QTrans) -> (a, QTrans) -> Bool
together (a
c1,QTrans
qtrans1) (a
c2,QTrans
qtrans2) = (a
c1 forall a. Eq a => a -> a -> Bool
== a
c2) Bool -> Bool -> Bool
&& QTrans -> QTrans -> Bool
eqQTrans QTrans
qtrans1 QTrans
qtrans2
          eqQTrans :: QTrans -> QTrans -> Bool
          eqQTrans :: QTrans -> QTrans -> Bool
eqQTrans = forall a. Eq a => a -> a -> Bool
(==)
  QT
_ == QT
_ = Bool
False