Simon Jakobi pushed to branch wip/sjakobi/T27379 at Glasgow Haskell Compiler / GHC

Commits:

5 changed files:

Changes:

  • compiler/GHC/Data/Word64Map/Internal.hs
    ... ... @@ -235,6 +235,7 @@ module GHC.Data.Word64Map.Internal (
    235 235
         -- * Submap
    
    236 236
         , isSubmapOf, isSubmapOfBy
    
    237 237
         , isProperSubmapOf, isProperSubmapOfBy
    
    238
    +    , keysAreSubsetOf
    
    238 239
     
    
    239 240
         -- * Min\/Max
    
    240 241
         , lookupMin
    
    ... ... @@ -2441,6 +2442,21 @@ isSubmapOfBy predicate (Tip k x) t = case lookup k t of
    2441 2442
                                              Nothing -> False
    
    2442 2443
     isSubmapOfBy _         Nil _           = True
    
    2443 2444
     
    
    2445
    +-- | \(O(n \cdot W)\). Are all of the first map's keys present in the second?
    
    2446
    +--
    
    2447
    +-- Like @'isSubmapOfBy' (\\_ _ -> True)@ but fully value-agnostic.
    
    2448
    +keysAreSubsetOf :: Word64Map a -> Word64Map b -> Bool
    
    2449
    +keysAreSubsetOf t1@(Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
    
    2450
    +  | shorter m1 m2  = False
    
    2451
    +  | shorter m2 m1  = match p1 p2 m2 &&
    
    2452
    +                       if zero p1 m2
    
    2453
    +                       then keysAreSubsetOf t1 l2
    
    2454
    +                       else keysAreSubsetOf t1 r2
    
    2455
    +  | otherwise      = p1 == p2 && keysAreSubsetOf l1 l2 && keysAreSubsetOf r1 r2
    
    2456
    +keysAreSubsetOf (Bin _ _ _ _) _ = False
    
    2457
    +keysAreSubsetOf (Tip k _) t     = member k t
    
    2458
    +keysAreSubsetOf Nil _           = True
    
    2459
    +
    
    2444 2460
     {--------------------------------------------------------------------
    
    2445 2461
       Mapping
    
    2446 2462
     --------------------------------------------------------------------}
    

  • compiler/GHC/Data/Word64Map/Lazy.hs
    ... ... @@ -206,6 +206,7 @@ module GHC.Data.Word64Map.Lazy (
    206 206
         -- * Submap
    
    207 207
         , isSubmapOf, isSubmapOfBy
    
    208 208
         , isProperSubmapOf, isProperSubmapOfBy
    
    209
    +    , keysAreSubsetOf
    
    209 210
     
    
    210 211
         -- * Min\/Max
    
    211 212
         , lookupMin
    

  • compiler/GHC/Types/Unique/DFM.hs
    ... ... @@ -48,7 +48,7 @@ module GHC.Types.Unique.DFM (
    48 48
             isNullUDFM,
    
    49 49
             sizeUDFM,
    
    50 50
             intersectUDFM, udfmIntersectUFM,
    
    51
    -        disjointUDFM, disjointUdfmUfm,
    
    51
    +        disjointUDFM, disjointUdfmUfm, subUDFM,
    
    52 52
             equalKeysUDFM,
    
    53 53
             minusUDFM,
    
    54 54
             listToUDFM, listToUDFM_Directly,
    
    ... ... @@ -388,6 +388,10 @@ disjointUDFM (UDFM x _i) (UDFM y _j) = M.disjoint x y
    388 388
     disjointUdfmUfm :: UniqDFM key elt -> UniqFM key elt2 -> Bool
    
    389 389
     disjointUdfmUfm (UDFM x _i) y = M.disjoint x (ufmToIntMap y)
    
    390 390
     
    
    391
    +-- | True if the first map's keys are a subset of the second's.
    
    392
    +subUDFM :: UniqDFM key elt1 -> UniqDFM key elt2 -> Bool
    
    393
    +subUDFM (UDFM x _i) (UDFM y _j) = M.keysAreSubsetOf x y
    
    394
    +
    
    391 395
     minusUDFM :: UniqDFM key elt1 -> UniqDFM key elt2 -> UniqDFM key elt1
    
    392 396
     minusUDFM (UDFM x i) (UDFM y _j) = UDFM (M.difference x y) i
    
    393 397
       -- 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 (
    66 66
             intersectUFM_C,
    
    67 67
             strictIntersectUFM_C,
    
    68 68
             disjointUFM,
    
    69
    +        subUFM,
    
    69 70
             equalKeysUFM,
    
    70 71
             diffUFM,
    
    71 72
             nonDetStrictFoldUFM, nonDetFoldUFM, nonDetStrictFoldUFM_DirectlyM,
    
    ... ... @@ -430,6 +431,10 @@ strictIntersectUFM_C f (UFM x) (UFM y) = UFM (MS.intersectionWith f x y)
    430 431
     disjointUFM :: UniqFM key elt1 -> UniqFM key elt2 -> Bool
    
    431 432
     disjointUFM (UFM x) (UFM y) = M.disjoint x y
    
    432 433
     
    
    434
    +-- | True if the first map's keys are a subset of the second's.
    
    435
    +subUFM :: UniqFM key elt1 -> UniqFM key elt2 -> Bool
    
    436
    +subUFM (UFM x) (UFM y) = M.keysAreSubsetOf x y
    
    437
    +
    
    433 438
     -- | Fold over a 'UniqFM'.
    
    434 439
     --
    
    435 440
     -- Non-deterministic, unless the folding function is commutative
    

  • compiler/GHC/Types/Var/Set.hs
    ... ... @@ -53,8 +53,8 @@ import GHC.Types.Unique
    53 53
     import GHC.Types.Name     ( Name )
    
    54 54
     import GHC.Types.Unique.Set
    
    55 55
     import GHC.Types.Unique.DSet
    
    56
    -import GHC.Types.Unique.FM( disjointUFM, pluralUFM, pprUFM )
    
    57
    -import GHC.Types.Unique.DFM( disjointUDFM, udfmToUfm, anyUDFM, allUDFM )
    
    56
    +import GHC.Types.Unique.FM( disjointUFM, subUFM, pluralUFM, pprUFM )
    
    57
    +import GHC.Types.Unique.DFM( disjointUDFM, subUDFM, udfmToUfm, anyUDFM, allUDFM )
    
    58 58
     import GHC.Utils.Outputable (SDoc)
    
    59 59
     
    
    60 60
     -- | A non-deterministic Variable Set
    
    ... ... @@ -141,7 +141,7 @@ mapUnionVarSet get_set xs = foldr (unionVarSet . get_set) emptyVarSet xs
    141 141
     -- See comments with type signatures
    
    142 142
     intersectsVarSet s1 s2 = not (s1 `disjointVarSet` s2)
    
    143 143
     disjointVarSet   s1 s2 = disjointUFM (getUniqSet s1) (getUniqSet s2)
    
    144
    -subVarSet        s1 s2 = isEmptyVarSet (s1 `minusVarSet` s2)
    
    144
    +subVarSet        s1 s2 = subUFM (getUniqSet s1) (getUniqSet s2)
    
    145 145
     
    
    146 146
     anyVarSet :: (Var -> Bool) -> VarSet -> Bool
    
    147 147
     anyVarSet = uniqSetAny
    
    ... ... @@ -261,7 +261,7 @@ dVarSetElems :: DVarSet -> [Var]
    261 261
     dVarSetElems = uniqDSetToList
    
    262 262
     
    
    263 263
     subDVarSet :: DVarSet -> DVarSet -> Bool
    
    264
    -subDVarSet s1 s2 = isEmptyDVarSet (s1 `minusDVarSet` s2)
    
    264
    +subDVarSet s1 s2 = subUDFM (getUniqDSet s1) (getUniqDSet s2)
    
    265 265
     
    
    266 266
     unionDVarSet :: DVarSet -> DVarSet -> DVarSet
    
    267 267
     unionDVarSet = unionUniqDSets