13
13
--
14
14
-- ----------------------------------------------------------------------------}
15
15
16
- module DFA (scanner2dfa ) where
16
+ module DFA (scanner2dfa ) where
17
+
18
+ import Data.Array ( (!) )
19
+ import Data.Function ( on )
20
+ import Data.Maybe ( fromJust )
17
21
18
- import AbsSyn
19
- import qualified Data.Map as Map
20
22
import qualified Data.IntMap as IntMap
23
+ import qualified Data.IntSet as IntSet
24
+ import qualified Data.Map as Map
25
+ import qualified Data.List as List
26
+
27
+ import AbsSyn
21
28
import NFA
22
- import Sort ( msort , nub' )
23
29
import CharSet
24
30
25
- import Data.Array ( (!) )
26
- import Data.Maybe ( fromJust )
27
-
28
31
{- Defined in the Scan Module
29
32
30
33
-- (This section should logically belong to the DFA module but it has been
@@ -128,22 +131,19 @@ nfa2pdfa nfa pdfa (ss:umkd)
128
131
| Acc _ _ _ (RightContextRExp s) <- accs ]
129
132
130
133
outs :: [(ByteSet ,SNum )]
131
- outs = [ out | s <- ss, out <- nst_outs (nfa! s) ]
134
+ outs = [ out | s <- ss, out <- nst_outs (nfa ! s) ]
132
135
133
- accs = sort_accs [acc | s<- ss, acc<- nst_accs (nfa!s) ]
136
+ accs = sort_accs [ acc | s <- ss, acc <- nst_accs (nfa ! s) ]
134
137
135
138
-- `sort_accs' sorts a list of accept values into descending order of priority,
136
139
-- eliminating any elements that follow an unconditional accept value.
137
140
138
- sort_accs:: [Accept a] -> [Accept a]
139
- sort_accs accs = foldr chk [] (msort le accs)
141
+ sort_accs :: [Accept a ] -> [Accept a ]
142
+ sort_accs accs = foldr chk [] $ List. sortBy ( compare `on` accPrio) accs
140
143
where
141
144
chk acc@ (Acc _ _ Nothing NoRightContext ) _ = [acc]
142
145
chk acc rst = acc: rst
143
146
144
- le (Acc{accPrio = n}) (Acc{accPrio=n'}) = n<=n'
145
-
146
-
147
147
148
148
{- -----------------------------------------------------------------------------
149
149
State Sets and Partial DFAs
@@ -160,19 +160,17 @@ sort_accs accs = foldr chk [] (msort le accs)
160
160
161
161
type StateSet = [SNum ]
162
162
163
- new_pdfa:: Int -> NFA -> DFA StateSet a
163
+ new_pdfa :: Int -> NFA -> DFA StateSet a
164
164
new_pdfa starts nfa
165
- = DFA { dfa_start_states = start_ss,
166
- dfa_states = Map.empty
165
+ = DFA { dfa_start_states = [ List. sort $ nst_cl $ nfa ! n | n <- [ 0 .. starts - 1 ] ]
166
+ , dfa_states = Map. empty
167
167
}
168
- where
169
- start_ss = [ msort (<=) (nst_cl(nfa!n)) | n <- [0..(starts-1)]]
170
168
171
169
-- starts is the number of start states
172
170
173
171
-- constructs the epsilon-closure of a set of NFA states
174
- mk_ss:: NFA -> [SNum] -> StateSet
175
- mk_ss nfa l = nub' (<=) [s' | s<- l, s'<- nst_cl(nfa!s) ]
172
+ mk_ss :: NFA -> [SNum ] -> StateSet
173
+ mk_ss nfa l = IntSet. toAscList $ IntSet. fromList [ s' | s <- l, s' <- nst_cl (nfa ! s) ]
176
174
177
175
add_pdfa :: StateSet -> State StateSet a -> DFA StateSet a -> DFA StateSet a
178
176
add_pdfa ss pst (DFA st mp) = DFA st (Map. insert ss pst mp)
@@ -205,44 +203,3 @@ mk_int_dfa nfa (DFA start_states mp)
205
203
RightContextRExp s ->
206
204
RightContextRExp (lookup' (mk_ss nfa [s]))
207
205
other -> other
208
-
209
- {-
210
-
211
- -- `mk_st' constructs a state node from the list of accept values and a list of
212
- -- transitions. The transitions list all the valid transitions out of the
213
- -- node; all invalid transitions should be represented in the array by state
214
- -- -1. `mk_st' has to work out whether the accept states contain an
215
- -- unconditional entry, in which case the first field of `St' should be true,
216
- -- and which default state to use in constructing the array (the array may span
217
- -- a sub-range of the character set, the state number given the third argument
218
- -- of `St' being taken as the default if an input character lies outside the
219
- -- range). The default values is chosen to minimise the bounds of the array
220
- -- and so there are two candidates: the value that 0 maps to (in which case
221
- -- some initial segment of the array may be omitted) or the value that 255 maps
222
- -- to (in which case a final segment of the array may be omitted), hence the
223
- -- calculation of `(df,bds)'.
224
- --
225
- -- Note that empty arrays are avoided as they can cause severe problems for
226
- -- some popular Haskell compilers.
227
-
228
- mk_st:: [Accept Code] -> [(Char,Int)] -> State Code
229
- mk_st accs as =
230
- if null as
231
- then St accs (-1) (listArray ('0','0') [-1])
232
- else St accs df (listArray bds [arr!c| c<-range bds])
233
- where
234
- bds = if sz==0 then ('0','0') else bds0
235
-
236
- (sz,df,bds0) | sz1 < sz2 = (sz1,df1,bds1)
237
- | otherwise = (sz2,df2,bds2)
238
-
239
- (sz1,df1,bds1) = mk_bds(arr!chr 0)
240
- (sz2,df2,bds2) = mk_bds(arr!chr 255)
241
-
242
- mk_bds df = (t-b, df, (chr b, chr (255-t)))
243
- where
244
- b = length (takeWhile id [arr!c==df| c<-['\0'..'\xff']])
245
- t = length (takeWhile id [arr!c==df| c<-['\xff','\xfe'..'\0']])
246
-
247
- arr = listArray ('\0','\xff') (take 256 (repeat (-1))) // as
248
- -}
0 commit comments