Compilerbau: Transformation: NFA -> DFA
| Compilerbau: Transformation: NFA -> DFA |
|
|
|
1module NFAtoDFA
2where
3
4import NFA
5import NFAshow
6import DFA(DFA)
7
8import Data.Maybe
9import Data.List
10
11nfaToDfa :: NFA -> DFA
12nfaToDfa = snd . nfaToLabeledDfa
13
14
15nfaToLabeledDfa :: NFA -> (NodeLabels, DFA)
16
17nfaToLabeledDfa (states, inputSymbols, start, finalStates, delta)
18 = (labels, dfa)
19 where
20 dfa = ( newStates, inputSymbols
21 , newStart, newFinalStates
22 , newDelta
23 )
24 newStates = map snd $ newStates'
25
26 newStart = fromJust . lookup newStart'
27 $ newStates'
28
29 newFinalStates = map snd
30 . filter
31 ( containsFinalState finalStates .
32 fst
33 )
34 $
35 newStates'
36
37 delta' :: SetOfQ -> Maybe I -> SetOfQ
38 delta' = extendDelta delta
39
40 deltaC :: SetOfQ -> I -> SetOfQ
41 deltaC qs = closure . delta' qs . Just
42
43 closure :: SetOfQ -> SetOfQ
44 closure = sort . epsilonClosure delta'
45
46 newStart' :: SetOfQ
47 newStart' = closure . singleSet $ start
48
49 newStates' :: [(SetOfQ,Q)]
50 newStates'
51 = zip (allStates) [1..]
52 -- assign numbers to all states
53 where
54 allStates = fst
55 . until (isEmptySet . snd) moreStates
56 $ (initStates, initStates)
57
58 initStates = singleSet newStart'
59
60 moreStates :: ([SetOfQ],[SetOfQ]) -> ([SetOfQ],[SetOfQ])
61 moreStates (all, new)
62 = (all `union` new', new' \\ all)
63 where
64 new' = foldr union emptySet
65 . map more
66 $ new
67 where
68 more qs = nub
69 . filter (not . isEmptySet)
70 . map (deltaC qs)
71 $ inputSymbols
72
73 newDelta :: Q -> I -> Maybe Q
74 newDelta
75 = foldr buildDeltaForQ (\ q' i -> Nothing) $ newStates'
76
77 where
78
79 buildDeltaForQ :: (SetOfQ,Q) ->
80 (Q -> I -> Maybe Q) ->
81 (Q -> I -> Maybe Q)
82 buildDeltaForQ (qs, q') deltaQ'
83 | isEmptySet reachableStates
84 = deltaQ'
85 | otherwise
86 = \ q -> if q == q'
87 then buildDeltaForQandI
88 else deltaQ' q
89 where
90
91 reachableStates :: [(I,SetOfQ)]
92 reachableStates
93 -- all states reachable from qs
94 -- filter dead ends
95 = filter (not . isEmptySet . snd)
96 .
97 -- compute delta
98 map (\ i -> (i, deltaC qs i))
99 $
100 -- try all input symbols
101 inputSymbols
102
103 buildDeltaForQandI :: (I -> Maybe Q)
104 buildDeltaForQandI
105 = foldr buildDeltaForI (const Nothing)
106 $ reachableStates
107 where
108
109 buildDeltaForI :: (I,SetOfQ) ->
110 (I -> Maybe Q) ->
111 (I -> Maybe Q)
112 buildDeltaForI (i, qs) deltaI'
113 = \ c -> if c == i
114 then Just . fromJust . lookup qs
115 $ newStates'
116 else deltaI' c
117
118 labels :: [(Q,String)]
119 labels = map (\ (qs, q') ->
120 (q', foldr1 (\ x y -> x ++ "," ++ y) .
121 map show $ qs
122 )
123 ) newStates'
124
125
126-- break the list of labels into several lines
127-- such that the label length is minimized and so the size of
128-- the nodes does not grow too strong
129
130formatLabel s
131 = insNL ll s
132 where
133 sl = length s
134 nl = max 1. truncate . sqrt . (* 0.6) $ l
135 where
136 l :: Double
137 l = fromInteger . toInteger $ sl
138 ll = sl `div` nl
139
140 insNL i [] = []
141 insNL i (x : xs)
142 | i <= 1 && x == ','
143 = ",\\n" ++ insNL ll xs
144 | otherwise
145 = x : insNL (i-1) xs
|
|
1module NFAexample4 ( nfa4 )
2where
3
4import NFA
5
6nfa4 :: NFA
7nfa4
8 = (states, alphabet, q0, f, delta)
9 where
10 states = [1..8]
11 alphabet = " -" ++ ['a'..'z'] ++ ['0'..'9']
12 q0 = 1
13 f = [2]
14
15 delta 1 Nothing = [7]
16 delta 1 (Just c)
17 | c == 'i' = [3,4]
18 | c `elem` ['a'..'h']
19 ||
20 c `elem` ['j'..'z'] = [4]
21 | c `elem` [' ', '-'] = [2]
22
23 delta 3 (Just 'f') = [2]
24
25 delta 4 Nothing = [2,5]
26
27 delta 5 (Just c)
28 | c `elem` ['0'..'9']
29 ||
30 c `elem` ['a'..'z'] = [6]
31
32 delta 6 Nothing = [2,5]
33
34 delta 7 (Just c)
35 | c `elem` ['0'..'9'] = [8]
36
37 delta 8 Nothing = [2,7]
38
39 delta _ _ = []
|
|
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| Letzte Änderung: 30.11.2015 | © Prof. Dr. Uwe Schmidt |
