-\begin{code}
-srtCaseAlts :: SrtOffset -> StgCaseAlts -> (StgCaseAlts, SrtIds, SrtOffset)
-
-srtCaseAlts off (StgAlgAlts t alts dflt)
- = srtDefault off dflt =: \ ((dflt_off, dflt_srt), dflt') ->
- mapAccumL srtAlgAlt (dflt_off, dflt_srt) alts =: \ ((alts_off, alts_srt), alts') ->
- (StgAlgAlts t alts' dflt', alts_srt, alts_off)
-
-srtCaseAlts off (StgPrimAlts t alts dflt)
- = srtDefault off dflt =: \ ((dflt_off, dflt_srt), dflt') ->
- mapAccumL srtPrimAlt (dflt_off, dflt_srt) alts =: \ ((alts_off, alts_srt), alts') ->
- (StgPrimAlts t alts' dflt', alts_srt, alts_off)
-
-srtAlgAlt (off,srt) (con,args,used,rhs)
- = srtExpr off rhs =: \(rhs', rhs_srt, rhs_off) ->
- ((rhs_off, rhs_srt ++ srt), (con,args,used,rhs'))
-
-srtPrimAlt (off,srt) (lit,rhs)
- = srtExpr off rhs =: \(rhs', rhs_srt, rhs_off) ->
- ((rhs_off, rhs_srt ++ srt), (lit, rhs'))
-
-srtDefault off StgNoDefault
- = ((off,[]), StgNoDefault)
-srtDefault off (StgBindDefault rhs)
- = srtExpr off rhs =: \(rhs', srt, off) ->
- ((off,srt), StgBindDefault rhs')
-\end{code}
+constructSRT :: IdEnv Int -> SRT -> SRT
+constructSRT table (SRTEntries entries)
+ | isEmptyVarSet entries = NoSRT
+ | otherwise = SRT offset len bitmap
+ where
+ ints = map (expectJust "constructSRT" . lookupVarEnv table)
+ (varSetElems entries)
+ sorted_ints = sortLe (<=) ints
+ offset = head sorted_ints
+ bitmap_entries = map (subtract offset) sorted_ints
+ len = last bitmap_entries + 1
+ bitmap = intsToBitmap len bitmap_entries