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