module DFA(scanner2dfa) where
import AbsSyn
import qualified Map
import qualified Data.IntMap as IntMap
import NFA
import Sort ( msort, nub' )
import CharSet
import Data.Array ( (!) )
import Data.Maybe ( fromJust )
scanner2dfa:: Encoding -> Scanner -> [StartCode] -> DFA SNum Code
scanner2dfa :: Encoding -> Scanner -> [SNum] -> DFA SNum Code
scanner2dfa Encoding
enc Scanner
scanner [SNum]
scs = [SNum] -> NFA -> DFA SNum Code
nfa2dfa [SNum]
scs (Encoding -> Scanner -> [SNum] -> NFA
scanner2nfa Encoding
enc Scanner
scanner [SNum]
scs)
nfa2dfa:: [StartCode] -> NFA -> DFA SNum Code
nfa2dfa :: [SNum] -> NFA -> DFA SNum Code
nfa2dfa [SNum]
scs NFA
nfa = NFA -> DFA [SNum] Code -> DFA SNum Code
forall a. NFA -> DFA [SNum] a -> DFA SNum a
mk_int_dfa NFA
nfa (NFA -> DFA [SNum] Code -> [[SNum]] -> DFA [SNum] Code
nfa2pdfa NFA
nfa DFA [SNum] Code
forall {a}. DFA [SNum] a
pdfa (DFA [SNum] Any -> [[SNum]]
forall s a. DFA s a -> [s]
dfa_start_states DFA [SNum] Any
forall {a}. DFA [SNum] a
pdfa))
where
pdfa :: DFA [SNum] a
pdfa = SNum -> NFA -> DFA [SNum] a
forall a. SNum -> NFA -> DFA [SNum] a
new_pdfa SNum
n_starts NFA
nfa
n_starts :: SNum
n_starts = [SNum] -> SNum
forall (t :: * -> *) a. Foldable t => t a -> SNum
length [SNum]
scs
nfa2pdfa:: NFA -> DFA StateSet Code -> [StateSet] -> DFA StateSet Code
nfa2pdfa :: NFA -> DFA [SNum] Code -> [[SNum]] -> DFA [SNum] Code
nfa2pdfa NFA
_ DFA [SNum] Code
pdfa [] = DFA [SNum] Code
pdfa
nfa2pdfa NFA
nfa DFA [SNum] Code
pdfa ([SNum]
ss:[[SNum]]
umkd)
| [SNum]
ss [SNum] -> DFA [SNum] Code -> Bool
forall a. [SNum] -> DFA [SNum] a -> Bool
`in_pdfa` DFA [SNum] Code
pdfa = NFA -> DFA [SNum] Code -> [[SNum]] -> DFA [SNum] Code
nfa2pdfa NFA
nfa DFA [SNum] Code
pdfa [[SNum]]
umkd
| Bool
otherwise = NFA -> DFA [SNum] Code -> [[SNum]] -> DFA [SNum] Code
nfa2pdfa NFA
nfa DFA [SNum] Code
pdfa' [[SNum]]
umkd'
where
pdfa' :: DFA [SNum] Code
pdfa' = [SNum] -> State [SNum] Code -> DFA [SNum] Code -> DFA [SNum] Code
forall a. [SNum] -> State [SNum] a -> DFA [SNum] a -> DFA [SNum] a
add_pdfa [SNum]
ss ([Accept Code] -> IntMap [SNum] -> State [SNum] Code
forall s a. [Accept a] -> IntMap s -> State s a
State [Accept Code]
accs ([(SNum, [SNum])] -> IntMap [SNum]
forall a. [(SNum, a)] -> IntMap a
IntMap.fromList [(SNum, [SNum])]
ss_outs)) DFA [SNum] Code
pdfa
umkd' :: [[SNum]]
umkd' = [[SNum]]
rctx_sss [[SNum]] -> [[SNum]] -> [[SNum]]
forall a. [a] -> [a] -> [a]
++ ((SNum, [SNum]) -> [SNum]) -> [(SNum, [SNum])] -> [[SNum]]
forall a b. (a -> b) -> [a] -> [b]
map (SNum, [SNum]) -> [SNum]
forall a b. (a, b) -> b
snd [(SNum, [SNum])]
ss_outs [[SNum]] -> [[SNum]] -> [[SNum]]
forall a. [a] -> [a] -> [a]
++ [[SNum]]
umkd
ss_outs :: [(Int, StateSet)]
ss_outs :: [(SNum, [SNum])]
ss_outs = [ (Byte -> SNum
forall a b. (Integral a, Num b) => a -> b
fromIntegral Byte
ch, NFA -> [SNum] -> [SNum]
mk_ss NFA
nfa [SNum]
ss')
| Byte
ch <- ByteSet -> [Byte]
byteSetElems (ByteSet -> [Byte]) -> ByteSet -> [Byte]
forall a b. (a -> b) -> a -> b
$ [ByteSet] -> ByteSet
forall a. DiscreteOrdered a => [RSet a] -> RSet a
setUnions [ByteSet
p | (ByteSet
p,SNum
_) <- [(ByteSet, SNum)]
outs],
let ss' :: [SNum]
ss' = [ SNum
s' | (ByteSet
p,SNum
s') <- [(ByteSet, SNum)]
outs, ByteSet -> Byte -> Bool
byteSetElem ByteSet
p Byte
ch ],
Bool -> Bool
not ([SNum] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SNum]
ss')
]
rctx_sss :: [[SNum]]
rctx_sss = [ NFA -> [SNum] -> [SNum]
mk_ss NFA
nfa [SNum
s]
| Acc SNum
_ Maybe Code
_ Maybe CharSet
_ (RightContextRExp SNum
s) <- [Accept Code]
accs ]
outs :: [(ByteSet,SNum)]
outs :: [(ByteSet, SNum)]
outs = [ (ByteSet, SNum)
out | SNum
s <- [SNum]
ss, (ByteSet, SNum)
out <- NState -> [(ByteSet, SNum)]
nst_outs (NFA
nfaNFA -> SNum -> NState
forall i e. Ix i => Array i e -> i -> e
!SNum
s) ]
accs :: [Accept Code]
accs = [Accept Code] -> [Accept Code]
forall a. [Accept a] -> [Accept a]
sort_accs [Accept Code
acc| SNum
s<-[SNum]
ss, Accept Code
acc<-NState -> [Accept Code]
nst_accs (NFA
nfaNFA -> SNum -> NState
forall i e. Ix i => Array i e -> i -> e
!SNum
s)]
sort_accs:: [Accept a] -> [Accept a]
sort_accs :: forall a. [Accept a] -> [Accept a]
sort_accs [Accept a]
accs = (Accept a -> [Accept a] -> [Accept a])
-> [Accept a] -> [Accept a] -> [Accept a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Accept a -> [Accept a] -> [Accept a]
forall {a}. Accept a -> [Accept a] -> [Accept a]
chk [] ((Accept a -> Accept a -> Bool) -> [Accept a] -> [Accept a]
forall a. (a -> a -> Bool) -> [a] -> [a]
msort Accept a -> Accept a -> Bool
forall {a} {a}. Accept a -> Accept a -> Bool
le [Accept a]
accs)
where
chk :: Accept a -> [Accept a] -> [Accept a]
chk acc :: Accept a
acc@(Acc SNum
_ Maybe a
_ Maybe CharSet
Nothing RightContext SNum
NoRightContext) [Accept a]
_ = [Accept a
acc]
chk Accept a
acc [Accept a]
rst = Accept a
accAccept a -> [Accept a] -> [Accept a]
forall a. a -> [a] -> [a]
:[Accept a]
rst
le :: Accept a -> Accept a -> Bool
le (Acc{accPrio :: forall a. Accept a -> SNum
accPrio = SNum
n}) (Acc{accPrio :: forall a. Accept a -> SNum
accPrio=SNum
n'}) = SNum
nSNum -> SNum -> Bool
forall a. Ord a => a -> a -> Bool
<=SNum
n'
type StateSet = [SNum]
new_pdfa:: Int -> NFA -> DFA StateSet a
new_pdfa :: forall a. SNum -> NFA -> DFA [SNum] a
new_pdfa SNum
starts NFA
nfa
= DFA :: forall s a. [s] -> Map s (State s a) -> DFA s a
DFA { dfa_start_states :: [[SNum]]
dfa_start_states = [[SNum]]
start_ss,
dfa_states :: Map [SNum] (State [SNum] a)
dfa_states = Map [SNum] (State [SNum] a)
forall k a. Map k a
Map.empty
}
where
start_ss :: [[SNum]]
start_ss = [ (SNum -> SNum -> Bool) -> [SNum] -> [SNum]
forall a. (a -> a -> Bool) -> [a] -> [a]
msort SNum -> SNum -> Bool
forall a. Ord a => a -> a -> Bool
(<=) (NState -> [SNum]
nst_cl(NFA
nfaNFA -> SNum -> NState
forall i e. Ix i => Array i e -> i -> e
!SNum
n)) | SNum
n <- [SNum
0..(SNum
startsSNum -> SNum -> SNum
forall a. Num a => a -> a -> a
-SNum
1)]]
mk_ss:: NFA -> [SNum] -> StateSet
mk_ss :: NFA -> [SNum] -> [SNum]
mk_ss NFA
nfa [SNum]
l = (SNum -> SNum -> Bool) -> [SNum] -> [SNum]
forall a. (a -> a -> Bool) -> [a] -> [a]
nub' SNum -> SNum -> Bool
forall a. Ord a => a -> a -> Bool
(<=) [SNum
s'| SNum
s<-[SNum]
l, SNum
s'<-NState -> [SNum]
nst_cl(NFA
nfaNFA -> SNum -> NState
forall i e. Ix i => Array i e -> i -> e
!SNum
s)]
add_pdfa:: StateSet -> State StateSet a -> DFA StateSet a -> DFA StateSet a
add_pdfa :: forall a. [SNum] -> State [SNum] a -> DFA [SNum] a -> DFA [SNum] a
add_pdfa [SNum]
ss State [SNum] a
pst (DFA [[SNum]]
st Map [SNum] (State [SNum] a)
mp) = [[SNum]] -> Map [SNum] (State [SNum] a) -> DFA [SNum] a
forall s a. [s] -> Map s (State s a) -> DFA s a
DFA [[SNum]]
st ([SNum]
-> State [SNum] a
-> Map [SNum] (State [SNum] a)
-> Map [SNum] (State [SNum] a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert [SNum]
ss State [SNum] a
pst Map [SNum] (State [SNum] a)
mp)
in_pdfa:: StateSet -> DFA StateSet a -> Bool
in_pdfa :: forall a. [SNum] -> DFA [SNum] a -> Bool
in_pdfa [SNum]
ss (DFA [[SNum]]
_ Map [SNum] (State [SNum] a)
mp) = [SNum]
ss [SNum] -> Map [SNum] (State [SNum] a) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map [SNum] (State [SNum] a)
mp
mk_int_dfa:: NFA -> DFA StateSet a -> DFA SNum a
mk_int_dfa :: forall a. NFA -> DFA [SNum] a -> DFA SNum a
mk_int_dfa NFA
nfa (DFA [[SNum]]
start_states Map [SNum] (State [SNum] a)
mp)
= [SNum] -> Map SNum (State SNum a) -> DFA SNum a
forall s a. [s] -> Map s (State s a) -> DFA s a
DFA [SNum
0 .. [[SNum]] -> SNum
forall (t :: * -> *) a. Foldable t => t a -> SNum
length [[SNum]]
start_statesSNum -> SNum -> SNum
forall a. Num a => a -> a -> a
-SNum
1]
([(SNum, State SNum a)] -> Map SNum (State SNum a)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ ([SNum] -> SNum
lookup' [SNum]
st, State [SNum] a -> State SNum a
forall a. State [SNum] a -> State SNum a
cnv State [SNum] a
pds) | ([SNum]
st, State [SNum] a
pds) <- Map [SNum] (State [SNum] a) -> [([SNum], State [SNum] a)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map [SNum] (State [SNum] a)
mp ])
where
mp' :: Map [SNum] SNum
mp' = [([SNum], SNum)] -> Map [SNum] SNum
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([[SNum]] -> [SNum] -> [([SNum], SNum)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([[SNum]]
start_states [[SNum]] -> [[SNum]] -> [[SNum]]
forall a. [a] -> [a] -> [a]
++
((([SNum], State [SNum] a) -> [SNum])
-> [([SNum], State [SNum] a)] -> [[SNum]]
forall a b. (a -> b) -> [a] -> [b]
map ([SNum], State [SNum] a) -> [SNum]
forall a b. (a, b) -> a
fst ([([SNum], State [SNum] a)] -> [[SNum]])
-> (Map [SNum] (State [SNum] a) -> [([SNum], State [SNum] a)])
-> Map [SNum] (State [SNum] a)
-> [[SNum]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map [SNum] (State [SNum] a) -> [([SNum], State [SNum] a)]
forall k a. Map k a -> [(k, a)]
Map.toAscList) (([SNum]
-> Map [SNum] (State [SNum] a) -> Map [SNum] (State [SNum] a))
-> Map [SNum] (State [SNum] a)
-> [[SNum]]
-> Map [SNum] (State [SNum] a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [SNum]
-> Map [SNum] (State [SNum] a) -> Map [SNum] (State [SNum] a)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Map [SNum] (State [SNum] a)
mp [[SNum]]
start_states)) [SNum
0..])
lookup' :: [SNum] -> SNum
lookup' = Maybe SNum -> SNum
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe SNum -> SNum) -> ([SNum] -> Maybe SNum) -> [SNum] -> SNum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SNum] -> Map [SNum] SNum -> Maybe SNum)
-> Map [SNum] SNum -> [SNum] -> Maybe SNum
forall a b c. (a -> b -> c) -> b -> a -> c
flip [SNum] -> Map [SNum] SNum -> Maybe SNum
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Map [SNum] SNum
mp'
cnv :: State StateSet a -> State SNum a
cnv :: forall a. State [SNum] a -> State SNum a
cnv (State [Accept a]
accs IntMap [SNum]
as) = [Accept a] -> IntMap SNum -> State SNum a
forall s a. [Accept a] -> IntMap s -> State s a
State [Accept a]
accs' IntMap SNum
as'
where
as' :: IntMap SNum
as' = (SNum -> [SNum] -> SNum) -> IntMap [SNum] -> IntMap SNum
forall a b. (SNum -> a -> b) -> IntMap a -> IntMap b
IntMap.mapWithKey (\SNum
_ch [SNum]
s -> [SNum] -> SNum
lookup' [SNum]
s) IntMap [SNum]
as
accs' :: [Accept a]
accs' = (Accept a -> Accept a) -> [Accept a] -> [Accept a]
forall a b. (a -> b) -> [a] -> [b]
map Accept a -> Accept a
forall {a}. Accept a -> Accept a
cnv_acc [Accept a]
accs
cnv_acc :: Accept a -> Accept a
cnv_acc (Acc SNum
p Maybe a
a Maybe CharSet
lctx RightContext SNum
rctx) = SNum -> Maybe a -> Maybe CharSet -> RightContext SNum -> Accept a
forall a.
SNum -> Maybe a -> Maybe CharSet -> RightContext SNum -> Accept a
Acc SNum
p Maybe a
a Maybe CharSet
lctx RightContext SNum
rctx'
where rctx' :: RightContext SNum
rctx' =
case RightContext SNum
rctx of
RightContextRExp SNum
s ->
SNum -> RightContext SNum
forall r. r -> RightContext r
RightContextRExp ([SNum] -> SNum
lookup' (NFA -> [SNum] -> [SNum]
mk_ss NFA
nfa [SNum
s]))
RightContext SNum
other -> RightContext SNum
other