Compilerbau: Nichtdeterministische endliche Automaten
| Compilerbau: Nichtdeterministische endliche Automaten |
|
|
|
1module NFA
2 ( I, Alphabet
3 , Q, SetOfQ
4 , Delta
5 , Delta'
6 , NFA
7 , Token, Tokens
8
9 , epsilon
10 , emptySet
11 , singleSet
12 , isEmptySet
13 , card
14 , extendDelta
15 , epsilonClosure
16 , containsFinalState
17
18 , run
19 , accept
20
21 , dfaToNfa
22 , showTokens
23 )
24where
25
26import DFA
27 ( I
28 , Alphabet
29 , Q
30 , SetOfQ
31 , Input
32 , Token
33 , DFA
34 )
35
36import DFAexample1
37
38import Data.Maybe
39import Data.List
40
41type Delta = Q -> Maybe I -> SetOfQ
42 -- Delta for DFA's extended
43 -- result is a set of states,
44 -- the emty set represents undefined in the DFA
45 -- input domain is extended: epsilon is represented by Nothing
46
47type Delta' = SetOfQ -> Maybe I -> SetOfQ
48 -- Delta extended to work with sets of states
49
50type Tokens = ([(SetOfQ, Token)], Input)
51
52type NFA = (SetOfQ, Alphabet, Q, SetOfQ, Delta)
53 -- the complete automaton, consisting of start state,
54 -- set of final states and transition relation
55
56type NFAState = (SetOfQ, Token, Input)
57 -- single state in DFA is extended to a set of all possible states
58
59-- auxiliary functions and predicates
60
61epsilon :: Maybe I
62epsilon = Nothing
63
64emptySet :: [a]
65emptySet = []
66
67singleSet :: a -> [a]
68singleSet q = [q]
69
70isEmptySet :: [a] -> Bool
71isEmptySet = null
72
73card :: [a] -> Int
74card = length
75
76extendDelta :: Delta -> Delta'
77extendDelta delta qs c
78 = foldr union emptySet . map (\ q' -> delta q' c) $ qs
79
80
81epsilonClosure :: Delta' -> SetOfQ -> SetOfQ
82epsilonClosure delta' qs
83 | card qs == card qs'
84 = qs'
85 | otherwise
86 = epsilonClosure delta' qs'
87 where
88 qs' = qs `union` delta' qs epsilon
89
90containsFinalState :: SetOfQ -> SetOfQ -> Bool
91containsFinalState finalStates qs
92 = not (isEmptySet (qs `intersect` finalStates))
93
94
95-- the main function
96
97run :: NFA -> Input -> Tokens
98
99run (_allStates, _allSymbols, start, finalStates, delta) input
100 | null input
101 &&
102 containsFinalState finalStates start'
103 = ([(start', "")], "")
104 | otherwise
105 = loop input
106 where
107 start' :: SetOfQ
108 start' = closure (singleSet start)
109
110 delta' :: Delta'
111 delta' = extendDelta delta
112
113 closure :: SetOfQ -> SetOfQ
114 closure = epsilonClosure delta'
115
116 -- the main loop
117
118 loop :: Input -> Tokens
119 loop inp
120 | null s
121 = ([], inp)
122 | null inp'
123 = ([(qs,s)], "")
124 | otherwise
125 = let
126 (ts, rest) = loop inp'
127 in
128 ((qs, s) : ts, rest)
129 where
130 init = (start', "", inp)
131 (qs, s, inp') = symbol init init
132
133 -- scan one symbol
134
135 symbol :: NFAState -> NFAState -> NFAState
136 symbol lastFinalState currState@(qs, s, i)
137 | isFinalState && longestMatch -- success: token recognized
138 = currState
139
140 | isFinalState && not longestMatch -- token may still be longer
141 = symbol currState nextState
142
143 | not isFinalState && longestMatch -- failure: restore last possible token
144 = lastFinalState
145
146 | not isFinalState && not longestMatch -- token not yet complete
147 = symbol lastFinalState nextState
148
149 where
150 isFinalState = containsFinalState finalStates qs
151
152 longestMatch = null i -- EOF or delta undefined
153 ||
154 isEmptySet (delta' qs nextChar')
155
156 nextChar = head i
157 nextChar' = Just nextChar
158 -- compute next state
159 -- and read next input char
160 nextState = ( closure (delta' qs nextChar')
161 , s ++ [nextChar]
162 , tail i
163 )
164
165-- word test
166
167accept :: NFA -> Input -> Bool
168accept a
169 = oneSymbol . run a
170 where
171 oneSymbol ([_], "") = True
172 oneSymbol _ = False
173
174-- every DFA is also a NFA
175
176dfaToNfa :: DFA -> NFA
177dfaToNfa (states, alphabet, start, finalStates, delta)
178 = (states, alphabet, start, finalStates, delta')
179 where
180 delta' _ Nothing = []
181 delta' q (Just c) = maybeToList (delta q c)
182
183
184
185-- format result
186
187showTokens :: Tokens -> String
188showTokens (ts, rest)
189 = concatMap showToken ts
190 ++
191 showRest rest
192 where
193 showToken (qs, s)
194 = showStates qs ++ "\t: " ++ show s ++ "\n"
195 showStates
196 = foldr1 (\ s1 s2 -> s1 ++ "," ++ s2) . map show . sort
197 showRest ""
198 = ""
199 showRest r
200 = "input not accepted: " ++ show r ++ "\n"
|
|
1nfa1 :: NFA
2nfa1
3 = (states, alphabet, q0, f, delta)
4 where
5 states = [1..6]
6 alphabet = "a"
7 q0 = 1
8 f = [1,4,6]
9 delta 1 (Just 'a') = [2,5]
10 delta 2 (Just 'a') = [3]
11 delta 3 (Just 'a') = [4]
12 delta 4 (Just 'a') = [2]
13 delta 5 (Just 'a') = [6]
14 delta 6 (Just 'a') = [5]
15 delta _ _ = []
|
|
1nfa2 :: NFA
2nfa2
3 = (states, alphabet, q0, f, delta)
4 where
5 states = [1..6]
6 alphabet = "a"
7 q0 = 1
8 f = [2,5]
9 delta 1 Nothing = [2,5]
10 delta 2 (Just 'a') = [3]
11 delta 3 (Just 'a') = [4]
12 delta 4 (Just 'a') = [2]
13 delta 5 (Just 'a') = [6]
14 delta 6 (Just 'a') = [5]
15 delta _ _ = []
|
|
| Letzte Änderung: 11.11.2017 | © Prof. Dr. Uwe Schmidt |
