-- -----------------------------------------------------------------------------
-- 
-- NFA.hs, part of Alex
--
-- (c) Chris Dornan 1995-2000, Simon Marlow 2003
--
-- The `scanner2nfa' takes a `Scanner' (see the `RExp' module) and
-- generates its equivelent nondeterministic finite automaton.  NFAs
-- are turned into DFAs in the DFA module.
-- 
-- See the chapter on `Finite Automata and Lexical Analysis' in the
-- dragon book for an excellent overview of the algorithms in this
-- module.
--
-- ----------------------------------------------------------------------------}

module NFA where

import AbsSyn
import CharSet
import DFS ( t_close, out )
import Map ( Map )
import qualified Map hiding ( Map )
import Util ( str, space )

import Control.Applicative( Applicative(..) )
import Control.Monad ( forM_, zipWithM, zipWithM_, when, ap )
import Data.Array ( Array, (!), array, listArray, assocs, bounds )

-- Each state of a nondeterministic automaton contains a list of `Accept'
-- values, a list of epsilon transitions (an epsilon transition represents a
-- transition to another state that can be made without reading a character)
-- and a list of transitions qualified with a character predicate (the
-- transition can only be made to the given state on input of a character
-- permitted by the predicate).  Although a list of `Accept' values is provided
-- for, in actual fact each state will have zero or one of them (the `Maybe'
-- type is not used because the flexibility offered by the list representation
-- is useful).

type NFA = Array SNum NState

data NState = NSt {
 NState -> [Accept Code]
nst_accs :: [Accept Code],
 NState -> [SNum]
nst_cl   :: [SNum],
 NState -> [(ByteSet, SNum)]
nst_outs :: [(ByteSet,SNum)]
 }

-- Debug stuff
instance Show NState where
  showsPrec :: SNum -> NState -> ShowS
showsPrec SNum
_ (NSt [Accept Code]
accs [SNum]
cl [(ByteSet, SNum)]
outs) =
    Code -> ShowS
str Code
"NSt " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Accept Code] -> ShowS
forall a. Show a => a -> ShowS
shows [Accept Code]
accs ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
space ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SNum] -> ShowS
forall a. Show a => a -> ShowS
shows [SNum]
cl ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
space ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        [(ByteSet, SNum)] -> ShowS
forall a. Show a => a -> ShowS
shows [ (ByteSet
c, SNum
s) | (ByteSet
c,SNum
s) <- [(ByteSet, SNum)]
outs ]

