Skip to content

Commit 99042a7

Browse files
committed
Remove module Sort, use standard implementation
- `List.sort` and `List.sortBy` instead of `Sort.msort` - `Set.toList . Set.fromList` instead of `Sort.nub'`
1 parent b446bbd commit 99042a7

File tree

4 files changed

+27
-126
lines changed

4 files changed

+27
-126
lines changed

alex.cabal

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -134,7 +134,6 @@ executable alex
134134
Parser
135135
ParseMonad
136136
Scan
137-
Sort
138137
Util
139138
UTF8
140139
Data.Ranged

src/AbsSyn.hs

Lines changed: 8 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -27,10 +27,9 @@ import CharSet ( CharSet, Encoding )
2727
import Data.Maybe ( fromJust )
2828
import Data.Map ( Map )
2929
import Data.IntMap ( IntMap )
30-
import Sort ( nub' )
3130
import Util ( str, nl )
3231
import qualified Data.Map as Map
33-
32+
import qualified Data.Set as Set
3433

3534
infixl 4 :||
3635
infixl 5 :%%
@@ -330,10 +329,14 @@ encodeStartCodes scan = (scan', 0 : map snd name_code_pairs, sc_hdr)
330329

331330
code_map = Map.fromList name_code_pairs
332331

333-
name_code_pairs = zip (nub' (<=) nms) [1..]
332+
name_code_pairs = zip nms [1..]
334333

335-
nms = [nm | RECtx{reCtxStartCodes = scs} <- scannerTokens scan,
336-
(nm,_) <- scs, nm /= "0"]
334+
nms = Set.toAscList . Set.fromList $
335+
[ nm
336+
| RECtx{ reCtxStartCodes = scs } <- scannerTokens scan
337+
, (nm, _) <- scs
338+
, nm /= "0"
339+
]
337340

338341

339342
-- Grab the code fragments for the token actions, and replace them

src/DFA.hs

Lines changed: 19 additions & 62 deletions
Original file line numberDiff line numberDiff line change
@@ -13,18 +13,21 @@
1313
--
1414
-- ----------------------------------------------------------------------------}
1515

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 )
1721

18-
import AbsSyn
19-
import qualified Data.Map as Map
2022
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
2128
import NFA
22-
import Sort ( msort, nub' )
2329
import CharSet
2430

25-
import Data.Array ( (!) )
26-
import Data.Maybe ( fromJust )
27-
2831
{- Defined in the Scan Module
2932
3033
-- (This section should logically belong to the DFA module but it has been
@@ -128,22 +131,19 @@ nfa2pdfa nfa pdfa (ss:umkd)
128131
| Acc _ _ _ (RightContextRExp s) <- accs ]
129132

130133
outs :: [(ByteSet,SNum)]
131-
outs = [ out | s <- ss, out <- nst_outs (nfa!s) ]
134+
outs = [ out | s <- ss, out <- nst_outs (nfa ! s) ]
132135

133-
accs = sort_accs [acc| s<-ss, acc<-nst_accs (nfa!s)]
136+
accs = sort_accs [ acc | s <- ss, acc <- nst_accs (nfa ! s) ]
134137

135138
-- `sort_accs' sorts a list of accept values into descending order of priority,
136139
-- eliminating any elements that follow an unconditional accept value.
137140

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
140143
where
141144
chk acc@(Acc _ _ Nothing NoRightContext) _ = [acc]
142145
chk acc rst = acc:rst
143146

144-
le (Acc{accPrio = n}) (Acc{accPrio=n'}) = n<=n'
145-
146-
147147

148148
{------------------------------------------------------------------------------
149149
State Sets and Partial DFAs
@@ -160,19 +160,17 @@ sort_accs accs = foldr chk [] (msort le accs)
160160

161161
type StateSet = [SNum]
162162

163-
new_pdfa:: Int -> NFA -> DFA StateSet a
163+
new_pdfa :: Int -> NFA -> DFA StateSet a
164164
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
167167
}
168-
where
169-
start_ss = [ msort (<=) (nst_cl(nfa!n)) | n <- [0..(starts-1)]]
170168

171169
-- starts is the number of start states
172170

173171
-- 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) ]
176174

177175
add_pdfa:: StateSet -> State StateSet a -> DFA StateSet a -> DFA StateSet a
178176
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)
205203
RightContextRExp s ->
206204
RightContextRExp (lookup' (mk_ss nfa [s]))
207205
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-
-}

src/Sort.hs

Lines changed: 0 additions & 58 deletions
This file was deleted.

0 commit comments

Comments
 (0)