[Git][ghc/ghc][wip/optimize-faststringtable] 4 commits: Make WithDmdType unlifted

1 May 2026


      Cheng Shao pushed to branch wip/optimize-faststringtable at Glasgow Haskell Compiler / GHC


Commits:
02e37756 by Cheng Shao at 2026-05-01T14:48:01+00:00
Make WithDmdType unlifted

- - - - -
cb891f3c by Cheng Shao at 2026-05-01T15:02:08+00:00
Make occurrence analysis results unlifted

- - - - -
9e6b8815 by Cheng Shao at 2026-05-01T15:24:02+00:00
Make Word64 map helpers unlifted

- - - - -
8601c1ca by Cheng Shao at 2026-05-01T15:37:10+00:00
Make StrictPair unlifted

- - - - -


6 changed files:

- compiler/GHC/Core/Opt/DmdAnal.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Data/Word64Map/Internal.hs
- compiler/GHC/Data/Word64Map/Strict/Internal.hs
- compiler/GHC/Data/Word64Set/Internal.hs
- compiler/GHC/Utils/Containers/Internal/StrictPair.hs


Changes:

=====================================
compiler/GHC/Core/Opt/DmdAnal.hs
=====================================
@@ -1,3 +1,6 @@
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE UnliftedDatatypes #-}
+
 {-
 (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
 
@@ -51,6 +54,8 @@ import GHC.Utils.Panic
 import GHC.Utils.Outputable
 
 import Data.List        ( mapAccumL )
+import qualified Data.Kind as Kind
+import GHC.Exts         ( UnliftedType )
 
 {-
 ************************************************************************
@@ -78,6 +83,7 @@ data DmdAnalOpts = DmdAnalOpts
 
 -- This is a strict alternative to (,)
 -- See Note [Space Leaks in Demand Analysis]
+type WithDmdType :: Kind.Type -> UnliftedType
 data WithDmdType a = WithDmdType !DmdType !a
 
 getAnnotated :: WithDmdType a -> a
@@ -2446,9 +2452,10 @@ annotateLamIdBndr :: AnalEnv
 annotateLamIdBndr env dmd_ty id
 -- For lambdas we add the demand to the argument demands
 -- Only called for Ids
-  = assert (isId id) $
-    -- pprTrace "annLamBndr" (vcat [ppr id, ppr dmd_ty, ppr final_ty]) $
-    WithDmdType main_ty new_id
+  = case assert (isId id) () of
+      () ->
+        -- pprTrace "annLamBndr" (vcat [ppr id, ppr dmd_ty, ppr final_ty]) $
+        WithDmdType main_ty new_id
   where
     new_id  = setIdDemandInfo id dmd
     main_ty = addDemand dmd dmd_ty'


=====================================
compiler/GHC/Core/Opt/OccurAnal.hs
=====================================
@@ -1,4 +1,6 @@
 {-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE UnliftedDatatypes #-}
 
 {-# OPTIONS_GHC -cpp -Wno-incomplete-record-updates #-}
 
@@ -68,6 +70,8 @@ import GHC.Builtin.Names( runRWKey )
 import GHC.Unit.Module( Module )
 
 import Data.List (mapAccumL)
+import qualified Data.Kind as Kind
+import GHC.Exts (UnliftedType)
 
 {-
 ************************************************************************
@@ -1198,8 +1202,11 @@ occAnalRecBind :: OccEnv -> TopLevelFlag -> ImpRuleEdges -> [(Var,CoreExpr)]
 --      * feed those components to occAnalRec
 -- See Note [Recursive bindings: the grand plan]
 occAnalRecBind !rhs_env lvl imp_rule_edges pairs body_usage
-  = foldr (occAnalRec rhs_env lvl) (WUD body_usage []) sccs
+  = go sccs
   where
+    go []         = WUD body_usage []
+    go (scc:sccs) = occAnalRec rhs_env lvl scc (go sccs)
+
     sccs :: [SCC NodeDetails]
     sccs = stronglyConnCompFromEdgedVerticesUniq nodes
 
@@ -3818,7 +3825,10 @@ instance Outputable TailUsageDetails where
   ppr (TUD ja uds) = lambda <> ppr ja <> ppr uds
 
 ---------------------
+type WithUsageDetails :: Kind.Type -> UnliftedType
 data WithUsageDetails     a = WUD  !UsageDetails     !a
+
+type WithTailUsageDetails :: Kind.Type -> UnliftedType
 data WithTailUsageDetails a = WTUD !TailUsageDetails !a
 
 -------------------


=====================================
compiler/GHC/Data/Word64Map/Internal.hs
=====================================
@@ -1,5 +1,7 @@
 {-# LANGUAGE MagicHash #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UnliftedDatatypes #-}
 
 {-# OPTIONS_HADDOCK not-home #-}
 {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
@@ -292,6 +294,7 @@ import GHC.Prelude.Basic hiding
   (lookup, filter, foldr, foldl, foldl', null, map)
 
 import Data.Functor.Identity (Identity (..))
+import qualified Data.Kind as Kind
 import Data.Semigroup (Semigroup(stimes,(<>)),stimesIdempotentMonoid)
 import Data.Functor.Classes
 
@@ -307,7 +310,7 @@ import GHC.Utils.Containers.Internal.StrictPair
 import Data.Coerce
 import Data.Data (Data(..), Constr, mkConstr, constrIndex, Fixity(Prefix),
                   DataType, mkDataType, gcast1)
-import GHC.Exts (build)
+import GHC.Exts (UnliftedType, build)
 import qualified GHC.Exts as GHCExts
 import Text.Read
 import qualified Control.Category as Category
@@ -2192,6 +2195,7 @@ updateMaxWithKey f t =
     go _ Nil = error "updateMaxWithKey Nil"
 
 
+type View :: Kind.Type -> UnliftedType
 data View a = View {-# UNPACK #-} !Key a !(Word64Map a)
 
 -- | \(O(\min(n,W))\). Retrieves the maximal (key,value) pair of the map, and
@@ -2850,6 +2854,7 @@ split k t =
     go _ Nil = (Nil :*: Nil)
 
 
+type SplitLookup :: Kind.Type -> UnliftedType
 data SplitLookup a = SplitLookup !(Word64Map a) !(Maybe a) !(Word64Map a)
 
 mapLT :: (Word64Map a -> Word64Map a) -> SplitLookup a -> SplitLookup a
@@ -3347,6 +3352,7 @@ fromMonoListWithKey distinct f = go
         = addMany m kx (linkWithMask mxy ky ty {-kx-} tx) zs'
 {-# INLINE fromMonoListWithKey #-}
 
+type Inserted :: Kind.Type -> UnliftedType
 data Inserted a = Inserted !(Word64Map a) ![(Key,a)]
 
 data Distinct = Distinct | Nondistinct


=====================================
compiler/GHC/Data/Word64Map/Strict/Internal.hs
=====================================
@@ -1,4 +1,7 @@
 
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE UnliftedDatatypes #-}
+
 {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
 
 -----------------------------------------------------------------------------
@@ -335,7 +338,9 @@ import GHC.Data.Word64Map.Internal
 import qualified GHC.Data.Word64Set.Internal as Word64Set
 import GHC.Utils.Containers.Internal.BitUtil
 import GHC.Utils.Containers.Internal.StrictPair
+import qualified Data.Kind as Kind
 import qualified Data.Foldable as Foldable
+import GHC.Exts (UnliftedType)
 
 {--------------------------------------------------------------------
   Query
@@ -1209,6 +1214,7 @@ fromMonoListWithKey distinct f = go
         = addMany m kx (linkWithMask mxy ky ty {-kx-} tx) zs'
 {-# INLINE fromMonoListWithKey #-}
 
+type Inserted :: Kind.Type -> UnliftedType
 data Inserted a = Inserted !(Word64Map a) ![(Key,a)]
 
 data Distinct = Distinct | Nondistinct


=====================================
compiler/GHC/Data/Word64Set/Internal.hs
=====================================
@@ -1,5 +1,7 @@
 {-# LANGUAGE MagicHash #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UnliftedDatatypes #-}
 
 {-# OPTIONS_HADDOCK not-home #-}
 
@@ -199,6 +201,7 @@ import qualified Data.Data
 import Text.Read
 
 import qualified GHC.Exts
+import GHC.Exts (UnliftedType)
 
 import Data.Functor.Identity (Identity(..))
 
@@ -1243,6 +1246,7 @@ fromMonoList (kx : zs1) = addAll' (prefixOf kx) (bitmapOf kx) zs1
         = addMany m px (linkWithMask mxy py ty {-px-} tx) zs'
 {-# INLINE fromMonoList #-}
 
+type Inserted :: UnliftedType
 data Inserted = Inserted !Word64Set ![Key]
 
 {--------------------------------------------------------------------


=====================================
compiler/GHC/Utils/Containers/Internal/StrictPair.hs
=====================================
@@ -1,4 +1,6 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE UnliftedDatatypes #-}
 
 -- | A strict pair
 
@@ -6,6 +8,8 @@ module GHC.Utils.Containers.Internal.StrictPair (StrictPair(..), toPair) where
 
 -- See W1 of Note [Tracking dependencies on primitives] in GHC.Internal.Base
 import GHC.Base ()
+import qualified Data.Kind as Kind
+import GHC.Exts (UnliftedType)
 
 default ()
 
@@ -14,6 +18,7 @@ default ()
 -- @
 -- (x :*: _|_) = (_|_ :*: y) = _|_
 -- @
+type StrictPair :: Kind.Type -> Kind.Type -> UnliftedType
 data StrictPair a b = !a :*: !b
 
 infixr 1 :*:



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7a8549f4005b1ab9037228a9deaba60...

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7a8549f4005b1ab9037228a9deaba60...
You're receiving this email because of your account on gitlab.haskell.org.

    

Cheng Shao (＠TerrorJack)

tags

participants (1)