{-                           From the Scan Module

-- The `Accept' structure contains the priority of the token being accepted
-- (lower numbers => higher priorities), the name of the token, a place holder
-- that can be used for storing the `action' function, a list of start codes
-- (listing the start codes that the scanner must be in for the token to be
-- accepted; empty => no restriction), the leading and trailing context (both
-- `Nothing' if there is none).
--  
-- The leading context consists simply of a character predicate that will
-- return true if the last character read is acceptable.  The trailing context
-- consists of an alternative starting state within the DFA; if this `sub-dfa'
-- turns up any accepting state when applied to the residual input then the
-- trailing context is acceptable.
-}


-- `scanner2nfa' takes a scanner (see the AbsSyn module) and converts it to an
-- NFA, using the NFA creation monad (see below).
--
-- We generate a start state for each startcode, with the same number
-- as that startcode, and epsilon transitions from this state to each
-- of the sub-NFAs for each of the tokens acceptable in that startcode.

scanner2nfa:: Encoding -> Scanner -> [StartCode] -> NFA
scanner2nfa :: Encoding -> Scanner -> [SNum] -> NFA
scanner2nfa Encoding
enc Scanner{scannerTokens :: Scanner -> [RECtx]
scannerTokens = [RECtx]
toks} [SNum]
startcodes
   = Encoding -> NFAM () -> NFA
runNFA Encoding
enc (NFAM () -> NFA) -> NFAM () -> NFA
forall a b. (a -> b) -> a -> b
$
        do
          -- make a start state for each start code (these will be
          -- numbered from zero).
          [SNum]
start_states <- [NFAM SNum] -> NFAM [SNum]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (SNum -> NFAM SNum -> [NFAM SNum]
forall a. SNum -> a -> [a]
replicate ([SNum] -> SNum
forall (t :: * -> *) a. Foldable t => t a -> SNum
length [SNum]
startcodes) NFAM SNum
newState)
          
          -- construct the NFA for each token
          [SNum]
tok_states <- (RECtx -> SNum -> NFAM SNum) -> [RECtx] -> [SNum] -> NFAM [SNum]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM RECtx -> SNum -> NFAM SNum
do_token [RECtx]
toks [SNum
0..]

          -- make an epsilon edge from each state state to each
          -- token that is acceptable in that state
          (SNum -> SNum -> NFAM ()) -> [SNum] -> [SNum] -> NFAM ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ ([(RECtx, SNum)] -> SNum -> SNum -> NFAM ()
tok_transitions ([RECtx] -> [SNum] -> [(RECtx, SNum)]
forall a b. [a] -> [b] -> [(a, b)]
zip [RECtx]
toks [SNum]
tok_states)) 
                [SNum]
startcodes [SNum]
start_states

        where
          do_token :: RECtx -> SNum -> NFAM SNum
do_token (RECtx [(Code, SNum)]
_scs Maybe CharSet
lctx RExp
re RightContext RExp
rctx Maybe Code
code) SNum
prio = do
                SNum
b <- NFAM SNum
newState
                SNum
e <- NFAM SNum
newState
                SNum -> SNum -> RExp -> NFAM ()
rexp2nfa SNum
b SNum
e RExp
re

                RightContext SNum
rctx_e <- case RightContext RExp
rctx of
                                  RightContext RExp
NoRightContext ->
                                        RightContext SNum -> NFAM (RightContext SNum)
forall (m :: * -> *) a. Monad m => a -> m a
return RightContext SNum
forall r. RightContext r
NoRightContext
                                  RightContextCode Code
code' ->
                                        RightContext SNum -> NFAM (RightContext SNum)
forall (m :: * -> *) a. Monad m => a -> m a
return (Code -> RightContext SNum
forall r. Code -> RightContext r
RightContextCode Code
code')
                                  RightContextRExp RExp
re' -> do 
                                        SNum
r_b <- NFAM SNum
newState
                                        SNum
r_e <- NFAM SNum
newState
                                        SNum -> SNum -> RExp -> NFAM ()
rexp2nfa SNum
r_b SNum
r_e RExp
re'
                                        SNum -> Accept Code -> NFAM ()
accept SNum
r_e Accept Code
rctxt_accept
                                        RightContext SNum -> NFAM (RightContext SNum)
forall (m :: * -> *) a. Monad m => a -> m a
return (SNum -> RightContext SNum
forall r. r -> RightContext r
RightContextRExp SNum
r_b)

                let lctx' :: Maybe CharSet
lctx' = case Maybe CharSet
lctx of
                                  Maybe CharSet
Nothing -> Maybe CharSet
forall a. Maybe a
Nothing
                                  Just CharSet
st -> CharSet -> Maybe CharSet
forall a. a -> Maybe a
Just CharSet
st

                SNum -> Accept Code -> NFAM ()
accept SNum
e (SNum
-> Maybe Code -> Maybe CharSet -> RightContext SNum -> Accept Code
forall a.
SNum -> Maybe a -> Maybe CharSet -> RightContext SNum -> Accept a
Acc SNum
prio Maybe Code
code Maybe CharSet
lctx' RightContext SNum
rctx_e)
                SNum -> NFAM SNum
forall (m :: * -> *) a. Monad m => a -> m a
return SNum
b

          tok_transitions :: [(RECtx, SNum)] -> SNum -> SNum -> NFAM ()
tok_transitions [(RECtx, SNum)]
toks_with_states SNum
start_code SNum
start_state = do
                let states :: [SNum]
states = [ SNum
s | (RECtx [(Code, SNum)]
scs Maybe CharSet
_ RExp
_ RightContext RExp
_ Maybe Code
_, SNum
s) <- [(RECtx, SNum)]
toks_with_states,
                                   [(Code, SNum)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Code, SNum)]
scs Bool -> Bool -> Bool
|| SNum
start_code SNum -> [SNum] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Code, SNum) -> SNum) -> [(Code, SNum)] -> [SNum]
forall a b. (a -> b) -> [a] -> [b]
map (Code, SNum) -> SNum
forall a b. (a, b) -> b
snd [(Code, SNum)]
scs ]
                (SNum -> NFAM ()) -> [SNum] -> NFAM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (SNum -> SNum -> NFAM ()
epsilonEdge SNum
start_state) [SNum]
states

-- -----------------------------------------------------------------------------
-- NFA creation from a regular expression

-- rexp2nfa B E R generates an NFA that begins in state B, recognises
-- R, and ends in state E only if R has been recognised. 

rexp2nfa :: SNum -> SNum -> RExp -> NFAM ()
rexp2nfa :: SNum -> SNum -> RExp -> NFAM ()
rexp2nfa SNum
b SNum
e RExp
Eps    = SNum -> SNum -> NFAM ()
epsilonEdge SNum
b SNum
e
rexp2nfa SNum
b SNum
e (Ch CharSet
p) = SNum -> CharSet -> SNum -> NFAM ()
charEdge SNum
b CharSet
p SNum
e
rexp2nfa SNum
b SNum
e (RExp
re1 :%% RExp
re2) = do
  SNum
s <- NFAM SNum
newState
  SNum -> SNum -> RExp -> NFAM ()
rexp2nfa SNum
b SNum
s RExp
re1
  SNum -> SNum -> RExp -> NFAM ()
rexp2nfa SNum
s SNum
e RExp
re2
rexp2nfa SNum
b SNum
e (RExp
re1 :| RExp
re2) = do
  SNum -> SNum -> RExp -> NFAM ()
rexp2nfa SNum
b SNum
e RExp
re1
  SNum -> SNum -> RExp -> NFAM ()
rexp2nfa SNum
b SNum
e RExp
re2
rexp2nfa SNum
b SNum
e (Star RExp
re) = do
  SNum
s <- NFAM SNum
newState
  SNum -> SNum -> NFAM ()
epsilonEdge SNum
b SNum
s
  SNum -> SNum -> RExp -> NFAM ()
rexp2nfa SNum
s SNum
s RExp
re
  SNum -> SNum -> NFAM ()
epsilonEdge SNum
s SNum
e
rexp2nfa SNum
b SNum
e (Plus RExp
re) = do
  SNum
s1 <- NFAM SNum
newState
  SNum
s2 <- NFAM SNum
newState
  SNum -> SNum -> RExp -> NFAM ()
rexp2nfa SNum
s1 SNum
s2 RExp
re
  SNum -> SNum -> NFAM ()
epsilonEdge SNum
b SNum
s1
  SNum -> SNum -> NFAM ()
epsilonEdge SNum
s2 SNum
s1
  SNum -> SNum -> NFAM ()
epsilonEdge SNum
s2 SNum
e
rexp2nfa SNum
b SNum
e (Ques RExp
re) = do
  SNum -> SNum -> RExp -> NFAM ()
rexp2nfa SNum
b SNum
e RExp
re
  SNum -> SNum -> NFAM ()
epsilonEdge SNum
b SNum
e

-- -----------------------------------------------------------------------------
-- NFA creation monad.

-- Partial credit to Thomas Hallgren for this code, as I adapted it from
-- his "Lexing Haskell in Haskell" lexer generator.

type MapNFA = Map SNum NState

newtype NFAM a = N {NFAM a -> SNum -> MapNFA -> Encoding -> (SNum, MapNFA, a)
unN :: SNum -> MapNFA -> Encoding -> (SNum, MapNFA, a)}

instance Monad NFAM where
  return :: a -> NFAM a
return a
a = (SNum -> MapNFA -> Encoding -> (SNum, MapNFA, a)) -> NFAM a
forall a.
(SNum -> MapNFA -> Encoding -> (SNum, MapNFA, a)) -> NFAM a
N ((SNum -> MapNFA -> Encoding -> (SNum, MapNFA, a)) -> NFAM a)
-> (SNum -> MapNFA -> Encoding -> (SNum, MapNFA, a)) -> NFAM a
forall a b. (a -> b) -> a -> b
$ \SNum
s MapNFA
n Encoding
e -> (SNum
s,MapNFA
n,a
a)

  NFAM a
m >>= :: NFAM a -> (a -> NFAM b) -> NFAM b
>>= a -> NFAM b
k  = (SNum -> MapNFA -> Encoding -> (SNum, MapNFA, b)) -> NFAM b
forall a.
(SNum -> MapNFA -> Encoding -> (SNum, MapNFA, a)) -> NFAM a
N ((SNum -> MapNFA -> Encoding -> (SNum, MapNFA, b)) -> NFAM b)
-> (SNum -> MapNFA -> Encoding -> (SNum, MapNFA, b)) -> NFAM b
forall a b. (a -> b) -> a -> b
$ \SNum
s MapNFA
n Encoding
e -> case NFAM a -> SNum -> MapNFA -> Encoding -> (SNum, MapNFA, a)
forall a. NFAM a -> SNum -> MapNFA -> Encoding -> (SNum, MapNFA, a)
unN NFAM a
m SNum
s MapNFA
n Encoding
e of
                                 (SNum
s', MapNFA
n', a
a) -> NFAM b -> SNum -> MapNFA -> Encoding -> (SNum, MapNFA, b)
forall a. NFAM a -> SNum -> MapNFA -> Encoding -> (SNum, MapNFA, a)
unN (a -> NFAM b
k a
a) SNum
s' MapNFA
n' Encoding
e

instance Functor NFAM where
  fmap :: (a -> b) -> NFAM a -> NFAM b
fmap a -> b
f NFAM a
a = NFAM a
a NFAM a -> (a -> NFAM b) -> NFAM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (b -> NFAM b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> NFAM b) -> (a -> b) -> a -> NFAM b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

instance Applicative NFAM where
  <*> :: NFAM (a -> b) -> NFAM a -> NFAM b
(<*>) = NFAM (a -> b) -> NFAM a -> NFAM b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
  pure :: a -> NFAM a
pure = a -> NFAM a
forall (m :: * -> *) a. Monad m => a -> m a
return

runNFA :: Encoding -> NFAM () -> NFA
runNFA :: Encoding -> NFAM () -> NFA
runNFA Encoding
e NFAM ()
m = case NFAM () -> SNum -> MapNFA -> Encoding -> (SNum, MapNFA, ())
forall a. NFAM a -> SNum -> MapNFA -> Encoding -> (SNum, MapNFA, a)
unN NFAM ()
m SNum
0 MapNFA
forall k a. Map k a
Map.empty Encoding
e of
                (SNum
s, MapNFA
nfa_map, ()) -> -- trace ("runNfa.." ++ show (Map.toAscList nfa_map)) $ 
                                    NFA -> NFA
e_close ((SNum, SNum) -> [(SNum, NState)] -> NFA
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (SNum
0,SNum
sSNum -> SNum -> SNum
forall a. Num a => a -> a -> a
-SNum
1) (MapNFA -> [(SNum, NState)]
forall k a. Map k a -> [(k, a)]
Map.toAscList MapNFA
nfa_map))

e_close:: Array Int NState -> NFA
e_close :: NFA -> NFA
e_close NFA
ar = (SNum, SNum) -> [NState] -> NFA
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (SNum, SNum)
bds
                [[Accept Code] -> [SNum] -> [(ByteSet, SNum)] -> NState
NSt [Accept Code]
accs (Graph -> SNum -> [SNum]
out Graph
gr SNum
v) [(ByteSet, SNum)]
outs|(SNum
v,NSt [Accept Code]
accs [SNum]
_ [(ByteSet, SNum)]
outs)<-NFA -> [(SNum, NState)]
forall i e. Ix i => Array i e -> [(i, e)]
assocs NFA
ar]
        where
        gr :: Graph
gr = Graph -> Graph
t_close (SNum
hiSNum -> SNum -> SNum
forall a. Num a => a -> a -> a
+SNum
1,\SNum
v->NState -> [SNum]
nst_cl (NFA
arNFA -> SNum -> NState
forall i e. Ix i => Array i e -> i -> e
!SNum
v))
        bds :: (SNum, SNum)
bds@(SNum
_,SNum
hi) = NFA -> (SNum, SNum)
forall i e. Array i e -> (i, i)
bounds NFA
ar

newState :: NFAM SNum
newState :: NFAM SNum
newState = (SNum -> MapNFA -> Encoding -> (SNum, MapNFA, SNum)) -> NFAM SNum
forall a.
(SNum -> MapNFA -> Encoding -> (SNum, MapNFA, a)) -> NFAM a
N ((SNum -> MapNFA -> Encoding -> (SNum, MapNFA, SNum)) -> NFAM SNum)
-> (SNum -> MapNFA -> Encoding -> (SNum, MapNFA, SNum))
-> NFAM SNum
forall a b. (a -> b) -> a -> b
$ \SNum
s MapNFA
n Encoding
e -> (SNum
sSNum -> SNum -> SNum
forall a. Num a => a -> a -> a
+SNum
1,MapNFA
n,SNum
s)

getEncoding :: NFAM Encoding
getEncoding :: NFAM Encoding
getEncoding = (SNum -> MapNFA -> Encoding -> (SNum, MapNFA, Encoding))
-> NFAM Encoding
forall a.
(SNum -> MapNFA -> Encoding -> (SNum, MapNFA, a)) -> NFAM a
N ((SNum -> MapNFA -> Encoding -> (SNum, MapNFA, Encoding))
 -> NFAM Encoding)
-> (SNum -> MapNFA -> Encoding -> (SNum, MapNFA, Encoding))
-> NFAM Encoding
forall a b. (a -> b) -> a -> b
$ \SNum
s MapNFA
n Encoding
e -> (SNum
s,MapNFA
n,Encoding
e)

anyBytes :: SNum -> Int -> SNum -> NFAM ()
anyBytes :: SNum -> SNum -> SNum -> NFAM ()
anyBytes SNum
from SNum
0 SNum
to = SNum -> SNum -> NFAM ()
epsilonEdge SNum
from SNum
to
anyBytes SNum
from SNum
n SNum
to = do
        SNum
s <- NFAM SNum
newState
        SNum -> ByteSet -> SNum -> NFAM ()
byteEdge SNum
from (Byte -> Byte -> ByteSet
byteSetRange Byte
0 Byte
0xff) SNum
s
        SNum -> SNum -> SNum -> NFAM ()
anyBytes SNum
s (SNum
nSNum -> SNum -> SNum
forall a. Num a => a -> a -> a
-SNum
1) SNum
to

bytesEdge :: SNum -> [Byte] -> [Byte] -> SNum -> NFAM ()
bytesEdge :: SNum -> [Byte] -> [Byte] -> SNum -> NFAM ()
bytesEdge SNum
from [] [] SNum
to = SNum -> SNum -> NFAM ()
epsilonEdge SNum
from SNum
to
bytesEdge SNum
from [Byte
x] [Byte
y] SNum
to = SNum -> ByteSet -> SNum -> NFAM ()
byteEdge SNum
from (Byte -> Byte -> ByteSet
byteSetRange Byte
x Byte
y) SNum
to -- (OPTIMISATION)
bytesEdge SNum
from (Byte
x:[Byte]
xs) (Byte
y:[Byte]
ys) SNum
to 
    | Byte
x Byte -> Byte -> Bool
forall a. Eq a => a -> a -> Bool
== Byte
y = do 
        SNum
s <- NFAM SNum
newState
        SNum -> ByteSet -> SNum -> NFAM ()
byteEdge SNum
from (Byte -> ByteSet
byteSetSingleton Byte
x) SNum
s
        SNum -> [Byte] -> [Byte] -> SNum -> NFAM ()
bytesEdge SNum
s [Byte]
xs [Byte]
ys SNum
to
    | Byte
x Byte -> Byte -> Bool
forall a. Ord a => a -> a -> Bool
< Byte
y = do
        do SNum
s <- NFAM SNum
newState
           SNum -> ByteSet -> SNum -> NFAM ()
byteEdge SNum
from (Byte -> ByteSet
byteSetSingleton Byte
x) SNum
s
           SNum -> [Byte] -> [Byte] -> SNum -> NFAM ()
bytesEdge SNum
s [Byte]
xs ((Byte -> Byte) -> [Byte] -> [Byte]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Byte -> Byte -> Byte
forall a b. a -> b -> a
const Byte
0xff) [Byte]
ys) SNum
to

        do SNum
t <- NFAM SNum
newState
           SNum -> ByteSet -> SNum -> NFAM ()
byteEdge SNum
from (Byte -> ByteSet
byteSetSingleton Byte
y) SNum
t
           SNum -> [Byte] -> [Byte] -> SNum -> NFAM ()
bytesEdge SNum
t ((Byte -> Byte) -> [Byte] -> [Byte]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Byte -> Byte -> Byte
forall a b. a -> b -> a
const Byte
0x00) [Byte]
xs) [Byte]
ys SNum
to

        Bool -> NFAM () -> NFAM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Byte
xByte -> Byte -> Byte
forall a. Num a => a -> a -> a
+Byte
1) Byte -> Byte -> Bool
forall a. Ord a => a -> a -> Bool
<= (Byte
yByte -> Byte -> Byte
forall a. Num a => a -> a -> a
-Byte
1)) (NFAM () -> NFAM ()) -> NFAM () -> NFAM ()
forall a b. (a -> b) -> a -> b
$ do 
           SNum
u <- NFAM SNum
newState
           SNum -> ByteSet -> SNum -> NFAM ()
byteEdge SNum
from (Byte -> Byte -> ByteSet
byteSetRange (Byte
xByte -> Byte -> Byte
forall a. Num a => a -> a -> a
+Byte
1) (Byte
yByte -> Byte -> Byte
forall a. Num a => a -> a -> a
-Byte
1)) SNum
u
           SNum -> SNum -> SNum -> NFAM ()
anyBytes SNum
u ([Byte] -> SNum
forall (t :: * -> *) a. Foldable t => t a -> SNum
length [Byte]
xs) SNum
to

charEdge :: SNum -> CharSet -> SNum -> NFAM ()
charEdge :: SNum -> CharSet -> SNum -> NFAM ()
charEdge SNum
from CharSet
charset SNum
to = do
  -- trace ("charEdge: " ++ (show $ charset) ++ " => " ++ show (byteRanges charset)) $ 
  Encoding
e <- NFAM Encoding
getEncoding
  [([Byte], [Byte])] -> (([Byte], [Byte]) -> NFAM ()) -> NFAM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Encoding -> CharSet -> [([Byte], [Byte])]
byteRanges Encoding
e CharSet
charset) ((([Byte], [Byte]) -> NFAM ()) -> NFAM ())
-> (([Byte], [Byte]) -> NFAM ()) -> NFAM ()
forall a b. (a -> b) -> a -> b
$ \([Byte]
xs,[Byte]
ys) -> do
    SNum -> [Byte] -> [Byte] -> SNum -> NFAM ()
bytesEdge SNum
from [Byte]
xs [Byte]
ys SNum
to
    


byteEdge :: SNum -> ByteSet -> SNum -> NFAM ()
byteEdge :: SNum -> ByteSet -> SNum -> NFAM ()
byteEdge SNum
from ByteSet
charset SNum
to = (SNum -> MapNFA -> Encoding -> (SNum, MapNFA, ())) -> NFAM ()
forall a.
(SNum -> MapNFA -> Encoding -> (SNum, MapNFA, a)) -> NFAM a
N ((SNum -> MapNFA -> Encoding -> (SNum, MapNFA, ())) -> NFAM ())
-> (SNum -> MapNFA -> Encoding -> (SNum, MapNFA, ())) -> NFAM ()
forall a b. (a -> b) -> a -> b
$ \SNum
s MapNFA
n Encoding
e -> (SNum
s, MapNFA -> MapNFA
addEdge MapNFA
n, ())
 where
   addEdge :: MapNFA -> MapNFA
addEdge MapNFA
n =
     case SNum -> MapNFA -> Maybe NState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup SNum
from MapNFA
n of
       Maybe NState
Nothing -> 
           SNum -> NState -> MapNFA -> MapNFA
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert SNum
from ([Accept Code] -> [SNum] -> [(ByteSet, SNum)] -> NState
NSt [] [] [(ByteSet
charset,SNum
to)]) MapNFA
n
       Just (NSt [Accept Code]
acc [SNum]
eps [(ByteSet, SNum)]
trans) ->
           SNum -> NState -> MapNFA -> MapNFA
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert SNum
from ([Accept Code] -> [SNum] -> [(ByteSet, SNum)] -> NState
NSt [Accept Code]
acc [SNum]
eps ((ByteSet
charset,SNum
to)(ByteSet, SNum) -> [(ByteSet, SNum)] -> [(ByteSet, SNum)]
forall a. a -> [a] -> [a]
:[(ByteSet, SNum)]
trans)) MapNFA
n

epsilonEdge :: SNum -> SNum -> NFAM ()
epsilonEdge :: SNum -> SNum -> NFAM ()
epsilonEdge SNum
from SNum
to 
 | SNum
from SNum -> SNum -> Bool
forall a. Eq a => a -> a -> Bool
== SNum
to = () -> NFAM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
 | Bool
otherwise  = (SNum -> MapNFA -> Encoding -> (SNum, MapNFA, ())) -> NFAM ()
forall a.
(SNum -> MapNFA -> Encoding -> (SNum, MapNFA, a)) -> NFAM a
N ((SNum -> MapNFA -> Encoding -> (SNum, MapNFA, ())) -> NFAM ())
-> (SNum -> MapNFA -> Encoding -> (SNum, MapNFA, ())) -> NFAM ()
forall a b. (a -> b) -> a -> b
$ \SNum
s MapNFA
n Encoding
e -> (SNum
s, MapNFA -> MapNFA
addEdge MapNFA
n, ())
 where
   addEdge :: MapNFA -> MapNFA
addEdge MapNFA
n =
     case SNum -> MapNFA -> Maybe NState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup SNum
from MapNFA
n of
       Maybe NState
Nothing                  -> SNum -> NState -> MapNFA -> MapNFA
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert SNum
from ([Accept Code] -> [SNum] -> [(ByteSet, SNum)] -> NState
NSt [] [SNum
to] []) MapNFA
n
       Just (NSt [Accept Code]
acc [SNum]
eps [(ByteSet, SNum)]
trans) -> SNum -> NState -> MapNFA -> MapNFA
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert SNum
from ([Accept Code] -> [SNum] -> [(ByteSet, SNum)] -> NState
NSt [Accept Code]
acc (SNum
toSNum -> [SNum] -> [SNum]
forall a. a -> [a] -> [a]
:[SNum]
eps) [(ByteSet, SNum)]
trans) MapNFA
n

accept :: SNum -> Accept Code -> NFAM ()
accept :: SNum -> Accept Code -> NFAM ()
accept SNum
state Accept Code
new_acc = (SNum -> MapNFA -> Encoding -> (SNum, MapNFA, ())) -> NFAM ()
forall a.
(SNum -> MapNFA -> Encoding -> (SNum, MapNFA, a)) -> NFAM a
N ((SNum -> MapNFA -> Encoding -> (SNum, MapNFA, ())) -> NFAM ())
-> (SNum -> MapNFA -> Encoding -> (SNum, MapNFA, ())) -> NFAM ()
forall a b. (a -> b) -> a -> b
$ \SNum
s MapNFA
n Encoding
e -> (SNum
s, MapNFA -> MapNFA
addAccept MapNFA
n, ())
 where
   addAccept :: MapNFA -> MapNFA
addAccept MapNFA
n = 
     case SNum -> MapNFA -> Maybe NState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup SNum
state MapNFA
n of
       Maybe NState
Nothing ->
           SNum -> NState -> MapNFA -> MapNFA
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert SNum
state ([Accept Code] -> [SNum] -> [(ByteSet, SNum)] -> NState
NSt [Accept Code
new_acc] [] []) MapNFA
n
       Just (NSt [Accept Code]
acc [SNum]
eps [(ByteSet, SNum)]
trans) ->
           SNum -> NState -> MapNFA -> MapNFA
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert SNum
state ([Accept Code] -> [SNum] -> [(ByteSet, SNum)] -> NState
NSt (Accept Code
new_accAccept Code -> [Accept Code] -> [Accept Code]
forall a. a -> [a] -> [a]
:[Accept Code]
acc) [SNum]
eps [(ByteSet, SNum)]
trans) MapNFA
n


rctxt_accept :: Accept Code
rctxt_accept :: Accept Code
rctxt_accept = SNum
-> Maybe Code -> Maybe CharSet -> RightContext SNum -> Accept Code
forall a.
SNum -> Maybe a -> Maybe CharSet -> RightContext SNum -> Accept a
Acc SNum
0 Maybe Code
forall a. Maybe a
Nothing Maybe CharSet
forall a. Maybe a
Nothing RightContext SNum
forall r. RightContext r
NoRightContext