| ... |
... |
@@ -84,11 +84,11 @@ import Data.Coerce (coerce) |
|
84
|
84
|
#if MIN_VERSION_rts(1,0,3)
|
|
85
|
85
|
import qualified Data.ByteString.Char8 as BS
|
|
86
|
86
|
#endif
|
|
87
|
|
-import Data.Map (Map)
|
|
88
|
87
|
import Data.IntMap (IntMap)
|
|
89
|
88
|
import qualified Data.Map as Map
|
|
90
|
89
|
import qualified Data.IntMap as IntMap
|
|
91
|
|
-import qualified GHC.Data.FiniteMap as Map
|
|
|
90
|
+import GHC.Types.Unique.Map (UniqMap)
|
|
|
91
|
+import qualified GHC.Types.Unique.Map as UniqMap
|
|
92
|
92
|
import Data.Ord
|
|
93
|
93
|
import Data.Either ( partitionEithers )
|
|
94
|
94
|
|
| ... |
... |
@@ -209,7 +209,7 @@ type StackDepth = ByteOff |
|
209
|
209
|
|
|
210
|
210
|
-- | Maps Ids to their stack depth. This allows us to avoid having to mess with
|
|
211
|
211
|
-- it after each push/pop.
|
|
212
|
|
-type BCEnv = Map Id StackDepth -- To find vars on the stack
|
|
|
212
|
+type BCEnv = UniqMap Id StackDepth -- To find vars on the stack
|
|
213
|
213
|
|
|
214
|
214
|
{-
|
|
215
|
215
|
ppBCEnv :: BCEnv -> SDoc
|
| ... |
... |
@@ -379,7 +379,7 @@ schemeR_wrk fvs nm original_body (args, body) |
|
379
|
379
|
sum_szsb_args = sum szsb_args
|
|
380
|
380
|
-- Make a stack offset for each argument or free var -- they should
|
|
381
|
381
|
-- appear contiguous in the stack, in order.
|
|
382
|
|
- p_init = Map.fromList (zip all_args (mkStackOffsets 0 szsb_args))
|
|
|
382
|
+ p_init = UniqMap.listToUniqMap (zip all_args (mkStackOffsets 0 szsb_args))
|
|
383
|
383
|
|
|
384
|
384
|
-- make the arg bitmap
|
|
385
|
385
|
bits = argBits platform (reverse (map (idArgRep platform) all_args))
|
| ... |
... |
@@ -442,7 +442,7 @@ fvsToEnv :: BCEnv -> CgStgRhs -> [Id] |
|
442
|
442
|
-- it, have to agree about this layout
|
|
443
|
443
|
|
|
444
|
444
|
fvsToEnv p rhs = [v | v <- dVarSetElems $ freeVarsOfRhs rhs,
|
|
445
|
|
- v `Map.member` p]
|
|
|
445
|
+ v `UniqMap.elemUniqMap` p]
|
|
446
|
446
|
|
|
447
|
447
|
-- -----------------------------------------------------------------------------
|
|
448
|
448
|
-- schemeE
|
| ... |
... |
@@ -533,7 +533,7 @@ schemeE d s p (StgLet _xlet |
|
533
|
533
|
alloc_code <- mkConAppCode d s p data_con args
|
|
534
|
534
|
platform <- targetPlatform <$> getDynFlags
|
|
535
|
535
|
let !d2 = d + wordSize platform
|
|
536
|
|
- body_code <- schemeE d2 s (Map.insert x d2 p) body
|
|
|
536
|
+ body_code <- schemeE d2 s (UniqMap.addToUniqMap p x d2) body
|
|
537
|
537
|
return (alloc_code `appOL` body_code)
|
|
538
|
538
|
-- General case for let. Generates correct, if inefficient, code in
|
|
539
|
539
|
-- all situations.
|
| ... |
... |
@@ -557,7 +557,7 @@ schemeE d s p (StgLet _ext binds body) = do |
|
557
|
557
|
-- after the closures have been allocated in the heap (but not
|
|
558
|
558
|
-- filled in), and pointers to them parked on the stack.
|
|
559
|
559
|
offsets = mkStackOffsets d (genericReplicate n_binds (wordSize platform))
|
|
560
|
|
- p' = Map.insertList (zipEqual xs offsets) p
|
|
|
560
|
+ p' = UniqMap.addListToUniqMap p $ zipEqual xs offsets
|
|
561
|
561
|
d' = d + wordsToBytes platform n_binds
|
|
562
|
562
|
|
|
563
|
563
|
-- ToDo: don't build thunks for things with no free variables
|
| ... |
... |
@@ -1180,7 +1180,7 @@ doCase d s p scrut bndr alts |
|
1180
|
1180
|
|
|
1181
|
1181
|
-- Env in which to compile the alts, not including
|
|
1182
|
1182
|
-- any vars bound by the alts themselves
|
|
1183
|
|
- p_alts = Map.insert bndr d_bndr p
|
|
|
1183
|
+ p_alts = UniqMap.addToUniqMap p bndr d_bndr
|
|
1184
|
1184
|
|
|
1185
|
1185
|
bndr_ty = idType bndr
|
|
1186
|
1186
|
isAlgCase = isAlgType bndr_ty
|
| ... |
... |
@@ -1208,12 +1208,11 @@ doCase d s p scrut bndr alts |
|
1208
|
1208
|
|
|
1209
|
1209
|
stack_bot = d_alts
|
|
1210
|
1210
|
|
|
1211
|
|
- p' = Map.insertList
|
|
|
1211
|
+ p' = UniqMap.addListToUniqMap p_alts
|
|
1212
|
1212
|
[ (arg, tuple_start -
|
|
1213
|
1213
|
wordsToBytes platform (nativeCallSize call_info) +
|
|
1214
|
1214
|
offset)
|
|
1215
|
1215
|
| (NonVoid arg, offset) <- args_offsets]
|
|
1216
|
|
- p_alts
|
|
1217
|
1216
|
in do
|
|
1218
|
1217
|
rhs_code <- schemeE stack_bot s p' rhs
|
|
1219
|
1218
|
return (NoDiscr, rhs_code)
|
| ... |
... |
@@ -1227,10 +1226,9 @@ doCase d s p scrut bndr alts |
|
1227
|
1226
|
stack_bot = d_alts + wordsToBytes platform size
|
|
1228
|
1227
|
|
|
1229
|
1228
|
-- convert offsets from Sp into offsets into the virtual stack
|
|
1230
|
|
- p' = Map.insertList
|
|
|
1229
|
+ p' = UniqMap.addListToUniqMap p_alts
|
|
1231
|
1230
|
[ (arg, stack_bot - ByteOff offset)
|
|
1232
|
1231
|
| (NonVoid arg, offset) <- args_offsets ]
|
|
1233
|
|
- p_alts
|
|
1234
|
1232
|
|
|
1235
|
1233
|
in do
|
|
1236
|
1234
|
massert isAlgCase
|
| ... |
... |
@@ -1312,12 +1310,13 @@ doCase d s p scrut bndr alts |
|
1312
|
1310
|
-- NB: unboxed tuple cases bind the scrut binder to the same offset
|
|
1313
|
1311
|
-- as one of the alt binders, so we have to remove any duplicates here:
|
|
1314
|
1312
|
-- 'toAscList' takes care of sorting the result, which was previously done after the application of 'filter'.
|
|
1315
|
|
- rel_slots = IntSet.toAscList $ IntSet.fromList $ Map.elems $ Map.mapMaybeWithKey spread p
|
|
1316
|
|
- spread id offset | isUnboxedTupleType (idType id) ||
|
|
1317
|
|
- isUnboxedSumType (idType id) = Nothing
|
|
1318
|
|
- | isFollowableArg (idArgRep platform id) = Just (fromIntegral rel_offset)
|
|
1319
|
|
- | otherwise = Nothing
|
|
1320
|
|
- where rel_offset = bytesToWords platform (d - offset)
|
|
|
1313
|
+ rel_slots = IntSet.toAscList $ UniqMap.nonDetFoldUniqMap go IntSet.empty p
|
|
|
1314
|
+ go (var, offset) !acc
|
|
|
1315
|
+ | isUnboxedTupleType (idType var) || isUnboxedSumType (idType var)
|
|
|
1316
|
+ = acc
|
|
|
1317
|
+ | isFollowableArg (idArgRep platform var)
|
|
|
1318
|
+ = fromIntegral (bytesToWords platform (d - offset)) `IntSet.insert` acc
|
|
|
1319
|
+ | otherwise = acc
|
|
1321
|
1320
|
|
|
1322
|
1321
|
bitmap = intsToReverseBitmap platform bitmap_size' pointers
|
|
1323
|
1322
|
|
| ... |
... |
@@ -2546,7 +2545,7 @@ instance Outputable Discr where |
|
2546
|
2545
|
|
|
2547
|
2546
|
|
|
2548
|
2547
|
lookupBCEnv_maybe :: Id -> BCEnv -> Maybe ByteOff
|
|
2549
|
|
-lookupBCEnv_maybe = Map.lookup
|
|
|
2548
|
+lookupBCEnv_maybe v env = UniqMap.lookupUniqMap env v
|
|
2550
|
2549
|
|
|
2551
|
2550
|
idSizeW :: Platform -> Id -> WordOff
|
|
2552
|
2551
|
idSizeW platform = WordOff . argRepSizeW platform . idArgRep platform
|