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.