module Language.HaLex.Ndfa (
Ndfa (..)
, ndfaaccept
, ndfawalk
, epsilon_closure
, ttNdfa2Ndfa
, ndfaTransitionsFromTo
, ndfadestinationsFrom
, transitionTableNdfa
, ndfareachedStatesFrom
, toHaskell
, renameNdfa
, showNdfaDelta
, sizeNdfa
, ndfadeadstates
, ndfaIsStDead
, ndfaIsSyncState
, ndfanumberIncomingArrows
, ndfanumberOutgoingArrows
) where
import Data.List
import Language.HaLex.Util
import Language.HaLex.Dfa
data Ndfa st sy = Ndfa [sy]
[st]
[st]
[st]
(st -> Maybe sy -> [st])
ndfaaccept :: Ord st
=> Ndfa st sy
-> [sy]
-> Bool
ndfaaccept (Ndfa _ _ s z delta) symbs =
(ndfawalk delta (epsilon_closure delta s) symbs) `intersect` z /= []
ndfawalk :: Ord st
=> (st -> Maybe sy -> [st])
-> [st]
-> [sy]
-> [st]
ndfawalk delta sts [] = sts
ndfawalk delta sts (x:xs) =
ndfawalk delta (epsilon_closure delta (delta' delta sts (Just x))) xs
delta' :: Eq st
=> (st -> (Maybe sy) -> [st])
-> [st]
-> (Maybe sy)
-> [st]
delta' delta [] sy = []
delta' delta (st:sts) sy = (delta st sy) `union` (delta' delta sts sy)
epsilon_closure :: Ord st
=> (st -> Maybe sy -> [st])
-> [st]
-> [st]
epsilon_closure delta = limit f
where f sts = sort (sts `union` (delta' delta sts Nothing))
instance (Eq st , Show st, Show sy) => Show (Ndfa st sy) where
showsPrec p (Ndfa v q s z delta) =
showString("ndfa = Ndfa v q s z delta") .
showString ("\n where \n\t v = ") .
showList v .
showString ("\n\t q = ") .
showList q .
showString ("\n\t s = ") .
shows s .
showString ("\n\t z = ") .
showList z .
showString ("\n\t -- delta :: st -> sy -> st \n") .
(showNdfaDelta q v delta) .
showString ("\t delta _ _ = []\n")
showNdfaDelta q v d = foldr (.) (showChar '\n') f
where f = zipWith3 showF m n q'
(m,n) = unzip l'
q' = map (uncurry d) l'
l' = filter ((/= []) . (uncurry d)) l
l = [(a, c) | a <- q
, b <- v
, c <- [(Just b)]
] ++ [ (a,Nothing) | a <- q ]
showF st sy st' = showString("\t delta ") .
shows st .
showString(" (") .
shows sy .
showString(") = ") .
shows st' .
showChar('\n')
toHaskell :: Show fa
=> fa
-> [Char]
-> IO ()
toHaskell fa modulename = writeFile (modulename ++ ".hs")
("module " ++ modulename ++ " where\n\n" ++
"import Language.HaLex.Dfa\n\n" ++
"import Language.HaLex.Ndfa\n\n" ++
(show fa))
ndfaTransitionsFromTo :: Eq st
=> (st -> Maybe sy -> [st]) -> [sy] -> st -> st -> [Maybe sy]
ndfaTransitionsFromTo delta vs o d = [ v
| v <- vs'
, d `elem` delta o v
]
where vs' = map Just vs ++ [Nothing]
ndfadestinationsFrom :: Ord st
=> (st -> Maybe sy -> [st])
-> [sy]
-> st
-> [st]
ndfadestinationsFrom delta vs o = concat (o'' : [ ndfawalk delta o' [v] | v <- vs ])
where o' = epsilon_closure delta [o]
o'' = delete o o'
ndfareachedStatesFrom :: Ord st
=> (st -> Maybe sy -> [st])
-> [sy]
-> st
-> [st]
ndfareachedStatesFrom d v origin = nub $ origin : qs
where qs = limit stPath' (ndfadestinationsFrom d v origin)
stPath' = stPath d v
stPath :: Ord st => (st -> Maybe sy -> [st]) -> [sy] -> [st] -> [st]
stPath d v sts = sort $ nub $ (concat $ map (ndfadestinationsFrom d v) sts) ++ sts
transitionTableNdfa :: Ndfa st sy
-> [(st,Maybe sy,st)]
transitionTableNdfa (Ndfa vs qs s z delta) = [ (q,Just v,r)
| q <- qs , v <- vs
, r <- delta q (Just v)
] ++
[ (q,Nothing,r)
| q <- qs
, r <- delta q Nothing
]
ttNdfa2Ndfa :: (Eq st, Eq sy)
=> ([sy],[st],[st],[st],[(st,Maybe sy,st)])
-> Ndfa st sy
ttNdfa2Ndfa (vs,qs,s,z,tt) = Ndfa vs qs s z d
where d st sy = lookupTT st sy tt
lookupTT st sy ((a,b,c) : []) | st == a && sy == b = [c]
| otherwise = []
lookupTT st sy ((a,b,c) : xs) | st == a && sy == b = c : lookupTT st sy xs
| otherwise = lookupTT st sy xs
renameNdfa :: Eq st
=> Ndfa st sy
-> Int
-> Ndfa Int sy
renameNdfa (Ndfa v q s z d) istid = (Ndfa v q' s' z' d')
where newSts = zipWith (\ a b -> (a,b)) q [istid .. ]
q' = old2new newSts q
s' = old2new newSts s
z' = old2new newSts z
d' st sy = old2new newSts (d (lookupSnd newSts st) sy)
old2new :: Eq st => [(st,Int)] -> [st] -> [Int]
old2new nsts sts = map (lookupFst nsts) sts
lookupFst :: Eq st => [(st,Int)] -> st -> Int
lookupFst nsts ost = snd $ head (filter (\ (a,b) -> a == ost) nsts)
lookupSnd :: [(st,Int)] -> Int -> st
lookupSnd nsts nst = fst $ head (filter (\ (a,b) -> b == nst) nsts)
ndfadeadstates :: Ord st
=> Ndfa st sy
-> [st]
ndfadeadstates (Ndfa v qs s z d) = filter (ndfaIsStDead d v z) qs
sizeNdfa :: Ndfa st sy
-> Int
sizeNdfa (Ndfa _ q _ _ _) = length q
ndfaIsStDead :: Ord st
=> (st -> Maybe sy -> [st])
-> [sy]
-> [st]
-> st
-> Bool
ndfaIsStDead d v z st = ndfareachedStatesFrom d v st `intersect` z == []
ndfaIsSyncState :: Ord st
=> (st -> Maybe sy -> [st])
-> [sy]
-> [st]
-> st
-> Bool
ndfaIsSyncState d vs z st = (not (st `elem` z)) && (and qs)
where qs = [ [st] == (d st (Just v))
&& (([st] == d st Nothing) || ([] == d st Nothing))
| v <- vs
]
ndfanumberIncomingArrows :: Eq st
=> (st -> Maybe sy -> [st])
-> [sy]
-> [st]
-> st
-> Int
ndfanumberIncomingArrows d vs qs dest =
length [ q
| v <- vs
, q <- qs
, (dest `elem` d q (Just v)) || (dest `elem` d q Nothing)
]
ndfanumberOutgoingArrows :: Ord st
=> (st -> Maybe sy -> [st])
-> [sy]
-> st
-> Int
ndfanumberOutgoingArrows d v o = length $ ndfadestinationsFrom d v o