Simon Jakobi pushed to branch wip/sjakobi/T27379 at Glasgow Haskell Compiler / GHC
Commits:
3f0299bd by Simon Jakobi at 2026-06-16T12:42:42+02:00
Base subVarSet/subDVarSet on a proper subset operation
Previously these were defined as isEmpty (s1 minus s2), which
materializes the entire difference map just to test it for emptiness.
The new subUFM/subUDFM use Word64Map.keysAreSubsetOf, which short-circuits
on the first non-member and allocates nothing.
Complexity-wise the recursion is driven by the first map and only probes
the second to depth W (the word width) at each step, never traversing it
in full. So keysAreSubsetOf is O(n*W), i.e. O(n) in the size of the first
map for fixed W, rather than the O(n+m) of the difference-based version.
Closes #27379
Co-Authored-By: Claude Fable 5
- - - - -
5 changed files:
- compiler/GHC/Data/Word64Map/Internal.hs
- compiler/GHC/Data/Word64Map/Lazy.hs
- compiler/GHC/Types/Unique/DFM.hs
- compiler/GHC/Types/Unique/FM.hs
- compiler/GHC/Types/Var/Set.hs
Changes:
=====================================
compiler/GHC/Data/Word64Map/Internal.hs
=====================================
@@ -235,6 +235,7 @@ module GHC.Data.Word64Map.Internal (
-- * Submap
, isSubmapOf, isSubmapOfBy
, isProperSubmapOf, isProperSubmapOfBy
+ , keysAreSubsetOf
-- * Min\/Max
, lookupMin
@@ -2441,6 +2442,21 @@ isSubmapOfBy predicate (Tip k x) t = case lookup k t of
Nothing -> False
isSubmapOfBy _ Nil _ = True
+-- | \(O(n \cdot W)\). Are all of the first map's keys present in the second?
+--
+-- Like @'isSubmapOfBy' (\\_ _ -> True)@ but fully value-agnostic.
+keysAreSubsetOf :: Word64Map a -> Word64Map b -> Bool
+keysAreSubsetOf t1@(Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
+ | shorter m1 m2 = False
+ | shorter m2 m1 = match p1 p2 m2 &&
+ if zero p1 m2
+ then keysAreSubsetOf t1 l2
+ else keysAreSubsetOf t1 r2
+ | otherwise = p1 == p2 && keysAreSubsetOf l1 l2 && keysAreSubsetOf r1 r2
+keysAreSubsetOf (Bin _ _ _ _) _ = False
+keysAreSubsetOf (Tip k _) t = member k t
+keysAreSubsetOf Nil _ = True
+
{--------------------------------------------------------------------
Mapping
--------------------------------------------------------------------}
=====================================
compiler/GHC/Data/Word64Map/Lazy.hs
=====================================
@@ -206,6 +206,7 @@ module GHC.Data.Word64Map.Lazy (
-- * Submap
, isSubmapOf, isSubmapOfBy
, isProperSubmapOf, isProperSubmapOfBy
+ , keysAreSubsetOf
-- * Min\/Max
, lookupMin
=====================================
compiler/GHC/Types/Unique/DFM.hs
=====================================
@@ -48,7 +48,7 @@ module GHC.Types.Unique.DFM (
isNullUDFM,
sizeUDFM,
intersectUDFM, udfmIntersectUFM,
- disjointUDFM, disjointUdfmUfm,
+ disjointUDFM, disjointUdfmUfm, subUDFM,
equalKeysUDFM,
minusUDFM,
listToUDFM, listToUDFM_Directly,
@@ -388,6 +388,10 @@ disjointUDFM (UDFM x _i) (UDFM y _j) = M.disjoint x y
disjointUdfmUfm :: UniqDFM key elt -> UniqFM key elt2 -> Bool
disjointUdfmUfm (UDFM x _i) y = M.disjoint x (ufmToIntMap y)
+-- | True if the first map's keys are a subset of the second's.
+subUDFM :: UniqDFM key elt1 -> UniqDFM key elt2 -> Bool
+subUDFM (UDFM x _i) (UDFM y _j) = M.keysAreSubsetOf x y
+
minusUDFM :: UniqDFM key elt1 -> UniqDFM key elt2 -> UniqDFM key elt1
minusUDFM (UDFM x i) (UDFM y _j) = UDFM (M.difference x y) i
-- M.difference returns a subset of a left set, so `i` is a good upper
=====================================
compiler/GHC/Types/Unique/FM.hs
=====================================
@@ -66,6 +66,7 @@ module GHC.Types.Unique.FM (
intersectUFM_C,
strictIntersectUFM_C,
disjointUFM,
+ subUFM,
equalKeysUFM,
diffUFM,
nonDetStrictFoldUFM, nonDetFoldUFM, nonDetStrictFoldUFM_DirectlyM,
@@ -430,6 +431,10 @@ strictIntersectUFM_C f (UFM x) (UFM y) = UFM (MS.intersectionWith f x y)
disjointUFM :: UniqFM key elt1 -> UniqFM key elt2 -> Bool
disjointUFM (UFM x) (UFM y) = M.disjoint x y
+-- | True if the first map's keys are a subset of the second's.
+subUFM :: UniqFM key elt1 -> UniqFM key elt2 -> Bool
+subUFM (UFM x) (UFM y) = M.keysAreSubsetOf x y
+
-- | Fold over a 'UniqFM'.
--
-- Non-deterministic, unless the folding function is commutative
=====================================
compiler/GHC/Types/Var/Set.hs
=====================================
@@ -53,8 +53,8 @@ import GHC.Types.Unique
import GHC.Types.Name ( Name )
import GHC.Types.Unique.Set
import GHC.Types.Unique.DSet
-import GHC.Types.Unique.FM( disjointUFM, pluralUFM, pprUFM )
-import GHC.Types.Unique.DFM( disjointUDFM, udfmToUfm, anyUDFM, allUDFM )
+import GHC.Types.Unique.FM( disjointUFM, subUFM, pluralUFM, pprUFM )
+import GHC.Types.Unique.DFM( disjointUDFM, subUDFM, udfmToUfm, anyUDFM, allUDFM )
import GHC.Utils.Outputable (SDoc)
-- | A non-deterministic Variable Set
@@ -141,7 +141,7 @@ mapUnionVarSet get_set xs = foldr (unionVarSet . get_set) emptyVarSet xs
-- See comments with type signatures
intersectsVarSet s1 s2 = not (s1 `disjointVarSet` s2)
disjointVarSet s1 s2 = disjointUFM (getUniqSet s1) (getUniqSet s2)
-subVarSet s1 s2 = isEmptyVarSet (s1 `minusVarSet` s2)
+subVarSet s1 s2 = subUFM (getUniqSet s1) (getUniqSet s2)
anyVarSet :: (Var -> Bool) -> VarSet -> Bool
anyVarSet = uniqSetAny
@@ -261,7 +261,7 @@ dVarSetElems :: DVarSet -> [Var]
dVarSetElems = uniqDSetToList
subDVarSet :: DVarSet -> DVarSet -> Bool
-subDVarSet s1 s2 = isEmptyDVarSet (s1 `minusDVarSet` s2)
+subDVarSet s1 s2 = subUDFM (getUniqDSet s1) (getUniqDSet s2)
unionDVarSet :: DVarSet -> DVarSet -> DVarSet
unionDVarSet = unionUniqDSets
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3f0299bde8063675d36432ff2ebf44a2...
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3f0299bde8063675d36432ff2ebf44a2...
You're receiving this email because of your account on gitlab.haskell.org.
