Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 783cd7d6 by Cheng Shao at 2025-08-18T20:13:14-04:00 compiler: use `UniqMap` instead of `Map` for `BCEnv` in bytecode compiler The bytecode compiler maintains a `BCEnv` which was previously `Map Id StackDepth`. Given `Id` is `Uniquable`, we might as well use `UniqMap` here as a more efficient data structure, hence this patch. Co-authored-by: Codex - - - - - 1 changed file: - compiler/GHC/StgToByteCode.hs Changes: ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -84,11 +84,11 @@ import Data.Coerce (coerce) #if MIN_VERSION_rts(1,0,3) import qualified Data.ByteString.Char8 as BS #endif -import Data.Map (Map) import Data.IntMap (IntMap) import qualified Data.Map as Map import qualified Data.IntMap as IntMap -import qualified GHC.Data.FiniteMap as Map +import GHC.Types.Unique.Map (UniqMap) +import qualified GHC.Types.Unique.Map as UniqMap import Data.Ord import Data.Either ( partitionEithers ) @@ -209,7 +209,7 @@ type StackDepth = ByteOff -- | Maps Ids to their stack depth. This allows us to avoid having to mess with -- it after each push/pop. -type BCEnv = Map Id StackDepth -- To find vars on the stack +type BCEnv = UniqMap Id StackDepth -- To find vars on the stack {- ppBCEnv :: BCEnv -> SDoc @@ -379,7 +379,7 @@ schemeR_wrk fvs nm original_body (args, body) sum_szsb_args = sum szsb_args -- Make a stack offset for each argument or free var -- they should -- appear contiguous in the stack, in order. - p_init = Map.fromList (zip all_args (mkStackOffsets 0 szsb_args)) + p_init = UniqMap.listToUniqMap (zip all_args (mkStackOffsets 0 szsb_args)) -- make the arg bitmap bits = argBits platform (reverse (map (idArgRep platform) all_args)) @@ -442,7 +442,7 @@ fvsToEnv :: BCEnv -> CgStgRhs -> [Id] -- it, have to agree about this layout fvsToEnv p rhs = [v | v <- dVarSetElems $ freeVarsOfRhs rhs, - v `Map.member` p] + v `UniqMap.elemUniqMap` p] -- ----------------------------------------------------------------------------- -- schemeE @@ -533,7 +533,7 @@ schemeE d s p (StgLet _xlet alloc_code <- mkConAppCode d s p data_con args platform <- targetPlatform <$> getDynFlags let !d2 = d + wordSize platform - body_code <- schemeE d2 s (Map.insert x d2 p) body + body_code <- schemeE d2 s (UniqMap.addToUniqMap p x d2) body return (alloc_code `appOL` body_code) -- General case for let. Generates correct, if inefficient, code in -- all situations. @@ -557,7 +557,7 @@ schemeE d s p (StgLet _ext binds body) = do -- after the closures have been allocated in the heap (but not -- filled in), and pointers to them parked on the stack. offsets = mkStackOffsets d (genericReplicate n_binds (wordSize platform)) - p' = Map.insertList (zipEqual xs offsets) p + p' = UniqMap.addListToUniqMap p $ zipEqual xs offsets d' = d + wordsToBytes platform n_binds -- ToDo: don't build thunks for things with no free variables @@ -1180,7 +1180,7 @@ doCase d s p scrut bndr alts -- Env in which to compile the alts, not including -- any vars bound by the alts themselves - p_alts = Map.insert bndr d_bndr p + p_alts = UniqMap.addToUniqMap p bndr d_bndr bndr_ty = idType bndr isAlgCase = isAlgType bndr_ty @@ -1208,12 +1208,11 @@ doCase d s p scrut bndr alts stack_bot = d_alts - p' = Map.insertList + p' = UniqMap.addListToUniqMap p_alts [ (arg, tuple_start - wordsToBytes platform (nativeCallSize call_info) + offset) | (NonVoid arg, offset) <- args_offsets] - p_alts in do rhs_code <- schemeE stack_bot s p' rhs return (NoDiscr, rhs_code) @@ -1227,10 +1226,9 @@ doCase d s p scrut bndr alts stack_bot = d_alts + wordsToBytes platform size -- convert offsets from Sp into offsets into the virtual stack - p' = Map.insertList + p' = UniqMap.addListToUniqMap p_alts [ (arg, stack_bot - ByteOff offset) | (NonVoid arg, offset) <- args_offsets ] - p_alts in do massert isAlgCase @@ -1312,12 +1310,13 @@ doCase d s p scrut bndr alts -- NB: unboxed tuple cases bind the scrut binder to the same offset -- as one of the alt binders, so we have to remove any duplicates here: -- 'toAscList' takes care of sorting the result, which was previously done after the application of 'filter'. - rel_slots = IntSet.toAscList $ IntSet.fromList $ Map.elems $ Map.mapMaybeWithKey spread p - spread id offset | isUnboxedTupleType (idType id) || - isUnboxedSumType (idType id) = Nothing - | isFollowableArg (idArgRep platform id) = Just (fromIntegral rel_offset) - | otherwise = Nothing - where rel_offset = bytesToWords platform (d - offset) + rel_slots = IntSet.toAscList $ UniqMap.nonDetFoldUniqMap go IntSet.empty p + go (var, offset) !acc + | isUnboxedTupleType (idType var) || isUnboxedSumType (idType var) + = acc + | isFollowableArg (idArgRep platform var) + = fromIntegral (bytesToWords platform (d - offset)) `IntSet.insert` acc + | otherwise = acc bitmap = intsToReverseBitmap platform bitmap_size' pointers @@ -2546,7 +2545,7 @@ instance Outputable Discr where lookupBCEnv_maybe :: Id -> BCEnv -> Maybe ByteOff -lookupBCEnv_maybe = Map.lookup +lookupBCEnv_maybe v env = UniqMap.lookupUniqMap env v idSizeW :: Platform -> Id -> WordOff idSizeW platform = WordOff . argRepSizeW platform . idArgRep platform View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/783cd7d67dc6c2bbfa6a0dbc8af46872... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/783cd7d67dc6c2bbfa6a0dbc8af46872... You're receiving this email because of your account on gitlab.haskell.org.