ghc 9.8.3 → 9.8.4

raw patch · 71 files changed

+8121/−523 lines, 71 filesdep ~ghc-bootdep ~ghc-heapdep ~ghciPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: ghc-boot, ghc-heap, ghci

API changes (from Hackage documentation)

Files

• GHC/Builtin/Uniques.hs +33/−28
• GHC/Builtin/primops.txt.pp +46/−16
• GHC/ByteCode/Asm.hs +3/−4
• GHC/ByteCode/Instr.hs +3/−7
• GHC/ByteCode/Types.hs +5/−1
• GHC/Cmm/CommonBlockElim.hs +4/−1
• GHC/Cmm/Dataflow/Collections.hs +7/−6
• GHC/Cmm/Dataflow/Label.hs +5/−4
• GHC/Cmm/Dominators.hs +16/−10
• GHC/Cmm/LRegSet.hs +15/−14
• GHC/Cmm/Lexer.hs +2/−2
• GHC/Cmm/Sink.hs +4/−4
• GHC/CmmToAsm/CFG.hs +12/−7
• GHC/CmmToAsm/CFG/Dominators.hs +93/−70
• GHC/CmmToAsm/Wasm/Asm.hs +5/−5
• GHC/CmmToAsm/Wasm/FromCmm.hs +2/−2
• GHC/CmmToAsm/Wasm/Types.hs +3/−3
• GHC/CmmToLlvm/Base.hs +6/−6
• GHC/Core/Opt/Monad.hs +10/−10
• GHC/Core/Opt/Pipeline.hs +2/−2
• GHC/Core/Opt/Simplify/Monad.hs +5/−5
• GHC/Data/Graph/UnVar.hs +5/−4
• GHC/Data/Word64Map.hs +62/−0
• GHC/Data/Word64Map/Internal.hs +3607/−0
• GHC/Data/Word64Map/Lazy.hs +237/−0
• GHC/Data/Word64Map/Strict.hs +257/−0
• GHC/Data/Word64Map/Strict/Internal.hs +1208/−0
• GHC/Data/Word64Set.hs +174/−0
• GHC/Data/Word64Set/Internal.hs +1704/−0
• GHC/Driver/CmdLine.hs +7/−6
• GHC/Driver/DynFlags.hs +2/−1
• GHC/Driver/Main.hs +2/−2
• GHC/Driver/Make.hs +9/−7
• GHC/Driver/Session.hs +6/−5
• GHC/HsToCore/Breakpoints.hs +7/−5
• GHC/HsToCore/Foreign/JavaScript.hs +1/−1
• GHC/HsToCore/Match/Literal.hs +38/−37
• GHC/Linker/Deps.hs +5/−0
• GHC/Parser/HaddockLex.hs +2/−2
• GHC/Parser/Lexer.hs +2/−2
• GHC/Runtime/Eval.hs +4/−6
• GHC/Runtime/Interpreter.hs +7/−4
• GHC/Stg/Pipeline.hs +4/−4
• GHC/StgToByteCode.hs +8/−6
• GHC/StgToCmm/Ticky.hs +13/−13
• GHC/StgToJS/Deps.hs +11/−10
• GHC/StgToJS/Ids.hs +1/−1
• GHC/StgToJS/Symbols.hs +11/−2
• GHC/StgToJS/Types.hs +2/−1
• GHC/Tc/Deriv/Utils.hs +32/−31
• GHC/Tc/Gen/Foreign.hs +11/−10
• GHC/Tc/Types.hs +1/−1
• GHC/Tc/Types/Origin.hs +1/−1
• GHC/Tc/Utils/Instantiate.hs +7/−6
• GHC/Tc/Utils/Monad.hs +7/−7
• GHC/ThToHs.hs +2/−1
• GHC/Types/Name/Cache.hs +1/−1
• GHC/Types/Unique.hs +51/−34
• GHC/Types/Unique/DFM.hs +11/−9
• GHC/Types/Unique/FM.hs +16/−16
• GHC/Types/Unique/Supply.hs +65/−51
• GHC/Types/Var.hs +14/−14
• GHC/Types/Var/Env.hs +2/−2
• GHC/Utils/Containers/Internal/BitUtil.hs +71/−0
• GHC/Utils/Containers/Internal/StrictPair.hs +24/−0
• GHC/Utils/Outputable.hs +7/−4
• GHC/Utils/Unique.hs +35/−0
• GHC/Utils/Word64.hs +20/−0
• cbits/genSym.c +20/−4
• ghc.cabal +20/−5
• jsbits/genSym.js +26/−0

@@ -66,8 +66,10 @@  import GHC.Utils.Outputable import GHC.Utils.Panic+import GHC.Utils.Panic.Plain (assert)  import Data.Maybe+import GHC.Utils.Word64 (word64ToInt)  -- | Get the 'Name' associated with a known-key 'Unique'. knownUniqueName :: Unique -> Maybe Name@@ -83,7 +85,9 @@       'm' -> Just $ getCTupleDataConName n       _   -> Nothing   where-    (tag, n) = unpkUnique u+    (tag, n') = unpkUnique u+    -- Known unique names are guaranteed to fit in Int, so we don't need the whole Word64.+    n = assert (isValidKnownKeyUnique u) (word64ToInt n')  {- Note [Unique layout for unboxed sums]@@ -115,14 +119,14 @@     assertPpr (arity <= 0x3f) (ppr arity) $               -- 0x3f since we only have 6 bits to encode the               -- alternative-    mkUnique 'z' (arity `shiftL` 8 .|. 0xfc)+    mkUniqueInt 'z' (arity `shiftL` 8 .|. 0xfc)  mkSumDataConUnique :: ConTagZ -> Arity -> Unique mkSumDataConUnique alt arity   | alt >= arity   = panic ("mkSumDataConUnique: " ++ show alt ++ " >= " ++ show arity)   | otherwise-  = mkUnique 'z' (arity `shiftL` 8 + alt `shiftL` 2) {- skip the tycon -}+  = mkUniqueInt 'z' (arity `shiftL` 8 + alt `shiftL` 2) {- skip the tycon -}  getUnboxedSumName :: Int -> Name getUnboxedSumName n@@ -209,17 +213,17 @@ -}  mkCTupleTyConUnique :: Arity -> Unique-mkCTupleTyConUnique a = mkUnique 'k' (2*a)+mkCTupleTyConUnique a = mkUniqueInt 'k' (2*a)  mkCTupleDataConUnique :: Arity -> Unique-mkCTupleDataConUnique a = mkUnique 'm' (3*a)+mkCTupleDataConUnique a = mkUniqueInt 'm' (3*a)  mkCTupleSelIdUnique :: ConTagZ -> Arity -> Unique mkCTupleSelIdUnique sc_pos arity   | sc_pos >= arity   = panic ("mkCTupleSelIdUnique: " ++ show sc_pos ++ " >= " ++ show arity)   | otherwise-  = mkUnique 'j' (arity `shiftL` cTupleSelIdArityBits + sc_pos)+  = mkUniqueInt 'j' (arity `shiftL` cTupleSelIdArityBits + sc_pos)  getCTupleTyConName :: Int -> Name getCTupleTyConName n =@@ -262,12 +266,12 @@ -- Normal tuples  mkTupleDataConUnique :: Boxity -> Arity -> Unique-mkTupleDataConUnique Boxed          a = mkUnique '7' (3*a)    -- may be used in C labels-mkTupleDataConUnique Unboxed        a = mkUnique '8' (3*a)+mkTupleDataConUnique Boxed          a = mkUniqueInt '7' (3*a)    -- may be used in C labels+mkTupleDataConUnique Unboxed        a = mkUniqueInt '8' (3*a)  mkTupleTyConUnique :: Boxity -> Arity -> Unique-mkTupleTyConUnique Boxed           a  = mkUnique '4' (2*a)-mkTupleTyConUnique Unboxed         a  = mkUnique '5' (2*a)+mkTupleTyConUnique Boxed           a  = mkUniqueInt '4' (2*a)+mkTupleTyConUnique Unboxed         a  = mkUniqueInt '5' (2*a)  -- | This function is an inverse of `mkTupleTyConUnique` isTupleTyConUnique :: Unique -> Maybe (Boxity, Arity)@@ -278,7 +282,8 @@     _        -> Nothing   where     (tag,   n) = unpkUnique u-    (arity, i) = quotRem n 2+    (arity', i) = quotRem n 2+    arity = word64ToInt arity'  getTupleTyConName :: Boxity -> Int -> Name getTupleTyConName boxity n =@@ -298,7 +303,7 @@       _          -> panic "getTupleDataConName: impossible"  {--Note [Uniques for wired-in prelude things and known masks]+Note [Uniques for wired-in prelude things and known tags] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Allocation of unique supply characters:         v,u: for renumbering value-, and usage- vars.@@ -358,27 +363,27 @@ mkPrimOpWrapperUnique  :: Int -> Unique mkPreludeMiscIdUnique  :: Int -> Unique -mkAlphaTyVarUnique   i = mkUnique '1' i-mkPreludeClassUnique i = mkUnique '2' i+mkAlphaTyVarUnique   i = mkUniqueInt '1' i+mkPreludeClassUnique i = mkUniqueInt '2' i  ---------------------------------------------------mkPrimOpIdUnique op         = mkUnique '9' (2*op)-mkPrimOpWrapperUnique op    = mkUnique '9' (2*op+1)-mkPreludeMiscIdUnique  i    = mkUnique '0' i+mkPrimOpIdUnique op         = mkUniqueInt '9' (2*op)+mkPrimOpWrapperUnique op    = mkUniqueInt '9' (2*op+1)+mkPreludeMiscIdUnique  i    = mkUniqueInt '0' i  mkPseudoUniqueE, mkBuiltinUnique :: Int -> Unique -mkBuiltinUnique i = mkUnique 'B' i-mkPseudoUniqueE i = mkUnique 'E' i -- used in NCG spiller to create spill VirtualRegs+mkBuiltinUnique i = mkUniqueInt 'B' i+mkPseudoUniqueE i = mkUniqueInt 'E' i -- used in NCG spiller to create spill VirtualRegs  mkRegSingleUnique, mkRegPairUnique, mkRegSubUnique, mkRegClassUnique :: Int -> Unique-mkRegSingleUnique = mkUnique 'R'-mkRegSubUnique    = mkUnique 'S'-mkRegPairUnique   = mkUnique 'P'-mkRegClassUnique  = mkUnique 'L'+mkRegSingleUnique = mkUniqueInt 'R'+mkRegSubUnique    = mkUniqueInt 'S'+mkRegPairUnique   = mkUniqueInt 'P'+mkRegClassUnique  = mkUniqueInt 'L'  mkCostCentreUnique :: Int -> Unique-mkCostCentreUnique = mkUnique 'C'+mkCostCentreUnique = mkUniqueInt 'C'  varNSUnique, dataNSUnique, tvNSUnique, tcNSUnique :: Unique varNSUnique    = mkUnique 'i' 0@@ -387,7 +392,7 @@ tcNSUnique     = mkUnique 'c' 0  mkFldNSUnique :: FastString -> Unique-mkFldNSUnique fs = mkUnique 'f' (uniqueOfFS fs)+mkFldNSUnique fs = mkUniqueInt 'f' (uniqueOfFS fs)  isFldNSUnique :: Unique -> Bool isFldNSUnique uniq = case unpkUnique uniq of@@ -401,7 +406,7 @@ -- See Note [Related uniques for wired-in things]  mkPreludeTyConUnique   :: Int -> Unique-mkPreludeTyConUnique i = mkUnique '3' (2*i)+mkPreludeTyConUnique i = mkUniqueInt '3' (2*i)  tyConRepNameUnique :: Unique -> Unique tyConRepNameUnique  u = incrUnique u@@ -411,7 +416,7 @@ -- See Note [Related uniques for wired-in things]  mkPreludeDataConUnique :: Int -> Unique-mkPreludeDataConUnique i = mkUnique '6' (3*i)    -- Must be alphabetic+mkPreludeDataConUnique i = mkUniqueInt '6' (3*i)    -- Must be alphabetic  dataConTyRepNameUnique, dataConWorkerUnique :: Unique -> Unique dataConWorkerUnique  u = incrUnique u@@ -437,7 +442,7 @@ -- A little delicate!  mkBoxingTyConUnique :: Int -> Unique-mkBoxingTyConUnique i = mkUnique 'b' (5*i)+mkBoxingTyConUnique i = mkUniqueInt 'b' (5*i)  boxingDataConUnique :: Unique -> Unique boxingDataConUnique u = stepUnique u 2

@@ -2535,18 +2535,45 @@ section "Exceptions" ------------------------------------------------------------------------ --- Note [Strictness for mask/unmask/catch]--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- Note [Strict IO wrappers]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~ -- Consider this example, which comes from GHC.IO.Handle.Internals:---    wantReadableHandle3 f ma b st+--    wantReadableHandle3 f mv b st --      = case ... of---          DEFAULT -> case ma of MVar a -> ...---          0#      -> maskAsyncExceptions# (\st -> case ma of MVar a -> ...)+--          DEFAULT -> case mv of MVar a -> ...+--          0#      -> maskAsyncExceptions# (\st -> case mv of MVar a -> ...) -- The outer case just decides whether to mask exceptions, but we don't want--- thereby to hide the strictness in 'ma'!  Hence the use of strictOnceApply1Dmd--- in mask and unmask. But catch really is lazy in its first argument, see--- #11555. So for IO actions 'ma' we often use a wrapper around it that is--- head-strict in 'ma': GHC.IO.catchException.+-- thereby to hide the strictness in `mv`!  Hence the use of strictOnceApply1Dmd+-- in mask#, unmask# and atomically# (where we use strictManyApply1Dmd to respect+-- that it potentially calls its action multiple times).+--+-- Note [Strictness for catch-style primops]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- The catch#-style primops always call their action, just like outlined+-- in Note [Strict IO wrappers].+-- However, it is important that we give their first arg lazyApply1Dmd and not+-- strictOnceApply1Dmd, like for mask#. Here is why. Consider a call+--+--   catch# act handler s+--+-- If `act = raiseIO# ...`, using strictOnceApply1Dmd for `act` would mean that+-- the call forwards the dead-end flag from `act` (see Note [Dead ends] and+-- Note [Precise exceptions and strictness analysis]).+-- This would cause dead code elimination to discard the continuation of the+-- catch# call, among other things. This first came up in #11555.+--+-- Hence catch# uses lazyApply1Dmd in order /not/ to forward the dead-end flag+-- from `act`. (This is a bit brutal, but the language of strictness types is+-- not expressive enough to give it a more precise semantics that is still+-- sound.)+-- For perf reasons we often (but not always) choose to use a wrapper around+-- catch# that is head-strict in `act`: GHC.IO.catchException.+--+-- A similar caveat applies to prompt#, which can be seen as a+-- generalisation of catch# as explained in GHC.Prim#continuations#.+-- The reason is that even if `act` appears dead-ending (e.g., looping)+-- `prompt# tag ma s` might return alright due to a (higher-order) use of+-- `control0#` in `act`. This came up in #25439.  primop  CatchOp "catch#" GenPrimOp           (State# RealWorld -> (# State# RealWorld, o #) )@@ -2563,7 +2590,7 @@    strictness  = { \ _arity -> mkClosedDmdSig [ lazyApply1Dmd                                                  , lazyApply2Dmd                                                  , topDmd] topDiv }-                 -- See Note [Strictness for mask/unmask/catch]+                 -- See Note [Strictness for catch-style primops]    out_of_line = True    has_side_effects = True @@ -2628,7 +2655,7 @@      in continuation-style primops\" for details. }    with    strictness  = { \ _arity -> mkClosedDmdSig [strictOnceApply1Dmd,topDmd] topDiv }-                 -- See Note [Strictness for mask/unmask/catch]+                 -- See Note [Strict IO wrappers]    out_of_line = True    has_side_effects = True @@ -2643,6 +2670,7 @@      in continuation-style primops\" for details. }    with    strictness  = { \ _arity -> mkClosedDmdSig [strictOnceApply1Dmd,topDmd] topDiv }+                 -- See Note [Strict IO wrappers]    out_of_line = True    has_side_effects = True @@ -2657,7 +2685,7 @@      in continuation-style primops\" for details. }    with    strictness  = { \ _arity -> mkClosedDmdSig [strictOnceApply1Dmd,topDmd] topDiv }-                 -- See Note [Strictness for mask/unmask/catch]+                 -- See Note [Strict IO wrappers]    out_of_line = True    has_side_effects = True @@ -2843,7 +2871,8 @@      -> State# RealWorld -> (# State# RealWorld, a #)    { See "GHC.Prim#continuations". }    with-   strictness = { \ _arity -> mkClosedDmdSig [topDmd, strictOnceApply1Dmd, topDmd] topDiv }+   strictness = { \ _arity -> mkClosedDmdSig [topDmd, lazyApply1Dmd, topDmd] topDiv }+                 -- See Note [Strictness for catch-style primops]    out_of_line = True    has_side_effects = True @@ -2870,7 +2899,7 @@    -> State# RealWorld -> (# State# RealWorld, v #)    with    strictness  = { \ _arity -> mkClosedDmdSig [strictManyApply1Dmd,topDmd] topDiv }-                 -- See Note [Strictness for mask/unmask/catch]+                 -- See Note [Strict IO wrappers]    out_of_line = True    has_side_effects = True @@ -2899,7 +2928,7 @@    strictness  = { \ _arity -> mkClosedDmdSig [ lazyApply1Dmd                                                  , lazyApply1Dmd                                                  , topDmd ] topDiv }-                 -- See Note [Strictness for mask/unmask/catch]+                 -- See Note [Strictness for catch-style primops]    out_of_line = True    has_side_effects = True @@ -2911,7 +2940,7 @@    strictness  = { \ _arity -> mkClosedDmdSig [ lazyApply1Dmd                                                  , lazyApply2Dmd                                                  , topDmd ] topDiv }-                 -- See Note [Strictness for mask/unmask/catch]+                 -- See Note [Strictness for catch-style primops]    out_of_line = True    has_side_effects = True @@ -3586,6 +3615,7 @@    with    out_of_line = True    strictness = { \ _arity -> mkClosedDmdSig [topDmd, topDmd, strictOnceApply1Dmd] topDiv }+                 -- See Note [Strict IO wrappers]   ------------------------------------------------------------------------

@@ -27,7 +27,6 @@ import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.Literal-import GHC.Types.Unique import GHC.Types.Unique.DSet  import GHC.Utils.Outputable@@ -518,11 +517,11 @@   CCALL off m_addr i       -> do np <- addr m_addr                                  emit bci_CCALL [wOp off, Op np, SmallOp i]   PRIMCALL                 -> emit bci_PRIMCALL []-  BRK_FUN index uniq cc    -> do p1 <- ptr BCOPtrBreakArray-                                 q <- int (getKey uniq)+  BRK_FUN index mod cc     -> do p1 <- ptr BCOPtrBreakArray+                                 m <- addr mod                                  np <- addr cc                                  emit bci_BRK_FUN [Op p1, SmallOp index,-                                                   Op q, Op np]+                                                   Op m, Op np]    where     literal (LitLabel fs (Just sz) _)

@@ -19,7 +19,6 @@ import GHC.StgToCmm.Layout     ( ArgRep(..) ) import GHC.Utils.Outputable import GHC.Types.Name-import GHC.Types.Unique import GHC.Types.Literal import GHC.Core.DataCon import GHC.Builtin.PrimOps@@ -31,6 +30,7 @@ import GHC.Stack.CCS (CostCentre)  import GHC.Stg.Syntax+import Language.Haskell.Syntax.Module.Name (ModuleName)  -- ---------------------------------------------------------------------------- -- Bytecode instructions@@ -205,7 +205,7 @@                    -- Note [unboxed tuple bytecodes and tuple_BCO] in GHC.StgToByteCode     -- Breakpoints-   | BRK_FUN         !Word16 Unique (RemotePtr CostCentre)+   | BRK_FUN         !Word16 (RemotePtr ModuleName) (RemotePtr CostCentre)  -- ----------------------------------------------------------------------------- -- Printing bytecode instructions@@ -356,11 +356,7 @@    ppr ENTER                 = text "ENTER"    ppr (RETURN pk)           = text "RETURN  " <+> ppr pk    ppr (RETURN_TUPLE)        = text "RETURN_TUPLE"-   ppr (BRK_FUN index uniq _cc) = text "BRK_FUN" <+> ppr index <+> mb_uniq <+> text "<cc>"-     where mb_uniq = sdocOption sdocSuppressUniques $ \case-             True  -> text "<uniq>"-             False -> ppr uniq-+   ppr (BRK_FUN index _mod_name _cc) = text "BRK_FUN" <+> ppr index <+> text "<module>" <+> text "<cc>"   -- -----------------------------------------------------------------------------

@@ -44,6 +44,7 @@ import GHC.Stack.CCS import GHC.Cmm.Expr ( GlobalRegSet, emptyRegSet, regSetToList ) import GHC.Iface.Syntax+import Language.Haskell.Syntax.Module.Name (ModuleName)  -- ----------------------------------------------------------------------------- -- Compiled Byte Code@@ -242,6 +243,7 @@         -- ^ Array pointing to cost centre for each breakpoint    , modBreaks_breakInfo :: IntMap CgBreakInfo         -- ^ info about each breakpoint from the bytecode generator+   , modBreaks_module :: RemotePtr ModuleName    }  seqModBreaks :: ModBreaks -> ()@@ -251,7 +253,8 @@   rnf modBreaks_vars `seq`   rnf modBreaks_decls `seq`   rnf modBreaks_ccs `seq`-  rnf (fmap seqCgBreakInfo modBreaks_breakInfo)+  rnf (fmap seqCgBreakInfo modBreaks_breakInfo) `seq`+  rnf modBreaks_module  -- | Construct an empty ModBreaks emptyModBreaks :: ModBreaks@@ -263,6 +266,7 @@    , modBreaks_decls = array (0,-1) []    , modBreaks_ccs = array (0,-1) []    , modBreaks_breakInfo = IntMap.empty+   , modBreaks_module = toRemotePtr nullPtr    }  {-

@@ -26,6 +26,7 @@ import qualified GHC.Data.TrieMap as TM import GHC.Types.Unique.FM import GHC.Types.Unique+import GHC.Utils.Word64 (truncateWord64ToWord32) import Control.Arrow (first, second) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE@@ -182,8 +183,10 @@          cvt = fromInteger . toInteger +        -- Since we are hashing, we can savely downcast Word64 to Word32 here.+        -- Although a different hashing function may be more effective.         hash_unique :: Uniquable a => a -> Word32-        hash_unique = cvt . getKey . getUnique+        hash_unique = truncateWord64ToWord32 . getKey . getUnique  -- | Ignore these node types for equality dont_care :: CmmNode O x -> Bool

@@ -12,10 +12,11 @@  import GHC.Prelude -import qualified Data.IntMap.Strict as M-import qualified Data.IntSet as S+import qualified GHC.Data.Word64Map.Strict as M+import qualified GHC.Data.Word64Set as S  import Data.List (foldl1')+import Data.Word (Word64)  class IsSet set where   type ElemOf set@@ -107,10 +108,10 @@ -- Basic instances ----------------------------------------------------------------------------- -newtype UniqueSet = US S.IntSet deriving (Eq, Ord, Show, Semigroup, Monoid)+newtype UniqueSet = US S.Word64Set deriving (Eq, Ord, Show, Semigroup, Monoid)  instance IsSet UniqueSet where-  type ElemOf UniqueSet = Int+  type ElemOf UniqueSet = Word64    setNull (US s) = S.null s   setSize (US s) = S.size s@@ -133,11 +134,11 @@   setElems (US s) = S.elems s   setFromList ks = US (S.fromList ks) -newtype UniqueMap v = UM (M.IntMap v)+newtype UniqueMap v = UM (M.Word64Map v)   deriving (Eq, Ord, Show, Functor, Foldable, Traversable)  instance IsMap UniqueMap where-  type KeyOf UniqueMap = Int+  type KeyOf UniqueMap = Word64    mapNull (UM m) = M.null m   mapSize (UM m) = M.size m

@@ -20,25 +20,26 @@ -- TODO: This should really just use GHC's Unique and Uniq{Set,FM} import GHC.Cmm.Dataflow.Collections -import GHC.Types.Unique (Uniquable(..))+import GHC.Types.Unique (Uniquable(..), mkUniqueGrimily) import GHC.Data.TrieMap+import Data.Word (Word64)   ----------------------------------------------------------------------------- --              Label ----------------------------------------------------------------------------- -newtype Label = Label { lblToUnique :: Int }+newtype Label = Label { lblToUnique :: Word64 }   deriving (Eq, Ord) -mkHooplLabel :: Int -> Label+mkHooplLabel :: Word64 -> Label mkHooplLabel = Label  instance Show Label where   show (Label n) = "L" ++ show n  instance Uniquable Label where-  getUnique label = getUnique (lblToUnique label)+  getUnique label = mkUniqueGrimily (lblToUnique label)  instance Outputable Label where   ppr label = ppr (getUnique label)

@@ -26,8 +26,7 @@ import Data.Foldable() import qualified Data.Tree as Tree -import qualified Data.IntMap.Strict as IM-import qualified Data.IntSet as IS+import Data.Word  import qualified GHC.CmmToAsm.CFG.Dominators as LT @@ -41,6 +40,9 @@ import GHC.Utils.Outputable( Outputable(..), text, int, hcat, (<+>)) import GHC.Utils.Misc import GHC.Utils.Panic+import GHC.Utils.Word64 (intToWord64)+import qualified GHC.Data.Word64Map as WM+import qualified GHC.Data.Word64Set as WS   -- | =Dominator sets@@ -129,33 +131,37 @@ -- The implementation uses the Lengauer-Tarjan algorithm from the x86 -- back end. +-- Technically, we do not need Word64 here, however the dominators code+-- has to accomodate Word64 for other uses.+ graphWithDominators g = GraphWithDominators (reachable rpblocks g) dmap rpmap       where rpblocks = revPostorderFrom (graphMap g) (g_entry g)             rplabels' = map entryLabel rpblocks-            rplabels :: Array Int Label+            rplabels :: Array Word64 Label             rplabels = listArray bounds rplabels'              rpmap :: LabelMap RPNum             rpmap = mapFromList $ zipWith kvpair rpblocks [0..]               where kvpair block i = (entryLabel block, RPNum i) -            labelIndex :: Label -> Int+            labelIndex :: Label -> Word64             labelIndex = flip findLabelIn imap-              where imap :: LabelMap Int+              where imap :: LabelMap Word64                     imap = mapFromList $ zip rplabels' [0..]             blockIndex = labelIndex . entryLabel -            bounds = (0, length rpblocks - 1)+            bounds :: (Word64, Word64)+            bounds = (0, intToWord64 (length rpblocks - 1))              ltGraph :: [Block node C C] -> LT.Graph-            ltGraph [] = IM.empty+            ltGraph [] = WM.empty             ltGraph (block:blocks) =-                IM.insert+                WM.insert                       (blockIndex block)-                      (IS.fromList $ map labelIndex $ successors block)+                      (WS.fromList $ map labelIndex $ successors block)                       (ltGraph blocks) -            idom_array :: Array Int LT.Node+            idom_array :: Array Word64 LT.Node             idom_array = array bounds $ LT.idom (0, ltGraph rpblocks)              domSet 0 = EntryNode

@@ -20,34 +20,35 @@ import GHC.Prelude import GHC.Types.Unique import GHC.Cmm.Expr+import GHC.Word -import Data.IntSet as IntSet+import GHC.Data.Word64Set as Word64Set  -- Compact sets for membership tests of local variables. -type LRegSet = IntSet.IntSet-type LRegKey = Int+type LRegSet = Word64Set.Word64Set+type LRegKey = Word64  emptyLRegSet :: LRegSet-emptyLRegSet = IntSet.empty+emptyLRegSet = Word64Set.empty  nullLRegSet :: LRegSet -> Bool-nullLRegSet = IntSet.null+nullLRegSet = Word64Set.null  insertLRegSet :: LocalReg -> LRegSet -> LRegSet-insertLRegSet l = IntSet.insert (getKey (getUnique l))+insertLRegSet l = Word64Set.insert (getKey (getUnique l))  elemLRegSet :: LocalReg -> LRegSet -> Bool-elemLRegSet l = IntSet.member (getKey (getUnique l))+elemLRegSet l = Word64Set.member (getKey (getUnique l))  deleteFromLRegSet :: LRegSet -> LocalReg -> LRegSet-deleteFromLRegSet set reg = IntSet.delete (getKey . getUnique $ reg) set+deleteFromLRegSet set reg = Word64Set.delete (getKey . getUnique $ reg) set -sizeLRegSet :: IntSet -> Int-sizeLRegSet = IntSet.size+sizeLRegSet :: Word64Set -> Int+sizeLRegSet = Word64Set.size -plusLRegSet :: IntSet -> IntSet -> IntSet-plusLRegSet = IntSet.union+plusLRegSet :: Word64Set -> Word64Set -> Word64Set+plusLRegSet = Word64Set.union -elemsLRegSet :: IntSet -> [Int]-elemsLRegSet = IntSet.toList+elemsLRegSet :: Word64Set -> [Word64]+elemsLRegSet = Word64Set.toList

@@ -1,7 +1,7 @@ {-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-missing-signatures #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-}-{-# LINE 13 "_build/source-dist/ghc-9.8.3-src/ghc-9.8.3/compiler/GHC/Cmm/Lexer.x" #-}+{-# LINE 13 "_build/source-dist/ghc-9.8.4-src/ghc-9.8.4/compiler/GHC/Cmm/Lexer.x" #-} module GHC.Cmm.Lexer (    CmmToken(..), cmmlex,   ) where@@ -386,7 +386,7 @@   , (0,alex_action_20)   ] -{-# LINE 134 "_build/source-dist/ghc-9.8.3-src/ghc-9.8.3/compiler/GHC/Cmm/Lexer.x" #-}+{-# LINE 134 "_build/source-dist/ghc-9.8.4-src/ghc-9.8.4/compiler/GHC/Cmm/Lexer.x" #-} data CmmToken   = CmmT_SpecChar  Char   | CmmT_DotDot

@@ -21,7 +21,7 @@ import GHC.Platform import GHC.Types.Unique.FM -import qualified Data.IntSet as IntSet+import qualified GHC.Data.Word64Set as Word64Set import Data.List (partition) import Data.Maybe @@ -175,7 +175,7 @@       -- Annotate the middle nodes with the registers live *after*       -- the node.  This will help us decide whether we can inline       -- an assignment in the current node or not.-      live = IntSet.unions (map getLive succs)+      live = Word64Set.unions (map getLive succs)       live_middle = gen_killL platform last live       ann_middles = annotate platform live_middle (blockToList middle) @@ -188,7 +188,7 @@       -- one predecessor), so identify the join points and the set       -- of registers live in them.       (joins, nonjoins) = partition (`mapMember` join_pts) succs-      live_in_joins = IntSet.unions (map getLive joins)+      live_in_joins = Word64Set.unions (map getLive joins)        -- We do not want to sink an assignment into multiple branches,       -- so identify the set of registers live in multiple successors.@@ -215,7 +215,7 @@             live_sets' | should_drop = live_sets                        | otherwise   = map upd live_sets -            upd set | r `elemLRegSet` set = set `IntSet.union` live_rhs+            upd set | r `elemLRegSet` set = set `Word64Set.union` live_rhs                     | otherwise          = set              live_rhs = foldRegsUsed platform (flip insertLRegSet) emptyLRegSet rhs

@@ -60,12 +60,16 @@ import GHC.Types.Unique import qualified GHC.CmmToAsm.CFG.Dominators as Dom import GHC.CmmToAsm.CFG.Weight+import GHC.Data.Word64Map.Strict (Word64Map)+import GHC.Data.Word64Set (Word64Set) import Data.IntMap.Strict (IntMap) import Data.IntSet (IntSet)  import qualified Data.IntMap.Strict as IM+import qualified GHC.Data.Word64Map.Strict as WM import qualified Data.Map as M import qualified Data.IntSet as IS+import qualified GHC.Data.Word64Set as WS import qualified Data.Set as S import Data.Tree import Data.Bifunctor@@ -90,6 +94,7 @@  import Control.Monad import GHC.Data.UnionFind+import Data.Word  type Prob = Double @@ -851,7 +856,7 @@      --TODO - This should be a no op: Export constructors? Use unsafeCoerce? ...     rooted = ( fromBlockId root-              , toIntMap $ fmap toIntSet graph) :: (Int, IntMap IntSet)+              , toWord64Map $ fmap toWord64Set graph) :: (Word64, Word64Map Word64Set)     tree = fmap toBlockId $ Dom.domTree rooted :: Tree BlockId      -- Map from Nodes to their dominators@@ -898,10 +903,10 @@           loopCount n = length $ nub . map fst . filter (setMember n . snd) $ bodies       in  map (\n -> (n, loopCount n)) $ nodes :: [(BlockId, Int)] -    toIntSet :: LabelSet -> IntSet-    toIntSet s = IS.fromList . map fromBlockId . setElems $ s-    toIntMap :: LabelMap a -> IntMap a-    toIntMap m = IM.fromList $ map (\(x,y) -> (fromBlockId x,y)) $ mapToList m+    toWord64Set :: LabelSet -> Word64Set+    toWord64Set s = WS.fromList . map fromBlockId . setElems $ s+    toWord64Map :: LabelMap a -> Word64Map a+    toWord64Map m = WM.fromList $ map (\(x,y) -> (fromBlockId x,y)) $ mapToList m      mkDomMap :: Tree BlockId -> LabelMap LabelSet     mkDomMap root = mapFromList $ go setEmpty root@@ -916,10 +921,10 @@                             (\n -> go (setInsert (rootLabel n) parents) n)                             leaves -    fromBlockId :: BlockId -> Int+    fromBlockId :: BlockId -> Word64     fromBlockId = getKey . getUnique -    toBlockId :: Int -> BlockId+    toBlockId :: Word64 -> BlockId     toBlockId = mkBlockId . mkUniqueGrimily  -- We make the CFG a Hoopl Graph, so we can reuse revPostOrder.

@@ -21,8 +21,8 @@       /Advanced Compiler Design and Implementation/, 1997.      \[3\] Brisk, Sarrafzadeh,-      /Interference Graphs for Procedures in Static Single/-      /Information Form are Interval Graphs/, 2007.+      /Interference CGraphs for Procedures in Static Single/+      /Information Form are Interval CGraphs/, 2007.   * Strictness @@ -40,7 +40,7 @@   ,pddfs,rpddfs   ,fromAdj,fromEdges   ,toAdj,toEdges-  ,asTree,asGraph+  ,asTree,asCGraph   ,parents,ancestors ) where @@ -61,15 +61,24 @@ import Data.Array.Base   (unsafeNewArray_   ,unsafeWrite,unsafeRead)+import GHC.Data.Word64Set (Word64Set)+import qualified GHC.Data.Word64Set as WS+import GHC.Data.Word64Map (Word64Map)+import qualified GHC.Data.Word64Map as WM+import Data.Word  ----------------------------------------------------------------------------- -type Node       = Int-type Path       = [Node]-type Edge       = (Node,Node)-type Graph      = IntMap IntSet-type Rooted     = (Node, Graph)+-- Compacted nodes; these can be stored in contiguous arrays+type CNode       = Int+type CGraph      = IntMap IntSet +type Node     = Word64+type Path     = [Node]+type Edge     = (Node, Node)+type Graph    = Word64Map Word64Set+type Rooted   = (Node, Graph)+ -----------------------------------------------------------------------------  -- | /Dominators/.@@ -111,7 +120,7 @@ -- | /Immediate post-dominators/. -- Complexity as for @idom@. ipdom :: Rooted -> [(Node,Node)]-ipdom rg = runST (evalS idomM =<< initEnv (pruneReach (second predG rg)))+ipdom rg = runST (evalS idomM =<< initEnv (pruneReach (second predGW rg)))  ----------------------------------------------------------------------------- @@ -126,24 +135,24 @@ -----------------------------------------------------------------------------  type Dom s a = S s (Env s) a-type NodeSet    = IntSet-type NodeMap a  = IntMap a+type NodeSet    = Word64Set+type NodeMap a  = Word64Map a data Env s = Env-  {succE      :: !Graph-  ,predE      :: !Graph-  ,bucketE    :: !Graph+  {succE      :: !CGraph+  ,predE      :: !CGraph+  ,bucketE    :: !CGraph   ,dfsE       :: {-# UNPACK #-}!Int-  ,zeroE      :: {-# UNPACK #-}!Node-  ,rootE      :: {-# UNPACK #-}!Node-  ,labelE     :: {-# UNPACK #-}!(Arr s Node)-  ,parentE    :: {-# UNPACK #-}!(Arr s Node)-  ,ancestorE  :: {-# UNPACK #-}!(Arr s Node)-  ,childE     :: {-# UNPACK #-}!(Arr s Node)-  ,ndfsE      :: {-# UNPACK #-}!(Arr s Node)+  ,zeroE      :: {-# UNPACK #-}!CNode+  ,rootE      :: {-# UNPACK #-}!CNode+  ,labelE     :: {-# UNPACK #-}!(Arr s CNode)+  ,parentE    :: {-# UNPACK #-}!(Arr s CNode)+  ,ancestorE  :: {-# UNPACK #-}!(Arr s CNode)+  ,childE     :: {-# UNPACK #-}!(Arr s CNode)+  ,ndfsE      :: {-# UNPACK #-}!(Arr s CNode)   ,dfnE       :: {-# UNPACK #-}!(Arr s Int)   ,sdnoE      :: {-# UNPACK #-}!(Arr s Int)   ,sizeE      :: {-# UNPACK #-}!(Arr s Int)-  ,domE       :: {-# UNPACK #-}!(Arr s Node)+  ,domE       :: {-# UNPACK #-}!(Arr s CNode)   ,rnE        :: {-# UNPACK #-}!(Arr s Node)}  -----------------------------------------------------------------------------@@ -188,7 +197,7 @@  ----------------------------------------------------------------------------- -eval :: Node -> Dom s Node+eval :: CNode -> Dom s CNode eval v = do   n0 <- zeroM   a  <- ancestorM v@@ -205,7 +214,7 @@         True-> return l         False-> return la -compress :: Node -> Dom s ()+compress :: CNode -> Dom s () compress v = do   n0  <- zeroM   a   <- ancestorM v@@ -224,7 +233,7 @@  ----------------------------------------------------------------------------- -link :: Node -> Node -> Dom s ()+link :: CNode -> CNode -> Dom s () link v w = do   n0  <- zeroM   lw  <- labelM w@@ -268,7 +277,7 @@  ----------------------------------------------------------------------------- -dfsDom :: Node -> Dom s ()+dfsDom :: CNode -> Dom s () dfsDom i = do   _   <- go i   n0  <- zeroM@@ -293,10 +302,10 @@  initEnv :: Rooted -> ST s (Env s) initEnv (r0,g0) = do-  -- Graph renumbered to indices from 1 to |V|+  -- CGraph renumbered to indices from 1 to |V|   let (g,rnmap) = renum 1 g0       pred      = predG g -- reverse graph-      root      = rnmap IM.! r0 -- renamed root+      root      = rnmap WM.! r0 -- renamed root       n         = IM.size g       ns        = [0..n]       m         = n+1@@ -304,9 +313,9 @@   let bucket = IM.fromList         (zip ns (repeat mempty)) -  rna <- newI m+  rna <- newW m   writes rna (fmap swap-        (IM.toList rnmap))+        (WM.toList rnmap))    doms      <- newI m   sdno      <- newI m@@ -361,33 +370,33 @@  ----------------------------------------------------------------------------- -zeroM :: Dom s Node+zeroM :: Dom s CNode zeroM = gets zeroE-domM :: Node -> Dom s Node+domM :: CNode -> Dom s CNode domM = fetch domE-rootM :: Dom s Node+rootM :: Dom s CNode rootM = gets rootE-succsM :: Node -> Dom s [Node]+succsM :: CNode -> Dom s [CNode] succsM i = gets (IS.toList . (! i) . succE)-predsM :: Node -> Dom s [Node]+predsM :: CNode -> Dom s [CNode] predsM i = gets (IS.toList . (! i) . predE)-bucketM :: Node -> Dom s [Node]+bucketM :: CNode -> Dom s [CNode] bucketM i = gets (IS.toList . (! i) . bucketE)-sizeM :: Node -> Dom s Int+sizeM :: CNode -> Dom s Int sizeM = fetch sizeE-sdnoM :: Node -> Dom s Int+sdnoM :: CNode -> Dom s Int sdnoM = fetch sdnoE--- dfnM :: Node -> Dom s Int+-- dfnM :: CNode -> Dom s Int -- dfnM = fetch dfnE-ndfsM :: Int -> Dom s Node+ndfsM :: Int -> Dom s CNode ndfsM = fetch ndfsE-childM :: Node -> Dom s Node+childM :: CNode -> Dom s CNode childM = fetch childE-ancestorM :: Node -> Dom s Node+ancestorM :: CNode -> Dom s CNode ancestorM = fetch ancestorE-parentM :: Node -> Dom s Node+parentM :: CNode -> Dom s CNode parentM = fetch parentE-labelM :: Node -> Dom s Node+labelM :: CNode -> Dom s CNode labelM = fetch labelE nextM :: Dom s Int nextM = do@@ -422,6 +431,9 @@ newI :: Int -> ST s (Arr s Int) newI = new +newW :: Int -> ST s (Arr s Node)+newW = new+ writes :: (MArray (A s) a (ST s))      => Arr s a -> [(Int,a)] -> ST s () writes a xs = forM_ xs (\(i,x) -> (a.=x) i)@@ -431,18 +443,18 @@ (!) g n = maybe mempty id (IM.lookup n g)  fromAdj :: [(Node, [Node])] -> Graph-fromAdj = IM.fromList . fmap (second IS.fromList)+fromAdj = WM.fromList . fmap (second WS.fromList)  fromEdges :: [Edge] -> Graph-fromEdges = collectI IS.union fst (IS.singleton . snd)+fromEdges = collectW WS.union fst (WS.singleton . snd)  toAdj :: Graph -> [(Node, [Node])]-toAdj = fmap (second IS.toList) . IM.toList+toAdj = fmap (second WS.toList) . WM.toList  toEdges :: Graph -> [Edge] toEdges = concatMap (uncurry (fmap . (,))) . toAdj -predG :: Graph -> Graph+predG :: CGraph -> CGraph predG g = IM.unionWith IS.union (go g) g0   where g0 = fmap (const mempty) g         go = flip IM.foldrWithKey mempty (\i a m ->@@ -451,15 +463,24 @@                         m                        (IS.toList a)) +predGW :: Graph -> Graph+predGW g = WM.unionWith WS.union (go g) g0+  where g0 = fmap (const mempty) g+        go = flip WM.foldrWithKey mempty (\i a m ->+                foldl' (\m p -> WM.insertWith mappend p+                                      (WS.singleton i) m)+                        m+                       (WS.toList a))+ pruneReach :: Rooted -> Rooted pruneReach (r,g) = (r,g2)   where is = reachable               (maybe mempty id-                . flip IM.lookup g) $ r-        g2 = IM.fromList-            . fmap (second (IS.filter (`IS.member`is)))-            . filter ((`IS.member`is) . fst)-            . IM.toList $ g+                . flip WM.lookup g) $ r+        g2 = WM.fromList+            . fmap (second (WS.filter (`WS.member`is)))+            . filter ((`WS.member`is) . fst)+            . WM.toList $ g  tip :: Tree a -> (a, [Tree a]) tip (Node a ts) = (a, ts)@@ -476,26 +497,28 @@             in p acc' xs ++ concatMap (go acc') xs         p is = fmap (flip (,) is . rootLabel) -asGraph :: Tree Node -> Rooted-asGraph t@(Node a _) = let g = go t in (a, fromAdj g)+asCGraph :: Tree Node -> Rooted+asCGraph t@(Node a _) = let g = go t in (a, fromAdj g)   where go (Node a ts) = let as = (fst . unzip . fmap tip) ts                           in (a, as) : concatMap go ts  asTree :: Rooted -> Tree Node-asTree (r,g) = let go a = Node a (fmap go ((IS.toList . f) a))+asTree (r,g) = let go a = Node a (fmap go ((WS.toList . f) a))                    f = (g !)             in go r+  where (!) g n = maybe mempty id (WM.lookup n g) + reachable :: (Node -> NodeSet) -> (Node -> NodeSet)-reachable f a = go (IS.singleton a) a+reachable f a = go (WS.singleton a) a   where go seen a = let s = f a-                        as = IS.toList (s `IS.difference` seen)-                    in foldl' go (s `IS.union` seen) as+                        as = WS.toList (s `WS.difference` seen)+                    in foldl' go (s `WS.union` seen) as -collectI :: (c -> c -> c)-        -> (a -> Int) -> (a -> c) -> [a] -> IntMap c-collectI (<>) f g-  = foldl' (\m a -> IM.insertWith (<>)+collectW :: (c -> c -> c)+        -> (a -> Node) -> (a -> c) -> [a] -> Word64Map c+collectW (<>) f g+  = foldl' (\m a -> WM.insertWith (<>)                                   (f a)                                   (g a) m) mempty @@ -504,12 +527,12 @@ -- Gives nodes sequential names starting at n. -- Returns the new graph and a mapping. -- (renamed, old -> new)-renum :: Int -> Graph -> (Graph, NodeMap Node)+renum :: Int -> Graph -> (CGraph, NodeMap CNode) renum from = (\(_,m,g)->(g,m))-  . IM.foldrWithKey+  . WM.foldrWithKey       (\i ss (!n,!env,!new)->           let (j,n2,env2) = go n env i-              (n3,env3,ss2) = IS.fold+              (n3,env3,ss2) = WS.fold                 (\k (!n,!env,!new)->                     case go n env k of                       (l,n2,env2)-> (n2,env2,l `IS.insert` new))@@ -517,13 +540,13 @@               new2 = IM.insertWith IS.union j ss2 new           in (n3,env3,new2)) (from,mempty,mempty)   where go :: Int-           -> NodeMap Node+           -> NodeMap CNode            -> Node-           -> (Node,Int,NodeMap Node)+           -> (CNode,Int,NodeMap CNode)         go !n !env i =-          case IM.lookup i env of+          case WM.lookup i env of             Just j -> (j,n,env)-            Nothing -> (n,n+1,IM.insert i n env)+            Nothing -> (n,n+1,WM.insert i n env)  ----------------------------------------------------------------------------- 

@@ -14,7 +14,7 @@ import Data.ByteString.Builder import Data.Coerce import Data.Foldable-import qualified Data.IntSet as IS+import qualified GHC.Data.Word64Set as WS import Data.Maybe import Data.Semigroup import GHC.Cmm@@ -181,9 +181,9 @@ asmTellSectionHeader k = asmTellTabLine $ ".section " <> k <> ",\"\",@"  asmTellDataSection ::-  WasmTypeTag w -> IS.IntSet -> SymName -> DataSection -> WasmAsmM ()+  WasmTypeTag w -> WS.Word64Set -> SymName -> DataSection -> WasmAsmM () asmTellDataSection ty_word def_syms sym DataSection {..} = do-  when (getKey (getUnique sym) `IS.member` def_syms) $ asmTellDefSym sym+  when (getKey (getUnique sym) `WS.member` def_syms) $ asmTellDefSym sym   asmTellSectionHeader sec_name   asmTellAlign dataSectionAlignment   asmTellTabLine asm_size@@ -420,12 +420,12 @@  asmTellFunc ::   WasmTypeTag w ->-  IS.IntSet ->+  WS.Word64Set ->   SymName ->   (([SomeWasmType], [SomeWasmType]), FuncBody w) ->   WasmAsmM () asmTellFunc ty_word def_syms sym (func_ty, FuncBody {..}) = do-  when (getKey (getUnique sym) `IS.member` def_syms) $ asmTellDefSym sym+  when (getKey (getUnique sym) `WS.member` def_syms) $ asmTellDefSym sym   asmTellSectionHeader $ ".text." <> asm_sym   asmTellLine $ asm_sym <> ":"   asmTellFuncType sym func_ty

@@ -26,7 +26,7 @@ import qualified Data.ByteString as BS import Data.Foldable import Data.Functor-import qualified Data.IntSet as IS+import qualified GHC.Data.Word64Set as WS import Data.Semigroup import Data.String import Data.Traversable@@ -1553,7 +1553,7 @@   SymDefault -> wasmModifyM $ \s ->     s       { defaultSyms =-          IS.insert+          WS.insert             (getKey $ getUnique sym)             $ defaultSyms s       }

@@ -52,7 +52,7 @@ import Data.ByteString (ByteString) import Data.Coerce import Data.Functor-import qualified Data.IntSet as IS+import qualified GHC.Data.Word64Set as WS import Data.Kind import Data.String import Data.Type.Equality@@ -197,7 +197,7 @@ type SymMap = UniqMap SymName  -- | No need to remember the symbols.-type SymSet = IS.IntSet+type SymSet = WS.Word64Set  type GlobalInfo = (SymName, SomeWasmType) @@ -427,7 +427,7 @@   WasmCodeGenState     { wasmPlatform =         platform,-      defaultSyms = IS.empty,+      defaultSyms = WS.empty,       funcTypes = emptyUniqMap,       funcBodies =         emptyUniqMap,

@@ -260,7 +260,7 @@   , envConfig    :: !LlvmCgConfig    -- ^ Configuration for LLVM code gen   , envLogger    :: !Logger          -- ^ Logger   , envOutput    :: BufHandle        -- ^ Output buffer-  , envMask      :: !Char            -- ^ Mask for creating unique values+  , envTag       :: !Char            -- ^ Tag for creating unique values   , envFreshMeta :: MetaId           -- ^ Supply of fresh metadata IDs   , envUniqMeta  :: UniqFM Unique MetaId   -- ^ Global metadata nodes   , envFunMap    :: LlvmEnvMap       -- ^ Global functions so far, with type@@ -292,12 +292,12 @@  instance MonadUnique LlvmM where     getUniqueSupplyM = do-        mask <- getEnv envMask-        liftIO $! mkSplitUniqSupply mask+        tag <- getEnv envTag+        liftIO $! mkSplitUniqSupply tag      getUniqueM = do-        mask <- getEnv envMask-        liftIO $! uniqFromMask mask+        tag <- getEnv envTag+        liftIO $! uniqFromTag tag  -- | Lifting of IO actions. Not exported, as we want to encapsulate IO. liftIO :: IO a -> LlvmM a@@ -318,7 +318,7 @@                       , envConfig    = cfg                       , envLogger    = logger                       , envOutput    = out-                      , envMask      = 'n'+                      , envTag       = 'n'                       , envFreshMeta = MetaId 0                       , envUniqMeta  = emptyUFM                       }

@@ -20,7 +20,7 @@     initRuleEnv, getExternalRuleBase,     getDynFlags, getPackageFamInstEnv,     getInteractiveContext,-    getUniqMask,+    getUniqTag,     getNamePprCtx, getSrcSpanM,      -- ** Writing to the monad@@ -117,7 +117,7 @@         cr_name_ppr_ctx        :: NamePprCtx,         cr_loc                 :: SrcSpan,   -- Use this for log/error messages so they                                              -- are at least tagged with the right source file-        cr_uniq_mask           :: !Char      -- Mask for creating unique values+        cr_uniq_tag            :: !Char      -- Tag for creating unique values }  -- Note: CoreWriter used to be defined with data, rather than newtype.  If it@@ -167,12 +167,12 @@  instance MonadUnique CoreM where     getUniqueSupplyM = do-        mask <- read cr_uniq_mask-        liftIO $! mkSplitUniqSupply mask+        tag <- read cr_uniq_tag+        liftIO $! mkSplitUniqSupply tag      getUniqueM = do-        mask <- read cr_uniq_mask-        liftIO $! uniqFromMask mask+        tag <- read cr_uniq_tag+        liftIO $! uniqFromTag tag  runCoreM :: HscEnv          -> RuleBase@@ -182,7 +182,7 @@          -> SrcSpan          -> CoreM a          -> IO (a, SimplCount)-runCoreM hsc_env rule_base mask mod name_ppr_ctx loc m+runCoreM hsc_env rule_base tag mod name_ppr_ctx loc m   = liftM extract $ runIOEnv reader $ unCoreM m   where     reader = CoreReader {@@ -191,7 +191,7 @@             cr_module = mod,             cr_name_ppr_ctx = name_ppr_ctx,             cr_loc = loc,-            cr_uniq_mask = mask+            cr_uniq_tag = tag         }      extract :: (a, CoreWriter) -> (a, SimplCount)@@ -261,8 +261,8 @@ addSimplCount :: SimplCount -> CoreM () addSimplCount count = write (CoreWriter { cw_simpl_count = count }) -getUniqMask :: CoreM Char-getUniqMask = read cr_uniq_mask+getUniqTag :: CoreM Char+getUniqTag = read cr_uniq_tag  -- Convenience accessors for useful fields of HscEnv 

@@ -77,9 +77,9 @@                                 , mg_loc     = loc                                 , mg_rdr_env = rdr_env })   = do { let builtin_passes = getCoreToDo dflags hpt_rule_base extra_vars-             uniq_mask = 's'+             uniq_tag = 's' -       ; (guts2, stats) <- runCoreM hsc_env hpt_rule_base uniq_mask mod+       ; (guts2, stats) <- runCoreM hsc_env hpt_rule_base uniq_tag mod                                     name_ppr_ctx loc $                            do { hsc_env' <- getHscEnv                               ; all_passes <- withPlugins (hsc_plugins hsc_env')

@@ -180,13 +180,13 @@ ************************************************************************ -} --- See Note [Uniques for wired-in prelude things and known masks] in GHC.Builtin.Uniques-simplMask :: Char-simplMask = 's'+-- See Note [Uniques for wired-in prelude things and known tags] in GHC.Builtin.Uniques+simplTag :: Char+simplTag = 's'  instance MonadUnique SimplM where-    getUniqueSupplyM = liftIO $ mkSplitUniqSupply simplMask-    getUniqueM = liftIO $ uniqFromMask simplMask+    getUniqueSupplyM = liftIO $ mkSplitUniqSupply simplTag+    getUniqueM = liftIO $ uniqFromTag simplTag  instance HasLogger SimplM where     getLogger = gets st_logger

@@ -35,8 +35,9 @@ import GHC.Types.Var import GHC.Utils.Outputable import GHC.Types.Unique+import GHC.Word -import qualified Data.IntSet as S+import qualified GHC.Data.Word64Set as S  -- We need a type for sets of variables (UnVarSet). -- We do not use VarSet, because for that we need to have the actual variable@@ -44,10 +45,10 @@ -- Therefore, use a IntSet directly (which is likely also a bit more efficient).  -- Set of uniques, i.e. for adjacent nodes-newtype UnVarSet = UnVarSet (S.IntSet)+newtype UnVarSet = UnVarSet S.Word64Set     deriving Eq -k :: Var -> Int+k :: Var -> Word64 k v = getKey (getUnique v)  domUFMUnVarSet :: UniqFM key elt -> UnVarSet@@ -92,7 +93,7 @@  instance Outputable UnVarSet where     ppr (UnVarSet s) = braces $-        hcat $ punctuate comma [ ppr (getUnique i) | i <- S.toList s]+        hcat $ punctuate comma [ ppr (mkUniqueGrimily i) | i <- S.toList s]  data UnVarGraph = CBPG  !UnVarSet !UnVarSet -- ^ complete bipartite graph                 | CG    !UnVarSet           -- ^ complete graph

@@ -0,0 +1,62 @@+{-# LANGUAGE CPP #-}+#if !defined(TESTING) && defined(__GLASGOW_HASKELL__)+{-# LANGUAGE Safe #-}+#endif+#ifdef __GLASGOW_HASKELL__+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MonoLocalBinds #-}+#endif++#include "containers.h"++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Word64Map+-- Copyright   :  (c) Daan Leijen 2002+--                (c) Andriy Palamarchuk 2008+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Portability :  portable+--+-- An efficient implementation of maps from integer keys to values+-- (dictionaries).+--+-- This module re-exports the value lazy "Data.Word64Map.Lazy" API, plus+-- several deprecated value strict functions. Please note that these functions+-- have different strictness properties than those in "Data.Word64Map.Strict":+-- they only evaluate the result of the combining function. For example, the+-- default value to 'insertWith'' is only evaluated if the combining function+-- is called and uses it.+--+-- These modules are intended to be imported qualified, to avoid name+-- clashes with Prelude functions, e.g.+--+-- >  import Data.Word64Map (Word64Map)+-- >  import qualified Data.Word64Map as Word64Map+--+-- The implementation is based on /big-endian patricia trees/.  This data+-- structure performs especially well on binary operations like 'union'+-- and 'intersection'.  However, my benchmarks show that it is also+-- (much) faster on insertions and deletions when compared to a generic+-- size-balanced map implementation (see "Data.Map").+--+--    * Chris Okasaki and Andy Gill,  \"/Fast Mergeable Integer Maps/\",+--      Workshop on ML, September 1998, pages 77-86,+--      <http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.37.5452>+--+--    * D.R. Morrison, \"/PATRICIA -- Practical Algorithm To Retrieve Information Coded In Alphanumeric/\",+--      Journal of the ACM, 15(4), October 1968, pages 514-534.+--+-- Operation comments contain the operation time complexity in+-- the Big-O notation <http://en.wikipedia.org/wiki/Big_O_notation>.+-- Many operations have a worst-case complexity of \(O(\min(n,64))\).+-- This means that the operation can become linear in the number of+-- elements with a maximum of \(64\)+-----------------------------------------------------------------------------++module GHC.Data.Word64Map+    ( module GHC.Data.Word64Map.Lazy+    ) where++import GHC.Data.Word64Map.Lazy

@@ -0,0 +1,3607 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE PatternGuards #-}+#ifdef __GLASGOW_HASKELL__+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+#endif+#if !defined(TESTING) && defined(__GLASGOW_HASKELL__)+{-# LANGUAGE Trustworthy #-}+#endif++{-# OPTIONS_HADDOCK not-home #-}+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}++#include "containers.h"++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Word64Map.Internal+-- Copyright   :  (c) Daan Leijen 2002+--                (c) Andriy Palamarchuk 2008+--                (c) wren romano 2016+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Portability :  portable+--+-- = WARNING+--+-- This module is considered __internal__.+--+-- The Package Versioning Policy __does not apply__.+--+-- The contents of this module may change __in any way whatsoever__+-- and __without any warning__ between minor versions of this package.+--+-- Authors importing this module are expected to track development+-- closely.+--+-- = Description+--+-- This defines the data structures and core (hidden) manipulations+-- on representations.+--+-- @since 0.5.9+-----------------------------------------------------------------------------++-- [Note: INLINE bit fiddling]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- It is essential that the bit fiddling functions like mask, zero, branchMask+-- etc are inlined. If they do not, the memory allocation skyrockets. The GHC+-- usually gets it right, but it is disastrous if it does not. Therefore we+-- explicitly mark these functions INLINE.+++-- [Note: Local 'go' functions and capturing]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- Care must be taken when using 'go' function which captures an argument.+-- Sometimes (for example when the argument is passed to a data constructor,+-- as in insert), GHC heap-allocates more than necessary. Therefore C-- code+-- must be checked for increased allocation when creating and modifying such+-- functions.+++-- [Note: Order of constructors]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- The order of constructors of Word64Map matters when considering performance.+-- Currently in GHC 7.0, when type has 3 constructors, they are matched from+-- the first to the last -- the best performance is achieved when the+-- constructors are ordered by frequency.+-- On GHC 7.0, reordering constructors from Nil | Tip | Bin to Bin | Tip | Nil+-- improves the benchmark by circa 10%.+--++module GHC.Data.Word64Map.Internal (+    -- * Map type+      Word64Map(..), Key          -- instance Eq,Show++    -- * Operators+    , (!), (!?), (\\)++    -- * Query+    , null+    , size+    , member+    , notMember+    , lookup+    , findWithDefault+    , lookupLT+    , lookupGT+    , lookupLE+    , lookupGE+    , disjoint++    -- * Construction+    , empty+    , singleton++    -- ** Insertion+    , insert+    , insertWith+    , insertWithKey+    , insertLookupWithKey++    -- ** Delete\/Update+    , delete+    , adjust+    , adjustWithKey+    , update+    , updateWithKey+    , updateLookupWithKey+    , alter+    , alterF++    -- * Combine++    -- ** Union+    , union+    , unionWith+    , unionWithKey+    , unions+    , unionsWith++    -- ** Difference+    , difference+    , differenceWith+    , differenceWithKey++    -- ** Intersection+    , intersection+    , intersectionWith+    , intersectionWithKey++    -- ** Compose+    , compose++    -- ** General combining function+    , SimpleWhenMissing+    , SimpleWhenMatched+    , runWhenMatched+    , runWhenMissing+    , merge+    -- *** @WhenMatched@ tactics+    , zipWithMaybeMatched+    , zipWithMatched+    -- *** @WhenMissing@ tactics+    , mapMaybeMissing+    , dropMissing+    , preserveMissing+    , mapMissing+    , filterMissing++    -- ** Applicative general combining function+    , WhenMissing (..)+    , WhenMatched (..)+    , mergeA+    -- *** @WhenMatched@ tactics+    -- | The tactics described for 'merge' work for+    -- 'mergeA' as well. Furthermore, the following+    -- are available.+    , zipWithMaybeAMatched+    , zipWithAMatched+    -- *** @WhenMissing@ tactics+    -- | The tactics described for 'merge' work for+    -- 'mergeA' as well. Furthermore, the following+    -- are available.+    , traverseMaybeMissing+    , traverseMissing+    , filterAMissing++    -- ** Deprecated general combining function+    , mergeWithKey+    , mergeWithKey'++    -- * Traversal+    -- ** Map+    , map+    , mapWithKey+    , traverseWithKey+    , traverseMaybeWithKey+    , mapAccum+    , mapAccumWithKey+    , mapAccumRWithKey+    , mapKeys+    , mapKeysWith+    , mapKeysMonotonic++    -- * Folds+    , foldr+    , foldl+    , foldrWithKey+    , foldlWithKey+    , foldMapWithKey++    -- ** Strict folds+    , foldr'+    , foldl'+    , foldrWithKey'+    , foldlWithKey'++    -- * Conversion+    , elems+    , keys+    , assocs+    , keysSet+    , fromSet++    -- ** Lists+    , toList+    , fromList+    , fromListWith+    , fromListWithKey++    -- ** Ordered lists+    , toAscList+    , toDescList+    , fromAscList+    , fromAscListWith+    , fromAscListWithKey+    , fromDistinctAscList++    -- * Filter+    , filter+    , filterWithKey+    , restrictKeys+    , withoutKeys+    , partition+    , partitionWithKey++    , takeWhileAntitone+    , dropWhileAntitone+    , spanAntitone++    , mapMaybe+    , mapMaybeWithKey+    , mapEither+    , mapEitherWithKey++    , split+    , splitLookup+    , splitRoot++    -- * Submap+    , isSubmapOf, isSubmapOfBy+    , isProperSubmapOf, isProperSubmapOfBy++    -- * Min\/Max+    , lookupMin+    , lookupMax+    , findMin+    , findMax+    , deleteMin+    , deleteMax+    , deleteFindMin+    , deleteFindMax+    , updateMin+    , updateMax+    , updateMinWithKey+    , updateMaxWithKey+    , minView+    , maxView+    , minViewWithKey+    , maxViewWithKey++    -- * Debugging+    , showTree+    , showTreeWith++    -- * Internal types+    , Mask, Prefix, Nat++    -- * Utility+    , natFromInt+    , intFromNat+    , link+    , linkWithMask+    , bin+    , binCheckLeft+    , binCheckRight+    , zero+    , nomatch+    , match+    , mask+    , maskW+    , shorter+    , branchMask+    , highestBitMask++    -- * Used by "Word64Map.Merge.Lazy" and "Word64Map.Merge.Strict"+    , mapWhenMissing+    , mapWhenMatched+    , lmapWhenMissing+    , contramapFirstWhenMatched+    , contramapSecondWhenMatched+    , mapGentlyWhenMissing+    , mapGentlyWhenMatched+    ) where++import GHC.Prelude.Basic hiding+  (lookup, filter, foldr, foldl, foldl', null, map)++import Data.Functor.Identity (Identity (..))+import Data.Semigroup (Semigroup(stimes,(<>)),stimesIdempotentMonoid)+import Data.Functor.Classes++import Control.DeepSeq (NFData(rnf))+import qualified Data.Foldable as Foldable+import Data.Maybe (fromMaybe)++import GHC.Data.Word64Set.Internal (Key)+import qualified GHC.Data.Word64Set.Internal as Word64Set+import GHC.Utils.Containers.Internal.BitUtil+import GHC.Utils.Containers.Internal.StrictPair++#ifdef __GLASGOW_HASKELL__+import Data.Coerce+import Data.Data (Data(..), Constr, mkConstr, constrIndex, Fixity(Prefix),+                  DataType, mkDataType, gcast1)+import GHC.Exts (build)+import qualified GHC.Exts as GHCExts+import Text.Read+#endif+import qualified Control.Category as Category+import Data.Word+++-- A "Nat" is a 64 bit machine word (an unsigned Int64)+type Nat = Word64++natFromInt :: Key -> Nat+natFromInt = id+{-# INLINE natFromInt #-}++intFromNat :: Nat -> Key+intFromNat = id+{-# INLINE intFromNat #-}++{--------------------------------------------------------------------+  Types+--------------------------------------------------------------------}+++-- | A map of integers to values @a@.++-- See Note: Order of constructors+data Word64Map a = Bin {-# UNPACK #-} !Prefix+                    {-# UNPACK #-} !Mask+                    !(Word64Map a)+                    !(Word64Map a)+-- Fields:+--   prefix: The most significant bits shared by all keys in this Bin.+--   mask: The switching bit to determine if a key should follow the left+--         or right subtree of a 'Bin'.+-- Invariant: Nil is never found as a child of Bin.+-- Invariant: The Mask is a power of 2. It is the largest bit position at which+--            two keys of the map differ.+-- Invariant: Prefix is the common high-order bits that all elements share to+--            the left of the Mask bit.+-- Invariant: In (Bin prefix mask left right), left consists of the elements that+--            don't have the mask bit set; right is all the elements that do.+              | Tip {-# UNPACK #-} !Key a+              | Nil++type Prefix = Word64+type Mask   = Word64+++-- Some stuff from "Data.Word64Set.Internal", for 'restrictKeys' and+-- 'withoutKeys' to use.+type Word64SetPrefix = Word64+type Word64SetBitMap = Word64++bitmapOf :: Word64 -> Word64SetBitMap+bitmapOf x = shiftLL 1 (fromIntegral (x .&. Word64Set.suffixBitMask))+{-# INLINE bitmapOf #-}++{--------------------------------------------------------------------+  Operators+--------------------------------------------------------------------}++-- | \(O(\min(n,W))\). Find the value at a key.+-- Calls 'error' when the element can not be found.+--+-- > fromList [(5,'a'), (3,'b')] ! 1    Error: element not in the map+-- > fromList [(5,'a'), (3,'b')] ! 5 == 'a'++(!) :: Word64Map a -> Key -> a+(!) m k = find k m++-- | \(O(\min(n,W))\). Find the value at a key.+-- Returns 'Nothing' when the element can not be found.+--+-- > fromList [(5,'a'), (3,'b')] !? 1 == Nothing+-- > fromList [(5,'a'), (3,'b')] !? 5 == Just 'a'+--+-- @since 0.5.11++(!?) :: Word64Map a -> Key -> Maybe a+(!?) m k = lookup k m++-- | Same as 'difference'.+(\\) :: Word64Map a -> Word64Map b -> Word64Map a+m1 \\ m2 = difference m1 m2++infixl 9 !?,\\{-This comment teaches CPP correct behaviour -}++{--------------------------------------------------------------------+  Types+--------------------------------------------------------------------}++instance Monoid (Word64Map a) where+    mempty  = empty+    mconcat = unions+    mappend = (<>)++-- | @since 0.5.7+instance Semigroup (Word64Map a) where+    (<>)    = union+    stimes  = stimesIdempotentMonoid++-- | Folds in order of increasing key.+instance Foldable.Foldable Word64Map where+  fold = go+    where go Nil = mempty+          go (Tip _ v) = v+          go (Bin _ m l r)+            | m < 0     = go r `mappend` go l+            | otherwise = go l `mappend` go r+  {-# INLINABLE fold #-}+  foldr = foldr+  {-# INLINE foldr #-}+  foldl = foldl+  {-# INLINE foldl #-}+  foldMap f t = go t+    where go Nil = mempty+          go (Tip _ v) = f v+          go (Bin _ m l r)+            | m < 0     = go r `mappend` go l+            | otherwise = go l `mappend` go r+  {-# INLINE foldMap #-}+  foldl' = foldl'+  {-# INLINE foldl' #-}+  foldr' = foldr'+  {-# INLINE foldr' #-}+  length = size+  {-# INLINE length #-}+  null   = null+  {-# INLINE null #-}+  toList = elems -- NB: Foldable.toList /= Word64Map.toList+  {-# INLINE toList #-}+  elem = go+    where go !_ Nil = False+          go x (Tip _ y) = x == y+          go x (Bin _ _ l r) = go x l || go x r+  {-# INLINABLE elem #-}+  maximum = start+    where start Nil = error "Data.Foldable.maximum (for Data.Word64Map): empty map"+          start (Tip _ y) = y+          start (Bin _ m l r)+            | m < 0     = go (start r) l+            | otherwise = go (start l) r++          go !m Nil = m+          go m (Tip _ y) = max m y+          go m (Bin _ _ l r) = go (go m l) r+  {-# INLINABLE maximum #-}+  minimum = start+    where start Nil = error "Data.Foldable.minimum (for Data.Word64Map): empty map"+          start (Tip _ y) = y+          start (Bin _ m l r)+            | m < 0     = go (start r) l+            | otherwise = go (start l) r++          go !m Nil = m+          go m (Tip _ y) = min m y+          go m (Bin _ _ l r) = go (go m l) r+  {-# INLINABLE minimum #-}+  sum = foldl' (+) 0+  {-# INLINABLE sum #-}+  product = foldl' (*) 1+  {-# INLINABLE product #-}++-- | Traverses in order of increasing key.+instance Traversable Word64Map where+    traverse f = traverseWithKey (\_ -> f)+    {-# INLINE traverse #-}++instance NFData a => NFData (Word64Map a) where+    rnf Nil = ()+    rnf (Tip _ v) = rnf v+    rnf (Bin _ _ l r) = rnf l `seq` rnf r++#if __GLASGOW_HASKELL__++{--------------------------------------------------------------------+  A Data instance+--------------------------------------------------------------------}++-- This instance preserves data abstraction at the cost of inefficiency.+-- We provide limited reflection services for the sake of data abstraction.++instance Data a => Data (Word64Map a) where+  gfoldl f z im = z fromList `f` (toList im)+  toConstr _     = fromListConstr+  gunfold k z c  = case constrIndex c of+    1 -> k (z fromList)+    _ -> error "gunfold"+  dataTypeOf _   = intMapDataType+  dataCast1 f    = gcast1 f++fromListConstr :: Constr+fromListConstr = mkConstr intMapDataType "fromList" [] Prefix++intMapDataType :: DataType+intMapDataType = mkDataType "Data.Word64Map.Internal.Word64Map" [fromListConstr]++#endif++{--------------------------------------------------------------------+  Query+--------------------------------------------------------------------}+-- | \(O(1)\). Is the map empty?+--+-- > Data.Word64Map.null (empty)           == True+-- > Data.Word64Map.null (singleton 1 'a') == False++null :: Word64Map a -> Bool+null Nil = True+null _   = False+{-# INLINE null #-}++-- | \(O(n)\). Number of elements in the map.+--+-- > size empty                                   == 0+-- > size (singleton 1 'a')                       == 1+-- > size (fromList([(1,'a'), (2,'c'), (3,'b')])) == 3+size :: Word64Map a -> Int+size = go 0+  where+    go !acc (Bin _ _ l r) = go (go acc l) r+    go acc (Tip _ _) = 1 + acc+    go acc Nil = acc++-- | \(O(\min(n,W))\). Is the key a member of the map?+--+-- > member 5 (fromList [(5,'a'), (3,'b')]) == True+-- > member 1 (fromList [(5,'a'), (3,'b')]) == False++-- See Note: Local 'go' functions and capturing]+member :: Key -> Word64Map a -> Bool+member !k = go+  where+    go (Bin p m l r) | nomatch k p m = False+                     | zero k m  = go l+                     | otherwise = go r+    go (Tip kx _) = k == kx+    go Nil = False++-- | \(O(\min(n,W))\). Is the key not a member of the map?+--+-- > notMember 5 (fromList [(5,'a'), (3,'b')]) == False+-- > notMember 1 (fromList [(5,'a'), (3,'b')]) == True++notMember :: Key -> Word64Map a -> Bool+notMember k m = not $ member k m++-- | \(O(\min(n,W))\). Lookup the value at a key in the map. See also 'Data.Map.lookup'.++-- See Note: Local 'go' functions and capturing+lookup :: Key -> Word64Map a -> Maybe a+lookup !k = go+  where+    go (Bin _p m l r) | zero k m  = go l+                      | otherwise = go r+    go (Tip kx x) | k == kx   = Just x+                  | otherwise = Nothing+    go Nil = Nothing++-- See Note: Local 'go' functions and capturing]+find :: Key -> Word64Map a -> a+find !k = go+  where+    go (Bin _p m l r) | zero k m  = go l+                      | otherwise = go r+    go (Tip kx x) | k == kx   = x+                  | otherwise = not_found+    go Nil = not_found++    not_found = error ("Word64Map.!: key " ++ show k ++ " is not an element of the map")++-- | \(O(\min(n,W))\). The expression @('findWithDefault' def k map)@+-- returns the value at key @k@ or returns @def@ when the key is not an+-- element of the map.+--+-- > findWithDefault 'x' 1 (fromList [(5,'a'), (3,'b')]) == 'x'+-- > findWithDefault 'x' 5 (fromList [(5,'a'), (3,'b')]) == 'a'++-- See Note: Local 'go' functions and capturing]+findWithDefault :: a -> Key -> Word64Map a -> a+findWithDefault def !k = go+  where+    go (Bin p m l r) | nomatch k p m = def+                     | zero k m  = go l+                     | otherwise = go r+    go (Tip kx x) | k == kx   = x+                  | otherwise = def+    go Nil = def++-- | \(O(\min(n,W))\). Find largest key smaller than the given one and return the+-- corresponding (key, value) pair.+--+-- > lookupLT 3 (fromList [(3,'a'), (5,'b')]) == Nothing+-- > lookupLT 4 (fromList [(3,'a'), (5,'b')]) == Just (3, 'a')++-- See Note: Local 'go' functions and capturing.+lookupLT :: Key -> Word64Map a -> Maybe (Key, a)+lookupLT !k t = case t of+    Bin _ m l r | m < 0 -> if k >= 0 then go r l else go Nil r+    _ -> go Nil t+  where+    go def (Bin p m l r)+      | nomatch k p m = if k < p then unsafeFindMax def else unsafeFindMax r+      | zero k m  = go def l+      | otherwise = go l r+    go def (Tip ky y)+      | k <= ky   = unsafeFindMax def+      | otherwise = Just (ky, y)+    go def Nil = unsafeFindMax def++-- | \(O(\min(n,W))\). Find smallest key greater than the given one and return the+-- corresponding (key, value) pair.+--+-- > lookupGT 4 (fromList [(3,'a'), (5,'b')]) == Just (5, 'b')+-- > lookupGT 5 (fromList [(3,'a'), (5,'b')]) == Nothing++-- See Note: Local 'go' functions and capturing.+lookupGT :: Key -> Word64Map a -> Maybe (Key, a)+lookupGT !k t = case t of+    Bin _ m l r | m < 0 -> if k >= 0 then go Nil l else go l r+    _ -> go Nil t+  where+    go def (Bin p m l r)+      | nomatch k p m = if k < p then unsafeFindMin l else unsafeFindMin def+      | zero k m  = go r l+      | otherwise = go def r+    go def (Tip ky y)+      | k >= ky   = unsafeFindMin def+      | otherwise = Just (ky, y)+    go def Nil = unsafeFindMin def++-- | \(O(\min(n,W))\). Find largest key smaller or equal to the given one and return+-- the corresponding (key, value) pair.+--+-- > lookupLE 2 (fromList [(3,'a'), (5,'b')]) == Nothing+-- > lookupLE 4 (fromList [(3,'a'), (5,'b')]) == Just (3, 'a')+-- > lookupLE 5 (fromList [(3,'a'), (5,'b')]) == Just (5, 'b')++-- See Note: Local 'go' functions and capturing.+lookupLE :: Key -> Word64Map a -> Maybe (Key, a)+lookupLE !k t = case t of+    Bin _ m l r | m < 0 -> if k >= 0 then go r l else go Nil r+    _ -> go Nil t+  where+    go def (Bin p m l r)+      | nomatch k p m = if k < p then unsafeFindMax def else unsafeFindMax r+      | zero k m  = go def l+      | otherwise = go l r+    go def (Tip ky y)+      | k < ky    = unsafeFindMax def+      | otherwise = Just (ky, y)+    go def Nil = unsafeFindMax def++-- | \(O(\min(n,W))\). Find smallest key greater or equal to the given one and return+-- the corresponding (key, value) pair.+--+-- > lookupGE 3 (fromList [(3,'a'), (5,'b')]) == Just (3, 'a')+-- > lookupGE 4 (fromList [(3,'a'), (5,'b')]) == Just (5, 'b')+-- > lookupGE 6 (fromList [(3,'a'), (5,'b')]) == Nothing++-- See Note: Local 'go' functions and capturing.+lookupGE :: Key -> Word64Map a -> Maybe (Key, a)+lookupGE !k t = case t of+    Bin _ m l r | m < 0 -> if k >= 0 then go Nil l else go l r+    _ -> go Nil t+  where+    go def (Bin p m l r)+      | nomatch k p m = if k < p then unsafeFindMin l else unsafeFindMin def+      | zero k m  = go r l+      | otherwise = go def r+    go def (Tip ky y)+      | k > ky    = unsafeFindMin def+      | otherwise = Just (ky, y)+    go def Nil = unsafeFindMin def+++-- Helper function for lookupGE and lookupGT. It assumes that if a Bin node is+-- given, it has m > 0.+unsafeFindMin :: Word64Map a -> Maybe (Key, a)+unsafeFindMin Nil = Nothing+unsafeFindMin (Tip ky y) = Just (ky, y)+unsafeFindMin (Bin _ _ l _) = unsafeFindMin l++-- Helper function for lookupLE and lookupLT. It assumes that if a Bin node is+-- given, it has m > 0.+unsafeFindMax :: Word64Map a -> Maybe (Key, a)+unsafeFindMax Nil = Nothing+unsafeFindMax (Tip ky y) = Just (ky, y)+unsafeFindMax (Bin _ _ _ r) = unsafeFindMax r++{--------------------------------------------------------------------+  Disjoint+--------------------------------------------------------------------}+-- | \(O(n+m)\). Check whether the key sets of two maps are disjoint+-- (i.e. their 'intersection' is empty).+--+-- > disjoint (fromList [(2,'a')]) (fromList [(1,()), (3,())])   == True+-- > disjoint (fromList [(2,'a')]) (fromList [(1,'a'), (2,'b')]) == False+-- > disjoint (fromList [])        (fromList [])                 == True+--+-- > disjoint a b == null (intersection a b)+--+-- @since 0.6.2.1+disjoint :: Word64Map a -> Word64Map b -> Bool+disjoint Nil _ = True+disjoint _ Nil = True+disjoint (Tip kx _) ys = notMember kx ys+disjoint xs (Tip ky _) = notMember ky xs+disjoint t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)+  | shorter m1 m2 = disjoint1+  | shorter m2 m1 = disjoint2+  | p1 == p2      = disjoint l1 l2 && disjoint r1 r2+  | otherwise     = True+  where+    disjoint1 | nomatch p2 p1 m1 = True+              | zero p2 m1       = disjoint l1 t2+              | otherwise        = disjoint r1 t2+    disjoint2 | nomatch p1 p2 m2 = True+              | zero p1 m2       = disjoint t1 l2+              | otherwise        = disjoint t1 r2++{--------------------------------------------------------------------+  Compose+--------------------------------------------------------------------}+-- | Relate the keys of one map to the values of+-- the other, by using the values of the former as keys for lookups+-- in the latter.+--+-- Complexity: \( O(n * \min(m,W)) \), where \(m\) is the size of the first argument+--+-- > compose (fromList [('a', "A"), ('b', "B")]) (fromList [(1,'a'),(2,'b'),(3,'z')]) = fromList [(1,"A"),(2,"B")]+--+-- @+-- ('compose' bc ab '!?') = (bc '!?') <=< (ab '!?')+-- @+--+-- __Note:__ Prior to v0.6.4, "Data.Word64Map.Strict" exposed a version of+-- 'compose' that forced the values of the output 'Word64Map'. This version does+-- not force these values.+--+-- @since 0.6.3.1+compose :: Word64Map c -> Word64Map Word64 -> Word64Map c+compose bc !ab+  | null bc = empty+  | otherwise = mapMaybe (bc !?) ab++{--------------------------------------------------------------------+  Construction+--------------------------------------------------------------------}+-- | \(O(1)\). The empty map.+--+-- > empty      == fromList []+-- > size empty == 0++empty :: Word64Map a+empty+  = Nil+{-# INLINE empty #-}++-- | \(O(1)\). A map of one element.+--+-- > singleton 1 'a'        == fromList [(1, 'a')]+-- > size (singleton 1 'a') == 1++singleton :: Key -> a -> Word64Map a+singleton k x+  = Tip k x+{-# INLINE singleton #-}++{--------------------------------------------------------------------+  Insert+--------------------------------------------------------------------}+-- | \(O(\min(n,W))\). Insert a new key\/value pair in the map.+-- If the key is already present in the map, the associated value is+-- replaced with the supplied value, i.e. 'insert' is equivalent to+-- @'insertWith' 'const'@.+--+-- > insert 5 'x' (fromList [(5,'a'), (3,'b')]) == fromList [(3, 'b'), (5, 'x')]+-- > insert 7 'x' (fromList [(5,'a'), (3,'b')]) == fromList [(3, 'b'), (5, 'a'), (7, 'x')]+-- > insert 5 'x' empty                         == singleton 5 'x'++insert :: Key -> a -> Word64Map a -> Word64Map a+insert !k x t@(Bin p m l r)+  | nomatch k p m = link k (Tip k x) p t+  | zero k m      = Bin p m (insert k x l) r+  | otherwise     = Bin p m l (insert k x r)+insert k x t@(Tip ky _)+  | k==ky         = Tip k x+  | otherwise     = link k (Tip k x) ky t+insert k x Nil = Tip k x++-- right-biased insertion, used by 'union'+-- | \(O(\min(n,W))\). Insert with a combining function.+-- @'insertWith' f key value mp@+-- will insert the pair (key, value) into @mp@ if key does+-- not exist in the map. If the key does exist, the function will+-- insert @f new_value old_value@.+--+-- > insertWith (++) 5 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "xxxa")]+-- > insertWith (++) 7 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "xxx")]+-- > insertWith (++) 5 "xxx" empty                         == singleton 5 "xxx"++insertWith :: (a -> a -> a) -> Key -> a -> Word64Map a -> Word64Map a+insertWith f k x t+  = insertWithKey (\_ x' y' -> f x' y') k x t++-- | \(O(\min(n,W))\). Insert with a combining function.+-- @'insertWithKey' f key value mp@+-- will insert the pair (key, value) into @mp@ if key does+-- not exist in the map. If the key does exist, the function will+-- insert @f key new_value old_value@.+--+-- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value+-- > insertWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:xxx|a")]+-- > insertWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "xxx")]+-- > insertWithKey f 5 "xxx" empty                         == singleton 5 "xxx"++insertWithKey :: (Key -> a -> a -> a) -> Key -> a -> Word64Map a -> Word64Map a+insertWithKey f !k x t@(Bin p m l r)+  | nomatch k p m = link k (Tip k x) p t+  | zero k m      = Bin p m (insertWithKey f k x l) r+  | otherwise     = Bin p m l (insertWithKey f k x r)+insertWithKey f k x t@(Tip ky y)+  | k == ky       = Tip k (f k x y)+  | otherwise     = link k (Tip k x) ky t+insertWithKey _ k x Nil = Tip k x++-- | \(O(\min(n,W))\). The expression (@'insertLookupWithKey' f k x map@)+-- is a pair where the first element is equal to (@'lookup' k map@)+-- and the second element equal to (@'insertWithKey' f k x map@).+--+-- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value+-- > insertLookupWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "5:xxx|a")])+-- > insertLookupWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) == (Nothing,  fromList [(3, "b"), (5, "a"), (7, "xxx")])+-- > insertLookupWithKey f 5 "xxx" empty                         == (Nothing,  singleton 5 "xxx")+--+-- This is how to define @insertLookup@ using @insertLookupWithKey@:+--+-- > let insertLookup kx x t = insertLookupWithKey (\_ a _ -> a) kx x t+-- > insertLookup 5 "x" (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "x")])+-- > insertLookup 7 "x" (fromList [(5,"a"), (3,"b")]) == (Nothing,  fromList [(3, "b"), (5, "a"), (7, "x")])++insertLookupWithKey :: (Key -> a -> a -> a) -> Key -> a -> Word64Map a -> (Maybe a, Word64Map a)+insertLookupWithKey f !k x t@(Bin p m l r)+  | nomatch k p m = (Nothing,link k (Tip k x) p t)+  | zero k m      = let (found,l') = insertLookupWithKey f k x l+                    in (found,Bin p m l' r)+  | otherwise     = let (found,r') = insertLookupWithKey f k x r+                    in (found,Bin p m l r')+insertLookupWithKey f k x t@(Tip ky y)+  | k == ky       = (Just y,Tip k (f k x y))+  | otherwise     = (Nothing,link k (Tip k x) ky t)+insertLookupWithKey _ k x Nil = (Nothing,Tip k x)+++{--------------------------------------------------------------------+  Deletion+--------------------------------------------------------------------}+-- | \(O(\min(n,W))\). Delete a key and its value from the map. When the key is not+-- a member of the map, the original map is returned.+--+-- > delete 5 (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"+-- > delete 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]+-- > delete 5 empty                         == empty++delete :: Key -> Word64Map a -> Word64Map a+delete !k t@(Bin p m l r)+  | nomatch k p m = t+  | zero k m      = binCheckLeft p m (delete k l) r+  | otherwise     = binCheckRight p m l (delete k r)+delete k t@(Tip ky _)+  | k == ky       = Nil+  | otherwise     = t+delete _k Nil = Nil++-- | \(O(\min(n,W))\). Adjust a value at a specific key. When the key is not+-- a member of the map, the original map is returned.+--+-- > adjust ("new " ++) 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "new a")]+-- > adjust ("new " ++) 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]+-- > adjust ("new " ++) 7 empty                         == empty++adjust ::  (a -> a) -> Key -> Word64Map a -> Word64Map a+adjust f k m+  = adjustWithKey (\_ x -> f x) k m++-- | \(O(\min(n,W))\). Adjust a value at a specific key. When the key is not+-- a member of the map, the original map is returned.+--+-- > let f key x = (show key) ++ ":new " ++ x+-- > adjustWithKey f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:new a")]+-- > adjustWithKey f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]+-- > adjustWithKey f 7 empty                         == empty++adjustWithKey ::  (Key -> a -> a) -> Key -> Word64Map a -> Word64Map a+adjustWithKey f !k (Bin p m l r)+  | zero k m      = Bin p m (adjustWithKey f k l) r+  | otherwise     = Bin p m l (adjustWithKey f k r)+adjustWithKey f k t@(Tip ky y)+  | k == ky       = Tip ky (f k y)+  | otherwise     = t+adjustWithKey _ _ Nil = Nil+++-- | \(O(\min(n,W))\). The expression (@'update' f k map@) updates the value @x@+-- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is+-- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@.+--+-- > let f x = if x == "a" then Just "new a" else Nothing+-- > update f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "new a")]+-- > update f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]+-- > update f 3 (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"++update ::  (a -> Maybe a) -> Key -> Word64Map a -> Word64Map a+update f+  = updateWithKey (\_ x -> f x)++-- | \(O(\min(n,W))\). The expression (@'update' f k map@) updates the value @x@+-- at @k@ (if it is in the map). If (@f k x@) is 'Nothing', the element is+-- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@.+--+-- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing+-- > updateWithKey f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:new a")]+-- > updateWithKey f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]+-- > updateWithKey f 3 (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"++updateWithKey ::  (Key -> a -> Maybe a) -> Key -> Word64Map a -> Word64Map a+updateWithKey f !k (Bin p m l r)+  | zero k m      = binCheckLeft p m (updateWithKey f k l) r+  | otherwise     = binCheckRight p m l (updateWithKey f k r)+updateWithKey f k t@(Tip ky y)+  | k == ky       = case (f k y) of+                      Just y' -> Tip ky y'+                      Nothing -> Nil+  | otherwise     = t+updateWithKey _ _ Nil = Nil++-- | \(O(\min(n,W))\). Lookup and update.+-- The function returns original value, if it is updated.+-- This is different behavior than 'Data.Map.updateLookupWithKey'.+-- Returns the original key value if the map entry is deleted.+--+-- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing+-- > updateLookupWithKey f 5 (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "5:new a")])+-- > updateLookupWithKey f 7 (fromList [(5,"a"), (3,"b")]) == (Nothing,  fromList [(3, "b"), (5, "a")])+-- > updateLookupWithKey f 3 (fromList [(5,"a"), (3,"b")]) == (Just "b", singleton 5 "a")++updateLookupWithKey ::  (Key -> a -> Maybe a) -> Key -> Word64Map a -> (Maybe a,Word64Map a)+updateLookupWithKey f !k (Bin p m l r)+  | zero k m      = let !(found,l') = updateLookupWithKey f k l+                    in (found,binCheckLeft p m l' r)+  | otherwise     = let !(found,r') = updateLookupWithKey f k r+                    in (found,binCheckRight p m l r')+updateLookupWithKey f k t@(Tip ky y)+  | k==ky         = case (f k y) of+                      Just y' -> (Just y,Tip ky y')+                      Nothing -> (Just y,Nil)+  | otherwise     = (Nothing,t)+updateLookupWithKey _ _ Nil = (Nothing,Nil)++++-- | \(O(\min(n,W))\). The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof.+-- 'alter' can be used to insert, delete, or update a value in an 'Word64Map'.+-- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@.+alter :: (Maybe a -> Maybe a) -> Key -> Word64Map a -> Word64Map a+alter f !k t@(Bin p m l r)+  | nomatch k p m = case f Nothing of+                      Nothing -> t+                      Just x -> link k (Tip k x) p t+  | zero k m      = binCheckLeft p m (alter f k l) r+  | otherwise     = binCheckRight p m l (alter f k r)+alter f k t@(Tip ky y)+  | k==ky         = case f (Just y) of+                      Just x -> Tip ky x+                      Nothing -> Nil+  | otherwise     = case f Nothing of+                      Just x -> link k (Tip k x) ky t+                      Nothing -> Tip ky y+alter f k Nil     = case f Nothing of+                      Just x -> Tip k x+                      Nothing -> Nil++-- | \(O(\min(n,W))\). The expression (@'alterF' f k map@) alters the value @x@ at+-- @k@, or absence thereof.  'alterF' can be used to inspect, insert, delete,+-- or update a value in an 'Word64Map'.  In short : @'lookup' k <$> 'alterF' f k m = f+-- ('lookup' k m)@.+--+-- Example:+--+-- @+-- interactiveAlter :: Int -> Word64Map String -> IO (Word64Map String)+-- interactiveAlter k m = alterF f k m where+--   f Nothing = do+--      putStrLn $ show k +++--          " was not found in the map. Would you like to add it?"+--      getUserResponse1 :: IO (Maybe String)+--   f (Just old) = do+--      putStrLn $ "The key is currently bound to " ++ show old +++--          ". Would you like to change or delete it?"+--      getUserResponse2 :: IO (Maybe String)+-- @+--+-- 'alterF' is the most general operation for working with an individual+-- key that may or may not be in a given map.+--+-- Note: 'alterF' is a flipped version of the @at@ combinator from+-- @Control.Lens.At@.+--+-- @since 0.5.8++alterF :: Functor f+       => (Maybe a -> f (Maybe a)) -> Key -> Word64Map a -> f (Word64Map a)+-- This implementation was stolen from 'Control.Lens.At'.+alterF f k m = (<$> f mv) $ \fres ->+  case fres of+    Nothing -> maybe m (const (delete k m)) mv+    Just v' -> insert k v' m+  where mv = lookup k m++{--------------------------------------------------------------------+  Union+--------------------------------------------------------------------}+-- | The union of a list of maps.+--+-- > unions [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]+-- >     == fromList [(3, "b"), (5, "a"), (7, "C")]+-- > unions [(fromList [(5, "A3"), (3, "B3")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "a"), (3, "b")])]+-- >     == fromList [(3, "B3"), (5, "A3"), (7, "C")]++unions :: Foldable f => f (Word64Map a) -> Word64Map a+unions xs+  = Foldable.foldl' union empty xs++-- | The union of a list of maps, with a combining operation.+--+-- > unionsWith (++) [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]+-- >     == fromList [(3, "bB3"), (5, "aAA3"), (7, "C")]++unionsWith :: Foldable f => (a->a->a) -> f (Word64Map a) -> Word64Map a+unionsWith f ts+  = Foldable.foldl' (unionWith f) empty ts++-- | \(O(n+m)\). The (left-biased) union of two maps.+-- It prefers the first map when duplicate keys are encountered,+-- i.e. (@'union' == 'unionWith' 'const'@).+--+-- > union (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "a"), (7, "C")]++union :: Word64Map a -> Word64Map a -> Word64Map a+union m1 m2+  = mergeWithKey' Bin const id id m1 m2++-- | \(O(n+m)\). The union with a combining function.+--+-- > unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "aA"), (7, "C")]++unionWith :: (a -> a -> a) -> Word64Map a -> Word64Map a -> Word64Map a+unionWith f m1 m2+  = unionWithKey (\_ x y -> f x y) m1 m2++-- | \(O(n+m)\). The union with a combining function.+--+-- > let f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value+-- > unionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "5:a|A"), (7, "C")]++unionWithKey :: (Key -> a -> a -> a) -> Word64Map a -> Word64Map a -> Word64Map a+unionWithKey f m1 m2+  = mergeWithKey' Bin (\(Tip k1 x1) (Tip _k2 x2) -> Tip k1 (f k1 x1 x2)) id id m1 m2++{--------------------------------------------------------------------+  Difference+--------------------------------------------------------------------}+-- | \(O(n+m)\). Difference between two maps (based on keys).+--+-- > difference (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 3 "b"++difference :: Word64Map a -> Word64Map b -> Word64Map a+difference m1 m2+  = mergeWithKey (\_ _ _ -> Nothing) id (const Nil) m1 m2++-- | \(O(n+m)\). Difference with a combining function.+--+-- > let f al ar = if al == "b" then Just (al ++ ":" ++ ar) else Nothing+-- > differenceWith f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (7, "C")])+-- >     == singleton 3 "b:B"++differenceWith :: (a -> b -> Maybe a) -> Word64Map a -> Word64Map b -> Word64Map a+differenceWith f m1 m2+  = differenceWithKey (\_ x y -> f x y) m1 m2++-- | \(O(n+m)\). Difference with a combining function. When two equal keys are+-- encountered, the combining function is applied to the key and both values.+-- If it returns 'Nothing', the element is discarded (proper set difference).+-- If it returns (@'Just' y@), the element is updated with a new value @y@.+--+-- > let f k al ar = if al == "b" then Just ((show k) ++ ":" ++ al ++ "|" ++ ar) else Nothing+-- > differenceWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (10, "C")])+-- >     == singleton 3 "3:b|B"++differenceWithKey :: (Key -> a -> b -> Maybe a) -> Word64Map a -> Word64Map b -> Word64Map a+differenceWithKey f m1 m2+  = mergeWithKey f id (const Nil) m1 m2+++-- TODO(wrengr): re-verify that asymptotic bound+-- | \(O(n+m)\). Remove all the keys in a given set from a map.+--+-- @+-- m \`withoutKeys\` s = 'filterWithKey' (\\k _ -> k ``Word64Set.notMember`` s) m+-- @+--+-- @since 0.5.8+withoutKeys :: Word64Map a -> Word64Set.Word64Set -> Word64Map a+withoutKeys t1@(Bin p1 m1 l1 r1) t2@(Word64Set.Bin p2 m2 l2 r2)+    | shorter m1 m2  = difference1+    | shorter m2 m1  = difference2+    | p1 == p2       = bin p1 m1 (withoutKeys l1 l2) (withoutKeys r1 r2)+    | otherwise      = t1+    where+    difference1+        | nomatch p2 p1 m1  = t1+        | zero p2 m1        = binCheckLeft p1 m1 (withoutKeys l1 t2) r1+        | otherwise         = binCheckRight p1 m1 l1 (withoutKeys r1 t2)+    difference2+        | nomatch p1 p2 m2  = t1+        | zero p1 m2        = withoutKeys t1 l2+        | otherwise         = withoutKeys t1 r2+withoutKeys t1@(Bin p1 m1 _ _) (Word64Set.Tip p2 bm2) =+    let minbit = bitmapOf p1+        lt_minbit = minbit - 1+        maxbit = bitmapOf (p1 .|. (m1 .|. (m1 - 1)))+        gt_maxbit = (-maxbit) `xor` maxbit+    -- TODO(wrengr): should we manually inline/unroll 'updatePrefix'+    -- and 'withoutBM' here, in order to avoid redundant case analyses?+    in updatePrefix p2 t1 $ withoutBM (bm2 .|. lt_minbit .|. gt_maxbit)+withoutKeys t1@(Bin _ _ _ _) Word64Set.Nil = t1+withoutKeys t1@(Tip k1 _) t2+    | k1 `Word64Set.member` t2 = Nil+    | otherwise = t1+withoutKeys Nil _ = Nil+++updatePrefix+    :: Word64SetPrefix -> Word64Map a -> (Word64Map a -> Word64Map a) -> Word64Map a+updatePrefix !kp t@(Bin p m l r) f+    | m .&. Word64Set.suffixBitMask /= 0 =+        if p .&. Word64Set.prefixBitMask == kp then f t else t+    | nomatch kp p m = t+    | zero kp m      = binCheckLeft p m (updatePrefix kp l f) r+    | otherwise      = binCheckRight p m l (updatePrefix kp r f)+updatePrefix kp t@(Tip kx _) f+    | kx .&. Word64Set.prefixBitMask == kp = f t+    | otherwise = t+updatePrefix _ Nil _ = Nil+++withoutBM :: Word64SetBitMap -> Word64Map a -> Word64Map a+withoutBM 0 t = t+withoutBM bm (Bin p m l r) =+    let leftBits = bitmapOf (p .|. m) - 1+        bmL = bm .&. leftBits+        bmR = bm `xor` bmL -- = (bm .&. complement leftBits)+    in  bin p m (withoutBM bmL l) (withoutBM bmR r)+withoutBM bm t@(Tip k _)+    -- TODO(wrengr): need we manually inline 'Word64Set.Member' here?+    | k `Word64Set.member` Word64Set.Tip (k .&. Word64Set.prefixBitMask) bm = Nil+    | otherwise = t+withoutBM _ Nil = Nil+++{--------------------------------------------------------------------+  Intersection+--------------------------------------------------------------------}+-- | \(O(n+m)\). The (left-biased) intersection of two maps (based on keys).+--+-- > intersection (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "a"++intersection :: Word64Map a -> Word64Map b -> Word64Map a+intersection m1 m2+  = mergeWithKey' bin const (const Nil) (const Nil) m1 m2+++-- TODO(wrengr): re-verify that asymptotic bound+-- | \(O(n+m)\). The restriction of a map to the keys in a set.+--+-- @+-- m \`restrictKeys\` s = 'filterWithKey' (\\k _ -> k ``Word64Set.member`` s) m+-- @+--+-- @since 0.5.8+restrictKeys :: Word64Map a -> Word64Set.Word64Set -> Word64Map a+restrictKeys t1@(Bin p1 m1 l1 r1) t2@(Word64Set.Bin p2 m2 l2 r2)+    | shorter m1 m2  = intersection1+    | shorter m2 m1  = intersection2+    | p1 == p2       = bin p1 m1 (restrictKeys l1 l2) (restrictKeys r1 r2)+    | otherwise      = Nil+    where+    intersection1+        | nomatch p2 p1 m1  = Nil+        | zero p2 m1        = restrictKeys l1 t2+        | otherwise         = restrictKeys r1 t2+    intersection2+        | nomatch p1 p2 m2  = Nil+        | zero p1 m2        = restrictKeys t1 l2+        | otherwise         = restrictKeys t1 r2+restrictKeys t1@(Bin p1 m1 _ _) (Word64Set.Tip p2 bm2) =+    let minbit = bitmapOf p1+        ge_minbit = complement (minbit - 1)+        maxbit = bitmapOf (p1 .|. (m1 .|. (m1 - 1)))+        le_maxbit = maxbit .|. (maxbit - 1)+    -- TODO(wrengr): should we manually inline/unroll 'lookupPrefix'+    -- and 'restrictBM' here, in order to avoid redundant case analyses?+    in restrictBM (bm2 .&. ge_minbit .&. le_maxbit) (lookupPrefix p2 t1)+restrictKeys (Bin _ _ _ _) Word64Set.Nil = Nil+restrictKeys t1@(Tip k1 _) t2+    | k1 `Word64Set.member` t2 = t1+    | otherwise = Nil+restrictKeys Nil _ = Nil+++-- | \(O(\min(n,W))\). Restrict to the sub-map with all keys matching+-- a key prefix.+lookupPrefix :: Word64SetPrefix -> Word64Map a -> Word64Map a+lookupPrefix !kp t@(Bin p m l r)+    | m .&. Word64Set.suffixBitMask /= 0 =+        if p .&. Word64Set.prefixBitMask == kp then t else Nil+    | nomatch kp p m = Nil+    | zero kp m      = lookupPrefix kp l+    | otherwise      = lookupPrefix kp r+lookupPrefix kp t@(Tip kx _)+    | (kx .&. Word64Set.prefixBitMask) == kp = t+    | otherwise = Nil+lookupPrefix _ Nil = Nil+++restrictBM :: Word64SetBitMap -> Word64Map a -> Word64Map a+restrictBM 0 _ = Nil+restrictBM bm (Bin p m l r) =+    let leftBits = bitmapOf (p .|. m) - 1+        bmL = bm .&. leftBits+        bmR = bm `xor` bmL -- = (bm .&. complement leftBits)+    in  bin p m (restrictBM bmL l) (restrictBM bmR r)+restrictBM bm t@(Tip k _)+    -- TODO(wrengr): need we manually inline 'Word64Set.Member' here?+    | k `Word64Set.member` Word64Set.Tip (k .&. Word64Set.prefixBitMask) bm = t+    | otherwise = Nil+restrictBM _ Nil = Nil+++-- | \(O(n+m)\). The intersection with a combining function.+--+-- > intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "aA"++intersectionWith :: (a -> b -> c) -> Word64Map a -> Word64Map b -> Word64Map c+intersectionWith f m1 m2+  = intersectionWithKey (\_ x y -> f x y) m1 m2++-- | \(O(n+m)\). The intersection with a combining function.+--+-- > let f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar+-- > intersectionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "5:a|A"++intersectionWithKey :: (Key -> a -> b -> c) -> Word64Map a -> Word64Map b -> Word64Map c+intersectionWithKey f m1 m2+  = mergeWithKey' bin (\(Tip k1 x1) (Tip _k2 x2) -> Tip k1 (f k1 x1 x2)) (const Nil) (const Nil) m1 m2++{--------------------------------------------------------------------+  MergeWithKey+--------------------------------------------------------------------}++-- | \(O(n+m)\). A high-performance universal combining function. Using+-- 'mergeWithKey', all combining functions can be defined without any loss of+-- efficiency (with exception of 'union', 'difference' and 'intersection',+-- where sharing of some nodes is lost with 'mergeWithKey').+--+-- Please make sure you know what is going on when using 'mergeWithKey',+-- otherwise you can be surprised by unexpected code growth or even+-- corruption of the data structure.+--+-- When 'mergeWithKey' is given three arguments, it is inlined to the call+-- site. You should therefore use 'mergeWithKey' only to define your custom+-- combining functions. For example, you could define 'unionWithKey',+-- 'differenceWithKey' and 'intersectionWithKey' as+--+-- > myUnionWithKey f m1 m2 = mergeWithKey (\k x1 x2 -> Just (f k x1 x2)) id id m1 m2+-- > myDifferenceWithKey f m1 m2 = mergeWithKey f id (const empty) m1 m2+-- > myIntersectionWithKey f m1 m2 = mergeWithKey (\k x1 x2 -> Just (f k x1 x2)) (const empty) (const empty) m1 m2+--+-- When calling @'mergeWithKey' combine only1 only2@, a function combining two+-- 'Word64Map's is created, such that+--+-- * if a key is present in both maps, it is passed with both corresponding+--   values to the @combine@ function. Depending on the result, the key is either+--   present in the result with specified value, or is left out;+--+-- * a nonempty subtree present only in the first map is passed to @only1@ and+--   the output is added to the result;+--+-- * a nonempty subtree present only in the second map is passed to @only2@ and+--   the output is added to the result.+--+-- The @only1@ and @only2@ methods /must return a map with a subset (possibly empty) of the keys of the given map/.+-- The values can be modified arbitrarily. Most common variants of @only1@ and+-- @only2@ are 'id' and @'const' 'empty'@, but for example @'map' f@ or+-- @'filterWithKey' f@ could be used for any @f@.++mergeWithKey :: (Key -> a -> b -> Maybe c) -> (Word64Map a -> Word64Map c) -> (Word64Map b -> Word64Map c)+             -> Word64Map a -> Word64Map b -> Word64Map c+mergeWithKey f g1 g2 = mergeWithKey' bin combine g1 g2+  where -- We use the lambda form to avoid non-exhaustive pattern matches warning.+        combine = \(Tip k1 x1) (Tip _k2 x2) ->+          case f k1 x1 x2 of+            Nothing -> Nil+            Just x -> Tip k1 x+        {-# INLINE combine #-}+{-# INLINE mergeWithKey #-}++-- Slightly more general version of mergeWithKey. It differs in the following:+--+-- * the combining function operates on maps instead of keys and values. The+--   reason is to enable sharing in union, difference and intersection.+--+-- * mergeWithKey' is given an equivalent of bin. The reason is that in union*,+--   Bin constructor can be used, because we know both subtrees are nonempty.++mergeWithKey' :: (Prefix -> Mask -> Word64Map c -> Word64Map c -> Word64Map c)+              -> (Word64Map a -> Word64Map b -> Word64Map c) -> (Word64Map a -> Word64Map c) -> (Word64Map b -> Word64Map c)+              -> Word64Map a -> Word64Map b -> Word64Map c+mergeWithKey' bin' f g1 g2 = go+  where+    go t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)+      | shorter m1 m2  = merge1+      | shorter m2 m1  = merge2+      | p1 == p2       = bin' p1 m1 (go l1 l2) (go r1 r2)+      | otherwise      = maybe_link p1 (g1 t1) p2 (g2 t2)+      where+        merge1 | nomatch p2 p1 m1  = maybe_link p1 (g1 t1) p2 (g2 t2)+               | zero p2 m1        = bin' p1 m1 (go l1 t2) (g1 r1)+               | otherwise         = bin' p1 m1 (g1 l1) (go r1 t2)+        merge2 | nomatch p1 p2 m2  = maybe_link p1 (g1 t1) p2 (g2 t2)+               | zero p1 m2        = bin' p2 m2 (go t1 l2) (g2 r2)+               | otherwise         = bin' p2 m2 (g2 l2) (go t1 r2)++    go t1'@(Bin _ _ _ _) t2'@(Tip k2' _) = merge0 t2' k2' t1'+      where+        merge0 t2 k2 t1@(Bin p1 m1 l1 r1)+          | nomatch k2 p1 m1 = maybe_link p1 (g1 t1) k2 (g2 t2)+          | zero k2 m1 = bin' p1 m1 (merge0 t2 k2 l1) (g1 r1)+          | otherwise  = bin' p1 m1 (g1 l1) (merge0 t2 k2 r1)+        merge0 t2 k2 t1@(Tip k1 _)+          | k1 == k2 = f t1 t2+          | otherwise = maybe_link k1 (g1 t1) k2 (g2 t2)+        merge0 t2 _  Nil = g2 t2++    go t1@(Bin _ _ _ _) Nil = g1 t1++    go t1'@(Tip k1' _) t2' = merge0 t1' k1' t2'+      where+        merge0 t1 k1 t2@(Bin p2 m2 l2 r2)+          | nomatch k1 p2 m2 = maybe_link k1 (g1 t1) p2 (g2 t2)+          | zero k1 m2 = bin' p2 m2 (merge0 t1 k1 l2) (g2 r2)+          | otherwise  = bin' p2 m2 (g2 l2) (merge0 t1 k1 r2)+        merge0 t1 k1 t2@(Tip k2 _)+          | k1 == k2 = f t1 t2+          | otherwise = maybe_link k1 (g1 t1) k2 (g2 t2)+        merge0 t1 _  Nil = g1 t1++    go Nil t2 = g2 t2++    maybe_link _ Nil _ t2 = t2+    maybe_link _ t1 _ Nil = t1+    maybe_link p1 t1 p2 t2 = link p1 t1 p2 t2+    {-# INLINE maybe_link #-}+{-# INLINE mergeWithKey' #-}+++{--------------------------------------------------------------------+  mergeA+--------------------------------------------------------------------}++-- | A tactic for dealing with keys present in one map but not the+-- other in 'merge' or 'mergeA'.+--+-- A tactic of type @WhenMissing f k x z@ is an abstract representation+-- of a function of type @Key -> x -> f (Maybe z)@.+--+-- @since 0.5.9++data WhenMissing f x y = WhenMissing+  { missingSubtree :: Word64Map x -> f (Word64Map y)+  , missingKey :: Key -> x -> f (Maybe y)}++-- | @since 0.5.9+instance (Applicative f, Monad f) => Functor (WhenMissing f x) where+  fmap = mapWhenMissing+  {-# INLINE fmap #-}+++-- | @since 0.5.9+instance (Applicative f, Monad f) => Category.Category (WhenMissing f)+  where+    id = preserveMissing+    f . g =+      traverseMaybeMissing $ \ k x -> do+        y <- missingKey g k x+        case y of+          Nothing -> pure Nothing+          Just q  -> missingKey f k q+    {-# INLINE id #-}+    {-# INLINE (.) #-}+++-- | Equivalent to @ReaderT k (ReaderT x (MaybeT f))@.+--+-- @since 0.5.9+instance (Applicative f, Monad f) => Applicative (WhenMissing f x) where+  pure x = mapMissing (\ _ _ -> x)+  f <*> g =+    traverseMaybeMissing $ \k x -> do+      res1 <- missingKey f k x+      case res1 of+        Nothing -> pure Nothing+        Just r  -> (pure $!) . fmap r =<< missingKey g k x+  {-# INLINE pure #-}+  {-# INLINE (<*>) #-}+++-- | Equivalent to @ReaderT k (ReaderT x (MaybeT f))@.+--+-- @since 0.5.9+instance (Applicative f, Monad f) => Monad (WhenMissing f x) where+  m >>= f =+    traverseMaybeMissing $ \k x -> do+      res1 <- missingKey m k x+      case res1 of+        Nothing -> pure Nothing+        Just r  -> missingKey (f r) k x+  {-# INLINE (>>=) #-}+++-- | Map covariantly over a @'WhenMissing' f x@.+--+-- @since 0.5.9+mapWhenMissing+  :: (Applicative f, Monad f)+  => (a -> b)+  -> WhenMissing f x a+  -> WhenMissing f x b+mapWhenMissing f t = WhenMissing+  { missingSubtree = \m -> missingSubtree t m >>= \m' -> pure $! fmap f m'+  , missingKey     = \k x -> missingKey t k x >>= \q -> (pure $! fmap f q) }+{-# INLINE mapWhenMissing #-}+++-- | Map covariantly over a @'WhenMissing' f x@, using only a+-- 'Functor f' constraint.+mapGentlyWhenMissing+  :: Functor f+  => (a -> b)+  -> WhenMissing f x a+  -> WhenMissing f x b+mapGentlyWhenMissing f t = WhenMissing+  { missingSubtree = \m -> fmap f <$> missingSubtree t m+  , missingKey     = \k x -> fmap f <$> missingKey t k x }+{-# INLINE mapGentlyWhenMissing #-}+++-- | Map covariantly over a @'WhenMatched' f k x@, using only a+-- 'Functor f' constraint.+mapGentlyWhenMatched+  :: Functor f+  => (a -> b)+  -> WhenMatched f x y a+  -> WhenMatched f x y b+mapGentlyWhenMatched f t =+  zipWithMaybeAMatched $ \k x y -> fmap f <$> runWhenMatched t k x y+{-# INLINE mapGentlyWhenMatched #-}+++-- | Map contravariantly over a @'WhenMissing' f _ x@.+--+-- @since 0.5.9+lmapWhenMissing :: (b -> a) -> WhenMissing f a x -> WhenMissing f b x+lmapWhenMissing f t = WhenMissing+  { missingSubtree = \m -> missingSubtree t (fmap f m)+  , missingKey     = \k x -> missingKey t k (f x) }+{-# INLINE lmapWhenMissing #-}+++-- | Map contravariantly over a @'WhenMatched' f _ y z@.+--+-- @since 0.5.9+contramapFirstWhenMatched+  :: (b -> a)+  -> WhenMatched f a y z+  -> WhenMatched f b y z+contramapFirstWhenMatched f t =+  WhenMatched $ \k x y -> runWhenMatched t k (f x) y+{-# INLINE contramapFirstWhenMatched #-}+++-- | Map contravariantly over a @'WhenMatched' f x _ z@.+--+-- @since 0.5.9+contramapSecondWhenMatched+  :: (b -> a)+  -> WhenMatched f x a z+  -> WhenMatched f x b z+contramapSecondWhenMatched f t =+  WhenMatched $ \k x y -> runWhenMatched t k x (f y)+{-# INLINE contramapSecondWhenMatched #-}+++-- | A tactic for dealing with keys present in one map but not the+-- other in 'merge'.+--+-- A tactic of type @SimpleWhenMissing x z@ is an abstract+-- representation of a function of type @Key -> x -> Maybe z@.+--+-- @since 0.5.9+type SimpleWhenMissing = WhenMissing Identity+++-- | A tactic for dealing with keys present in both maps in 'merge'+-- or 'mergeA'.+--+-- A tactic of type @WhenMatched f x y z@ is an abstract representation+-- of a function of type @Key -> x -> y -> f (Maybe z)@.+--+-- @since 0.5.9+newtype WhenMatched f x y z = WhenMatched+  { matchedKey :: Key -> x -> y -> f (Maybe z) }+++-- | Along with zipWithMaybeAMatched, witnesses the isomorphism+-- between @WhenMatched f x y z@ and @Key -> x -> y -> f (Maybe z)@.+--+-- @since 0.5.9+runWhenMatched :: WhenMatched f x y z -> Key -> x -> y -> f (Maybe z)+runWhenMatched = matchedKey+{-# INLINE runWhenMatched #-}+++-- | Along with traverseMaybeMissing, witnesses the isomorphism+-- between @WhenMissing f x y@ and @Key -> x -> f (Maybe y)@.+--+-- @since 0.5.9+runWhenMissing :: WhenMissing f x y -> Key-> x -> f (Maybe y)+runWhenMissing = missingKey+{-# INLINE runWhenMissing #-}+++-- | @since 0.5.9+instance Functor f => Functor (WhenMatched f x y) where+  fmap = mapWhenMatched+  {-# INLINE fmap #-}+++-- | @since 0.5.9+instance (Monad f, Applicative f) => Category.Category (WhenMatched f x)+  where+    id = zipWithMatched (\_ _ y -> y)+    f . g =+      zipWithMaybeAMatched $ \k x y -> do+        res <- runWhenMatched g k x y+        case res of+          Nothing -> pure Nothing+          Just r  -> runWhenMatched f k x r+    {-# INLINE id #-}+    {-# INLINE (.) #-}+++-- | Equivalent to @ReaderT Key (ReaderT x (ReaderT y (MaybeT f)))@+--+-- @since 0.5.9+instance (Monad f, Applicative f) => Applicative (WhenMatched f x y) where+  pure x = zipWithMatched (\_ _ _ -> x)+  fs <*> xs =+    zipWithMaybeAMatched $ \k x y -> do+      res <- runWhenMatched fs k x y+      case res of+        Nothing -> pure Nothing+        Just r  -> (pure $!) . fmap r =<< runWhenMatched xs k x y+  {-# INLINE pure #-}+  {-# INLINE (<*>) #-}+++-- | Equivalent to @ReaderT Key (ReaderT x (ReaderT y (MaybeT f)))@+--+-- @since 0.5.9+instance (Monad f, Applicative f) => Monad (WhenMatched f x y) where+  m >>= f =+    zipWithMaybeAMatched $ \k x y -> do+      res <- runWhenMatched m k x y+      case res of+        Nothing -> pure Nothing+        Just r  -> runWhenMatched (f r) k x y+  {-# INLINE (>>=) #-}+++-- | Map covariantly over a @'WhenMatched' f x y@.+--+-- @since 0.5.9+mapWhenMatched+  :: Functor f+  => (a -> b)+  -> WhenMatched f x y a+  -> WhenMatched f x y b+mapWhenMatched f (WhenMatched g) =+  WhenMatched $ \k x y -> fmap (fmap f) (g k x y)+{-# INLINE mapWhenMatched #-}+++-- | A tactic for dealing with keys present in both maps in 'merge'.+--+-- A tactic of type @SimpleWhenMatched x y z@ is an abstract+-- representation of a function of type @Key -> x -> y -> Maybe z@.+--+-- @since 0.5.9+type SimpleWhenMatched = WhenMatched Identity+++-- | When a key is found in both maps, apply a function to the key+-- and values and use the result in the merged map.+--+-- > zipWithMatched+-- >   :: (Key -> x -> y -> z)+-- >   -> SimpleWhenMatched x y z+--+-- @since 0.5.9+zipWithMatched+  :: Applicative f+  => (Key -> x -> y -> z)+  -> WhenMatched f x y z+zipWithMatched f = WhenMatched $ \ k x y -> pure . Just $ f k x y+{-# INLINE zipWithMatched #-}+++-- | When a key is found in both maps, apply a function to the key+-- and values to produce an action and use its result in the merged+-- map.+--+-- @since 0.5.9+zipWithAMatched+  :: Applicative f+  => (Key -> x -> y -> f z)+  -> WhenMatched f x y z+zipWithAMatched f = WhenMatched $ \ k x y -> Just <$> f k x y+{-# INLINE zipWithAMatched #-}+++-- | When a key is found in both maps, apply a function to the key+-- and values and maybe use the result in the merged map.+--+-- > zipWithMaybeMatched+-- >   :: (Key -> x -> y -> Maybe z)+-- >   -> SimpleWhenMatched x y z+--+-- @since 0.5.9+zipWithMaybeMatched+  :: Applicative f+  => (Key -> x -> y -> Maybe z)+  -> WhenMatched f x y z+zipWithMaybeMatched f = WhenMatched $ \ k x y -> pure $ f k x y+{-# INLINE zipWithMaybeMatched #-}+++-- | When a key is found in both maps, apply a function to the key+-- and values, perform the resulting action, and maybe use the+-- result in the merged map.+--+-- This is the fundamental 'WhenMatched' tactic.+--+-- @since 0.5.9+zipWithMaybeAMatched+  :: (Key -> x -> y -> f (Maybe z))+  -> WhenMatched f x y z+zipWithMaybeAMatched f = WhenMatched $ \ k x y -> f k x y+{-# INLINE zipWithMaybeAMatched #-}+++-- | Drop all the entries whose keys are missing from the other+-- map.+--+-- > dropMissing :: SimpleWhenMissing x y+--+-- prop> dropMissing = mapMaybeMissing (\_ _ -> Nothing)+--+-- but @dropMissing@ is much faster.+--+-- @since 0.5.9+dropMissing :: Applicative f => WhenMissing f x y+dropMissing = WhenMissing+  { missingSubtree = const (pure Nil)+  , missingKey     = \_ _ -> pure Nothing }+{-# INLINE dropMissing #-}+++-- | Preserve, unchanged, the entries whose keys are missing from+-- the other map.+--+-- > preserveMissing :: SimpleWhenMissing x x+--+-- prop> preserveMissing = Merge.Lazy.mapMaybeMissing (\_ x -> Just x)+--+-- but @preserveMissing@ is much faster.+--+-- @since 0.5.9+preserveMissing :: Applicative f => WhenMissing f x x+preserveMissing = WhenMissing+  { missingSubtree = pure+  , missingKey     = \_ v -> pure (Just v) }+{-# INLINE preserveMissing #-}+++-- | Map over the entries whose keys are missing from the other map.+--+-- > mapMissing :: (k -> x -> y) -> SimpleWhenMissing x y+--+-- prop> mapMissing f = mapMaybeMissing (\k x -> Just $ f k x)+--+-- but @mapMissing@ is somewhat faster.+--+-- @since 0.5.9+mapMissing :: Applicative f => (Key -> x -> y) -> WhenMissing f x y+mapMissing f = WhenMissing+  { missingSubtree = \m -> pure $! mapWithKey f m+  , missingKey     = \k x -> pure $ Just (f k x) }+{-# INLINE mapMissing #-}+++-- | Map over the entries whose keys are missing from the other+-- map, optionally removing some. This is the most powerful+-- 'SimpleWhenMissing' tactic, but others are usually more efficient.+--+-- > mapMaybeMissing :: (Key -> x -> Maybe y) -> SimpleWhenMissing x y+--+-- prop> mapMaybeMissing f = traverseMaybeMissing (\k x -> pure (f k x))+--+-- but @mapMaybeMissing@ uses fewer unnecessary 'Applicative'+-- operations.+--+-- @since 0.5.9+mapMaybeMissing+  :: Applicative f => (Key -> x -> Maybe y) -> WhenMissing f x y+mapMaybeMissing f = WhenMissing+  { missingSubtree = \m -> pure $! mapMaybeWithKey f m+  , missingKey     = \k x -> pure $! f k x }+{-# INLINE mapMaybeMissing #-}+++-- | Filter the entries whose keys are missing from the other map.+--+-- > filterMissing :: (k -> x -> Bool) -> SimpleWhenMissing x x+--+-- prop> filterMissing f = Merge.Lazy.mapMaybeMissing $ \k x -> guard (f k x) *> Just x+--+-- but this should be a little faster.+--+-- @since 0.5.9+filterMissing+  :: Applicative f => (Key -> x -> Bool) -> WhenMissing f x x+filterMissing f = WhenMissing+  { missingSubtree = \m -> pure $! filterWithKey f m+  , missingKey     = \k x -> pure $! if f k x then Just x else Nothing }+{-# INLINE filterMissing #-}+++-- | Filter the entries whose keys are missing from the other map+-- using some 'Applicative' action.+--+-- > filterAMissing f = Merge.Lazy.traverseMaybeMissing $+-- >   \k x -> (\b -> guard b *> Just x) <$> f k x+--+-- but this should be a little faster.+--+-- @since 0.5.9+filterAMissing+  :: Applicative f => (Key -> x -> f Bool) -> WhenMissing f x x+filterAMissing f = WhenMissing+  { missingSubtree = \m -> filterWithKeyA f m+  , missingKey     = \k x -> bool Nothing (Just x) <$> f k x }+{-# INLINE filterAMissing #-}+++-- | \(O(n)\). Filter keys and values using an 'Applicative' predicate.+filterWithKeyA+  :: Applicative f => (Key -> a -> f Bool) -> Word64Map a -> f (Word64Map a)+filterWithKeyA _ Nil           = pure Nil+filterWithKeyA f t@(Tip k x)   = (\b -> if b then t else Nil) <$> f k x+filterWithKeyA f (Bin p m l r)+  | m < 0     = liftA2 (flip (bin p m)) (filterWithKeyA f r) (filterWithKeyA f l)+  | otherwise = liftA2 (bin p m) (filterWithKeyA f l) (filterWithKeyA f r)++-- | This wasn't in Data.Bool until 4.7.0, so we define it here+bool :: a -> a -> Bool -> a+bool f _ False = f+bool _ t True  = t+++-- | Traverse over the entries whose keys are missing from the other+-- map.+--+-- @since 0.5.9+traverseMissing+  :: Applicative f => (Key -> x -> f y) -> WhenMissing f x y+traverseMissing f = WhenMissing+  { missingSubtree = traverseWithKey f+  , missingKey = \k x -> Just <$> f k x }+{-# INLINE traverseMissing #-}+++-- | Traverse over the entries whose keys are missing from the other+-- map, optionally producing values to put in the result. This is+-- the most powerful 'WhenMissing' tactic, but others are usually+-- more efficient.+--+-- @since 0.5.9+traverseMaybeMissing+  :: Applicative f => (Key -> x -> f (Maybe y)) -> WhenMissing f x y+traverseMaybeMissing f = WhenMissing+  { missingSubtree = traverseMaybeWithKey f+  , missingKey = f }+{-# INLINE traverseMaybeMissing #-}+++-- | \(O(n)\). Traverse keys\/values and collect the 'Just' results.+--+-- @since 0.6.4+traverseMaybeWithKey+  :: Applicative f => (Key -> a -> f (Maybe b)) -> Word64Map a -> f (Word64Map b)+traverseMaybeWithKey f = go+    where+    go Nil           = pure Nil+    go (Tip k x)     = maybe Nil (Tip k) <$> f k x+    go (Bin p m l r)+      | m < 0     = liftA2 (flip (bin p m)) (go r) (go l)+      | otherwise = liftA2 (bin p m) (go l) (go r)+++-- | Merge two maps.+--+-- 'merge' takes two 'WhenMissing' tactics, a 'WhenMatched' tactic+-- and two maps. It uses the tactics to merge the maps. Its behavior+-- is best understood via its fundamental tactics, 'mapMaybeMissing'+-- and 'zipWithMaybeMatched'.+--+-- Consider+--+-- @+-- merge (mapMaybeMissing g1)+--              (mapMaybeMissing g2)+--              (zipWithMaybeMatched f)+--              m1 m2+-- @+--+-- Take, for example,+--+-- @+-- m1 = [(0, \'a\'), (1, \'b\'), (3, \'c\'), (4, \'d\')]+-- m2 = [(1, "one"), (2, "two"), (4, "three")]+-- @+--+-- 'merge' will first \"align\" these maps by key:+--+-- @+-- m1 = [(0, \'a\'), (1, \'b\'),               (3, \'c\'), (4, \'d\')]+-- m2 =           [(1, "one"), (2, "two"),           (4, "three")]+-- @+--+-- It will then pass the individual entries and pairs of entries+-- to @g1@, @g2@, or @f@ as appropriate:+--+-- @+-- maybes = [g1 0 \'a\', f 1 \'b\' "one", g2 2 "two", g1 3 \'c\', f 4 \'d\' "three"]+-- @+--+-- This produces a 'Maybe' for each key:+--+-- @+-- keys =     0        1          2           3        4+-- results = [Nothing, Just True, Just False, Nothing, Just True]+-- @+--+-- Finally, the @Just@ results are collected into a map:+--+-- @+-- return value = [(1, True), (2, False), (4, True)]+-- @+--+-- The other tactics below are optimizations or simplifications of+-- 'mapMaybeMissing' for special cases. Most importantly,+--+-- * 'dropMissing' drops all the keys.+-- * 'preserveMissing' leaves all the entries alone.+--+-- When 'merge' is given three arguments, it is inlined at the call+-- site. To prevent excessive inlining, you should typically use+-- 'merge' to define your custom combining functions.+--+--+-- Examples:+--+-- prop> unionWithKey f = merge preserveMissing preserveMissing (zipWithMatched f)+-- prop> intersectionWithKey f = merge dropMissing dropMissing (zipWithMatched f)+-- prop> differenceWith f = merge diffPreserve diffDrop f+-- prop> symmetricDifference = merge diffPreserve diffPreserve (\ _ _ _ -> Nothing)+-- prop> mapEachPiece f g h = merge (diffMapWithKey f) (diffMapWithKey g)+--+-- @since 0.5.9+merge+  :: SimpleWhenMissing a c -- ^ What to do with keys in @m1@ but not @m2@+  -> SimpleWhenMissing b c -- ^ What to do with keys in @m2@ but not @m1@+  -> SimpleWhenMatched a b c -- ^ What to do with keys in both @m1@ and @m2@+  -> Word64Map a -- ^ Map @m1@+  -> Word64Map b -- ^ Map @m2@+  -> Word64Map c+merge g1 g2 f m1 m2 =+  runIdentity $ mergeA g1 g2 f m1 m2+{-# INLINE merge #-}+++-- | An applicative version of 'merge'.+--+-- 'mergeA' takes two 'WhenMissing' tactics, a 'WhenMatched'+-- tactic and two maps. It uses the tactics to merge the maps.+-- Its behavior is best understood via its fundamental tactics,+-- 'traverseMaybeMissing' and 'zipWithMaybeAMatched'.+--+-- Consider+--+-- @+-- mergeA (traverseMaybeMissing g1)+--               (traverseMaybeMissing g2)+--               (zipWithMaybeAMatched f)+--               m1 m2+-- @+--+-- Take, for example,+--+-- @+-- m1 = [(0, \'a\'), (1, \'b\'), (3,\'c\'), (4, \'d\')]+-- m2 = [(1, "one"), (2, "two"), (4, "three")]+-- @+--+-- 'mergeA' will first \"align\" these maps by key:+--+-- @+-- m1 = [(0, \'a\'), (1, \'b\'),               (3, \'c\'), (4, \'d\')]+-- m2 =           [(1, "one"), (2, "two"),           (4, "three")]+-- @+--+-- It will then pass the individual entries and pairs of entries+-- to @g1@, @g2@, or @f@ as appropriate:+--+-- @+-- actions = [g1 0 \'a\', f 1 \'b\' "one", g2 2 "two", g1 3 \'c\', f 4 \'d\' "three"]+-- @+--+-- Next, it will perform the actions in the @actions@ list in order from+-- left to right.+--+-- @+-- keys =     0        1          2           3        4+-- results = [Nothing, Just True, Just False, Nothing, Just True]+-- @+--+-- Finally, the @Just@ results are collected into a map:+--+-- @+-- return value = [(1, True), (2, False), (4, True)]+-- @+--+-- The other tactics below are optimizations or simplifications of+-- 'traverseMaybeMissing' for special cases. Most importantly,+--+-- * 'dropMissing' drops all the keys.+-- * 'preserveMissing' leaves all the entries alone.+-- * 'mapMaybeMissing' does not use the 'Applicative' context.+--+-- When 'mergeA' is given three arguments, it is inlined at the call+-- site. To prevent excessive inlining, you should generally only use+-- 'mergeA' to define custom combining functions.+--+-- @since 0.5.9+mergeA+  :: (Applicative f)+  => WhenMissing f a c -- ^ What to do with keys in @m1@ but not @m2@+  -> WhenMissing f b c -- ^ What to do with keys in @m2@ but not @m1@+  -> WhenMatched f a b c -- ^ What to do with keys in both @m1@ and @m2@+  -> Word64Map a -- ^ Map @m1@+  -> Word64Map b -- ^ Map @m2@+  -> f (Word64Map c)+mergeA+    WhenMissing{missingSubtree = g1t, missingKey = g1k}+    WhenMissing{missingSubtree = g2t, missingKey = g2k}+    WhenMatched{matchedKey = f}+    = go+  where+    go t1  Nil = g1t t1+    go Nil t2  = g2t t2++    -- This case is already covered below.+    -- go (Tip k1 x1) (Tip k2 x2) = mergeTips k1 x1 k2 x2++    go (Tip k1 x1) t2' = merge2 t2'+      where+        merge2 t2@(Bin p2 m2 l2 r2)+          | nomatch k1 p2 m2 = linkA k1 (subsingletonBy g1k k1 x1) p2 (g2t t2)+          | zero k1 m2       = binA p2 m2 (merge2 l2) (g2t r2)+          | otherwise        = binA p2 m2 (g2t l2) (merge2 r2)+        merge2 (Tip k2 x2)   = mergeTips k1 x1 k2 x2+        merge2 Nil           = subsingletonBy g1k k1 x1++    go t1' (Tip k2 x2) = merge1 t1'+      where+        merge1 t1@(Bin p1 m1 l1 r1)+          | nomatch k2 p1 m1 = linkA p1 (g1t t1) k2 (subsingletonBy g2k k2 x2)+          | zero k2 m1       = binA p1 m1 (merge1 l1) (g1t r1)+          | otherwise        = binA p1 m1 (g1t l1) (merge1 r1)+        merge1 (Tip k1 x1)   = mergeTips k1 x1 k2 x2+        merge1 Nil           = subsingletonBy g2k k2 x2++    go t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)+      | shorter m1 m2  = merge1+      | shorter m2 m1  = merge2+      | p1 == p2       = binA p1 m1 (go l1 l2) (go r1 r2)+      | otherwise      = linkA p1 (g1t t1) p2 (g2t t2)+      where+        merge1 | nomatch p2 p1 m1  = linkA p1 (g1t t1) p2 (g2t t2)+               | zero p2 m1        = binA p1 m1 (go  l1 t2) (g1t r1)+               | otherwise         = binA p1 m1 (g1t l1)    (go  r1 t2)+        merge2 | nomatch p1 p2 m2  = linkA p1 (g1t t1) p2 (g2t t2)+               | zero p1 m2        = binA p2 m2 (go  t1 l2) (g2t    r2)+               | otherwise         = binA p2 m2 (g2t    l2) (go  t1 r2)++    subsingletonBy gk k x = maybe Nil (Tip k) <$> gk k x+    {-# INLINE subsingletonBy #-}++    mergeTips k1 x1 k2 x2+      | k1 == k2  = maybe Nil (Tip k1) <$> f k1 x1 x2+      | k1 <  k2  = liftA2 (subdoubleton k1 k2) (g1k k1 x1) (g2k k2 x2)+        {-+        = link_ k1 k2 <$> subsingletonBy g1k k1 x1 <*> subsingletonBy g2k k2 x2+        -}+      | otherwise = liftA2 (subdoubleton k2 k1) (g2k k2 x2) (g1k k1 x1)+    {-# INLINE mergeTips #-}++    subdoubleton _ _   Nothing Nothing     = Nil+    subdoubleton _ k2  Nothing (Just y2)   = Tip k2 y2+    subdoubleton k1 _  (Just y1) Nothing   = Tip k1 y1+    subdoubleton k1 k2 (Just y1) (Just y2) = link k1 (Tip k1 y1) k2 (Tip k2 y2)+    {-# INLINE subdoubleton #-}++    -- A variant of 'link_' which makes sure to execute side-effects+    -- in the right order.+    linkA+        :: Applicative f+        => Prefix -> f (Word64Map a)+        -> Prefix -> f (Word64Map a)+        -> f (Word64Map a)+    linkA p1 t1 p2 t2+      | zero p1 m = binA p m t1 t2+      | otherwise = binA p m t2 t1+      where+        m = branchMask p1 p2+        p = mask p1 m+    {-# INLINE linkA #-}++    -- A variant of 'bin' that ensures that effects for negative keys are executed+    -- first.+    binA+        :: Applicative f+        => Prefix+        -> Mask+        -> f (Word64Map a)+        -> f (Word64Map a)+        -> f (Word64Map a)+    binA p m a b+      | m < 0     = liftA2 (flip (bin p m)) b a+      | otherwise = liftA2       (bin p m)  a b+    {-# INLINE binA #-}+{-# INLINE mergeA #-}+++{--------------------------------------------------------------------+  Min\/Max+--------------------------------------------------------------------}++-- | \(O(\min(n,W))\). Update the value at the minimal key.+--+-- > updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"3:b"), (5,"a")]+-- > updateMinWithKey (\ _ _ -> Nothing)                     (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"++updateMinWithKey :: (Key -> a -> Maybe a) -> Word64Map a -> Word64Map a+updateMinWithKey f t =+  case t of Bin p m l r | m < 0 -> binCheckRight p m l (go f r)+            _ -> go f t+  where+    go f' (Bin p m l r) = binCheckLeft p m (go f' l) r+    go f' (Tip k y) = case f' k y of+                        Just y' -> Tip k y'+                        Nothing -> Nil+    go _ Nil = error "updateMinWithKey Nil"++-- | \(O(\min(n,W))\). Update the value at the maximal key.+--+-- > updateMaxWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"b"), (5,"5:a")]+-- > updateMaxWithKey (\ _ _ -> Nothing)                     (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"++updateMaxWithKey :: (Key -> a -> Maybe a) -> Word64Map a -> Word64Map a+updateMaxWithKey f t =+  case t of Bin p m l r | m < 0 -> binCheckLeft p m (go f l) r+            _ -> go f t+  where+    go f' (Bin p m l r) = binCheckRight p m l (go f' r)+    go f' (Tip k y) = case f' k y of+                        Just y' -> Tip k y'+                        Nothing -> Nil+    go _ Nil = error "updateMaxWithKey Nil"+++data View a = View {-# UNPACK #-} !Key a !(Word64Map a)++-- | \(O(\min(n,W))\). Retrieves the maximal (key,value) pair of the map, and+-- the map stripped of that element, or 'Nothing' if passed an empty map.+--+-- > maxViewWithKey (fromList [(5,"a"), (3,"b")]) == Just ((5,"a"), singleton 3 "b")+-- > maxViewWithKey empty == Nothing++maxViewWithKey :: Word64Map a -> Maybe ((Key, a), Word64Map a)+maxViewWithKey t = case t of+  Nil -> Nothing+  _ -> Just $ case maxViewWithKeySure t of+                View k v t' -> ((k, v), t')+{-# INLINE maxViewWithKey #-}++maxViewWithKeySure :: Word64Map a -> View a+maxViewWithKeySure t =+  case t of+    Nil -> error "maxViewWithKeySure Nil"+    Bin p m l r | m < 0 ->+      case go l of View k a l' -> View k a (binCheckLeft p m l' r)+    _ -> go t+  where+    go (Bin p m l r) =+        case go r of View k a r' -> View k a (binCheckRight p m l r')+    go (Tip k y) = View k y Nil+    go Nil = error "maxViewWithKey_go Nil"+-- See note on NOINLINE at minViewWithKeySure+{-# NOINLINE maxViewWithKeySure #-}++-- | \(O(\min(n,W))\). Retrieves the minimal (key,value) pair of the map, and+-- the map stripped of that element, or 'Nothing' if passed an empty map.+--+-- > minViewWithKey (fromList [(5,"a"), (3,"b")]) == Just ((3,"b"), singleton 5 "a")+-- > minViewWithKey empty == Nothing++minViewWithKey :: Word64Map a -> Maybe ((Key, a), Word64Map a)+minViewWithKey t =+  case t of+    Nil -> Nothing+    _ -> Just $ case minViewWithKeySure t of+                  View k v t' -> ((k, v), t')+-- We inline this to give GHC the best possible chance of+-- getting rid of the Maybe, pair, and Int constructors, as+-- well as a thunk under the Just. That is, we really want to+-- be certain this inlines!+{-# INLINE minViewWithKey #-}++minViewWithKeySure :: Word64Map a -> View a+minViewWithKeySure t =+  case t of+    Nil -> error "minViewWithKeySure Nil"+    Bin p m l r | m < 0 ->+      case go r of+        View k a r' -> View k a (binCheckRight p m l r')+    _ -> go t+  where+    go (Bin p m l r) =+        case go l of View k a l' -> View k a (binCheckLeft p m l' r)+    go (Tip k y) = View k y Nil+    go Nil = error "minViewWithKey_go Nil"+-- There's never anything significant to be gained by inlining+-- this. Sufficiently recent GHC versions will inline the wrapper+-- anyway, which should be good enough.+{-# NOINLINE minViewWithKeySure #-}++-- | \(O(\min(n,W))\). Update the value at the maximal key.+--+-- > updateMax (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "Xa")]+-- > updateMax (\ _ -> Nothing)         (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"++updateMax :: (a -> Maybe a) -> Word64Map a -> Word64Map a+updateMax f = updateMaxWithKey (const f)++-- | \(O(\min(n,W))\). Update the value at the minimal key.+--+-- > updateMin (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "Xb"), (5, "a")]+-- > updateMin (\ _ -> Nothing)         (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"++updateMin :: (a -> Maybe a) -> Word64Map a -> Word64Map a+updateMin f = updateMinWithKey (const f)++-- | \(O(\min(n,W))\). Retrieves the maximal key of the map, and the map+-- stripped of that element, or 'Nothing' if passed an empty map.+maxView :: Word64Map a -> Maybe (a, Word64Map a)+maxView t = fmap (\((_, x), t') -> (x, t')) (maxViewWithKey t)++-- | \(O(\min(n,W))\). Retrieves the minimal key of the map, and the map+-- stripped of that element, or 'Nothing' if passed an empty map.+minView :: Word64Map a -> Maybe (a, Word64Map a)+minView t = fmap (\((_, x), t') -> (x, t')) (minViewWithKey t)++-- | \(O(\min(n,W))\). Delete and find the maximal element.+-- This function throws an error if the map is empty. Use 'maxViewWithKey'+-- if the map may be empty.+deleteFindMax :: Word64Map a -> ((Key, a), Word64Map a)+deleteFindMax = fromMaybe (error "deleteFindMax: empty map has no maximal element") . maxViewWithKey++-- | \(O(\min(n,W))\). Delete and find the minimal element.+-- This function throws an error if the map is empty. Use 'minViewWithKey'+-- if the map may be empty.+deleteFindMin :: Word64Map a -> ((Key, a), Word64Map a)+deleteFindMin = fromMaybe (error "deleteFindMin: empty map has no minimal element") . minViewWithKey++-- | \(O(\min(n,W))\). The minimal key of the map. Returns 'Nothing' if the map is empty.+lookupMin :: Word64Map a -> Maybe (Key, a)+lookupMin Nil = Nothing+lookupMin (Tip k v) = Just (k,v)+lookupMin (Bin _ m l r)+  | m < 0     = go r+  | otherwise = go l+    where go (Tip k v)      = Just (k,v)+          go (Bin _ _ l' _) = go l'+          go Nil            = Nothing++-- | \(O(\min(n,W))\). The minimal key of the map. Calls 'error' if the map is empty.+-- Use 'minViewWithKey' if the map may be empty.+findMin :: Word64Map a -> (Key, a)+findMin t+  | Just r <- lookupMin t = r+  | otherwise = error "findMin: empty map has no minimal element"++-- | \(O(\min(n,W))\). The maximal key of the map. Returns 'Nothing' if the map is empty.+lookupMax :: Word64Map a -> Maybe (Key, a)+lookupMax Nil = Nothing+lookupMax (Tip k v) = Just (k,v)+lookupMax (Bin _ m l r)+  | m < 0     = go l+  | otherwise = go r+    where go (Tip k v)      = Just (k,v)+          go (Bin _ _ _ r') = go r'+          go Nil            = Nothing++-- | \(O(\min(n,W))\). The maximal key of the map. Calls 'error' if the map is empty.+-- Use 'maxViewWithKey' if the map may be empty.+findMax :: Word64Map a -> (Key, a)+findMax t+  | Just r <- lookupMax t = r+  | otherwise = error "findMax: empty map has no maximal element"++-- | \(O(\min(n,W))\). Delete the minimal key. Returns an empty map if the map is empty.+--+-- Note that this is a change of behaviour for consistency with 'Data.Map.Map' &#8211;+-- versions prior to 0.5 threw an error if the 'Word64Map' was already empty.+deleteMin :: Word64Map a -> Word64Map a+deleteMin = maybe Nil snd . minView++-- | \(O(\min(n,W))\). Delete the maximal key. Returns an empty map if the map is empty.+--+-- Note that this is a change of behaviour for consistency with 'Data.Map.Map' &#8211;+-- versions prior to 0.5 threw an error if the 'Word64Map' was already empty.+deleteMax :: Word64Map a -> Word64Map a+deleteMax = maybe Nil snd . maxView+++{--------------------------------------------------------------------+  Submap+--------------------------------------------------------------------}+-- | \(O(n+m)\). Is this a proper submap? (ie. a submap but not equal).+-- Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' (==)@).+isProperSubmapOf :: Eq a => Word64Map a -> Word64Map a -> Bool+isProperSubmapOf m1 m2+  = isProperSubmapOfBy (==) m1 m2++{- | \(O(n+m)\). Is this a proper submap? (ie. a submap but not equal).+ The expression (@'isProperSubmapOfBy' f m1 m2@) returns 'True' when+ @keys m1@ and @keys m2@ are not equal,+ all keys in @m1@ are in @m2@, and when @f@ returns 'True' when+ applied to their respective values. For example, the following+ expressions are all 'True':++  > isProperSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)])+  > isProperSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)])++ But the following are all 'False':++  > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)])+  > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)])+  > isProperSubmapOfBy (<)  (fromList [(1,1)])       (fromList [(1,1),(2,2)])+-}+isProperSubmapOfBy :: (a -> b -> Bool) -> Word64Map a -> Word64Map b -> Bool+isProperSubmapOfBy predicate t1 t2+  = case submapCmp predicate t1 t2 of+      LT -> True+      _  -> False++submapCmp :: (a -> b -> Bool) -> Word64Map a -> Word64Map b -> Ordering+submapCmp predicate t1@(Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)+  | shorter m1 m2  = GT+  | shorter m2 m1  = submapCmpLt+  | p1 == p2       = submapCmpEq+  | otherwise      = GT  -- disjoint+  where+    submapCmpLt | nomatch p1 p2 m2  = GT+                | zero p1 m2        = submapCmp predicate t1 l2+                | otherwise         = submapCmp predicate t1 r2+    submapCmpEq = case (submapCmp predicate l1 l2, submapCmp predicate r1 r2) of+                    (GT,_ ) -> GT+                    (_ ,GT) -> GT+                    (EQ,EQ) -> EQ+                    _       -> LT++submapCmp _         (Bin _ _ _ _) _  = GT+submapCmp predicate (Tip kx x) (Tip ky y)+  | (kx == ky) && predicate x y = EQ+  | otherwise                   = GT  -- disjoint+submapCmp predicate (Tip k x) t+  = case lookup k t of+     Just y | predicate x y -> LT+     _                      -> GT -- disjoint+submapCmp _    Nil Nil = EQ+submapCmp _    Nil _   = LT++-- | \(O(n+m)\). Is this a submap?+-- Defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@).+isSubmapOf :: Eq a => Word64Map a -> Word64Map a -> Bool+isSubmapOf m1 m2+  = isSubmapOfBy (==) m1 m2++{- | \(O(n+m)\).+ The expression (@'isSubmapOfBy' f m1 m2@) returns 'True' if+ all keys in @m1@ are in @m2@, and when @f@ returns 'True' when+ applied to their respective values. For example, the following+ expressions are all 'True':++  > isSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)])+  > isSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)])+  > isSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)])++ But the following are all 'False':++  > isSubmapOfBy (==) (fromList [(1,2)]) (fromList [(1,1),(2,2)])+  > isSubmapOfBy (<) (fromList [(1,1)]) (fromList [(1,1),(2,2)])+  > isSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)])+-}+isSubmapOfBy :: (a -> b -> Bool) -> Word64Map a -> Word64Map b -> Bool+isSubmapOfBy predicate 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 isSubmapOfBy predicate t1 l2+                       else isSubmapOfBy predicate t1 r2+  | otherwise      = (p1==p2) && isSubmapOfBy predicate l1 l2 && isSubmapOfBy predicate r1 r2+isSubmapOfBy _         (Bin _ _ _ _) _ = False+isSubmapOfBy predicate (Tip k x) t     = case lookup k t of+                                         Just y  -> predicate x y+                                         Nothing -> False+isSubmapOfBy _         Nil _           = True++{--------------------------------------------------------------------+  Mapping+--------------------------------------------------------------------}+-- | \(O(n)\). Map a function over all values in the map.+--+-- > map (++ "x") (fromList [(5,"a"), (3,"b")]) == fromList [(3, "bx"), (5, "ax")]++map :: (a -> b) -> Word64Map a -> Word64Map b+map f = go+  where+    go (Bin p m l r) = Bin p m (go l) (go r)+    go (Tip k x)     = Tip k (f x)+    go Nil           = Nil++#ifdef __GLASGOW_HASKELL__+{-# NOINLINE [1] map #-}+{-# RULES+"map/map" forall f g xs . map f (map g xs) = map (f . g) xs+"map/coerce" map coerce = coerce+ #-}+#endif++-- | \(O(n)\). Map a function over all values in the map.+--+-- > let f key x = (show key) ++ ":" ++ x+-- > mapWithKey f (fromList [(5,"a"), (3,"b")]) == fromList [(3, "3:b"), (5, "5:a")]++mapWithKey :: (Key -> a -> b) -> Word64Map a -> Word64Map b+mapWithKey f t+  = case t of+      Bin p m l r -> Bin p m (mapWithKey f l) (mapWithKey f r)+      Tip k x     -> Tip k (f k x)+      Nil         -> Nil++#ifdef __GLASGOW_HASKELL__+{-# NOINLINE [1] mapWithKey #-}+{-# RULES+"mapWithKey/mapWithKey" forall f g xs . mapWithKey f (mapWithKey g xs) =+  mapWithKey (\k a -> f k (g k a)) xs+"mapWithKey/map" forall f g xs . mapWithKey f (map g xs) =+  mapWithKey (\k a -> f k (g a)) xs+"map/mapWithKey" forall f g xs . map f (mapWithKey g xs) =+  mapWithKey (\k a -> f (g k a)) xs+ #-}+#endif++-- | \(O(n)\).+-- @'traverseWithKey' f s == 'fromList' <$> 'traverse' (\(k, v) -> (,) k <$> f k v) ('toList' m)@+-- That is, behaves exactly like a regular 'traverse' except that the traversing+-- function also has access to the key associated with a value.+--+-- > traverseWithKey (\k v -> if odd k then Just (succ v) else Nothing) (fromList [(1, 'a'), (5, 'e')]) == Just (fromList [(1, 'b'), (5, 'f')])+-- > traverseWithKey (\k v -> if odd k then Just (succ v) else Nothing) (fromList [(2, 'c')])           == Nothing+traverseWithKey :: Applicative t => (Key -> a -> t b) -> Word64Map a -> t (Word64Map b)+traverseWithKey f = go+  where+    go Nil = pure Nil+    go (Tip k v) = Tip k <$> f k v+    go (Bin p m l r)+      | m < 0     = liftA2 (flip (Bin p m)) (go r) (go l)+      | otherwise = liftA2 (Bin p m) (go l) (go r)+{-# INLINE traverseWithKey #-}++-- | \(O(n)\). The function @'mapAccum'@ threads an accumulating+-- argument through the map in ascending order of keys.+--+-- > let f a b = (a ++ b, b ++ "X")+-- > mapAccum f "Everything: " (fromList [(5,"a"), (3,"b")]) == ("Everything: ba", fromList [(3, "bX"), (5, "aX")])++mapAccum :: (a -> b -> (a,c)) -> a -> Word64Map b -> (a,Word64Map c)+mapAccum f = mapAccumWithKey (\a' _ x -> f a' x)++-- | \(O(n)\). The function @'mapAccumWithKey'@ threads an accumulating+-- argument through the map in ascending order of keys.+--+-- > let f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X")+-- > mapAccumWithKey f "Everything:" (fromList [(5,"a"), (3,"b")]) == ("Everything: 3-b 5-a", fromList [(3, "bX"), (5, "aX")])++mapAccumWithKey :: (a -> Key -> b -> (a,c)) -> a -> Word64Map b -> (a,Word64Map c)+mapAccumWithKey f a t+  = mapAccumL f a t++-- | \(O(n)\). The function @'mapAccumL'@ threads an accumulating+-- argument through the map in ascending order of keys.+mapAccumL :: (a -> Key -> b -> (a,c)) -> a -> Word64Map b -> (a,Word64Map c)+mapAccumL f a t+  = case t of+      Bin p m l r+        | m < 0 ->+            let (a1,r') = mapAccumL f a r+                (a2,l') = mapAccumL f a1 l+            in (a2,Bin p m l' r')+        | otherwise  ->+            let (a1,l') = mapAccumL f a l+                (a2,r') = mapAccumL f a1 r+            in (a2,Bin p m l' r')+      Tip k x     -> let (a',x') = f a k x in (a',Tip k x')+      Nil         -> (a,Nil)++-- | \(O(n)\). The function @'mapAccumRWithKey'@ threads an accumulating+-- argument through the map in descending order of keys.+mapAccumRWithKey :: (a -> Key -> b -> (a,c)) -> a -> Word64Map b -> (a,Word64Map c)+mapAccumRWithKey f a t+  = case t of+      Bin p m l r+        | m < 0 ->+            let (a1,l') = mapAccumRWithKey f a l+                (a2,r') = mapAccumRWithKey f a1 r+            in (a2,Bin p m l' r')+        | otherwise  ->+            let (a1,r') = mapAccumRWithKey f a r+                (a2,l') = mapAccumRWithKey f a1 l+            in (a2,Bin p m l' r')+      Tip k x     -> let (a',x') = f a k x in (a',Tip k x')+      Nil         -> (a,Nil)++-- | \(O(n \min(n,W))\).+-- @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@.+--+-- The size of the result may be smaller if @f@ maps two or more distinct+-- keys to the same new key.  In this case the value at the greatest of the+-- original keys is retained.+--+-- > mapKeys (+ 1) (fromList [(5,"a"), (3,"b")])                        == fromList [(4, "b"), (6, "a")]+-- > mapKeys (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 1 "c"+-- > mapKeys (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 3 "c"++mapKeys :: (Key->Key) -> Word64Map a -> Word64Map a+mapKeys f = fromList . foldrWithKey (\k x xs -> (f k, x) : xs) []++-- | \(O(n \min(n,W))\).+-- @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@.+--+-- The size of the result may be smaller if @f@ maps two or more distinct+-- keys to the same new key.  In this case the associated values will be+-- combined using @c@.+--+-- > mapKeysWith (++) (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 1 "cdab"+-- > mapKeysWith (++) (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 3 "cdab"++mapKeysWith :: (a -> a -> a) -> (Key->Key) -> Word64Map a -> Word64Map a+mapKeysWith c f+  = fromListWith c . foldrWithKey (\k x xs -> (f k, x) : xs) []++-- | \(O(n \min(n,W))\).+-- @'mapKeysMonotonic' f s == 'mapKeys' f s@, but works only when @f@+-- is strictly monotonic.+-- That is, for any values @x@ and @y@, if @x@ < @y@ then @f x@ < @f y@.+-- /The precondition is not checked./+-- Semi-formally, we have:+--+-- > and [x < y ==> f x < f y | x <- ls, y <- ls]+-- >                     ==> mapKeysMonotonic f s == mapKeys f s+-- >     where ls = keys s+--+-- This means that @f@ maps distinct original keys to distinct resulting keys.+-- This function has slightly better performance than 'mapKeys'.+--+-- > mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")]) == fromList [(6, "b"), (10, "a")]++mapKeysMonotonic :: (Key->Key) -> Word64Map a -> Word64Map a+mapKeysMonotonic f+  = fromDistinctAscList . foldrWithKey (\k x xs -> (f k, x) : xs) []++{--------------------------------------------------------------------+  Filter+--------------------------------------------------------------------}+-- | \(O(n)\). Filter all values that satisfy some predicate.+--+-- > filter (> "a") (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"+-- > filter (> "x") (fromList [(5,"a"), (3,"b")]) == empty+-- > filter (< "a") (fromList [(5,"a"), (3,"b")]) == empty++filter :: (a -> Bool) -> Word64Map a -> Word64Map a+filter p m+  = filterWithKey (\_ x -> p x) m++-- | \(O(n)\). Filter all keys\/values that satisfy some predicate.+--+-- > filterWithKey (\k _ -> k > 4) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"++filterWithKey :: (Key -> a -> Bool) -> Word64Map a -> Word64Map a+filterWithKey predicate = go+    where+    go Nil           = Nil+    go t@(Tip k x)   = if predicate k x then t else Nil+    go (Bin p m l r) = bin p m (go l) (go r)++-- | \(O(n)\). Partition the map according to some predicate. The first+-- map contains all elements that satisfy the predicate, the second all+-- elements that fail the predicate. See also 'split'.+--+-- > partition (> "a") (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", singleton 5 "a")+-- > partition (< "x") (fromList [(5,"a"), (3,"b")]) == (fromList [(3, "b"), (5, "a")], empty)+-- > partition (> "x") (fromList [(5,"a"), (3,"b")]) == (empty, fromList [(3, "b"), (5, "a")])++partition :: (a -> Bool) -> Word64Map a -> (Word64Map a,Word64Map a)+partition p m+  = partitionWithKey (\_ x -> p x) m++-- | \(O(n)\). Partition the map according to some predicate. The first+-- map contains all elements that satisfy the predicate, the second all+-- elements that fail the predicate. See also 'split'.+--+-- > partitionWithKey (\ k _ -> k > 3) (fromList [(5,"a"), (3,"b")]) == (singleton 5 "a", singleton 3 "b")+-- > partitionWithKey (\ k _ -> k < 7) (fromList [(5,"a"), (3,"b")]) == (fromList [(3, "b"), (5, "a")], empty)+-- > partitionWithKey (\ k _ -> k > 7) (fromList [(5,"a"), (3,"b")]) == (empty, fromList [(3, "b"), (5, "a")])++partitionWithKey :: (Key -> a -> Bool) -> Word64Map a -> (Word64Map a,Word64Map a)+partitionWithKey predicate0 t0 = toPair $ go predicate0 t0+  where+    go predicate t =+      case t of+        Bin p m l r ->+          let (l1 :*: l2) = go predicate l+              (r1 :*: r2) = go predicate r+          in bin p m l1 r1 :*: bin p m l2 r2+        Tip k x+          | predicate k x -> (t :*: Nil)+          | otherwise     -> (Nil :*: t)+        Nil -> (Nil :*: Nil)++-- | \(O(\min(n,W))\). Take while a predicate on the keys holds.+-- The user is responsible for ensuring that for all @Int@s, @j \< k ==\> p j \>= p k@.+-- See note at 'spanAntitone'.+--+-- @+-- takeWhileAntitone p = 'fromDistinctAscList' . 'Data.List.takeWhile' (p . fst) . 'toList'+-- takeWhileAntitone p = 'filterWithKey' (\\k _ -> p k)+-- @+--+-- @since 0.6.7+takeWhileAntitone :: (Key -> Bool) -> Word64Map a -> Word64Map a+takeWhileAntitone predicate t =+  case t of+    Bin p m l r+      | m < 0 ->+        if predicate 0 -- handle negative numbers.+        then bin p m (go predicate l) r+        else go predicate r+    _ -> go predicate t+  where+    go predicate' (Bin p m l r)+      | predicate' $! p+m = bin p m l (go predicate' r)+      | otherwise         = go predicate' l+    go predicate' t'@(Tip ky _)+      | predicate' ky = t'+      | otherwise     = Nil+    go _ Nil = Nil++-- | \(O(\min(n,W))\). Drop while a predicate on the keys holds.+-- The user is responsible for ensuring that for all @Int@s, @j \< k ==\> p j \>= p k@.+-- See note at 'spanAntitone'.+--+-- @+-- dropWhileAntitone p = 'fromDistinctAscList' . 'Data.List.dropWhile' (p . fst) . 'toList'+-- dropWhileAntitone p = 'filterWithKey' (\\k _ -> not (p k))+-- @+--+-- @since 0.6.7+dropWhileAntitone :: (Key -> Bool) -> Word64Map a -> Word64Map a+dropWhileAntitone predicate t =+  case t of+    Bin p m l r+      | m < 0 ->+        if predicate 0 -- handle negative numbers.+        then go predicate l+        else bin p m l (go predicate r)+    _ -> go predicate t+  where+    go predicate' (Bin p m l r)+      | predicate' $! p+m = go predicate' r+      | otherwise         = bin p m (go predicate' l) r+    go predicate' t'@(Tip ky _)+      | predicate' ky = Nil+      | otherwise     = t'+    go _ Nil = Nil++-- | \(O(\min(n,W))\). Divide a map at the point where a predicate on the keys stops holding.+-- The user is responsible for ensuring that for all @Int@s, @j \< k ==\> p j \>= p k@.+--+-- @+-- spanAntitone p xs = ('takeWhileAntitone' p xs, 'dropWhileAntitone' p xs)+-- spanAntitone p xs = 'partitionWithKey' (\\k _ -> p k) xs+-- @+--+-- Note: if @p@ is not actually antitone, then @spanAntitone@ will split the map+-- at some /unspecified/ point.+--+-- @since 0.6.7+spanAntitone :: (Key -> Bool) -> Word64Map a -> (Word64Map a, Word64Map a)+spanAntitone predicate t =+  case t of+    Bin p m l r+      | m < 0 ->+        if predicate 0 -- handle negative numbers.+        then+          case go predicate l of+            (lt :*: gt) ->+              let !lt' = bin p m lt r+              in (lt', gt)+        else+          case go predicate r of+            (lt :*: gt) ->+              let !gt' = bin p m l gt+              in (lt, gt')+    _ -> case go predicate t of+          (lt :*: gt) -> (lt, gt)+  where+    go predicate' (Bin p m l r)+      | predicate' $! p+m = case go predicate' r of (lt :*: gt) -> bin p m l lt :*: gt+      | otherwise         = case go predicate' l of (lt :*: gt) -> lt :*: bin p m gt r+    go predicate' t'@(Tip ky _)+      | predicate' ky = (t' :*: Nil)+      | otherwise     = (Nil :*: t')+    go _ Nil = (Nil :*: Nil)++-- | \(O(n)\). Map values and collect the 'Just' results.+--+-- > let f x = if x == "a" then Just "new a" else Nothing+-- > mapMaybe f (fromList [(5,"a"), (3,"b")]) == singleton 5 "new a"++mapMaybe :: (a -> Maybe b) -> Word64Map a -> Word64Map b+mapMaybe f = mapMaybeWithKey (\_ x -> f x)++-- | \(O(n)\). Map keys\/values and collect the 'Just' results.+--+-- > let f k _ = if k < 5 then Just ("key : " ++ (show k)) else Nothing+-- > mapMaybeWithKey f (fromList [(5,"a"), (3,"b")]) == singleton 3 "key : 3"++mapMaybeWithKey :: (Key -> a -> Maybe b) -> Word64Map a -> Word64Map b+mapMaybeWithKey f (Bin p m l r)+  = bin p m (mapMaybeWithKey f l) (mapMaybeWithKey f r)+mapMaybeWithKey f (Tip k x) = case f k x of+  Just y  -> Tip k y+  Nothing -> Nil+mapMaybeWithKey _ Nil = Nil++-- | \(O(n)\). Map values and separate the 'Left' and 'Right' results.+--+-- > let f a = if a < "c" then Left a else Right a+-- > mapEither f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])+-- >     == (fromList [(3,"b"), (5,"a")], fromList [(1,"x"), (7,"z")])+-- >+-- > mapEither (\ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])+-- >     == (empty, fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])++mapEither :: (a -> Either b c) -> Word64Map a -> (Word64Map b, Word64Map c)+mapEither f m+  = mapEitherWithKey (\_ x -> f x) m++-- | \(O(n)\). Map keys\/values and separate the 'Left' and 'Right' results.+--+-- > let f k a = if k < 5 then Left (k * 2) else Right (a ++ a)+-- > mapEitherWithKey f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])+-- >     == (fromList [(1,2), (3,6)], fromList [(5,"aa"), (7,"zz")])+-- >+-- > mapEitherWithKey (\_ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])+-- >     == (empty, fromList [(1,"x"), (3,"b"), (5,"a"), (7,"z")])++mapEitherWithKey :: (Key -> a -> Either b c) -> Word64Map a -> (Word64Map b, Word64Map c)+mapEitherWithKey f0 t0 = toPair $ go f0 t0+  where+    go f (Bin p m l r) =+      bin p m l1 r1 :*: bin p m l2 r2+      where+        (l1 :*: l2) = go f l+        (r1 :*: r2) = go f r+    go f (Tip k x) = case f k x of+      Left y  -> (Tip k y :*: Nil)+      Right z -> (Nil :*: Tip k z)+    go _ Nil = (Nil :*: Nil)++-- | \(O(\min(n,W))\). The expression (@'split' k map@) is a pair @(map1,map2)@+-- where all keys in @map1@ are lower than @k@ and all keys in+-- @map2@ larger than @k@. Any key equal to @k@ is found in neither @map1@ nor @map2@.+--+-- > split 2 (fromList [(5,"a"), (3,"b")]) == (empty, fromList [(3,"b"), (5,"a")])+-- > split 3 (fromList [(5,"a"), (3,"b")]) == (empty, singleton 5 "a")+-- > split 4 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", singleton 5 "a")+-- > split 5 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", empty)+-- > split 6 (fromList [(5,"a"), (3,"b")]) == (fromList [(3,"b"), (5,"a")], empty)++split :: Key -> Word64Map a -> (Word64Map a, Word64Map a)+split k t =+  case t of+    Bin p m l r+      | m < 0 ->+        if k >= 0 -- handle negative numbers.+        then+          case go k l of+            (lt :*: gt) ->+              let !lt' = bin p m lt r+              in (lt', gt)+        else+          case go k r of+            (lt :*: gt) ->+              let !gt' = bin p m l gt+              in (lt, gt')+    _ -> case go k t of+          (lt :*: gt) -> (lt, gt)+  where+    go k' t'@(Bin p m l r)+      | nomatch k' p m = if k' > p then t' :*: Nil else Nil :*: t'+      | zero k' m = case go k' l of (lt :*: gt) -> lt :*: bin p m gt r+      | otherwise = case go k' r of (lt :*: gt) -> bin p m l lt :*: gt+    go k' t'@(Tip ky _)+      | k' > ky   = (t' :*: Nil)+      | k' < ky   = (Nil :*: t')+      | otherwise = (Nil :*: Nil)+    go _ Nil = (Nil :*: Nil)+++data SplitLookup a = SplitLookup !(Word64Map a) !(Maybe a) !(Word64Map a)++mapLT :: (Word64Map a -> Word64Map a) -> SplitLookup a -> SplitLookup a+mapLT f (SplitLookup lt fnd gt) = SplitLookup (f lt) fnd gt+{-# INLINE mapLT #-}++mapGT :: (Word64Map a -> Word64Map a) -> SplitLookup a -> SplitLookup a+mapGT f (SplitLookup lt fnd gt) = SplitLookup lt fnd (f gt)+{-# INLINE mapGT #-}++-- | \(O(\min(n,W))\). Performs a 'split' but also returns whether the pivot+-- key was found in the original map.+--+-- > splitLookup 2 (fromList [(5,"a"), (3,"b")]) == (empty, Nothing, fromList [(3,"b"), (5,"a")])+-- > splitLookup 3 (fromList [(5,"a"), (3,"b")]) == (empty, Just "b", singleton 5 "a")+-- > splitLookup 4 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", Nothing, singleton 5 "a")+-- > splitLookup 5 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", Just "a", empty)+-- > splitLookup 6 (fromList [(5,"a"), (3,"b")]) == (fromList [(3,"b"), (5,"a")], Nothing, empty)++splitLookup :: Key -> Word64Map a -> (Word64Map a, Maybe a, Word64Map a)+splitLookup k t =+  case+    case t of+      Bin p m l r+        | m < 0 ->+          if k >= 0 -- handle negative numbers.+          then mapLT (flip (bin p m) r) (go k l)+          else mapGT (bin p m l) (go k r)+      _ -> go k t+  of SplitLookup lt fnd gt -> (lt, fnd, gt)+  where+    go k' t'@(Bin p m l r)+      | nomatch k' p m =+          if k' > p+          then SplitLookup t' Nothing Nil+          else SplitLookup Nil Nothing t'+      | zero k' m = mapGT (flip (bin p m) r) (go k' l)+      | otherwise = mapLT (bin p m l) (go k' r)+    go k' t'@(Tip ky y)+      | k' > ky   = SplitLookup t'  Nothing  Nil+      | k' < ky   = SplitLookup Nil Nothing  t'+      | otherwise = SplitLookup Nil (Just y) Nil+    go _ Nil      = SplitLookup Nil Nothing  Nil++{--------------------------------------------------------------------+  Fold+--------------------------------------------------------------------}+-- | \(O(n)\). Fold the values in the map using the given right-associative+-- binary operator, such that @'foldr' f z == 'Prelude.foldr' f z . 'elems'@.+--+-- For example,+--+-- > elems map = foldr (:) [] map+--+-- > let f a len = len + (length a)+-- > foldr f 0 (fromList [(5,"a"), (3,"bbb")]) == 4+foldr :: (a -> b -> b) -> b -> Word64Map a -> b+foldr f z = \t ->      -- Use lambda t to be inlinable with two arguments only.+  case t of+    Bin _ m l r+      | m < 0 -> go (go z l) r -- put negative numbers before+      | otherwise -> go (go z r) l+    _ -> go z t+  where+    go z' Nil           = z'+    go z' (Tip _ x)     = f x z'+    go z' (Bin _ _ l r) = go (go z' r) l+{-# INLINE foldr #-}++-- | \(O(n)\). A strict version of 'foldr'. Each application of the operator is+-- evaluated before using the result in the next application. This+-- function is strict in the starting value.+foldr' :: (a -> b -> b) -> b -> Word64Map a -> b+foldr' f z = \t ->      -- Use lambda t to be inlinable with two arguments only.+  case t of+    Bin _ m l r+      | m < 0 -> go (go z l) r -- put negative numbers before+      | otherwise -> go (go z r) l+    _ -> go z t+  where+    go !z' Nil          = z'+    go z' (Tip _ x)     = f x z'+    go z' (Bin _ _ l r) = go (go z' r) l+{-# INLINE foldr' #-}++-- | \(O(n)\). Fold the values in the map using the given left-associative+-- binary operator, such that @'foldl' f z == 'Prelude.foldl' f z . 'elems'@.+--+-- For example,+--+-- > elems = reverse . foldl (flip (:)) []+--+-- > let f len a = len + (length a)+-- > foldl f 0 (fromList [(5,"a"), (3,"bbb")]) == 4+foldl :: (a -> b -> a) -> a -> Word64Map b -> a+foldl f z = \t ->      -- Use lambda t to be inlinable with two arguments only.+  case t of+    Bin _ m l r+      | m < 0 -> go (go z r) l -- put negative numbers before+      | otherwise -> go (go z l) r+    _ -> go z t+  where+    go z' Nil           = z'+    go z' (Tip _ x)     = f z' x+    go z' (Bin _ _ l r) = go (go z' l) r+{-# INLINE foldl #-}++-- | \(O(n)\). A strict version of 'foldl'. Each application of the operator is+-- evaluated before using the result in the next application. This+-- function is strict in the starting value.+foldl' :: (a -> b -> a) -> a -> Word64Map b -> a+foldl' f z = \t ->      -- Use lambda t to be inlinable with two arguments only.+  case t of+    Bin _ m l r+      | m < 0 -> go (go z r) l -- put negative numbers before+      | otherwise -> go (go z l) r+    _ -> go z t+  where+    go !z' Nil          = z'+    go z' (Tip _ x)     = f z' x+    go z' (Bin _ _ l r) = go (go z' l) r+{-# INLINE foldl' #-}++-- | \(O(n)\). Fold the keys and values in the map using the given right-associative+-- binary operator, such that+-- @'foldrWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@.+--+-- For example,+--+-- > keys map = foldrWithKey (\k x ks -> k:ks) [] map+--+-- > let f k a result = result ++ "(" ++ (show k) ++ ":" ++ a ++ ")"+-- > foldrWithKey f "Map: " (fromList [(5,"a"), (3,"b")]) == "Map: (5:a)(3:b)"+foldrWithKey :: (Key -> a -> b -> b) -> b -> Word64Map a -> b+foldrWithKey f z = \t ->      -- Use lambda t to be inlinable with two arguments only.+  case t of+    Bin _ m l r+      | m < 0 -> go (go z l) r -- put negative numbers before+      | otherwise -> go (go z r) l+    _ -> go z t+  where+    go z' Nil           = z'+    go z' (Tip kx x)    = f kx x z'+    go z' (Bin _ _ l r) = go (go z' r) l+{-# INLINE foldrWithKey #-}++-- | \(O(n)\). A strict version of 'foldrWithKey'. Each application of the operator is+-- evaluated before using the result in the next application. This+-- function is strict in the starting value.+foldrWithKey' :: (Key -> a -> b -> b) -> b -> Word64Map a -> b+foldrWithKey' f z = \t ->      -- Use lambda t to be inlinable with two arguments only.+  case t of+    Bin _ m l r+      | m < 0 -> go (go z l) r -- put negative numbers before+      | otherwise -> go (go z r) l+    _ -> go z t+  where+    go !z' Nil          = z'+    go z' (Tip kx x)    = f kx x z'+    go z' (Bin _ _ l r) = go (go z' r) l+{-# INLINE foldrWithKey' #-}++-- | \(O(n)\). Fold the keys and values in the map using the given left-associative+-- binary operator, such that+-- @'foldlWithKey' f z == 'Prelude.foldl' (\\z' (kx, x) -> f z' kx x) z . 'toAscList'@.+--+-- For example,+--+-- > keys = reverse . foldlWithKey (\ks k x -> k:ks) []+--+-- > let f result k a = result ++ "(" ++ (show k) ++ ":" ++ a ++ ")"+-- > foldlWithKey f "Map: " (fromList [(5,"a"), (3,"b")]) == "Map: (3:b)(5:a)"+foldlWithKey :: (a -> Key -> b -> a) -> a -> Word64Map b -> a+foldlWithKey f z = \t ->      -- Use lambda t to be inlinable with two arguments only.+  case t of+    Bin _ m l r+      | m < 0 -> go (go z r) l -- put negative numbers before+      | otherwise -> go (go z l) r+    _ -> go z t+  where+    go z' Nil           = z'+    go z' (Tip kx x)    = f z' kx x+    go z' (Bin _ _ l r) = go (go z' l) r+{-# INLINE foldlWithKey #-}++-- | \(O(n)\). A strict version of 'foldlWithKey'. Each application of the operator is+-- evaluated before using the result in the next application. This+-- function is strict in the starting value.+foldlWithKey' :: (a -> Key -> b -> a) -> a -> Word64Map b -> a+foldlWithKey' f z = \t ->      -- Use lambda t to be inlinable with two arguments only.+  case t of+    Bin _ m l r+      | m < 0 -> go (go z r) l -- put negative numbers before+      | otherwise -> go (go z l) r+    _ -> go z t+  where+    go !z' Nil          = z'+    go z' (Tip kx x)    = f z' kx x+    go z' (Bin _ _ l r) = go (go z' l) r+{-# INLINE foldlWithKey' #-}++-- | \(O(n)\). Fold the keys and values in the map using the given monoid, such that+--+-- @'foldMapWithKey' f = 'Prelude.fold' . 'mapWithKey' f@+--+-- This can be an asymptotically faster than 'foldrWithKey' or 'foldlWithKey' for some monoids.+--+-- @since 0.5.4+foldMapWithKey :: Monoid m => (Key -> a -> m) -> Word64Map a -> m+foldMapWithKey f = go+  where+    go Nil           = mempty+    go (Tip kx x)    = f kx x+    go (Bin _ m l r)+      | m < 0     = go r `mappend` go l+      | otherwise = go l `mappend` go r+{-# INLINE foldMapWithKey #-}++{--------------------------------------------------------------------+  List variations+--------------------------------------------------------------------}+-- | \(O(n)\).+-- Return all elements of the map in the ascending order of their keys.+-- Subject to list fusion.+--+-- > elems (fromList [(5,"a"), (3,"b")]) == ["b","a"]+-- > elems empty == []++elems :: Word64Map a -> [a]+elems = foldr (:) []++-- | \(O(n)\). Return all keys of the map in ascending order. Subject to list+-- fusion.+--+-- > keys (fromList [(5,"a"), (3,"b")]) == [3,5]+-- > keys empty == []++keys  :: Word64Map a -> [Key]+keys = foldrWithKey (\k _ ks -> k : ks) []++-- | \(O(n)\). An alias for 'toAscList'. Returns all key\/value pairs in the+-- map in ascending key order. Subject to list fusion.+--+-- > assocs (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]+-- > assocs empty == []++assocs :: Word64Map a -> [(Key,a)]+assocs = toAscList++-- | \(O(n \min(n,W))\). The set of all keys of the map.+--+-- > keysSet (fromList [(5,"a"), (3,"b")]) == Data.Word64Set.fromList [3,5]+-- > keysSet empty == Data.Word64Set.empty++keysSet :: Word64Map a -> Word64Set.Word64Set+keysSet Nil = Word64Set.Nil+keysSet (Tip kx _) = Word64Set.singleton kx+keysSet (Bin p m l r)+  | m .&. Word64Set.suffixBitMask == 0 = Word64Set.Bin p m (keysSet l) (keysSet r)+  | otherwise = Word64Set.Tip (p .&. Word64Set.prefixBitMask) (computeBm (computeBm 0 l) r)+  where computeBm !acc (Bin _ _ l' r') = computeBm (computeBm acc l') r'+        computeBm acc (Tip kx _) = acc .|. Word64Set.bitmapOf kx+        computeBm _   Nil = error "Data.Word64Set.keysSet: Nil"++-- | \(O(n)\). Build a map from a set of keys and a function which for each key+-- computes its value.+--+-- > fromSet (\k -> replicate k 'a') (Data.Word64Set.fromList [3, 5]) == fromList [(5,"aaaaa"), (3,"aaa")]+-- > fromSet undefined Data.Word64Set.empty == empty++fromSet :: (Key -> a) -> Word64Set.Word64Set -> Word64Map a+fromSet _ Word64Set.Nil = Nil+fromSet f (Word64Set.Bin p m l r) = Bin p m (fromSet f l) (fromSet f r)+fromSet f (Word64Set.Tip kx bm) = buildTree f kx bm (Word64Set.suffixBitMask + 1)+  where+    -- This is slightly complicated, as we to convert the dense+    -- representation of Word64Set into tree representation of Word64Map.+    --+    -- We are given a nonzero bit mask 'bmask' of 'bits' bits with+    -- prefix 'prefix'. We split bmask into halves corresponding+    -- to left and right subtree. If they are both nonempty, we+    -- create a Bin node, otherwise exactly one of them is nonempty+    -- and we construct the Word64Map from that half.+    buildTree g !prefix !bmask bits = case bits of+      0 -> Tip prefix (g prefix)+      _ -> case intFromNat ((natFromInt bits) `shiftRL` 1) of+        bits2+          | bmask .&. ((1 `shiftLL` fromIntegral bits2) - 1) == 0 ->+              buildTree g (prefix + bits2) (bmask `shiftRL` fromIntegral bits2) bits2+          | (bmask `shiftRL` fromIntegral bits2) .&. ((1 `shiftLL` fromIntegral bits2) - 1) == 0 ->+              buildTree g prefix bmask bits2+          | otherwise ->+              Bin prefix bits2+                (buildTree g prefix bmask bits2)+                (buildTree g (prefix + bits2) (bmask `shiftRL` fromIntegral bits2) bits2)++{--------------------------------------------------------------------+  Lists+--------------------------------------------------------------------}++#ifdef __GLASGOW_HASKELL__+-- | @since 0.5.6.2+instance GHCExts.IsList (Word64Map a) where+  type Item (Word64Map a) = (Key,a)+  fromList = fromList+  toList   = toList+#endif++-- | \(O(n)\). Convert the map to a list of key\/value pairs. Subject to list+-- fusion.+--+-- > toList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]+-- > toList empty == []++toList :: Word64Map a -> [(Key,a)]+toList = toAscList++-- | \(O(n)\). Convert the map to a list of key\/value pairs where the+-- keys are in ascending order. Subject to list fusion.+--+-- > toAscList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]++toAscList :: Word64Map a -> [(Key,a)]+toAscList = foldrWithKey (\k x xs -> (k,x):xs) []++-- | \(O(n)\). Convert the map to a list of key\/value pairs where the keys+-- are in descending order. Subject to list fusion.+--+-- > toDescList (fromList [(5,"a"), (3,"b")]) == [(5,"a"), (3,"b")]++toDescList :: Word64Map a -> [(Key,a)]+toDescList = foldlWithKey (\xs k x -> (k,x):xs) []++-- List fusion for the list generating functions.+#if __GLASGOW_HASKELL__+-- The foldrFB and foldlFB are fold{r,l}WithKey equivalents, used for list fusion.+-- They are important to convert unfused methods back, see mapFB in prelude.+foldrFB :: (Key -> a -> b -> b) -> b -> Word64Map a -> b+foldrFB = foldrWithKey+{-# INLINE[0] foldrFB #-}+foldlFB :: (a -> Key -> b -> a) -> a -> Word64Map b -> a+foldlFB = foldlWithKey+{-# INLINE[0] foldlFB #-}++-- Inline assocs and toList, so that we need to fuse only toAscList.+{-# INLINE assocs #-}+{-# INLINE toList #-}++-- The fusion is enabled up to phase 2 included. If it does not succeed,+-- convert in phase 1 the expanded elems,keys,to{Asc,Desc}List calls back to+-- elems,keys,to{Asc,Desc}List.  In phase 0, we inline fold{lr}FB (which were+-- used in a list fusion, otherwise it would go away in phase 1), and let compiler+-- do whatever it wants with elems,keys,to{Asc,Desc}List -- it was forbidden to+-- inline it before phase 0, otherwise the fusion rules would not fire at all.+{-# NOINLINE[0] elems #-}+{-# NOINLINE[0] keys #-}+{-# NOINLINE[0] toAscList #-}+{-# NOINLINE[0] toDescList #-}+{-# RULES "Word64Map.elems" [~1] forall m . elems m = build (\c n -> foldrFB (\_ x xs -> c x xs) n m) #-}+{-# RULES "Word64Map.elemsBack" [1] foldrFB (\_ x xs -> x : xs) [] = elems #-}+{-# RULES "Word64Map.keys" [~1] forall m . keys m = build (\c n -> foldrFB (\k _ xs -> c k xs) n m) #-}+{-# RULES "Word64Map.keysBack" [1] foldrFB (\k _ xs -> k : xs) [] = keys #-}+{-# RULES "Word64Map.toAscList" [~1] forall m . toAscList m = build (\c n -> foldrFB (\k x xs -> c (k,x) xs) n m) #-}+{-# RULES "Word64Map.toAscListBack" [1] foldrFB (\k x xs -> (k, x) : xs) [] = toAscList #-}+{-# RULES "Word64Map.toDescList" [~1] forall m . toDescList m = build (\c n -> foldlFB (\xs k x -> c (k,x) xs) n m) #-}+{-# RULES "Word64Map.toDescListBack" [1] foldlFB (\xs k x -> (k, x) : xs) [] = toDescList #-}+#endif+++-- | \(O(n \min(n,W))\). Create a map from a list of key\/value pairs.+--+-- > fromList [] == empty+-- > fromList [(5,"a"), (3,"b"), (5, "c")] == fromList [(5,"c"), (3,"b")]+-- > fromList [(5,"c"), (3,"b"), (5, "a")] == fromList [(5,"a"), (3,"b")]++fromList :: [(Key,a)] -> Word64Map a+fromList xs+  = Foldable.foldl' ins empty xs+  where+    ins t (k,x)  = insert k x t++-- | \(O(n \min(n,W))\). Create a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'.+--+-- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"c")] == fromList [(3, "ab"), (5, "cba")]+-- > fromListWith (++) [] == empty++fromListWith :: (a -> a -> a) -> [(Key,a)] -> Word64Map a+fromListWith f xs+  = fromListWithKey (\_ x y -> f x y) xs++-- | \(O(n \min(n,W))\). Build a map from a list of key\/value pairs with a combining function. See also fromAscListWithKey'.+--+-- > let f key new_value old_value = show key ++ ":" ++ new_value ++ "|" ++ old_value+-- > fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"c")] == fromList [(3, "3:a|b"), (5, "5:c|5:b|a")]+-- > fromListWithKey f [] == empty++fromListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> Word64Map a+fromListWithKey f xs+  = Foldable.foldl' ins empty xs+  where+    ins t (k,x) = insertWithKey f k x t++-- | \(O(n)\). Build a map from a list of key\/value pairs where+-- the keys are in ascending order.+--+-- > fromAscList [(3,"b"), (5,"a")]          == fromList [(3, "b"), (5, "a")]+-- > fromAscList [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "b")]++fromAscList :: [(Key,a)] -> Word64Map a+fromAscList = fromMonoListWithKey Nondistinct (\_ x _ -> x)+{-# NOINLINE fromAscList #-}++-- | \(O(n)\). Build a map from a list of key\/value pairs where+-- the keys are in ascending order, with a combining function on equal keys.+-- /The precondition (input list is ascending) is not checked./+--+-- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")]++fromAscListWith :: (a -> a -> a) -> [(Key,a)] -> Word64Map a+fromAscListWith f = fromMonoListWithKey Nondistinct (\_ x y -> f x y)+{-# NOINLINE fromAscListWith #-}++-- | \(O(n)\). Build a map from a list of key\/value pairs where+-- the keys are in ascending order, with a combining function on equal keys.+-- /The precondition (input list is ascending) is not checked./+--+-- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value+-- > fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "5:b|a")]++fromAscListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> Word64Map a+fromAscListWithKey f = fromMonoListWithKey Nondistinct f+{-# NOINLINE fromAscListWithKey #-}++-- | \(O(n)\). Build a map from a list of key\/value pairs where+-- the keys are in ascending order and all distinct.+-- /The precondition (input list is strictly ascending) is not checked./+--+-- > fromDistinctAscList [(3,"b"), (5,"a")] == fromList [(3, "b"), (5, "a")]++fromDistinctAscList :: [(Key,a)] -> Word64Map a+fromDistinctAscList = fromMonoListWithKey Distinct (\_ x _ -> x)+{-# NOINLINE fromDistinctAscList #-}++-- | \(O(n)\). Build a map from a list of key\/value pairs with monotonic keys+-- and a combining function.+--+-- The precise conditions under which this function works are subtle:+-- For any branch mask, keys with the same prefix w.r.t. the branch+-- mask must occur consecutively in the list.++fromMonoListWithKey :: Distinct -> (Key -> a -> a -> a) -> [(Key,a)] -> Word64Map a+fromMonoListWithKey distinct f = go+  where+    go []              = Nil+    go ((kx,vx) : zs1) = addAll' kx vx zs1++    -- `addAll'` collects all keys equal to `kx` into a single value,+    -- and then proceeds with `addAll`.+    addAll' !kx vx []+        = Tip kx vx+    addAll' !kx vx ((ky,vy) : zs)+        | Nondistinct <- distinct, kx == ky+        = let v = f kx vy vx in addAll' ky v zs+        -- inlined: | otherwise = addAll kx (Tip kx vx) (ky : zs)+        | m <- branchMask kx ky+        , Inserted ty zs' <- addMany' m ky vy zs+        = addAll kx (linkWithMask m ky ty {-kx-} (Tip kx vx)) zs'++    -- for `addAll` and `addMany`, kx is /a/ key inside the tree `tx`+    -- `addAll` consumes the rest of the list, adding to the tree `tx`+    addAll !_kx !tx []+        = tx+    addAll !kx !tx ((ky,vy) : zs)+        | m <- branchMask kx ky+        , Inserted ty zs' <- addMany' m ky vy zs+        = addAll kx (linkWithMask m ky ty {-kx-} tx) zs'++    -- `addMany'` is similar to `addAll'`, but proceeds with `addMany'`.+    addMany' !_m !kx vx []+        = Inserted (Tip kx vx) []+    addMany' !m !kx vx zs0@((ky,vy) : zs)+        | Nondistinct <- distinct, kx == ky+        = let v = f kx vy vx in addMany' m ky v zs+        -- inlined: | otherwise = addMany m kx (Tip kx vx) (ky : zs)+        | mask kx m /= mask ky m+        = Inserted (Tip kx vx) zs0+        | mxy <- branchMask kx ky+        , Inserted ty zs' <- addMany' mxy ky vy zs+        = addMany m kx (linkWithMask mxy ky ty {-kx-} (Tip kx vx)) zs'++    -- `addAll` adds to `tx` all keys whose prefix w.r.t. `m` agrees with `kx`.+    addMany !_m !_kx tx []+        = Inserted tx []+    addMany !m !kx tx zs0@((ky,vy) : zs)+        | mask kx m /= mask ky m+        = Inserted tx zs0+        | mxy <- branchMask kx ky+        , Inserted ty zs' <- addMany' mxy ky vy zs+        = addMany m kx (linkWithMask mxy ky ty {-kx-} tx) zs'+{-# INLINE fromMonoListWithKey #-}++data Inserted a = Inserted !(Word64Map a) ![(Key,a)]++data Distinct = Distinct | Nondistinct++{--------------------------------------------------------------------+  Eq+--------------------------------------------------------------------}+instance Eq a => Eq (Word64Map a) where+  t1 == t2  = equal t1 t2+  t1 /= t2  = nequal t1 t2++equal :: Eq a => Word64Map a -> Word64Map a -> Bool+equal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)+  = (m1 == m2) && (p1 == p2) && (equal l1 l2) && (equal r1 r2)+equal (Tip kx x) (Tip ky y)+  = (kx == ky) && (x==y)+equal Nil Nil = True+equal _   _   = False++nequal :: Eq a => Word64Map a -> Word64Map a -> Bool+nequal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)+  = (m1 /= m2) || (p1 /= p2) || (nequal l1 l2) || (nequal r1 r2)+nequal (Tip kx x) (Tip ky y)+  = (kx /= ky) || (x/=y)+nequal Nil Nil = False+nequal _   _   = True++-- | @since 0.5.9+instance Eq1 Word64Map where+  liftEq eq (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)+    = (m1 == m2) && (p1 == p2) && (liftEq eq l1 l2) && (liftEq eq r1 r2)+  liftEq eq (Tip kx x) (Tip ky y)+    = (kx == ky) && (eq x y)+  liftEq _eq Nil Nil = True+  liftEq _eq _   _   = False++{--------------------------------------------------------------------+  Ord+--------------------------------------------------------------------}++instance Ord a => Ord (Word64Map a) where+    compare m1 m2 = compare (toList m1) (toList m2)++-- | @since 0.5.9+instance Ord1 Word64Map where+  liftCompare cmp m n =+    liftCompare (liftCompare cmp) (toList m) (toList n)++{--------------------------------------------------------------------+  Functor+--------------------------------------------------------------------}++instance Functor Word64Map where+    fmap = map++#ifdef __GLASGOW_HASKELL__+    a <$ Bin p m l r = Bin p m (a <$ l) (a <$ r)+    a <$ Tip k _     = Tip k a+    _ <$ Nil         = Nil+#endif++{--------------------------------------------------------------------+  Show+--------------------------------------------------------------------}++instance Show a => Show (Word64Map a) where+  showsPrec d m   = showParen (d > 10) $+    showString "fromList " . shows (toList m)++-- | @since 0.5.9+instance Show1 Word64Map where+    liftShowsPrec sp sl d m =+        showsUnaryWith (liftShowsPrec sp' sl') "fromList" d (toList m)+      where+        sp' = liftShowsPrec sp sl+        sl' = liftShowList sp sl++{--------------------------------------------------------------------+  Read+--------------------------------------------------------------------}+instance (Read e) => Read (Word64Map e) where+#ifdef __GLASGOW_HASKELL__+  readPrec = parens $ prec 10 $ do+    Ident "fromList" <- lexP+    xs <- readPrec+    return (fromList xs)++  readListPrec = readListPrecDefault+#else+  readsPrec p = readParen (p > 10) $ \ r -> do+    ("fromList",s) <- lex r+    (xs,t) <- reads s+    return (fromList xs,t)+#endif++-- | @since 0.5.9+instance Read1 Word64Map where+    liftReadsPrec rp rl = readsData $+        readsUnaryWith (liftReadsPrec rp' rl') "fromList" fromList+      where+        rp' = liftReadsPrec rp rl+        rl' = liftReadList rp rl++{--------------------------------------------------------------------+  Helpers+--------------------------------------------------------------------}+{--------------------------------------------------------------------+  Link+--------------------------------------------------------------------}+link :: Prefix -> Word64Map a -> Prefix -> Word64Map a -> Word64Map a+link p1 t1 p2 t2 = linkWithMask (branchMask p1 p2) p1 t1 {-p2-} t2+{-# INLINE link #-}++-- `linkWithMask` is useful when the `branchMask` has already been computed+linkWithMask :: Mask -> Prefix -> Word64Map a -> Word64Map a -> Word64Map a+linkWithMask m p1 t1 {-p2-} t2+  | zero p1 m = Bin p m t1 t2+  | otherwise = Bin p m t2 t1+  where+    p = mask p1 m+{-# INLINE linkWithMask #-}++{--------------------------------------------------------------------+  @bin@ assures that we never have empty trees within a tree.+--------------------------------------------------------------------}+bin :: Prefix -> Mask -> Word64Map a -> Word64Map a -> Word64Map a+bin _ _ l Nil = l+bin _ _ Nil r = r+bin p m l r   = Bin p m l r+{-# INLINE bin #-}++-- binCheckLeft only checks that the left subtree is non-empty+binCheckLeft :: Prefix -> Mask -> Word64Map a -> Word64Map a -> Word64Map a+binCheckLeft _ _ Nil r = r+binCheckLeft p m l r   = Bin p m l r+{-# INLINE binCheckLeft #-}++-- binCheckRight only checks that the right subtree is non-empty+binCheckRight :: Prefix -> Mask -> Word64Map a -> Word64Map a -> Word64Map a+binCheckRight _ _ l Nil = l+binCheckRight p m l r   = Bin p m l r+{-# INLINE binCheckRight #-}++{--------------------------------------------------------------------+  Endian independent bit twiddling+--------------------------------------------------------------------}++-- | Should this key follow the left subtree of a 'Bin' with switching+-- bit @m@? N.B., the answer is only valid when @match i p m@ is true.+zero :: Key -> Mask -> Bool+zero i m+  = (natFromInt i) .&. (natFromInt m) == 0+{-# INLINE zero #-}++nomatch,match :: Key -> Prefix -> Mask -> Bool++-- | Does the key @i@ differ from the prefix @p@ before getting to+-- the switching bit @m@?+nomatch i p m+  = (mask i m) /= p+{-# INLINE nomatch #-}++-- | Does the key @i@ match the prefix @p@ (up to but not including+-- bit @m@)?+match i p m+  = (mask i m) == p+{-# INLINE match #-}+++-- | The prefix of key @i@ up to (but not including) the switching+-- bit @m@.+mask :: Key -> Mask -> Prefix+mask i m+  = maskW (natFromInt i) (natFromInt m)+{-# INLINE mask #-}+++{--------------------------------------------------------------------+  Big endian operations+--------------------------------------------------------------------}++-- | The prefix of key @i@ up to (but not including) the switching+-- bit @m@.+maskW :: Nat -> Nat -> Prefix+maskW i m+  = intFromNat (i .&. ((-m) `xor` m))+{-# INLINE maskW #-}++-- | Does the left switching bit specify a shorter prefix?+shorter :: Mask -> Mask -> Bool+shorter m1 m2+  = (natFromInt m1) > (natFromInt m2)+{-# INLINE shorter #-}++-- | The first switching bit where the two prefixes disagree.+branchMask :: Prefix -> Prefix -> Mask+branchMask p1 p2+  = intFromNat (highestBitMask (natFromInt p1 `xor` natFromInt p2))+{-# INLINE branchMask #-}++{--------------------------------------------------------------------+  Utilities+--------------------------------------------------------------------}++-- | \(O(1)\).  Decompose a map into pieces based on the structure+-- of the underlying tree. This function is useful for consuming a+-- map in parallel.+--+-- No guarantee is made as to the sizes of the pieces; an internal, but+-- deterministic process determines this.  However, it is guaranteed that the+-- pieces returned will be in ascending order (all elements in the first submap+-- less than all elements in the second, and so on).+--+-- Examples:+--+-- > splitRoot (fromList (zip [1..6::Int] ['a'..])) ==+-- >   [fromList [(1,'a'),(2,'b'),(3,'c')],fromList [(4,'d'),(5,'e'),(6,'f')]]+--+-- > splitRoot empty == []+--+--  Note that the current implementation does not return more than two submaps,+--  but you should not depend on this behaviour because it can change in the+--  future without notice.+splitRoot :: Word64Map a -> [Word64Map a]+splitRoot orig =+  case orig of+    Nil -> []+    x@(Tip _ _) -> [x]+    Bin _ m l r | m < 0 -> [r, l]+                | otherwise -> [l, r]+{-# INLINE splitRoot #-}+++{--------------------------------------------------------------------+  Debugging+--------------------------------------------------------------------}++-- | \(O(n \min(n,W))\). Show the tree that implements the map. The tree is shown+-- in a compressed, hanging format.+showTree :: Show a => Word64Map a -> String+showTree s+  = showTreeWith True False s+++{- | \(O(n \min(n,W))\). The expression (@'showTreeWith' hang wide map@) shows+ the tree that implements the map. If @hang@ is+ 'True', a /hanging/ tree is shown otherwise a rotated tree is shown. If+ @wide@ is 'True', an extra wide version is shown.+-}+showTreeWith :: Show a => Bool -> Bool -> Word64Map a -> String+showTreeWith hang wide t+  | hang      = (showsTreeHang wide [] t) ""+  | otherwise = (showsTree wide [] [] t) ""++showsTree :: Show a => Bool -> [String] -> [String] -> Word64Map a -> ShowS+showsTree wide lbars rbars t = case t of+  Bin p m l r ->+    showsTree wide (withBar rbars) (withEmpty rbars) r .+    showWide wide rbars .+    showsBars lbars . showString (showBin p m) . showString "\n" .+    showWide wide lbars .+    showsTree wide (withEmpty lbars) (withBar lbars) l+  Tip k x ->+    showsBars lbars .+    showString " " . shows k . showString ":=" . shows x . showString "\n"+  Nil -> showsBars lbars . showString "|\n"++showsTreeHang :: Show a => Bool -> [String] -> Word64Map a -> ShowS+showsTreeHang wide bars t = case t of+  Bin p m l r ->+    showsBars bars . showString (showBin p m) . showString "\n" .+    showWide wide bars .+    showsTreeHang wide (withBar bars) l .+    showWide wide bars .+    showsTreeHang wide (withEmpty bars) r+  Tip k x ->+    showsBars bars .+    showString " " . shows k . showString ":=" . shows x . showString "\n"+  Nil -> showsBars bars . showString "|\n"++showBin :: Prefix -> Mask -> String+showBin _ _+  = "*" -- ++ show (p,m)++showWide :: Bool -> [String] -> String -> String+showWide wide bars+  | wide      = showString (concat (reverse bars)) . showString "|\n"+  | otherwise = id++showsBars :: [String] -> ShowS+showsBars bars+  = case bars of+      [] -> id+      _ : tl -> showString (concat (reverse tl)) . showString node++node :: String+node = "+--"++withBar, withEmpty :: [String] -> [String]+withBar bars   = "|  ":bars+withEmpty bars = "   ":bars

@@ -0,0 +1,237 @@+{-# LANGUAGE CPP #-}+#if !defined(TESTING) && defined(__GLASGOW_HASKELL__)+{-# LANGUAGE Safe #-}+#endif++#include "containers.h"++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Word64Map.Lazy+-- Copyright   :  (c) Daan Leijen 2002+--                (c) Andriy Palamarchuk 2008+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Portability :  portable+--+--+-- = Finite Word64 Maps (lazy interface)+--+-- The @'Word64Map' v@ type represents a finite map (sometimes called a dictionary)+-- from keys of type @Word64@ to values of type @v@.+--+-- The functions in "Data.Word64Map.Strict" are careful to force values before+-- installing them in an 'Word64Map'. This is usually more efficient in cases where+-- laziness is not essential. The functions in this module do not do so.+--+-- For a walkthrough of the most commonly used functions see the+-- <https://haskell-containers.readthedocs.io/en/latest/map.html maps introduction>.+--+-- This module is intended to be imported qualified, to avoid name clashes with+-- Prelude functions:+--+-- > import Data.Word64Map.Lazy (Word64Map)+-- > import qualified Data.Word64Map.Lazy as Word64Map+--+-- Note that the implementation is generally /left-biased/. Functions that take+-- two maps as arguments and combine them, such as `union` and `intersection`,+-- prefer the values in the first argument to those in the second.+--+--+-- == Detailed performance information+--+-- The amortized running time is given for each operation, with \(n\) referring to+-- the number of entries in the map and \(W\) referring to the number of bits in+-- an 'Word64' (64).+--+-- Benchmarks comparing "Data.Word64Map.Lazy" with other dictionary+-- implementations can be found at https://github.com/haskell-perf/dictionaries.+--+--+-- == Implementation+--+-- The implementation is based on /big-endian patricia trees/.  This data+-- structure performs especially well on binary operations like 'union' and+-- 'intersection'. Additionally, benchmarks show that it is also (much) faster+-- on insertions and deletions when compared to a generic size-balanced map+-- implementation (see "Data.Map").+--+--    * Chris Okasaki and Andy Gill,  \"/Fast Mergeable Integer Maps/\",+--      Workshop on ML, September 1998, pages 77-86,+--      <http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.37.5452>+--+--    * D.R. Morrison, \"/PATRICIA -- Practical Algorithm To Retrieve Information Coded In Alphanumeric/\",+--      Journal of the ACM, 15(4), October 1968, pages 514-534.+--+-----------------------------------------------------------------------------++module GHC.Data.Word64Map.Lazy (+    -- * Map type+#if !defined(TESTING)+    Word64Map, Key          -- instance Eq,Show+#else+    Word64Map(..), Key          -- instance Eq,Show+#endif++    -- * Construction+    , empty+    , singleton+    , fromSet++    -- ** From Unordered Lists+    , fromList+    , fromListWith+    , fromListWithKey++    -- ** From Ascending Lists+    , fromAscList+    , fromAscListWith+    , fromAscListWithKey+    , fromDistinctAscList++    -- * Insertion+    , insert+    , insertWith+    , insertWithKey+    , insertLookupWithKey++    -- * Deletion\/Update+    , delete+    , adjust+    , adjustWithKey+    , update+    , updateWithKey+    , updateLookupWithKey+    , alter+    , alterF++    -- * Query+    -- ** Lookup+    , WM.lookup+    , (!?)+    , (!)+    , findWithDefault+    , member+    , notMember+    , lookupLT+    , lookupGT+    , lookupLE+    , lookupGE++    -- ** Size+    , WM.null+    , size++    -- * Combine++    -- ** Union+    , union+    , unionWith+    , unionWithKey+    , unions+    , unionsWith++    -- ** Difference+    , difference+    , (\\)+    , differenceWith+    , differenceWithKey++    -- ** Intersection+    , intersection+    , intersectionWith+    , intersectionWithKey++    -- ** Disjoint+    , disjoint++    -- ** Compose+    , compose++    -- ** Universal combining function+    , mergeWithKey++    -- * Traversal+    -- ** Map+    , WM.map+    , mapWithKey+    , traverseWithKey+    , traverseMaybeWithKey+    , mapAccum+    , mapAccumWithKey+    , mapAccumRWithKey+    , mapKeys+    , mapKeysWith+    , mapKeysMonotonic++    -- * Folds+    , WM.foldr+    , WM.foldl+    , foldrWithKey+    , foldlWithKey+    , foldMapWithKey++    -- ** Strict folds+    , foldr'+    , foldl'+    , foldrWithKey'+    , foldlWithKey'++    -- * Conversion+    , elems+    , keys+    , assocs+    , keysSet++    -- ** Lists+    , toList++    -- ** Ordered lists+    , toAscList+    , toDescList++    -- * Filter+    , WM.filter+    , filterWithKey+    , restrictKeys+    , withoutKeys+    , partition+    , partitionWithKey++    , takeWhileAntitone+    , dropWhileAntitone+    , spanAntitone++    , mapMaybe+    , mapMaybeWithKey+    , mapEither+    , mapEitherWithKey++    , split+    , splitLookup+    , splitRoot++    -- * Submap+    , isSubmapOf, isSubmapOfBy+    , isProperSubmapOf, isProperSubmapOfBy++    -- * Min\/Max+    , lookupMin+    , lookupMax+    , findMin+    , findMax+    , deleteMin+    , deleteMax+    , deleteFindMin+    , deleteFindMax+    , updateMin+    , updateMax+    , updateMinWithKey+    , updateMaxWithKey+    , minView+    , maxView+    , minViewWithKey+    , maxViewWithKey+    ) where++import GHC.Data.Word64Map.Internal as WM

@@ -0,0 +1,257 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns #-}+#if !defined(TESTING) && defined(__GLASGOW_HASKELL__)+{-# LANGUAGE Trustworthy #-}+#endif++#include "containers.h"++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Word64Map.Strict+-- Copyright   :  (c) Daan Leijen 2002+--                (c) Andriy Palamarchuk 2008+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Portability :  portable+--+--+-- = Finite Word64 Maps (strict interface)+--+-- The @'Word64Map' v@ type represents a finite map (sometimes called a dictionary)+-- from key of type @Word64@ to values of type @v@.+--+-- Each function in this module is careful to force values before installing+-- them in an 'Word64Map'. This is usually more efficient when laziness is not+-- necessary. When laziness /is/ required, use the functions in+-- "Data.Word64Map.Lazy".+--+-- In particular, the functions in this module obey the following law:+--+--  - If all values stored in all maps in the arguments are in WHNF, then all+--    values stored in all maps in the results will be in WHNF once those maps+--    are evaluated.+--+-- For a walkthrough of the most commonly used functions see the+-- <https://haskell-containers.readthedocs.io/en/latest/map.html maps introduction>.+--+-- This module is intended to be imported qualified, to avoid name clashes with+-- Prelude functions:+--+-- > import Data.Word64Map.Strict (Word64Map)+-- > import qualified Data.Word64Map.Strict as Word64Map+--+-- Note that the implementation is generally /left-biased/. Functions that take+-- two maps as arguments and combine them, such as `union` and `intersection`,+-- prefer the values in the first argument to those in the second.+--+--+-- == Detailed performance information+--+-- The amortized running time is given for each operation, with \(n\) referring to+-- the number of entries in the map and \(W\) referring to the number of bits in+-- an 'Word64' (64).+--+-- Benchmarks comparing "Data.Word64Map.Strict" with other dictionary+-- implementations can be found at https://github.com/haskell-perf/dictionaries.+--+--+-- == Warning+--+-- The 'Word64Map' type is shared between the lazy and strict modules, meaning that+-- the same 'Word64Map' value can be passed to functions in both modules. This+-- means that the 'Functor', 'Traversable' and 'Data.Data.Data' instances are+-- the same as for the "Data.Word64Map.Lazy" module, so if they are used the+-- resulting map may contain suspended values (thunks).+--+--+-- == Implementation+--+-- The implementation is based on /big-endian patricia trees/.  This data+-- structure performs especially well on binary operations like 'union' and+-- 'intersection'. Additionally, benchmarks show that it is also (much) faster+-- on insertions and deletions when compared to a generic size-balanced map+-- implementation (see "Data.Map").+--+--    * Chris Okasaki and Andy Gill,  \"/Fast Mergeable Integer Maps/\",+--      Workshop on ML, September 1998, pages 77-86,+--      <http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.37.5452>+--+--    * D.R. Morrison, \"/PATRICIA -- Practical Algorithm To Retrieve Information Coded In Alphanumeric/\",+--      Journal of the ACM, 15(4), October 1968, pages 514-534.+--+-----------------------------------------------------------------------------++-- See the notes at the beginning of Data.Word64Map.Internal.++module GHC.Data.Word64Map.Strict (+    -- * Map type+#if !defined(TESTING)+    Word64Map, Key          -- instance Eq,Show+#else+    Word64Map(..), Key          -- instance Eq,Show+#endif++    -- * Construction+    , empty+    , singleton+    , fromSet++    -- ** From Unordered Lists+    , fromList+    , fromListWith+    , fromListWithKey++    -- ** From Ascending Lists+    , fromAscList+    , fromAscListWith+    , fromAscListWithKey+    , fromDistinctAscList++    -- * Insertion+    , insert+    , insertWith+    , insertWithKey+    , insertLookupWithKey++    -- * Deletion\/Update+    , delete+    , adjust+    , adjustWithKey+    , update+    , updateWithKey+    , updateLookupWithKey+    , alter+    , alterF++    -- * Query+    -- ** Lookup+    , lookup+    , (!?)+    , (!)+    , findWithDefault+    , member+    , notMember+    , lookupLT+    , lookupGT+    , lookupLE+    , lookupGE++    -- ** Size+    , null+    , size++    -- * Combine++    -- ** Union+    , union+    , unionWith+    , unionWithKey+    , unions+    , unionsWith++    -- ** Difference+    , difference+    , (\\)+    , differenceWith+    , differenceWithKey++    -- ** Intersection+    , intersection+    , intersectionWith+    , intersectionWithKey++    -- ** Disjoint+    , disjoint++    -- ** Compose+    , compose++    -- ** Universal combining function+    , mergeWithKey++    -- * Traversal+    -- ** Map+    , map+    , mapWithKey+    , traverseWithKey+    , traverseMaybeWithKey+    , mapAccum+    , mapAccumWithKey+    , mapAccumRWithKey+    , mapKeys+    , mapKeysWith+    , mapKeysMonotonic++    -- * Folds+    , foldr+    , foldl+    , foldrWithKey+    , foldlWithKey+    , foldMapWithKey++    -- ** Strict folds+    , foldr'+    , foldl'+    , foldrWithKey'+    , foldlWithKey'++    -- * Conversion+    , elems+    , keys+    , assocs+    , keysSet++    -- ** Lists+    , toList++-- ** Ordered lists+    , toAscList+    , toDescList++    -- * Filter+    , filter+    , filterWithKey+    , restrictKeys+    , withoutKeys+    , partition+    , partitionWithKey++    , takeWhileAntitone+    , dropWhileAntitone+    , spanAntitone++    , mapMaybe+    , mapMaybeWithKey+    , mapEither+    , mapEitherWithKey++    , split+    , splitLookup+    , splitRoot++    -- * Submap+    , isSubmapOf, isSubmapOfBy+    , isProperSubmapOf, isProperSubmapOfBy++    -- * Min\/Max+    , lookupMin+    , lookupMax+    , findMin+    , findMax+    , deleteMin+    , deleteMax+    , deleteFindMin+    , deleteFindMax+    , updateMin+    , updateMax+    , updateMinWithKey+    , updateMaxWithKey+    , minView+    , maxView+    , minViewWithKey+    , maxViewWithKey+    ) where++import GHC.Data.Word64Map.Strict.Internal+import Prelude ()

@@ -0,0 +1,1208 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE PatternGuards #-}++{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}++#include "containers.h"++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Word64Map.Strict.Internal+-- Copyright   :  (c) Daan Leijen 2002+--                (c) Andriy Palamarchuk 2008+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Portability :  portable+--+--+-- = Finite Int Maps (strict interface)+--+-- The @'Word64Map' v@ type represents a finite map (sometimes called a dictionary)+-- from key of type @Int@ to values of type @v@.+--+-- Each function in this module is careful to force values before installing+-- them in an 'Word64Map'. This is usually more efficient when laziness is not+-- necessary. When laziness /is/ required, use the functions in+-- "Data.Word64Map.Lazy".+--+-- In particular, the functions in this module obey the following law:+--+--  - If all values stored in all maps in the arguments are in WHNF, then all+--    values stored in all maps in the results will be in WHNF once those maps+--    are evaluated.+--+-- For a walkthrough of the most commonly used functions see the+-- <https://haskell-containers.readthedocs.io/en/latest/map.html maps introduction>.+--+-- This module is intended to be imported qualified, to avoid name clashes with+-- Prelude functions:+--+-- > import Data.Word64Map.Strict (Word64Map)+-- > import qualified Data.Word64Map.Strict as Word64Map+--+-- Note that the implementation is generally /left-biased/. Functions that take+-- two maps as arguments and combine them, such as `union` and `intersection`,+-- prefer the values in the first argument to those in the second.+--+--+-- == Detailed performance information+--+-- The amortized running time is given for each operation, with \(n\) referring to+-- the number of entries in the map and \(W\) referring to the number of bits in+-- an 'Int' (32 or 64).+--+-- Benchmarks comparing "Data.Word64Map.Strict" with other dictionary+-- implementations can be found at https://github.com/haskell-perf/dictionaries.+--+--+-- == Warning+--+-- The 'Word64Map' type is shared between the lazy and strict modules, meaning that+-- the same 'Word64Map' value can be passed to functions in both modules. This+-- means that the 'Functor', 'Traversable' and 'Data.Data.Data' instances are+-- the same as for the "Data.Word64Map.Lazy" module, so if they are used the+-- resulting map may contain suspended values (thunks).+--+--+-- == Implementation+--+-- The implementation is based on /big-endian patricia trees/.  This data+-- structure performs especially well on binary operations like 'union' and+-- 'intersection'. Additionally, benchmarks show that it is also (much) faster+-- on insertions and deletions when compared to a generic size-balanced map+-- implementation (see "Data.Map").+--+--    * Chris Okasaki and Andy Gill,  \"/Fast Mergeable Integer Maps/\",+--      Workshop on ML, September 1998, pages 77-86,+--      <http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.37.5452>+--+--    * D.R. Morrison, \"/PATRICIA -- Practical Algorithm To Retrieve Information Coded In Alphanumeric/\",+--      Journal of the ACM, 15(4), October 1968, pages 514-534.+--+-----------------------------------------------------------------------------++-- See the notes at the beginning of Data.Word64Map.Internal.++module GHC.Data.Word64Map.Strict.Internal (+    -- * Map type+#if !defined(TESTING)+    Word64Map, Key          -- instance Eq,Show+#else+    Word64Map(..), Key          -- instance Eq,Show+#endif++    -- * Construction+    , empty+    , singleton+    , fromSet++    -- ** From Unordered Lists+    , fromList+    , fromListWith+    , fromListWithKey++    -- ** From Ascending Lists+    , fromAscList+    , fromAscListWith+    , fromAscListWithKey+    , fromDistinctAscList++    -- * Insertion+    , insert+    , insertWith+    , insertWithKey+    , insertLookupWithKey++    -- * Deletion\/Update+    , delete+    , adjust+    , adjustWithKey+    , update+    , updateWithKey+    , updateLookupWithKey+    , alter+    , alterF++    -- * Query+    -- ** Lookup+    , lookup+    , (!?)+    , (!)+    , findWithDefault+    , member+    , notMember+    , lookupLT+    , lookupGT+    , lookupLE+    , lookupGE++    -- ** Size+    , null+    , size++    -- * Combine++    -- ** Union+    , union+    , unionWith+    , unionWithKey+    , unions+    , unionsWith++    -- ** Difference+    , difference+    , (\\)+    , differenceWith+    , differenceWithKey++    -- ** Intersection+    , intersection+    , intersectionWith+    , intersectionWithKey++    -- ** Disjoint+    , disjoint++    -- ** Compose+    , compose++    -- ** Universal combining function+    , mergeWithKey++    -- * Traversal+    -- ** Map+    , map+    , mapWithKey+    , traverseWithKey+    , traverseMaybeWithKey+    , mapAccum+    , mapAccumWithKey+    , mapAccumRWithKey+    , mapKeys+    , mapKeysWith+    , mapKeysMonotonic++    -- * Folds+    , foldr+    , foldl+    , foldrWithKey+    , foldlWithKey+    , foldMapWithKey++    -- ** Strict folds+    , foldr'+    , foldl'+    , foldrWithKey'+    , foldlWithKey'++    -- * Conversion+    , elems+    , keys+    , assocs+    , keysSet++    -- ** Lists+    , toList++-- ** Ordered lists+    , toAscList+    , toDescList++    -- * Filter+    , filter+    , filterWithKey+    , restrictKeys+    , withoutKeys+    , partition+    , partitionWithKey++    , takeWhileAntitone+    , dropWhileAntitone+    , spanAntitone++    , mapMaybe+    , mapMaybeWithKey+    , mapEither+    , mapEitherWithKey++    , split+    , splitLookup+    , splitRoot++    -- * Submap+    , isSubmapOf, isSubmapOfBy+    , isProperSubmapOf, isProperSubmapOfBy++    -- * Min\/Max+    , lookupMin+    , lookupMax+    , findMin+    , findMax+    , deleteMin+    , deleteMax+    , deleteFindMin+    , deleteFindMax+    , updateMin+    , updateMax+    , updateMinWithKey+    , updateMaxWithKey+    , minView+    , maxView+    , minViewWithKey+    , maxViewWithKey+    ) where++import GHC.Prelude.Basic hiding+  (lookup, filter, foldr, foldl, foldl', null, map)++import qualified GHC.Data.Word64Map.Internal as L+import GHC.Data.Word64Map.Internal+  ( Word64Map (..)+  , Key+  , mask+  , branchMask+  , nomatch+  , zero+  , natFromInt+  , intFromNat+  , bin+  , binCheckLeft+  , binCheckRight+  , link+  , linkWithMask++  , (\\)+  , (!)+  , (!?)+  , empty+  , assocs+  , filter+  , filterWithKey+  , findMin+  , findMax+  , foldMapWithKey+  , foldr+  , foldl+  , foldr'+  , foldl'+  , foldlWithKey+  , foldrWithKey+  , foldlWithKey'+  , foldrWithKey'+  , keysSet+  , mergeWithKey'+  , compose+  , delete+  , deleteMin+  , deleteMax+  , deleteFindMax+  , deleteFindMin+  , difference+  , elems+  , intersection+  , disjoint+  , isProperSubmapOf+  , isProperSubmapOfBy+  , isSubmapOf+  , isSubmapOfBy+  , lookup+  , lookupLE+  , lookupGE+  , lookupLT+  , lookupGT+  , lookupMin+  , lookupMax+  , minView+  , maxView+  , minViewWithKey+  , maxViewWithKey+  , keys+  , mapKeys+  , mapKeysMonotonic+  , member+  , notMember+  , null+  , partition+  , partitionWithKey+  , takeWhileAntitone+  , dropWhileAntitone+  , spanAntitone+  , restrictKeys+  , size+  , split+  , splitLookup+  , splitRoot+  , toAscList+  , toDescList+  , toList+  , union+  , unions+  , withoutKeys+  )+import qualified GHC.Data.Word64Set.Internal as Word64Set+import GHC.Utils.Containers.Internal.BitUtil+import GHC.Utils.Containers.Internal.StrictPair+import qualified Data.Foldable as Foldable++{--------------------------------------------------------------------+  Query+--------------------------------------------------------------------}++-- | \(O(\min(n,W))\). The expression @('findWithDefault' def k map)@+-- returns the value at key @k@ or returns @def@ when the key is not an+-- element of the map.+--+-- > findWithDefault 'x' 1 (fromList [(5,'a'), (3,'b')]) == 'x'+-- > findWithDefault 'x' 5 (fromList [(5,'a'), (3,'b')]) == 'a'++-- See Word64Map.Internal.Note: Local 'go' functions and capturing]+findWithDefault :: a -> Key -> Word64Map a -> a+findWithDefault def !k = go+  where+    go (Bin p m l r) | nomatch k p m = def+                     | zero k m  = go l+                     | otherwise = go r+    go (Tip kx x) | k == kx   = x+                  | otherwise = def+    go Nil = def++{--------------------------------------------------------------------+  Construction+--------------------------------------------------------------------}+-- | \(O(1)\). A map of one element.+--+-- > singleton 1 'a'        == fromList [(1, 'a')]+-- > size (singleton 1 'a') == 1++singleton :: Key -> a -> Word64Map a+singleton k !x+  = Tip k x+{-# INLINE singleton #-}++{--------------------------------------------------------------------+  Insert+--------------------------------------------------------------------}+-- | \(O(\min(n,W))\). Insert a new key\/value pair in the map.+-- If the key is already present in the map, the associated value is+-- replaced with the supplied value, i.e. 'insert' is equivalent to+-- @'insertWith' 'const'@.+--+-- > insert 5 'x' (fromList [(5,'a'), (3,'b')]) == fromList [(3, 'b'), (5, 'x')]+-- > insert 7 'x' (fromList [(5,'a'), (3,'b')]) == fromList [(3, 'b'), (5, 'a'), (7, 'x')]+-- > insert 5 'x' empty                         == singleton 5 'x'++insert :: Key -> a -> Word64Map a -> Word64Map a+insert !k !x t =+  case t of+    Bin p m l r+      | nomatch k p m -> link k (Tip k x) p t+      | zero k m      -> Bin p m (insert k x l) r+      | otherwise     -> Bin p m l (insert k x r)+    Tip ky _+      | k==ky         -> Tip k x+      | otherwise     -> link k (Tip k x) ky t+    Nil -> Tip k x++-- right-biased insertion, used by 'union'+-- | \(O(\min(n,W))\). Insert with a combining function.+-- @'insertWith' f key value mp@+-- will insert the pair (key, value) into @mp@ if key does+-- not exist in the map. If the key does exist, the function will+-- insert @f new_value old_value@.+--+-- > insertWith (++) 5 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "xxxa")]+-- > insertWith (++) 7 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "xxx")]+-- > insertWith (++) 5 "xxx" empty                         == singleton 5 "xxx"++insertWith :: (a -> a -> a) -> Key -> a -> Word64Map a -> Word64Map a+insertWith f k x t+  = insertWithKey (\_ x' y' -> f x' y') k x t++-- | \(O(\min(n,W))\). Insert with a combining function.+-- @'insertWithKey' f key value mp@+-- will insert the pair (key, value) into @mp@ if key does+-- not exist in the map. If the key does exist, the function will+-- insert @f key new_value old_value@.+--+-- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value+-- > insertWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:xxx|a")]+-- > insertWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "xxx")]+-- > insertWithKey f 5 "xxx" empty                         == singleton 5 "xxx"+--+-- If the key exists in the map, this function is lazy in @value@ but strict+-- in the result of @f@.++insertWithKey :: (Key -> a -> a -> a) -> Key -> a -> Word64Map a -> Word64Map a+insertWithKey f !k x t =+  case t of+    Bin p m l r+      | nomatch k p m -> link k (singleton k x) p t+      | zero k m      -> Bin p m (insertWithKey f k x l) r+      | otherwise     -> Bin p m l (insertWithKey f k x r)+    Tip ky y+      | k==ky         -> Tip k $! f k x y+      | otherwise     -> link k (singleton k x) ky t+    Nil -> singleton k x++-- | \(O(\min(n,W))\). The expression (@'insertLookupWithKey' f k x map@)+-- is a pair where the first element is equal to (@'lookup' k map@)+-- and the second element equal to (@'insertWithKey' f k x map@).+--+-- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value+-- > insertLookupWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "5:xxx|a")])+-- > insertLookupWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) == (Nothing,  fromList [(3, "b"), (5, "a"), (7, "xxx")])+-- > insertLookupWithKey f 5 "xxx" empty                         == (Nothing,  singleton 5 "xxx")+--+-- This is how to define @insertLookup@ using @insertLookupWithKey@:+--+-- > let insertLookup kx x t = insertLookupWithKey (\_ a _ -> a) kx x t+-- > insertLookup 5 "x" (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "x")])+-- > insertLookup 7 "x" (fromList [(5,"a"), (3,"b")]) == (Nothing,  fromList [(3, "b"), (5, "a"), (7, "x")])++insertLookupWithKey :: (Key -> a -> a -> a) -> Key -> a -> Word64Map a -> (Maybe a, Word64Map a)+insertLookupWithKey f0 !k0 x0 t0 = toPair $ go f0 k0 x0 t0+  where+    go f k x t =+      case t of+        Bin p m l r+          | nomatch k p m -> Nothing :*: link k (singleton k x) p t+          | zero k m      -> let (found :*: l') = go f k x l in (found :*: Bin p m l' r)+          | otherwise     -> let (found :*: r') = go f k x r in (found :*: Bin p m l r')+        Tip ky y+          | k==ky         -> (Just y :*: (Tip k $! f k x y))+          | otherwise     -> (Nothing :*: link k (singleton k x) ky t)+        Nil -> Nothing :*: (singleton k x)+++{--------------------------------------------------------------------+  Deletion+--------------------------------------------------------------------}+-- | \(O(\min(n,W))\). Adjust a value at a specific key. When the key is not+-- a member of the map, the original map is returned.+--+-- > adjust ("new " ++) 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "new a")]+-- > adjust ("new " ++) 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]+-- > adjust ("new " ++) 7 empty                         == empty++adjust ::  (a -> a) -> Key -> Word64Map a -> Word64Map a+adjust f k m+  = adjustWithKey (\_ x -> f x) k m++-- | \(O(\min(n,W))\). Adjust a value at a specific key. When the key is not+-- a member of the map, the original map is returned.+--+-- > let f key x = (show key) ++ ":new " ++ x+-- > adjustWithKey f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:new a")]+-- > adjustWithKey f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]+-- > adjustWithKey f 7 empty                         == empty++adjustWithKey ::  (Key -> a -> a) -> Key -> Word64Map a -> Word64Map a+adjustWithKey f !k t =+  case t of+    Bin p m l r+      | nomatch k p m -> t+      | zero k m      -> Bin p m (adjustWithKey f k l) r+      | otherwise     -> Bin p m l (adjustWithKey f k r)+    Tip ky y+      | k==ky         -> Tip ky $! f k y+      | otherwise     -> t+    Nil -> Nil++-- | \(O(\min(n,W))\). The expression (@'update' f k map@) updates the value @x@+-- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is+-- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@.+--+-- > let f x = if x == "a" then Just "new a" else Nothing+-- > update f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "new a")]+-- > update f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]+-- > update f 3 (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"++update ::  (a -> Maybe a) -> Key -> Word64Map a -> Word64Map a+update f+  = updateWithKey (\_ x -> f x)++-- | \(O(\min(n,W))\). The expression (@'update' f k map@) updates the value @x@+-- at @k@ (if it is in the map). If (@f k x@) is 'Nothing', the element is+-- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@.+--+-- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing+-- > updateWithKey f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:new a")]+-- > updateWithKey f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]+-- > updateWithKey f 3 (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"++updateWithKey ::  (Key -> a -> Maybe a) -> Key -> Word64Map a -> Word64Map a+updateWithKey f !k t =+  case t of+    Bin p m l r+      | nomatch k p m -> t+      | zero k m      -> binCheckLeft p m (updateWithKey f k l) r+      | otherwise     -> binCheckRight p m l (updateWithKey f k r)+    Tip ky y+      | k==ky         -> case f k y of+                           Just !y' -> Tip ky y'+                           Nothing -> Nil+      | otherwise     -> t+    Nil -> Nil++-- | \(O(\min(n,W))\). Lookup and update.+-- The function returns original value, if it is updated.+-- This is different behavior than 'Data.Map.updateLookupWithKey'.+-- Returns the original key value if the map entry is deleted.+--+-- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing+-- > updateLookupWithKey f 5 (fromList [(5,"a"), (3,"b")]) == (Just "a", fromList [(3, "b"), (5, "5:new a")])+-- > updateLookupWithKey f 7 (fromList [(5,"a"), (3,"b")]) == (Nothing,  fromList [(3, "b"), (5, "a")])+-- > updateLookupWithKey f 3 (fromList [(5,"a"), (3,"b")]) == (Just "b", singleton 5 "a")++updateLookupWithKey ::  (Key -> a -> Maybe a) -> Key -> Word64Map a -> (Maybe a,Word64Map a)+updateLookupWithKey f0 !k0 t0 = toPair $ go f0 k0 t0+  where+    go f k t =+      case t of+        Bin p m l r+          | nomatch k p m -> (Nothing :*: t)+          | zero k m      -> let (found :*: l') = go f k l in (found :*: binCheckLeft p m l' r)+          | otherwise     -> let (found :*: r') = go f k r in (found :*: binCheckRight p m l r')+        Tip ky y+          | k==ky         -> case f k y of+                               Just !y' -> (Just y :*: Tip ky y')+                               Nothing  -> (Just y :*: Nil)+          | otherwise     -> (Nothing :*: t)+        Nil -> (Nothing :*: Nil)++++-- | \(O(\min(n,W))\). The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof.+-- 'alter' can be used to insert, delete, or update a value in an 'Word64Map'.+-- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@.+alter :: (Maybe a -> Maybe a) -> Key -> Word64Map a -> Word64Map a+alter f !k t =+  case t of+    Bin p m l r+      | nomatch k p m -> case f Nothing of+                           Nothing -> t+                           Just !x  -> link k (Tip k x) p t+      | zero k m      -> binCheckLeft p m (alter f k l) r+      | otherwise     -> binCheckRight p m l (alter f k r)+    Tip ky y+      | k==ky         -> case f (Just y) of+                           Just !x -> Tip ky x+                           Nothing -> Nil+      | otherwise     -> case f Nothing of+                           Just !x -> link k (Tip k x) ky t+                           Nothing -> t+    Nil               -> case f Nothing of+                           Just !x -> Tip k x+                           Nothing -> Nil++-- | \(O(\log n)\). The expression (@'alterF' f k map@) alters the value @x@ at+-- @k@, or absence thereof.  'alterF' can be used to inspect, insert, delete,+-- or update a value in an 'Word64Map'.  In short : @'lookup' k <$> 'alterF' f k m = f+-- ('lookup' k m)@.+--+-- Example:+--+-- @+-- interactiveAlter :: Int -> Word64Map String -> IO (Word64Map String)+-- interactiveAlter k m = alterF f k m where+--   f Nothing = do+--      putStrLn $ show k +++--          " was not found in the map. Would you like to add it?"+--      getUserResponse1 :: IO (Maybe String)+--   f (Just old) = do+--      putStrLn $ "The key is currently bound to " ++ show old +++--          ". Would you like to change or delete it?"+--      getUserResponse2 :: IO (Maybe String)+-- @+--+-- 'alterF' is the most general operation for working with an individual+-- key that may or may not be in a given map.++-- Note: 'alterF' is a flipped version of the 'at' combinator from+-- 'Control.Lens.At'.+--+-- @since 0.5.8++alterF :: Functor f+       => (Maybe a -> f (Maybe a)) -> Key -> Word64Map a -> f (Word64Map a)+-- This implementation was modified from 'Control.Lens.At'.+alterF f k m = (<$> f mv) $ \fres ->+  case fres of+    Nothing -> maybe m (const (delete k m)) mv+    Just !v' -> insert k v' m+  where mv = lookup k m+++{--------------------------------------------------------------------+  Union+--------------------------------------------------------------------}+-- | The union of a list of maps, with a combining operation.+--+-- > unionsWith (++) [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]+-- >     == fromList [(3, "bB3"), (5, "aAA3"), (7, "C")]++unionsWith :: Foldable f => (a->a->a) -> f (Word64Map a) -> Word64Map a+unionsWith f ts+  = Foldable.foldl' (unionWith f) empty ts++-- | \(O(n+m)\). The union with a combining function.+--+-- > unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "aA"), (7, "C")]++unionWith :: (a -> a -> a) -> Word64Map a -> Word64Map a -> Word64Map a+unionWith f m1 m2+  = unionWithKey (\_ x y -> f x y) m1 m2++-- | \(O(n+m)\). The union with a combining function.+--+-- > let f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value+-- > unionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "5:a|A"), (7, "C")]++unionWithKey :: (Key -> a -> a -> a) -> Word64Map a -> Word64Map a -> Word64Map a+unionWithKey f m1 m2+  = mergeWithKey' Bin (\(Tip k1 x1) (Tip _k2 x2) -> Tip k1 $! f k1 x1 x2) id id m1 m2++{--------------------------------------------------------------------+  Difference+--------------------------------------------------------------------}++-- | \(O(n+m)\). Difference with a combining function.+--+-- > let f al ar = if al == "b" then Just (al ++ ":" ++ ar) else Nothing+-- > differenceWith f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (7, "C")])+-- >     == singleton 3 "b:B"++differenceWith :: (a -> b -> Maybe a) -> Word64Map a -> Word64Map b -> Word64Map a+differenceWith f m1 m2+  = differenceWithKey (\_ x y -> f x y) m1 m2++-- | \(O(n+m)\). Difference with a combining function. When two equal keys are+-- encountered, the combining function is applied to the key and both values.+-- If it returns 'Nothing', the element is discarded (proper set difference).+-- If it returns (@'Just' y@), the element is updated with a new value @y@.+--+-- > let f k al ar = if al == "b" then Just ((show k) ++ ":" ++ al ++ "|" ++ ar) else Nothing+-- > differenceWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (10, "C")])+-- >     == singleton 3 "3:b|B"++differenceWithKey :: (Key -> a -> b -> Maybe a) -> Word64Map a -> Word64Map b -> Word64Map a+differenceWithKey f m1 m2+  = mergeWithKey f id (const Nil) m1 m2++{--------------------------------------------------------------------+  Intersection+--------------------------------------------------------------------}++-- | \(O(n+m)\). The intersection with a combining function.+--+-- > intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "aA"++intersectionWith :: (a -> b -> c) -> Word64Map a -> Word64Map b -> Word64Map c+intersectionWith f m1 m2+  = intersectionWithKey (\_ x y -> f x y) m1 m2++-- | \(O(n+m)\). The intersection with a combining function.+--+-- > let f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar+-- > intersectionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "5:a|A"++intersectionWithKey :: (Key -> a -> b -> c) -> Word64Map a -> Word64Map b -> Word64Map c+intersectionWithKey f m1 m2+  = mergeWithKey' bin (\(Tip k1 x1) (Tip _k2 x2) -> Tip k1 $! f k1 x1 x2) (const Nil) (const Nil) m1 m2++{--------------------------------------------------------------------+  MergeWithKey+--------------------------------------------------------------------}++-- | \(O(n+m)\). A high-performance universal combining function. Using+-- 'mergeWithKey', all combining functions can be defined without any loss of+-- efficiency (with exception of 'union', 'difference' and 'intersection',+-- where sharing of some nodes is lost with 'mergeWithKey').+--+-- Please make sure you know what is going on when using 'mergeWithKey',+-- otherwise you can be surprised by unexpected code growth or even+-- corruption of the data structure.+--+-- When 'mergeWithKey' is given three arguments, it is inlined to the call+-- site. You should therefore use 'mergeWithKey' only to define your custom+-- combining functions. For example, you could define 'unionWithKey',+-- 'differenceWithKey' and 'intersectionWithKey' as+--+-- > myUnionWithKey f m1 m2 = mergeWithKey (\k x1 x2 -> Just (f k x1 x2)) id id m1 m2+-- > myDifferenceWithKey f m1 m2 = mergeWithKey f id (const empty) m1 m2+-- > myIntersectionWithKey f m1 m2 = mergeWithKey (\k x1 x2 -> Just (f k x1 x2)) (const empty) (const empty) m1 m2+--+-- When calling @'mergeWithKey' combine only1 only2@, a function combining two+-- 'Word64Map's is created, such that+--+-- * if a key is present in both maps, it is passed with both corresponding+--   values to the @combine@ function. Depending on the result, the key is either+--   present in the result with specified value, or is left out;+--+-- * a nonempty subtree present only in the first map is passed to @only1@ and+--   the output is added to the result;+--+-- * a nonempty subtree present only in the second map is passed to @only2@ and+--   the output is added to the result.+--+-- The @only1@ and @only2@ methods /must return a map with a subset (possibly empty) of the keys of the given map/.+-- The values can be modified arbitrarily.  Most common variants of @only1@ and+-- @only2@ are 'id' and @'const' 'empty'@, but for example @'map' f@ or+-- @'filterWithKey' f@ could be used for any @f@.++mergeWithKey :: (Key -> a -> b -> Maybe c) -> (Word64Map a -> Word64Map c) -> (Word64Map b -> Word64Map c)+             -> Word64Map a -> Word64Map b -> Word64Map c+mergeWithKey f g1 g2 = mergeWithKey' bin combine g1 g2+  where -- We use the lambda form to avoid non-exhaustive pattern matches warning.+        combine = \(Tip k1 x1) (Tip _k2 x2) -> case f k1 x1 x2 of Nothing -> Nil+                                                                  Just !x -> Tip k1 x+        {-# INLINE combine #-}+{-# INLINE mergeWithKey #-}++{--------------------------------------------------------------------+  Min\/Max+--------------------------------------------------------------------}++-- | \(O(\log n)\). Update the value at the minimal key.+--+-- > updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"3:b"), (5,"a")]+-- > updateMinWithKey (\ _ _ -> Nothing)                     (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"++updateMinWithKey :: (Key -> a -> Maybe a) -> Word64Map a -> Word64Map a+updateMinWithKey f t =+  case t of Bin p m l r | m < 0 -> binCheckRight p m l (go f r)+            _ -> go f t+  where+    go f' (Bin p m l r) = binCheckLeft p m (go f' l) r+    go f' (Tip k y) = case f' k y of+                        Just !y' -> Tip k y'+                        Nothing -> Nil+    go _ Nil = error "updateMinWithKey Nil"++-- | \(O(\log n)\). Update the value at the maximal key.+--+-- > updateMaxWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"b"), (5,"5:a")]+-- > updateMaxWithKey (\ _ _ -> Nothing)                     (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"++updateMaxWithKey :: (Key -> a -> Maybe a) -> Word64Map a -> Word64Map a+updateMaxWithKey f t =+  case t of Bin p m l r | m < 0 -> binCheckLeft p m (go f l) r+            _ -> go f t+  where+    go f' (Bin p m l r) = binCheckRight p m l (go f' r)+    go f' (Tip k y) = case f' k y of+                        Just !y' -> Tip k y'+                        Nothing -> Nil+    go _ Nil = error "updateMaxWithKey Nil"++-- | \(O(\log n)\). Update the value at the maximal key.+--+-- > updateMax (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "Xa")]+-- > updateMax (\ _ -> Nothing)         (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"++updateMax :: (a -> Maybe a) -> Word64Map a -> Word64Map a+updateMax f = updateMaxWithKey (const f)++-- | \(O(\log n)\). Update the value at the minimal key.+--+-- > updateMin (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "Xb"), (5, "a")]+-- > updateMin (\ _ -> Nothing)         (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"++updateMin :: (a -> Maybe a) -> Word64Map a -> Word64Map a+updateMin f = updateMinWithKey (const f)+++{--------------------------------------------------------------------+  Mapping+--------------------------------------------------------------------}+-- | \(O(n)\). Map a function over all values in the map.+--+-- > map (++ "x") (fromList [(5,"a"), (3,"b")]) == fromList [(3, "bx"), (5, "ax")]++map :: (a -> b) -> Word64Map a -> Word64Map b+map f = go+  where+    go (Bin p m l r) = Bin p m (go l) (go r)+    go (Tip k x)     = Tip k $! f x+    go Nil           = Nil++#ifdef __GLASGOW_HASKELL__+{-# NOINLINE [1] map #-}+{-# RULES+"map/map" forall f g xs . map f (map g xs) = map (\x -> f $! g x) xs+"map/mapL" forall f g xs . map f (L.map g xs) = map (\x -> f (g x)) xs+ #-}+#endif++-- | \(O(n)\). Map a function over all values in the map.+--+-- > let f key x = (show key) ++ ":" ++ x+-- > mapWithKey f (fromList [(5,"a"), (3,"b")]) == fromList [(3, "3:b"), (5, "5:a")]++mapWithKey :: (Key -> a -> b) -> Word64Map a -> Word64Map b+mapWithKey f t+  = case t of+      Bin p m l r -> Bin p m (mapWithKey f l) (mapWithKey f r)+      Tip k x     -> Tip k $! f k x+      Nil         -> Nil++#ifdef __GLASGOW_HASKELL__+-- Pay close attention to strictness here. We need to force the+-- intermediate result for map f . map g, and we need to refrain+-- from forcing it for map f . L.map g, etc.+--+-- TODO Consider moving map and mapWithKey to Word64Map.Internal so we can write+-- non-orphan RULES for things like L.map f (map g xs). We'd need a new function+-- for this, and we'd have to pay attention to simplifier phases. Something like+--+-- lsmap :: (b -> c) -> (a -> b) -> Word64Map a -> Word64Map c+-- lsmap _ _ Nil = Nil+-- lsmap f g (Tip k x) = let !gx = g x in Tip k (f gx)+-- lsmap f g (Bin p m l r) = Bin p m (lsmap f g l) (lsmap f g r)+{-# NOINLINE [1] mapWithKey #-}+{-# RULES+"mapWithKey/mapWithKey" forall f g xs . mapWithKey f (mapWithKey g xs) =+  mapWithKey (\k a -> f k $! g k a) xs+"mapWithKey/mapWithKeyL" forall f g xs . mapWithKey f (L.mapWithKey g xs) =+  mapWithKey (\k a -> f k (g k a)) xs+"mapWithKey/map" forall f g xs . mapWithKey f (map g xs) =+  mapWithKey (\k a -> f k $! g a) xs+"mapWithKey/mapL" forall f g xs . mapWithKey f (L.map g xs) =+  mapWithKey (\k a -> f k (g a)) xs+"map/mapWithKey" forall f g xs . map f (mapWithKey g xs) =+  mapWithKey (\k a -> f $! g k a) xs+"map/mapWithKeyL" forall f g xs . map f (L.mapWithKey g xs) =+  mapWithKey (\k a -> f (g k a)) xs+ #-}+#endif++-- | \(O(n)\).+-- @'traverseWithKey' f s == 'fromList' <$> 'traverse' (\(k, v) -> (,) k <$> f k v) ('toList' m)@+-- That is, behaves exactly like a regular 'traverse' except that the traversing+-- function also has access to the key associated with a value.+--+-- > traverseWithKey (\k v -> if odd k then Just (succ v) else Nothing) (fromList [(1, 'a'), (5, 'e')]) == Just (fromList [(1, 'b'), (5, 'f')])+-- > traverseWithKey (\k v -> if odd k then Just (succ v) else Nothing) (fromList [(2, 'c')])           == Nothing+traverseWithKey :: Applicative t => (Key -> a -> t b) -> Word64Map a -> t (Word64Map b)+traverseWithKey f = go+  where+    go Nil = pure Nil+    go (Tip k v) = (\ !v' -> Tip k v') <$> f k v+    go (Bin p m l r)+      | m < 0     = liftA2 (flip (Bin p m)) (go r) (go l)+      | otherwise = liftA2 (Bin p m) (go l) (go r)+{-# INLINE traverseWithKey #-}++-- | \(O(n)\). Traverse keys\/values and collect the 'Just' results.+--+-- @since 0.6.4+traverseMaybeWithKey+  :: Applicative f => (Key -> a -> f (Maybe b)) -> Word64Map a -> f (Word64Map b)+traverseMaybeWithKey f = go+    where+    go Nil           = pure Nil+    go (Tip k x)     = maybe Nil (Tip k $!) <$> f k x+    go (Bin p m l r)+      | m < 0     = liftA2 (flip (bin p m)) (go r) (go l)+      | otherwise = liftA2 (bin p m) (go l) (go r)++-- | \(O(n)\). The function @'mapAccum'@ threads an accumulating+-- argument through the map in ascending order of keys.+--+-- > let f a b = (a ++ b, b ++ "X")+-- > mapAccum f "Everything: " (fromList [(5,"a"), (3,"b")]) == ("Everything: ba", fromList [(3, "bX"), (5, "aX")])++mapAccum :: (a -> b -> (a,c)) -> a -> Word64Map b -> (a,Word64Map c)+mapAccum f = mapAccumWithKey (\a' _ x -> f a' x)++-- | \(O(n)\). The function @'mapAccumWithKey'@ threads an accumulating+-- argument through the map in ascending order of keys.+--+-- > let f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X")+-- > mapAccumWithKey f "Everything:" (fromList [(5,"a"), (3,"b")]) == ("Everything: 3-b 5-a", fromList [(3, "bX"), (5, "aX")])++mapAccumWithKey :: (a -> Key -> b -> (a,c)) -> a -> Word64Map b -> (a,Word64Map c)+mapAccumWithKey f a t+  = mapAccumL f a t++-- | \(O(n)\). The function @'mapAccumL'@ threads an accumulating+-- argument through the map in ascending order of keys.  Strict in+-- the accumulating argument and the both elements of the+-- result of the function.+mapAccumL :: (a -> Key -> b -> (a,c)) -> a -> Word64Map b -> (a,Word64Map c)+mapAccumL f0 a0 t0 = toPair $ go f0 a0 t0+  where+    go f a t+      = case t of+          Bin p m l r+            | m < 0 ->+                let (a1 :*: r') = go f a r+                    (a2 :*: l') = go f a1 l+                in (a2 :*: Bin p m l' r')+            | otherwise ->+                let (a1 :*: l') = go f a l+                    (a2 :*: r') = go f a1 r+                in (a2 :*: Bin p m l' r')+          Tip k x     -> let !(a',!x') = f a k x in (a' :*: Tip k x')+          Nil         -> (a :*: Nil)++-- | \(O(n)\). The function @'mapAccumRWithKey'@ threads an accumulating+-- argument through the map in descending order of keys.+mapAccumRWithKey :: (a -> Key -> b -> (a,c)) -> a -> Word64Map b -> (a,Word64Map c)+mapAccumRWithKey f0 a0 t0 = toPair $ go f0 a0 t0+  where+    go f a t+      = case t of+          Bin p m l r+            | m < 0 ->+              let (a1 :*: l') = go f a l+                  (a2 :*: r') = go f a1 r+              in (a2 :*: Bin p m l' r')+            | otherwise ->+              let (a1 :*: r') = go f a r+                  (a2 :*: l') = go f a1 l+              in (a2 :*: Bin p m l' r')+          Tip k x     -> let !(a',!x') = f a k x in (a' :*: Tip k x')+          Nil         -> (a :*: Nil)++-- | \(O(n \log n)\).+-- @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@.+--+-- The size of the result may be smaller if @f@ maps two or more distinct+-- keys to the same new key.  In this case the associated values will be+-- combined using @c@.+--+-- > mapKeysWith (++) (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 1 "cdab"+-- > mapKeysWith (++) (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 3 "cdab"++mapKeysWith :: (a -> a -> a) -> (Key->Key) -> Word64Map a -> Word64Map a+mapKeysWith c f = fromListWith c . foldrWithKey (\k x xs -> (f k, x) : xs) []++{--------------------------------------------------------------------+  Filter+--------------------------------------------------------------------}+-- | \(O(n)\). Map values and collect the 'Just' results.+--+-- > let f x = if x == "a" then Just "new a" else Nothing+-- > mapMaybe f (fromList [(5,"a"), (3,"b")]) == singleton 5 "new a"++mapMaybe :: (a -> Maybe b) -> Word64Map a -> Word64Map b+mapMaybe f = mapMaybeWithKey (\_ x -> f x)++-- | \(O(n)\). Map keys\/values and collect the 'Just' results.+--+-- > let f k _ = if k < 5 then Just ("key : " ++ (show k)) else Nothing+-- > mapMaybeWithKey f (fromList [(5,"a"), (3,"b")]) == singleton 3 "key : 3"++mapMaybeWithKey :: (Key -> a -> Maybe b) -> Word64Map a -> Word64Map b+mapMaybeWithKey f (Bin p m l r)+  = bin p m (mapMaybeWithKey f l) (mapMaybeWithKey f r)+mapMaybeWithKey f (Tip k x) = case f k x of+  Just !y  -> Tip k y+  Nothing -> Nil+mapMaybeWithKey _ Nil = Nil++-- | \(O(n)\). Map values and separate the 'Left' and 'Right' results.+--+-- > let f a = if a < "c" then Left a else Right a+-- > mapEither f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])+-- >     == (fromList [(3,"b"), (5,"a")], fromList [(1,"x"), (7,"z")])+-- >+-- > mapEither (\ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])+-- >     == (empty, fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])++mapEither :: (a -> Either b c) -> Word64Map a -> (Word64Map b, Word64Map c)+mapEither f m+  = mapEitherWithKey (\_ x -> f x) m++-- | \(O(n)\). Map keys\/values and separate the 'Left' and 'Right' results.+--+-- > let f k a = if k < 5 then Left (k * 2) else Right (a ++ a)+-- > mapEitherWithKey f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])+-- >     == (fromList [(1,2), (3,6)], fromList [(5,"aa"), (7,"zz")])+-- >+-- > mapEitherWithKey (\_ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])+-- >     == (empty, fromList [(1,"x"), (3,"b"), (5,"a"), (7,"z")])++mapEitherWithKey :: (Key -> a -> Either b c) -> Word64Map a -> (Word64Map b, Word64Map c)+mapEitherWithKey f0 t0 = toPair $ go f0 t0+  where+    go f (Bin p m l r)+      = bin p m l1 r1 :*: bin p m l2 r2+      where+        (l1 :*: l2) = go f l+        (r1 :*: r2) = go f r+    go f (Tip k x) = case f k x of+      Left !y  -> (Tip k y :*: Nil)+      Right !z -> (Nil :*: Tip k z)+    go _ Nil = (Nil :*: Nil)++{--------------------------------------------------------------------+  Conversions+--------------------------------------------------------------------}++-- | \(O(n)\). Build a map from a set of keys and a function which for each key+-- computes its value.+--+-- > fromSet (\k -> replicate k 'a') (Data.Word64Set.fromList [3, 5]) == fromList [(5,"aaaaa"), (3,"aaa")]+-- > fromSet undefined Data.Word64Set.empty == empty++fromSet :: (Key -> a) -> Word64Set.Word64Set -> Word64Map a+fromSet _ Word64Set.Nil = Nil+fromSet f (Word64Set.Bin p m l r) = Bin p m (fromSet f l) (fromSet f r)+fromSet f (Word64Set.Tip kx bm) = buildTree f kx bm (Word64Set.suffixBitMask + 1)+  where -- This is slightly complicated, as we to convert the dense+        -- representation of Word64Set into tree representation of Word64Map.+        --+        -- We are given a nonzero bit mask 'bmask' of 'bits' bits with prefix 'prefix'.+        -- We split bmask into halves corresponding to left and right subtree.+        -- If they are both nonempty, we create a Bin node, otherwise exactly+        -- one of them is nonempty and we construct the Word64Map from that half.+        buildTree g !prefix !bmask bits = case bits of+          0 -> Tip prefix $! g prefix+          _ -> case intFromNat ((natFromInt bits) `shiftRL` 1) of+                 bits2 | bmask .&. ((1 `shiftLL` fromIntegral bits2) - 1) == 0 ->+                           buildTree g (prefix + bits2) (bmask `shiftRL` fromIntegral bits2) bits2+                       | (bmask `shiftRL` fromIntegral bits2) .&. ((1 `shiftLL` fromIntegral bits2) - 1) == 0 ->+                           buildTree g prefix bmask bits2+                       | otherwise ->+                           Bin prefix bits2 (buildTree g prefix bmask bits2) (buildTree g (prefix + bits2) (bmask `shiftRL` fromIntegral bits2) bits2)++{--------------------------------------------------------------------+  Lists+--------------------------------------------------------------------}+-- | \(O(n \min(n,W))\). Create a map from a list of key\/value pairs.+--+-- > fromList [] == empty+-- > fromList [(5,"a"), (3,"b"), (5, "c")] == fromList [(5,"c"), (3,"b")]+-- > fromList [(5,"c"), (3,"b"), (5, "a")] == fromList [(5,"a"), (3,"b")]++fromList :: [(Key,a)] -> Word64Map a+fromList xs+  = Foldable.foldl' ins empty xs+  where+    ins t (k,x)  = insert k x t++-- | \(O(n \min(n,W))\). Create a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'.+--+-- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "ab"), (5, "aba")]+-- > fromListWith (++) [] == empty++fromListWith :: (a -> a -> a) -> [(Key,a)] -> Word64Map a+fromListWith f xs+  = fromListWithKey (\_ x y -> f x y) xs++-- | \(O(n \min(n,W))\). Build a map from a list of key\/value pairs with a combining function. See also fromAscListWithKey'.+--+-- > let f key new_value old_value = show key ++ ":" ++ new_value ++ "|" ++ old_value+-- > fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"c")] == fromList [(3, "3:a|b"), (5, "5:c|5:b|a")]+-- > fromListWithKey f [] == empty++fromListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> Word64Map a+fromListWithKey f xs+  = Foldable.foldl' ins empty xs+  where+    ins t (k,x) = insertWithKey f k x t++-- | \(O(n)\). Build a map from a list of key\/value pairs where+-- the keys are in ascending order.+--+-- > fromAscList [(3,"b"), (5,"a")]          == fromList [(3, "b"), (5, "a")]+-- > fromAscList [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "b")]++fromAscList :: [(Key,a)] -> Word64Map a+fromAscList = fromMonoListWithKey Nondistinct (\_ x _ -> x)+{-# NOINLINE fromAscList #-}++-- | \(O(n)\). Build a map from a list of key\/value pairs where+-- the keys are in ascending order, with a combining function on equal keys.+-- /The precondition (input list is ascending) is not checked./+--+-- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")]++fromAscListWith :: (a -> a -> a) -> [(Key,a)] -> Word64Map a+fromAscListWith f = fromMonoListWithKey Nondistinct (\_ x y -> f x y)+{-# NOINLINE fromAscListWith #-}++-- | \(O(n)\). Build a map from a list of key\/value pairs where+-- the keys are in ascending order, with a combining function on equal keys.+-- /The precondition (input list is ascending) is not checked./+--+-- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")]++fromAscListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> Word64Map a+fromAscListWithKey f = fromMonoListWithKey Nondistinct f+{-# NOINLINE fromAscListWithKey #-}++-- | \(O(n)\). Build a map from a list of key\/value pairs where+-- the keys are in ascending order and all distinct.+-- /The precondition (input list is strictly ascending) is not checked./+--+-- > fromDistinctAscList [(3,"b"), (5,"a")] == fromList [(3, "b"), (5, "a")]++fromDistinctAscList :: [(Key,a)] -> Word64Map a+fromDistinctAscList = fromMonoListWithKey Distinct (\_ x _ -> x)+{-# NOINLINE fromDistinctAscList #-}++-- | \(O(n)\). Build a map from a list of key\/value pairs with monotonic keys+-- and a combining function.+--+-- The precise conditions under which this function works are subtle:+-- For any branch mask, keys with the same prefix w.r.t. the branch+-- mask must occur consecutively in the list.++fromMonoListWithKey :: Distinct -> (Key -> a -> a -> a) -> [(Key,a)] -> Word64Map a+fromMonoListWithKey distinct f = go+  where+    go []              = Nil+    go ((kx,vx) : zs1) = addAll' kx vx zs1++    -- `addAll'` collects all keys equal to `kx` into a single value,+    -- and then proceeds with `addAll`.+    addAll' !kx vx []+        = Tip kx $! vx+    addAll' !kx vx ((ky,vy) : zs)+        | Nondistinct <- distinct, kx == ky+        = let !v = f kx vy vx in addAll' ky v zs+        -- inlined: | otherwise = addAll kx (Tip kx $! vx) (ky : zs)+        | m <- branchMask kx ky+        , Inserted ty zs' <- addMany' m ky vy zs+        = addAll kx (linkWithMask m ky ty {-kx-} (Tip kx $! vx)) zs'++    -- for `addAll` and `addMany`, kx is /a/ key inside the tree `tx`+    -- `addAll` consumes the rest of the list, adding to the tree `tx`+    addAll !_kx !tx []+        = tx+    addAll !kx !tx ((ky,vy) : zs)+        | m <- branchMask kx ky+        , Inserted ty zs' <- addMany' m ky vy zs+        = addAll kx (linkWithMask m ky ty {-kx-} tx) zs'++    -- `addMany'` is similar to `addAll'`, but proceeds with `addMany'`.+    addMany' !_m !kx vx []+        = Inserted (Tip kx $! vx) []+    addMany' !m !kx vx zs0@((ky,vy) : zs)+        | Nondistinct <- distinct, kx == ky+        = let !v = f kx vy vx in addMany' m ky v zs+        -- inlined: | otherwise = addMany m kx (Tip kx $! vx) (ky : zs)+        | mask kx m /= mask ky m+        = Inserted (Tip kx $! vx) zs0+        | mxy <- branchMask kx ky+        , Inserted ty zs' <- addMany' mxy ky vy zs+        = addMany m kx (linkWithMask mxy ky ty {-kx-} (Tip kx $! vx)) zs'++    -- `addAll` adds to `tx` all keys whose prefix w.r.t. `m` agrees with `kx`.+    addMany !_m !_kx tx []+        = Inserted tx []+    addMany !m !kx tx zs0@((ky,vy) : zs)+        | mask kx m /= mask ky m+        = Inserted tx zs0+        | mxy <- branchMask kx ky+        , Inserted ty zs' <- addMany' mxy ky vy zs+        = addMany m kx (linkWithMask mxy ky ty {-kx-} tx) zs'+{-# INLINE fromMonoListWithKey #-}++data Inserted a = Inserted !(Word64Map a) ![(Key,a)]++data Distinct = Distinct | Nondistinct

@@ -0,0 +1,174 @@+{-# LANGUAGE CPP #-}+#if !defined(TESTING) && defined(__GLASGOW_HASKELL__)+{-# LANGUAGE Safe #-}+#endif++#include "containers.h"++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Word64Set+-- Copyright   :  (c) Daan Leijen 2002+--                (c) Joachim Breitner 2011+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Portability :  portable+--+--+-- = Finite Int Sets+--+-- The @'Word64Set'@ type represents a set of elements of type @Int@.+--+-- For a walkthrough of the most commonly used functions see their+-- <https://haskell-containers.readthedocs.io/en/latest/set.html sets introduction>.+--+-- These modules are intended to be imported qualified, to avoid name+-- clashes with Prelude functions, e.g.+--+-- >  import Data.Word64Set (Word64Set)+-- >  import qualified Data.Word64Set as Word64Set+--+--+-- == Performance information+--+-- Many operations have a worst-case complexity of \(O(\min(n,W))\).+-- This means that the operation can become linear in the number of+-- elements with a maximum of \(W\) -- the number of bits in an 'Int'+-- (32 or 64).+--+--+-- == Implementation+--+-- The implementation is based on /big-endian patricia trees/.  This data+-- structure performs especially well on binary operations like 'union'+-- and 'intersection'.  However, my benchmarks show that it is also+-- (much) faster on insertions and deletions when compared to a generic+-- size-balanced set implementation (see "Data.Set").+--+--    * Chris Okasaki and Andy Gill,  \"/Fast Mergeable Integer Maps/\",+--      Workshop on ML, September 1998, pages 77-86,+--      <http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.37.5452>+--+--    * D.R. Morrison, \"/PATRICIA -- Practical Algorithm To Retrieve Information Coded In Alphanumeric/\",+--      Journal of the ACM, 15(4), October 1968, pages 514-534.+--+-- Additionally, this implementation places bitmaps in the leaves of the tree.+-- Their size is the natural size of a machine word (32 or 64 bits) and greatly+-- reduces the memory footprint and execution times for dense sets, e.g. sets+-- where it is likely that many values lie close to each other. The asymptotics+-- are not affected by this optimization.+--+-----------------------------------------------------------------------------++module GHC.Data.Word64Set (+            -- * Strictness properties+            -- $strictness++            -- * Set type+#if !defined(TESTING)+              Word64Set          -- instance Eq,Show+#else+              Word64Set(..)      -- instance Eq,Show+#endif+            , Key++            -- * Construction+            , empty+            , singleton+            , fromList+            , fromAscList+            , fromDistinctAscList++            -- * Insertion+            , insert++            -- * Deletion+            , delete++            -- * Generalized insertion/deletion+            , alterF++            -- * Query+            , member+            , notMember+            , lookupLT+            , lookupGT+            , lookupLE+            , lookupGE+            , WS.null+            , size+            , isSubsetOf+            , isProperSubsetOf+            , disjoint++            -- * Combine+            , union+            , unions+            , difference+            , (\\)+            , intersection++            -- * Filter+            , WS.filter+            , partition++            , takeWhileAntitone+            , dropWhileAntitone+            , spanAntitone++            , split+            , splitMember+            , splitRoot++            -- * Map+            , WS.map+            , mapMonotonic++            -- * Folds+            , WS.foldr+            , WS.foldl+            -- ** Strict folds+            , foldr'+            , foldl'+            -- ** Legacy folds+            , fold++            -- * Min\/Max+            , findMin+            , findMax+            , deleteMin+            , deleteMax+            , deleteFindMin+            , deleteFindMax+            , maxView+            , minView++            -- * Conversion++            -- ** List+            , elems+            , toList+            , toAscList+            , toDescList++            -- * Debugging+            , showTree+            , showTreeWith++#if defined(TESTING)+            -- * Internals+            , match+#endif+            ) where++import GHC.Data.Word64Set.Internal as WS++-- $strictness+--+-- This module satisfies the following strictness property:+--+-- * Key arguments are evaluated to WHNF+--+-- Here are some examples that illustrate the property:+--+-- > delete undefined s  ==  undefined

@@ -0,0 +1,1704 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE PatternGuards #-}+#ifdef __GLASGOW_HASKELL__+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+#endif+#if !defined(TESTING) && defined(__GLASGOW_HASKELL__)+{-# LANGUAGE Trustworthy #-}+#endif++{-# OPTIONS_HADDOCK not-home #-}++#include "containers.h"++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Word64Set.Internal+-- Copyright   :  (c) Daan Leijen 2002+--                (c) Joachim Breitner 2011+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Portability :  portable+--+-- = WARNING+--+-- This module is considered __internal__.+--+-- The Package Versioning Policy __does not apply__.+--+-- The contents of this module may change __in any way whatsoever__+-- and __without any warning__ between minor versions of this package.+--+-- Authors importing this module are expected to track development+-- closely.+--+-- = Description+--+-- An efficient implementation of integer sets.+--+-- These modules are intended to be imported qualified, to avoid name+-- clashes with Prelude functions, e.g.+--+-- >  import Data.Word64Set (Word64Set)+-- >  import qualified Data.Word64Set as Word64Set+--+-- The implementation is based on /big-endian patricia trees/.  This data+-- structure performs especially well on binary operations like 'union'+-- and 'intersection'.  However, my benchmarks show that it is also+-- (much) faster on insertions and deletions when compared to a generic+-- size-balanced set implementation (see "Data.Set").+--+--    * Chris Okasaki and Andy Gill,  \"/Fast Mergeable Integer Maps/\",+--      Workshop on ML, September 1998, pages 77-86,+--      <http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.37.5452>+--+--    * D.R. Morrison, \"/PATRICIA -- Practical Algorithm To Retrieve Information Coded In Alphanumeric/\",+--      Journal of the ACM, 15(4), October 1968, pages 514-534.+--+-- Additionally, this implementation places bitmaps in the leaves of the tree.+-- Their size is the natural size of a machine word (32 or 64 bits) and greatly+-- reduce memory footprint and execution times for dense sets, e.g. sets where+-- it is likely that many values lie close to each other. The asymptotics are+-- not affected by this optimization.+--+-- Many operations have a worst-case complexity of \(O(\min(n,W))\).+-- This means that the operation can become linear in the number of+-- elements with a maximum of \(W\) -- the number of bits in an 'Int'+-- (32 or 64).+--+-- @since 0.5.9+-----------------------------------------------------------------------------++-- [Note: INLINE bit fiddling]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- It is essential that the bit fiddling functions like mask, zero, branchMask+-- etc are inlined. If they do not, the memory allocation skyrockets. The GHC+-- usually gets it right, but it is disastrous if it does not. Therefore we+-- explicitly mark these functions INLINE.+++-- [Note: Local 'go' functions and capturing]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- Care must be taken when using 'go' function which captures an argument.+-- Sometimes (for example when the argument is passed to a data constructor,+-- as in insert), GHC heap-allocates more than necessary. Therefore C-- code+-- must be checked for increased allocation when creating and modifying such+-- functions.+++-- [Note: Order of constructors]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- The order of constructors of Word64Set matters when considering performance.+-- Currently in GHC 7.0, when type has 3 constructors, they are matched from+-- the first to the last -- the best performance is achieved when the+-- constructors are ordered by frequency.+-- On GHC 7.0, reordering constructors from Nil | Tip | Bin to Bin | Tip | Nil+-- improves the benchmark by circa 10%.++module GHC.Data.Word64Set.Internal (+    -- * Set type+      Word64Set(..), Key -- instance Eq,Show+    , Prefix, Mask, BitMap++    -- * Operators+    , (\\)++    -- * Query+    , null+    , size+    , member+    , notMember+    , lookupLT+    , lookupGT+    , lookupLE+    , lookupGE+    , isSubsetOf+    , isProperSubsetOf+    , disjoint++    -- * Construction+    , empty+    , singleton+    , insert+    , delete+    , alterF++    -- * Combine+    , union+    , unions+    , difference+    , intersection++    -- * Filter+    , filter+    , partition++    , takeWhileAntitone+    , dropWhileAntitone+    , spanAntitone++    , split+    , splitMember+    , splitRoot++    -- * Map+    , map+    , mapMonotonic++    -- * Folds+    , foldr+    , foldl+    -- ** Strict folds+    , foldr'+    , foldl'+    -- ** Legacy folds+    , fold++    -- * Min\/Max+    , findMin+    , findMax+    , deleteMin+    , deleteMax+    , deleteFindMin+    , deleteFindMax+    , maxView+    , minView++    -- * Conversion++    -- ** List+    , elems+    , toList+    , fromList++    -- ** Ordered list+    , toAscList+    , toDescList+    , fromAscList+    , fromDistinctAscList++    -- * Debugging+    , showTree+    , showTreeWith++    -- * Internals+    , match+    , suffixBitMask+    , prefixBitMask+    , bitmapOf+    , zero+    ) where++import Control.Applicative (Const(..))+import Control.DeepSeq (NFData(rnf))+import Data.Bits+import qualified Data.List as List+import Data.Maybe (fromMaybe)+import Data.Semigroup (Semigroup(stimes, (<>)), stimesIdempotentMonoid)+import GHC.Prelude.Basic hiding+  (filter, foldr, foldl, foldl', null, map)+import Data.Word ( Word64 )++import GHC.Utils.Containers.Internal.BitUtil+import GHC.Utils.Containers.Internal.StrictPair++#if __GLASGOW_HASKELL__+import Data.Data (Data(..), Constr, mkConstr, constrIndex, DataType, mkDataType)+import qualified Data.Data+import Text.Read+#endif++#if __GLASGOW_HASKELL__+import qualified GHC.Exts+#endif++import qualified Data.Foldable as Foldable+import Data.Functor.Identity (Identity(..))++infixl 9 \\{-This comment teaches CPP correct behaviour -}++-- A "Nat" is a 64 bit machine word+type Nat = Word64++natFromInt :: Word64 -> Nat+natFromInt = id+{-# INLINE natFromInt #-}++intFromNat :: Nat -> Word64+intFromNat = id+{-# INLINE intFromNat #-}++{--------------------------------------------------------------------+  Operators+--------------------------------------------------------------------}+-- | \(O(n+m)\). See 'difference'.+(\\) :: Word64Set -> Word64Set -> Word64Set+m1 \\ m2 = difference m1 m2++{--------------------------------------------------------------------+  Types+--------------------------------------------------------------------}++-- | A set of integers.++-- See Note: Order of constructors+data Word64Set = Bin {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask !Word64Set !Word64Set+-- Invariant: Nil is never found as a child of Bin.+-- Invariant: The Mask is a power of 2.  It is the largest bit position at which+--            two elements of the set differ.+-- Invariant: Prefix is the common high-order bits that all elements share to+--            the left of the Mask bit.+-- Invariant: In Bin prefix mask left right, left consists of the elements that+--            don't have the mask bit set; right is all the elements that do.+            | Tip {-# UNPACK #-} !Prefix {-# UNPACK #-} !BitMap+-- Invariant: The Prefix is zero for the last 6 bits. The values of the set+--            represented by a tip are the prefix plus the indices of the set+--            bits in the bit map.+            | Nil++-- A number stored in a set is stored as+-- * Prefix (all but last 6 bits) and+-- * BitMap (last 6 bits stored as a bitmask)+--   Last 6 bits are called a Suffix.++type Prefix = Word64+type Mask   = Word64+type BitMap = Word64+type Key    = Word64++instance Monoid Word64Set where+    mempty  = empty+    mconcat = unions+    mappend = (<>)++-- | @since 0.5.7+instance Semigroup Word64Set where+    (<>)    = union+    stimes  = stimesIdempotentMonoid++#if __GLASGOW_HASKELL__++{--------------------------------------------------------------------+  A Data instance+--------------------------------------------------------------------}++-- This instance preserves data abstraction at the cost of inefficiency.+-- We provide limited reflection services for the sake of data abstraction.++instance Data Word64Set where+  gfoldl f z is = z fromList `f` (toList is)+  toConstr _     = fromListConstr+  gunfold k z c  = case constrIndex c of+    1 -> k (z fromList)+    _ -> error "gunfold"+  dataTypeOf _   = intSetDataType++fromListConstr :: Constr+fromListConstr = mkConstr intSetDataType "fromList" [] Data.Data.Prefix++intSetDataType :: DataType+intSetDataType = mkDataType "Data.Word64Set.Internal.Word64Set" [fromListConstr]++#endif++{--------------------------------------------------------------------+  Query+--------------------------------------------------------------------}+-- | \(O(1)\). Is the set empty?+null :: Word64Set -> Bool+null Nil = True+null _   = False+{-# INLINE null #-}++-- | \(O(n)\). Cardinality of the set.+size :: Word64Set -> Int+size = go 0+  where+    go !acc (Bin _ _ l r) = go (go acc l) r+    go acc (Tip _ bm) = acc + bitcount 0 bm+    go acc Nil = acc++-- | \(O(\min(n,W))\). Is the value a member of the set?++-- See Note: Local 'go' functions and capturing.+member :: Key -> Word64Set -> Bool+member !x = go+  where+    go (Bin p m l r)+      | nomatch x p m = False+      | zero x m      = go l+      | otherwise     = go r+    go (Tip y bm) = prefixOf x == y && bitmapOf x .&. bm /= 0+    go Nil = False++-- | \(O(\min(n,W))\). Is the element not in the set?+notMember :: Key -> Word64Set -> Bool+notMember k = not . member k++-- | \(O(\min(n,W))\). Find largest element smaller than the given one.+--+-- > lookupLT 3 (fromList [3, 5]) == Nothing+-- > lookupLT 5 (fromList [3, 5]) == Just 3++-- See Note: Local 'go' functions and capturing.+lookupLT :: Key -> Word64Set -> Maybe Key+lookupLT !x t = case t of+    Bin _ m l r | m < 0 -> if x >= 0 then go r l else go Nil r+    _ -> go Nil t+  where+    go def (Bin p m l r) | nomatch x p m = if x < p then unsafeFindMax def else unsafeFindMax r+                         | zero x m  = go def l+                         | otherwise = go l r+    go def (Tip kx bm) | prefixOf x > kx = Just $ kx + highestBitSet bm+                       | prefixOf x == kx && maskLT /= 0 = Just $ kx + highestBitSet maskLT+                       | otherwise = unsafeFindMax def+                       where maskLT = (bitmapOf x - 1) .&. bm+    go def Nil = unsafeFindMax def+++-- | \(O(\min(n,W))\). Find smallest element greater than the given one.+--+-- > lookupGT 4 (fromList [3, 5]) == Just 5+-- > lookupGT 5 (fromList [3, 5]) == Nothing++-- See Note: Local 'go' functions and capturing.+lookupGT :: Key -> Word64Set -> Maybe Key+lookupGT !x t = case t of+    Bin _ m l r | m < 0 -> if x >= 0 then go Nil l else go l r+    _ -> go Nil t+  where+    go def (Bin p m l r) | nomatch x p m = if x < p then unsafeFindMin l else unsafeFindMin def+                         | zero x m  = go r l+                         | otherwise = go def r+    go def (Tip kx bm) | prefixOf x < kx = Just $ kx + lowestBitSet bm+                       | prefixOf x == kx && maskGT /= 0 = Just $ kx + lowestBitSet maskGT+                       | otherwise = unsafeFindMin def+                       where maskGT = (- ((bitmapOf x) `shiftLL` 1)) .&. bm+    go def Nil = unsafeFindMin def+++-- | \(O(\min(n,W))\). Find largest element smaller or equal to the given one.+--+-- > lookupLE 2 (fromList [3, 5]) == Nothing+-- > lookupLE 4 (fromList [3, 5]) == Just 3+-- > lookupLE 5 (fromList [3, 5]) == Just 5++-- See Note: Local 'go' functions and capturing.+lookupLE :: Key -> Word64Set -> Maybe Key+lookupLE !x t = case t of+    Bin _ m l r | m < 0 -> if x >= 0 then go r l else go Nil r+    _ -> go Nil t+  where+    go def (Bin p m l r) | nomatch x p m = if x < p then unsafeFindMax def else unsafeFindMax r+                         | zero x m  = go def l+                         | otherwise = go l r+    go def (Tip kx bm) | prefixOf x > kx = Just $ kx + highestBitSet bm+                       | prefixOf x == kx && maskLE /= 0 = Just $ kx + highestBitSet maskLE+                       | otherwise = unsafeFindMax def+                       where maskLE = (((bitmapOf x) `shiftLL` 1) - 1) .&. bm+    go def Nil = unsafeFindMax def+++-- | \(O(\min(n,W))\). Find smallest element greater or equal to the given one.+--+-- > lookupGE 3 (fromList [3, 5]) == Just 3+-- > lookupGE 4 (fromList [3, 5]) == Just 5+-- > lookupGE 6 (fromList [3, 5]) == Nothing++-- See Note: Local 'go' functions and capturing.+lookupGE :: Key -> Word64Set -> Maybe Key+lookupGE !x t = case t of+    Bin _ m l r | m < 0 -> if x >= 0 then go Nil l else go l r+    _ -> go Nil t+  where+    go def (Bin p m l r) | nomatch x p m = if x < p then unsafeFindMin l else unsafeFindMin def+                         | zero x m  = go r l+                         | otherwise = go def r+    go def (Tip kx bm) | prefixOf x < kx = Just $ kx + lowestBitSet bm+                       | prefixOf x == kx && maskGE /= 0 = Just $ kx + lowestBitSet maskGE+                       | otherwise = unsafeFindMin def+                       where maskGE = (- (bitmapOf x)) .&. bm+    go def Nil = unsafeFindMin def++++-- Helper function for lookupGE and lookupGT. It assumes that if a Bin node is+-- given, it has m > 0.+unsafeFindMin :: Word64Set -> Maybe Key+unsafeFindMin Nil = Nothing+unsafeFindMin (Tip kx bm) = Just $ kx + lowestBitSet bm+unsafeFindMin (Bin _ _ l _) = unsafeFindMin l++-- Helper function for lookupLE and lookupLT. It assumes that if a Bin node is+-- given, it has m > 0.+unsafeFindMax :: Word64Set -> Maybe Key+unsafeFindMax Nil = Nothing+unsafeFindMax (Tip kx bm) = Just $ kx + highestBitSet bm+unsafeFindMax (Bin _ _ _ r) = unsafeFindMax r++{--------------------------------------------------------------------+  Construction+--------------------------------------------------------------------}+-- | \(O(1)\). The empty set.+empty :: Word64Set+empty+  = Nil+{-# INLINE empty #-}++-- | \(O(1)\). A set of one element.+singleton :: Key -> Word64Set+singleton x+  = Tip (prefixOf x) (bitmapOf x)+{-# INLINE singleton #-}++{--------------------------------------------------------------------+  Insert+--------------------------------------------------------------------}+-- | \(O(\min(n,W))\). Add a value to the set. There is no left- or right bias for+-- Word64Sets.+insert :: Key -> Word64Set -> Word64Set+insert !x = insertBM (prefixOf x) (bitmapOf x)++-- Helper function for insert and union.+insertBM :: Prefix -> BitMap -> Word64Set -> Word64Set+insertBM !kx !bm t@(Bin p m l r)+  | nomatch kx p m = link kx (Tip kx bm) p t+  | zero kx m      = Bin p m (insertBM kx bm l) r+  | otherwise      = Bin p m l (insertBM kx bm r)+insertBM kx bm t@(Tip kx' bm')+  | kx' == kx = Tip kx' (bm .|. bm')+  | otherwise = link kx (Tip kx bm) kx' t+insertBM kx bm Nil = Tip kx bm++-- | \(O(\min(n,W))\). Delete a value in the set. Returns the+-- original set when the value was not present.+delete :: Key -> Word64Set -> Word64Set+delete !x = deleteBM (prefixOf x) (bitmapOf x)++-- Deletes all values mentioned in the BitMap from the set.+-- Helper function for delete and difference.+deleteBM :: Prefix -> BitMap -> Word64Set -> Word64Set+deleteBM !kx !bm t@(Bin p m l r)+  | nomatch kx p m = t+  | zero kx m      = bin p m (deleteBM kx bm l) r+  | otherwise      = bin p m l (deleteBM kx bm r)+deleteBM kx bm t@(Tip kx' bm')+  | kx' == kx = tip kx (bm' .&. complement bm)+  | otherwise = t+deleteBM _ _ Nil = Nil++-- | \(O(\min(n,W))\). @('alterF' f x s)@ can delete or insert @x@ in @s@ depending+-- on whether it is already present in @s@.+--+-- In short:+--+-- @+-- 'member' x \<$\> 'alterF' f x s = f ('member' x s)+-- @+--+-- Note: 'alterF' is a variant of the @at@ combinator from "Control.Lens.At".+--+-- @since 0.6.3.1+alterF :: Functor f => (Bool -> f Bool) -> Key -> Word64Set -> f Word64Set+alterF f k s = fmap choose (f member_)+  where+    member_ = member k s++    (inserted, deleted)+      | member_   = (s         , delete k s)+      | otherwise = (insert k s, s         )++    choose True  = inserted+    choose False = deleted+#ifndef __GLASGOW_HASKELL__+{-# INLINE alterF #-}+#else+{-# INLINABLE [2] alterF #-}++{-# RULES+"alterF/Const" forall k (f :: Bool -> Const a Bool) . alterF f k = \s -> Const . getConst . f $ member k s+ #-}+#endif++{-# SPECIALIZE alterF :: (Bool -> Identity Bool) -> Key -> Word64Set -> Identity Word64Set #-}++{--------------------------------------------------------------------+  Union+--------------------------------------------------------------------}+-- | The union of a list of sets.+unions :: Foldable f => f Word64Set -> Word64Set+unions xs+  = Foldable.foldl' union empty xs+++-- | \(O(n+m)\). The union of two sets.+union :: Word64Set -> Word64Set -> Word64Set+union t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)+  | shorter m1 m2  = union1+  | shorter m2 m1  = union2+  | p1 == p2       = Bin p1 m1 (union l1 l2) (union r1 r2)+  | otherwise      = link p1 t1 p2 t2+  where+    union1  | nomatch p2 p1 m1  = link p1 t1 p2 t2+            | zero p2 m1        = Bin p1 m1 (union l1 t2) r1+            | otherwise         = Bin p1 m1 l1 (union r1 t2)++    union2  | nomatch p1 p2 m2  = link p1 t1 p2 t2+            | zero p1 m2        = Bin p2 m2 (union t1 l2) r2+            | otherwise         = Bin p2 m2 l2 (union t1 r2)++union t@(Bin _ _ _ _) (Tip kx bm) = insertBM kx bm t+union t@(Bin _ _ _ _) Nil = t+union (Tip kx bm) t = insertBM kx bm t+union Nil t = t+++{--------------------------------------------------------------------+  Difference+--------------------------------------------------------------------}+-- | \(O(n+m)\). Difference between two sets.+difference :: Word64Set -> Word64Set -> Word64Set+difference t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)+  | shorter m1 m2  = difference1+  | shorter m2 m1  = difference2+  | p1 == p2       = bin p1 m1 (difference l1 l2) (difference r1 r2)+  | otherwise      = t1+  where+    difference1 | nomatch p2 p1 m1  = t1+                | zero p2 m1        = bin p1 m1 (difference l1 t2) r1+                | otherwise         = bin p1 m1 l1 (difference r1 t2)++    difference2 | nomatch p1 p2 m2  = t1+                | zero p1 m2        = difference t1 l2+                | otherwise         = difference t1 r2++difference t@(Bin _ _ _ _) (Tip kx bm) = deleteBM kx bm t+difference t@(Bin _ _ _ _) Nil = t++difference t1@(Tip kx bm) t2 = differenceTip t2+  where differenceTip (Bin p2 m2 l2 r2) | nomatch kx p2 m2 = t1+                                        | zero kx m2 = differenceTip l2+                                        | otherwise = differenceTip r2+        differenceTip (Tip kx2 bm2) | kx == kx2 = tip kx (bm .&. complement bm2)+                                    | otherwise = t1+        differenceTip Nil = t1++difference Nil _     = Nil++++{--------------------------------------------------------------------+  Intersection+--------------------------------------------------------------------}+-- | \(O(n+m)\). The intersection of two sets.+intersection :: Word64Set -> Word64Set -> Word64Set+intersection t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)+  | shorter m1 m2  = intersection1+  | shorter m2 m1  = intersection2+  | p1 == p2       = bin p1 m1 (intersection l1 l2) (intersection r1 r2)+  | otherwise      = Nil+  where+    intersection1 | nomatch p2 p1 m1  = Nil+                  | zero p2 m1        = intersection l1 t2+                  | otherwise         = intersection r1 t2++    intersection2 | nomatch p1 p2 m2  = Nil+                  | zero p1 m2        = intersection t1 l2+                  | otherwise         = intersection t1 r2++intersection t1@(Bin _ _ _ _) (Tip kx2 bm2) = intersectBM t1+  where intersectBM (Bin p1 m1 l1 r1) | nomatch kx2 p1 m1 = Nil+                                      | zero kx2 m1       = intersectBM l1+                                      | otherwise         = intersectBM r1+        intersectBM (Tip kx1 bm1) | kx1 == kx2 = tip kx1 (bm1 .&. bm2)+                                  | otherwise = Nil+        intersectBM Nil = Nil++intersection (Bin _ _ _ _) Nil = Nil++intersection (Tip kx1 bm1) t2 = intersectBM t2+  where intersectBM (Bin p2 m2 l2 r2) | nomatch kx1 p2 m2 = Nil+                                      | zero kx1 m2       = intersectBM l2+                                      | otherwise         = intersectBM r2+        intersectBM (Tip kx2 bm2) | kx1 == kx2 = tip kx1 (bm1 .&. bm2)+                                  | otherwise = Nil+        intersectBM Nil = Nil++intersection Nil _ = Nil++{--------------------------------------------------------------------+  Subset+--------------------------------------------------------------------}+-- | \(O(n+m)\). Is this a proper subset? (ie. a subset but not equal).+isProperSubsetOf :: Word64Set -> Word64Set -> Bool+isProperSubsetOf t1 t2+  = case subsetCmp t1 t2 of+      LT -> True+      _  -> False++subsetCmp :: Word64Set -> Word64Set -> Ordering+subsetCmp t1@(Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)+  | shorter m1 m2  = GT+  | shorter m2 m1  = case subsetCmpLt of+                       GT -> GT+                       _  -> LT+  | p1 == p2       = subsetCmpEq+  | otherwise      = GT  -- disjoint+  where+    subsetCmpLt | nomatch p1 p2 m2  = GT+                | zero p1 m2        = subsetCmp t1 l2+                | otherwise         = subsetCmp t1 r2+    subsetCmpEq = case (subsetCmp l1 l2, subsetCmp r1 r2) of+                    (GT,_ ) -> GT+                    (_ ,GT) -> GT+                    (EQ,EQ) -> EQ+                    _       -> LT++subsetCmp (Bin _ _ _ _) _  = GT+subsetCmp (Tip kx1 bm1) (Tip kx2 bm2)+  | kx1 /= kx2                  = GT -- disjoint+  | bm1 == bm2                  = EQ+  | bm1 .&. complement bm2 == 0 = LT+  | otherwise                   = GT+subsetCmp t1@(Tip kx _) (Bin p m l r)+  | nomatch kx p m = GT+  | zero kx m      = case subsetCmp t1 l of GT -> GT ; _ -> LT+  | otherwise      = case subsetCmp t1 r of GT -> GT ; _ -> LT+subsetCmp (Tip _ _) Nil = GT -- disjoint+subsetCmp Nil Nil = EQ+subsetCmp Nil _   = LT++-- | \(O(n+m)\). Is this a subset?+-- @(s1 \`isSubsetOf\` s2)@ tells whether @s1@ is a subset of @s2@.++isSubsetOf :: Word64Set -> Word64Set -> Bool+isSubsetOf 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 isSubsetOf t1 l2+                                                      else isSubsetOf t1 r2)+  | otherwise      = (p1==p2) && isSubsetOf l1 l2 && isSubsetOf r1 r2+isSubsetOf (Bin _ _ _ _) _  = False+isSubsetOf (Tip kx1 bm1) (Tip kx2 bm2) = kx1 == kx2 && bm1 .&. complement bm2 == 0+isSubsetOf t1@(Tip kx _) (Bin p m l r)+  | nomatch kx p m = False+  | zero kx m      = isSubsetOf t1 l+  | otherwise      = isSubsetOf t1 r+isSubsetOf (Tip _ _) Nil = False+isSubsetOf Nil _         = True+++{--------------------------------------------------------------------+  Disjoint+--------------------------------------------------------------------}+-- | \(O(n+m)\). Check whether two sets are disjoint (i.e. their intersection+--   is empty).+--+-- > disjoint (fromList [2,4,6])   (fromList [1,3])     == True+-- > disjoint (fromList [2,4,6,8]) (fromList [2,3,5,7]) == False+-- > disjoint (fromList [1,2])     (fromList [1,2,3,4]) == False+-- > disjoint (fromList [])        (fromList [])        == True+--+-- @since 0.5.11+disjoint :: Word64Set -> Word64Set -> Bool+disjoint t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)+  | shorter m1 m2  = disjoint1+  | shorter m2 m1  = disjoint2+  | p1 == p2       = disjoint l1 l2 && disjoint r1 r2+  | otherwise      = True+  where+    disjoint1 | nomatch p2 p1 m1  = True+              | zero p2 m1        = disjoint l1 t2+              | otherwise         = disjoint r1 t2++    disjoint2 | nomatch p1 p2 m2  = True+              | zero p1 m2        = disjoint t1 l2+              | otherwise         = disjoint t1 r2++disjoint t1@(Bin _ _ _ _) (Tip kx2 bm2) = disjointBM t1+  where disjointBM (Bin p1 m1 l1 r1) | nomatch kx2 p1 m1 = True+                                     | zero kx2 m1       = disjointBM l1+                                     | otherwise         = disjointBM r1+        disjointBM (Tip kx1 bm1) | kx1 == kx2 = (bm1 .&. bm2) == 0+                                 | otherwise = True+        disjointBM Nil = True++disjoint (Bin _ _ _ _) Nil = True++disjoint (Tip kx1 bm1) t2 = disjointBM t2+  where disjointBM (Bin p2 m2 l2 r2) | nomatch kx1 p2 m2 = True+                                     | zero kx1 m2       = disjointBM l2+                                     | otherwise         = disjointBM r2+        disjointBM (Tip kx2 bm2) | kx1 == kx2 = (bm1 .&. bm2) == 0+                                 | otherwise = True+        disjointBM Nil = True++disjoint Nil _ = True+++{--------------------------------------------------------------------+  Filter+--------------------------------------------------------------------}+-- | \(O(n)\). Filter all elements that satisfy some predicate.+filter :: (Key -> Bool) -> Word64Set -> Word64Set+filter predicate t+  = case t of+      Bin p m l r+        -> bin p m (filter predicate l) (filter predicate r)+      Tip kx bm+        -> tip kx (foldl'Bits 0 (bitPred kx) 0 bm)+      Nil -> Nil+  where bitPred kx bm bi | predicate (kx + bi) = bm .|. bitmapOfSuffix bi+                         | otherwise           = bm+        {-# INLINE bitPred #-}++-- | \(O(n)\). partition the set according to some predicate.+partition :: (Key -> Bool) -> Word64Set -> (Word64Set,Word64Set)+partition predicate0 t0 = toPair $ go predicate0 t0+  where+    go predicate t+      = case t of+          Bin p m l r+            -> let (l1 :*: l2) = go predicate l+                   (r1 :*: r2) = go predicate r+               in bin p m l1 r1 :*: bin p m l2 r2+          Tip kx bm+            -> let bm1 = foldl'Bits 0 (bitPred kx) 0 bm+               in  tip kx bm1 :*: tip kx (bm `xor` bm1)+          Nil -> (Nil :*: Nil)+      where bitPred kx bm bi | predicate (kx + bi) = bm .|. bitmapOfSuffix bi+                             | otherwise           = bm+            {-# INLINE bitPred #-}++-- | \(O(\min(n,W))\). Take while a predicate on the elements holds.+-- The user is responsible for ensuring that for all @Int@s, @j \< k ==\> p j \>= p k@.+-- See note at 'spanAntitone'.+--+-- @+-- takeWhileAntitone p = 'fromDistinctAscList' . 'Data.List.takeWhile' p . 'toList'+-- takeWhileAntitone p = 'filter' p+-- @+--+-- @since 0.6.7+takeWhileAntitone :: (Key -> Bool) -> Word64Set -> Word64Set+takeWhileAntitone predicate t =+  case t of+    Bin p m l r+      | m < 0 ->+        if predicate 0 -- handle negative numbers.+        then bin p m (go predicate l) r+        else go predicate r+    _ -> go predicate t+  where+    go predicate' (Bin p m l r)+      | predicate' $! p+m = bin p m l (go predicate' r)+      | otherwise         = go predicate' l+    go predicate' (Tip kx bm) = tip kx (takeWhileAntitoneBits kx predicate' bm)+    go _ Nil = Nil++-- | \(O(\min(n,W))\). Drop while a predicate on the elements holds.+-- The user is responsible for ensuring that for all @Int@s, @j \< k ==\> p j \>= p k@.+-- See note at 'spanAntitone'.+--+-- @+-- dropWhileAntitone p = 'fromDistinctAscList' . 'Data.List.dropWhile' p . 'toList'+-- dropWhileAntitone p = 'filter' (not . p)+-- @+--+-- @since 0.6.7+dropWhileAntitone :: (Key -> Bool) -> Word64Set -> Word64Set+dropWhileAntitone predicate t =+  case t of+    Bin p m l r+      | m < 0 ->+        if predicate 0 -- handle negative numbers.+        then go predicate l+        else bin p m l (go predicate r)+    _ -> go predicate t+  where+    go predicate' (Bin p m l r)+      | predicate' $! p+m = go predicate' r+      | otherwise         = bin p m (go predicate' l) r+    go predicate' (Tip kx bm) = tip kx (bm `xor` takeWhileAntitoneBits kx predicate' bm)+    go _ Nil = Nil++-- | \(O(\min(n,W))\). Divide a set at the point where a predicate on the elements stops holding.+-- The user is responsible for ensuring that for all @Int@s, @j \< k ==\> p j \>= p k@.+--+-- @+-- spanAntitone p xs = ('takeWhileAntitone' p xs, 'dropWhileAntitone' p xs)+-- spanAntitone p xs = 'partition' p xs+-- @+--+-- Note: if @p@ is not actually antitone, then @spanAntitone@ will split the set+-- at some /unspecified/ point.+--+-- @since 0.6.7+spanAntitone :: (Key -> Bool) -> Word64Set -> (Word64Set, Word64Set)+spanAntitone predicate t =+  case t of+    Bin p m l r+      | m < 0 ->+        if predicate 0 -- handle negative numbers.+        then+          case go predicate l of+            (lt :*: gt) ->+              let !lt' = bin p m lt r+              in (lt', gt)+        else+          case go predicate r of+            (lt :*: gt) ->+              let !gt' = bin p m l gt+              in (lt, gt')+    _ -> case go predicate t of+          (lt :*: gt) -> (lt, gt)+  where+    go predicate' (Bin p m l r)+      | predicate' $! p+m = case go predicate' r of (lt :*: gt) -> bin p m l lt :*: gt+      | otherwise         = case go predicate' l of (lt :*: gt) -> lt :*: bin p m gt r+    go predicate' (Tip kx bm) = let bm' = takeWhileAntitoneBits kx predicate' bm+                                in (tip kx bm' :*: tip kx (bm `xor` bm'))+    go _ Nil = (Nil :*: Nil)++-- | \(O(\min(n,W))\). The expression (@'split' x set@) is a pair @(set1,set2)@+-- where @set1@ comprises the elements of @set@ less than @x@ and @set2@+-- comprises the elements of @set@ greater than @x@.+--+-- > split 3 (fromList [1..5]) == (fromList [1,2], fromList [4,5])+split :: Key -> Word64Set -> (Word64Set,Word64Set)+split x t =+  case t of+    Bin p m l r+      | m < 0 ->+        if x >= 0  -- handle negative numbers.+        then+          case go x l of+            (lt :*: gt) ->+              let !lt' = bin p m lt r+              in (lt', gt)+        else+          case go x r of+            (lt :*: gt) ->+              let !gt' = bin p m l gt+              in (lt, gt')+    _ -> case go x t of+          (lt :*: gt) -> (lt, gt)+  where+    go !x' t'@(Bin p m l r)+        | nomatch x' p m = if x' < p then (Nil :*: t') else (t' :*: Nil)+        | zero x' m      = case go x' l of (lt :*: gt) -> lt :*: bin p m gt r+        | otherwise      = case go x' r of (lt :*: gt) -> bin p m l lt :*: gt+    go x' t'@(Tip kx' bm)+        | kx' > x'          = (Nil :*: t')+          -- equivalent to kx' > prefixOf x'+        | kx' < prefixOf x' = (t' :*: Nil)+        | otherwise = tip kx' (bm .&. lowerBitmap) :*: tip kx' (bm .&. higherBitmap)+            where lowerBitmap = bitmapOf x' - 1+                  higherBitmap = complement (lowerBitmap + bitmapOf x')+    go _ Nil = (Nil :*: Nil)++-- | \(O(\min(n,W))\). Performs a 'split' but also returns whether the pivot+-- element was found in the original set.+splitMember :: Key -> Word64Set -> (Word64Set,Bool,Word64Set)+splitMember x t =+  case t of+    Bin p m l r+      | m < 0 ->+        if x >= 0 -- handle negative numbers.+        then+          case go x l of+            (lt, fnd, gt) ->+              let !lt' = bin p m lt r+              in (lt', fnd, gt)+        else+          case go x r of+            (lt, fnd, gt) ->+              let !gt' = bin p m l gt+              in (lt, fnd, gt')+    _ -> go x t+  where+    go x' t'@(Bin p m l r)+        | nomatch x' p m = if x' < p then (Nil, False, t') else (t', False, Nil)+        | zero x' m =+          case go x' l of+            (lt, fnd, gt) ->+              let !gt' = bin p m gt r+              in (lt, fnd, gt')+        | otherwise =+          case go x' r of+            (lt, fnd, gt) ->+              let !lt' = bin p m l lt+              in (lt', fnd, gt)+    go x' t'@(Tip kx' bm)+        | kx' > x'          = (Nil, False, t')+          -- equivalent to kx' > prefixOf x'+        | kx' < prefixOf x' = (t', False, Nil)+        | otherwise = let !lt = tip kx' (bm .&. lowerBitmap)+                          !found = (bm .&. bitmapOfx') /= 0+                          !gt = tip kx' (bm .&. higherBitmap)+                      in (lt, found, gt)+            where bitmapOfx' = bitmapOf x'+                  lowerBitmap = bitmapOfx' - 1+                  higherBitmap = complement (lowerBitmap + bitmapOfx')+    go _ Nil = (Nil, False, Nil)++{----------------------------------------------------------------------+  Min/Max+----------------------------------------------------------------------}++-- | \(O(\min(n,W))\). Retrieves the maximal key of the set, and the set+-- stripped of that element, or 'Nothing' if passed an empty set.+maxView :: Word64Set -> Maybe (Key, Word64Set)+maxView t =+  case t of Nil -> Nothing+            Bin p m l r | m < 0 -> case go l of (result, l') -> Just (result, bin p m l' r)+            _ -> Just (go t)+  where+    go (Bin p m l r) = case go r of (result, r') -> (result, bin p m l r')+    go (Tip kx bm) = case highestBitSet bm of bi -> (kx + bi, tip kx (bm .&. complement (bitmapOfSuffix bi)))+    go Nil = error "maxView Nil"++-- | \(O(\min(n,W))\). Retrieves the minimal key of the set, and the set+-- stripped of that element, or 'Nothing' if passed an empty set.+minView :: Word64Set -> Maybe (Key, Word64Set)+minView t =+  case t of Nil -> Nothing+            Bin p m l r | m < 0 -> case go r of (result, r') -> Just (result, bin p m l r')+            _ -> Just (go t)+  where+    go (Bin p m l r) = case go l of (result, l') -> (result, bin p m l' r)+    go (Tip kx bm) = case lowestBitSet bm of bi -> (kx + bi, tip kx (bm .&. complement (bitmapOfSuffix bi)))+    go Nil = error "minView Nil"++-- | \(O(\min(n,W))\). Delete and find the minimal element.+--+-- > deleteFindMin set = (findMin set, deleteMin set)+deleteFindMin :: Word64Set -> (Key, Word64Set)+deleteFindMin = fromMaybe (error "deleteFindMin: empty set has no minimal element") . minView++-- | \(O(\min(n,W))\). Delete and find the maximal element.+--+-- > deleteFindMax set = (findMax set, deleteMax set)+deleteFindMax :: Word64Set -> (Key, Word64Set)+deleteFindMax = fromMaybe (error "deleteFindMax: empty set has no maximal element") . maxView+++-- | \(O(\min(n,W))\). The minimal element of the set.+findMin :: Word64Set -> Key+findMin Nil = error "findMin: empty set has no minimal element"+findMin (Tip kx bm) = kx + lowestBitSet bm+findMin (Bin _ m l r)+  |   m < 0   = find r+  | otherwise = find l+    where find (Tip kx bm) = kx + lowestBitSet bm+          find (Bin _ _ l' _) = find l'+          find Nil            = error "findMin Nil"++-- | \(O(\min(n,W))\). The maximal element of a set.+findMax :: Word64Set -> Key+findMax Nil = error "findMax: empty set has no maximal element"+findMax (Tip kx bm) = kx + highestBitSet bm+findMax (Bin _ m l r)+  |   m < 0   = find l+  | otherwise = find r+    where find (Tip kx bm) = kx + highestBitSet bm+          find (Bin _ _ _ r') = find r'+          find Nil            = error "findMax Nil"+++-- | \(O(\min(n,W))\). Delete the minimal element. Returns an empty set if the set is empty.+--+-- Note that this is a change of behaviour for consistency with 'Data.Set.Set' &#8211;+-- versions prior to 0.5 threw an error if the 'Word64Set' was already empty.+deleteMin :: Word64Set -> Word64Set+deleteMin = maybe Nil snd . minView++-- | \(O(\min(n,W))\). Delete the maximal element. Returns an empty set if the set is empty.+--+-- Note that this is a change of behaviour for consistency with 'Data.Set.Set' &#8211;+-- versions prior to 0.5 threw an error if the 'Word64Set' was already empty.+deleteMax :: Word64Set -> Word64Set+deleteMax = maybe Nil snd . maxView++{----------------------------------------------------------------------+  Map+----------------------------------------------------------------------}++-- | \(O(n \min(n,W))\).+-- @'map' f s@ is the set obtained by applying @f@ to each element of @s@.+--+-- It's worth noting that the size of the result may be smaller if,+-- for some @(x,y)@, @x \/= y && f x == f y@++map :: (Key -> Key) -> Word64Set -> Word64Set+map f = fromList . List.map f . toList++-- | \(O(n)\). The+--+-- @'mapMonotonic' f s == 'map' f s@, but works only when @f@ is strictly increasing.+-- /The precondition is not checked./+-- Semi-formally, we have:+--+-- > and [x < y ==> f x < f y | x <- ls, y <- ls]+-- >                     ==> mapMonotonic f s == map f s+-- >     where ls = toList s+--+-- @since 0.6.3.1++-- Note that for now the test is insufficient to support any fancier implementation.+mapMonotonic :: (Key -> Key) -> Word64Set -> Word64Set+mapMonotonic f = fromDistinctAscList . List.map f . toAscList+++{--------------------------------------------------------------------+  Fold+--------------------------------------------------------------------}+-- | \(O(n)\). Fold the elements in the set using the given right-associative+-- binary operator. This function is an equivalent of 'foldr' and is present+-- for compatibility only.+--+-- /Please note that fold will be deprecated in the future and removed./+fold :: (Key -> b -> b) -> b -> Word64Set -> b+fold = foldr+{-# INLINE fold #-}++-- | \(O(n)\). Fold the elements in the set using the given right-associative+-- binary operator, such that @'foldr' f z == 'Prelude.foldr' f z . 'toAscList'@.+--+-- For example,+--+-- > toAscList set = foldr (:) [] set+foldr :: (Key -> b -> b) -> b -> Word64Set -> b+foldr f z = \t ->      -- Use lambda t to be inlinable with two arguments only.+  case t of Bin _ m l r | m < 0 -> go (go z l) r -- put negative numbers before+                        | otherwise -> go (go z r) l+            _ -> go z t+  where+    go z' Nil           = z'+    go z' (Tip kx bm)   = foldrBits kx f z' bm+    go z' (Bin _ _ l r) = go (go z' r) l+{-# INLINE foldr #-}++-- | \(O(n)\). A strict version of 'foldr'. Each application of the operator is+-- evaluated before using the result in the next application. This+-- function is strict in the starting value.+foldr' :: (Key -> b -> b) -> b -> Word64Set -> b+foldr' f z = \t ->      -- Use lambda t to be inlinable with two arguments only.+  case t of Bin _ m l r | m < 0 -> go (go z l) r -- put negative numbers before+                        | otherwise -> go (go z r) l+            _ -> go z t+  where+    go !z' Nil           = z'+    go z' (Tip kx bm)   = foldr'Bits kx f z' bm+    go z' (Bin _ _ l r) = go (go z' r) l+{-# INLINE foldr' #-}++-- | \(O(n)\). Fold the elements in the set using the given left-associative+-- binary operator, such that @'foldl' f z == 'Prelude.foldl' f z . 'toAscList'@.+--+-- For example,+--+-- > toDescList set = foldl (flip (:)) [] set+foldl :: (a -> Key -> a) -> a -> Word64Set -> a+foldl f z = \t ->      -- Use lambda t to be inlinable with two arguments only.+  case t of Bin _ m l r | m < 0 -> go (go z r) l -- put negative numbers before+                        | otherwise -> go (go z l) r+            _ -> go z t+  where+    go z' Nil           = z'+    go z' (Tip kx bm)   = foldlBits kx f z' bm+    go z' (Bin _ _ l r) = go (go z' l) r+{-# INLINE foldl #-}++-- | \(O(n)\). A strict version of 'foldl'. Each application of the operator is+-- evaluated before using the result in the next application. This+-- function is strict in the starting value.+foldl' :: (a -> Key -> a) -> a -> Word64Set -> a+foldl' f z = \t ->      -- Use lambda t to be inlinable with two arguments only.+  case t of Bin _ m l r | m < 0 -> go (go z r) l -- put negative numbers before+                        | otherwise -> go (go z l) r+            _ -> go z t+  where+    go !z' Nil           = z'+    go z' (Tip kx bm)   = foldl'Bits kx f z' bm+    go z' (Bin _ _ l r) = go (go z' l) r+{-# INLINE foldl' #-}++{--------------------------------------------------------------------+  List variations+--------------------------------------------------------------------}+-- | \(O(n)\). An alias of 'toAscList'. The elements of a set in ascending order.+-- Subject to list fusion.+elems :: Word64Set -> [Key]+elems+  = toAscList++{--------------------------------------------------------------------+  Lists+--------------------------------------------------------------------}++#ifdef __GLASGOW_HASKELL__+-- | @since 0.5.6.2+instance GHC.Exts.IsList Word64Set where+  type Item Word64Set = Key+  fromList = fromList+  toList   = toList+#endif++-- | \(O(n)\). Convert the set to a list of elements. Subject to list fusion.+toList :: Word64Set -> [Key]+toList+  = toAscList++-- | \(O(n)\). Convert the set to an ascending list of elements. Subject to list+-- fusion.+toAscList :: Word64Set -> [Key]+toAscList = foldr (:) []++-- | \(O(n)\). Convert the set to a descending list of elements. Subject to list+-- fusion.+toDescList :: Word64Set -> [Key]+toDescList = foldl (flip (:)) []++-- List fusion for the list generating functions.+#if __GLASGOW_HASKELL__+-- The foldrFB and foldlFB are foldr and foldl equivalents, used for list fusion.+-- They are important to convert unfused to{Asc,Desc}List back, see mapFB in prelude.+foldrFB :: (Key -> b -> b) -> b -> Word64Set -> b+foldrFB = foldr+{-# INLINE[0] foldrFB #-}+foldlFB :: (a -> Key -> a) -> a -> Word64Set -> a+foldlFB = foldl+{-# INLINE[0] foldlFB #-}++-- Inline elems and toList, so that we need to fuse only toAscList.+{-# INLINE elems #-}+{-# INLINE toList #-}++-- The fusion is enabled up to phase 2 included. If it does not succeed,+-- convert in phase 1 the expanded to{Asc,Desc}List calls back to+-- to{Asc,Desc}List.  In phase 0, we inline fold{lr}FB (which were used in+-- a list fusion, otherwise it would go away in phase 1), and let compiler do+-- whatever it wants with to{Asc,Desc}List -- it was forbidden to inline it+-- before phase 0, otherwise the fusion rules would not fire at all.+{-# NOINLINE[0] toAscList #-}+{-# NOINLINE[0] toDescList #-}+{-# RULES "Word64Set.toAscList" [~1] forall s . toAscList s = GHC.Exts.build (\c n -> foldrFB c n s) #-}+{-# RULES "Word64Set.toAscListBack" [1] foldrFB (:) [] = toAscList #-}+{-# RULES "Word64Set.toDescList" [~1] forall s . toDescList s = GHC.Exts.build (\c n -> foldlFB (\xs x -> c x xs) n s) #-}+{-# RULES "Word64Set.toDescListBack" [1] foldlFB (\xs x -> x : xs) [] = toDescList #-}+#endif+++-- | \(O(n \min(n,W))\). Create a set from a list of integers.+fromList :: [Key] -> Word64Set+fromList xs+  = Foldable.foldl' ins empty xs+  where+    ins t x  = insert x t++-- | \(O(n)\). Build a set from an ascending list of elements.+-- /The precondition (input list is ascending) is not checked./+fromAscList :: [Key] -> Word64Set+fromAscList = fromMonoList+{-# NOINLINE fromAscList #-}++-- | \(O(n)\). Build a set from an ascending list of distinct elements.+-- /The precondition (input list is strictly ascending) is not checked./+fromDistinctAscList :: [Key] -> Word64Set+fromDistinctAscList = fromAscList+{-# INLINE fromDistinctAscList #-}++-- | \(O(n)\). Build a set from a monotonic list of elements.+--+-- The precise conditions under which this function works are subtle:+-- For any branch mask, keys with the same prefix w.r.t. the branch+-- mask must occur consecutively in the list.+fromMonoList :: [Key] -> Word64Set+fromMonoList []         = Nil+fromMonoList (kx : zs1) = addAll' (prefixOf kx) (bitmapOf kx) zs1+  where+    -- `addAll'` collects all keys with the prefix `px` into a single+    -- bitmap, and then proceeds with `addAll`.+    addAll' !px !bm []+        = Tip px bm+    addAll' !px !bm (ky : zs)+        | px == prefixOf ky+        = addAll' px (bm .|. bitmapOf ky) zs+        -- inlined: | otherwise = addAll px (Tip px bm) (ky : zs)+        | py <- prefixOf ky+        , m <- branchMask px py+        , Inserted ty zs' <- addMany' m py (bitmapOf ky) zs+        = addAll px (linkWithMask m py ty {-px-} (Tip px bm)) zs'++    -- for `addAll` and `addMany`, px is /a/ prefix inside the tree `tx`+    -- `addAll` consumes the rest of the list, adding to the tree `tx`+    addAll !_px !tx []+        = tx+    addAll !px !tx (ky : zs)+        | py <- prefixOf ky+        , m <- branchMask px py+        , Inserted ty zs' <- addMany' m py (bitmapOf ky) zs+        = addAll px (linkWithMask m py ty {-px-} tx) zs'++    -- `addMany'` is similar to `addAll'`, but proceeds with `addMany'`.+    addMany' !_m !px !bm []+        = Inserted (Tip px bm) []+    addMany' !m !px !bm zs0@(ky : zs)+        | px == prefixOf ky+        = addMany' m px (bm .|. bitmapOf ky) zs+        -- inlined: | otherwise = addMany m px (Tip px bm) (ky : zs)+        | mask px m /= mask ky m+        = Inserted (Tip (prefixOf px) bm) zs0+        | py <- prefixOf ky+        , mxy <- branchMask px py+        , Inserted ty zs' <- addMany' mxy py (bitmapOf ky) zs+        = addMany m px (linkWithMask mxy py ty {-px-} (Tip px bm)) zs'++    -- `addAll` adds to `tx` all keys whose prefix w.r.t. `m` agrees with `px`.+    addMany !_m !_px tx []+        = Inserted tx []+    addMany !m !px tx zs0@(ky : zs)+        | mask px m /= mask ky m+        = Inserted tx zs0+        | py <- prefixOf ky+        , mxy <- branchMask px py+        , Inserted ty zs' <- addMany' mxy py (bitmapOf ky) zs+        = addMany m px (linkWithMask mxy py ty {-px-} tx) zs'+{-# INLINE fromMonoList #-}++data Inserted = Inserted !Word64Set ![Key]++{--------------------------------------------------------------------+  Eq+--------------------------------------------------------------------}+instance Eq Word64Set where+  t1 == t2  = equal t1 t2+  t1 /= t2  = nequal t1 t2++equal :: Word64Set -> Word64Set -> Bool+equal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)+  = (m1 == m2) && (p1 == p2) && (equal l1 l2) && (equal r1 r2)+equal (Tip kx1 bm1) (Tip kx2 bm2)+  = kx1 == kx2 && bm1 == bm2+equal Nil Nil = True+equal _   _   = False++nequal :: Word64Set -> Word64Set -> Bool+nequal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)+  = (m1 /= m2) || (p1 /= p2) || (nequal l1 l2) || (nequal r1 r2)+nequal (Tip kx1 bm1) (Tip kx2 bm2)+  = kx1 /= kx2 || bm1 /= bm2+nequal Nil Nil = False+nequal _   _   = True++{--------------------------------------------------------------------+  Ord+--------------------------------------------------------------------}++instance Ord Word64Set where+    compare s1 s2 = compare (toAscList s1) (toAscList s2)+    -- tentative implementation. See if more efficient exists.++{--------------------------------------------------------------------+  Show+--------------------------------------------------------------------}+instance Show Word64Set where+  showsPrec p xs = showParen (p > 10) $+    showString "fromList " . shows (toList xs)++{--------------------------------------------------------------------+  Read+--------------------------------------------------------------------}+instance Read Word64Set where+#ifdef __GLASGOW_HASKELL__+  readPrec = parens $ prec 10 $ do+    Ident "fromList" <- lexP+    xs <- readPrec+    return (fromList xs)++  readListPrec = readListPrecDefault+#else+  readsPrec p = readParen (p > 10) $ \ r -> do+    ("fromList",s) <- lex r+    (xs,t) <- reads s+    return (fromList xs,t)+#endif++{--------------------------------------------------------------------+  NFData+--------------------------------------------------------------------}++-- The Word64Set constructors consist only of strict fields of Ints and+-- Word64Sets, thus the default NFData instance which evaluates to whnf+-- should suffice+instance NFData Word64Set where rnf x = seq x ()++{--------------------------------------------------------------------+  Debugging+--------------------------------------------------------------------}+-- | \(O(n \min(n,W))\). Show the tree that implements the set. The tree is shown+-- in a compressed, hanging format.+showTree :: Word64Set -> String+showTree s+  = showTreeWith True False s+++{- | \(O(n \min(n,W))\). The expression (@'showTreeWith' hang wide map@) shows+ the tree that implements the set. If @hang@ is+ 'True', a /hanging/ tree is shown otherwise a rotated tree is shown. If+ @wide@ is 'True', an extra wide version is shown.+-}+showTreeWith :: Bool -> Bool -> Word64Set -> String+showTreeWith hang wide t+  | hang      = (showsTreeHang wide [] t) ""+  | otherwise = (showsTree wide [] [] t) ""++showsTree :: Bool -> [String] -> [String] -> Word64Set -> ShowS+showsTree wide lbars rbars t+  = case t of+      Bin p m l r+          -> showsTree wide (withBar rbars) (withEmpty rbars) r .+             showWide wide rbars .+             showsBars lbars . showString (showBin p m) . showString "\n" .+             showWide wide lbars .+             showsTree wide (withEmpty lbars) (withBar lbars) l+      Tip kx bm+          -> showsBars lbars . showString " " . shows kx . showString " + " .+                                                showsBitMap bm . showString "\n"+      Nil -> showsBars lbars . showString "|\n"++showsTreeHang :: Bool -> [String] -> Word64Set -> ShowS+showsTreeHang wide bars t+  = case t of+      Bin p m l r+          -> showsBars bars . showString (showBin p m) . showString "\n" .+             showWide wide bars .+             showsTreeHang wide (withBar bars) l .+             showWide wide bars .+             showsTreeHang wide (withEmpty bars) r+      Tip kx bm+          -> showsBars bars . showString " " . shows kx . showString " + " .+                                               showsBitMap bm . showString "\n"+      Nil -> showsBars bars . showString "|\n"++showBin :: Prefix -> Mask -> String+showBin _ _+  = "*" -- ++ show (p,m)++showWide :: Bool -> [String] -> String -> String+showWide wide bars+  | wide      = showString (concat (reverse bars)) . showString "|\n"+  | otherwise = id++showsBars :: [String] -> ShowS+showsBars [] = id+showsBars (_ : tl) = showString (concat (reverse tl)) . showString node++showsBitMap :: Word64 -> ShowS+showsBitMap = showString . showBitMap++showBitMap :: Word64 -> String+showBitMap w = show $ foldrBits 0 (:) [] w++node :: String+node           = "+--"++withBar, withEmpty :: [String] -> [String]+withBar bars   = "|  ":bars+withEmpty bars = "   ":bars+++{--------------------------------------------------------------------+  Helpers+--------------------------------------------------------------------}+{--------------------------------------------------------------------+  Link+--------------------------------------------------------------------}+link :: Prefix -> Word64Set -> Prefix -> Word64Set -> Word64Set+link p1 t1 p2 t2 = linkWithMask (branchMask p1 p2) p1 t1 {-p2-} t2+{-# INLINE link #-}++-- `linkWithMask` is useful when the `branchMask` has already been computed+linkWithMask :: Mask -> Prefix -> Word64Set -> Word64Set -> Word64Set+linkWithMask m p1 t1 {-p2-} t2+  | zero p1 m = Bin p m t1 t2+  | otherwise = Bin p m t2 t1+  where+    p = mask p1 m+{-# INLINE linkWithMask #-}++{--------------------------------------------------------------------+  @bin@ assures that we never have empty trees within a tree.+--------------------------------------------------------------------}+bin :: Prefix -> Mask -> Word64Set -> Word64Set -> Word64Set+bin _ _ l Nil = l+bin _ _ Nil r = r+bin p m l r   = Bin p m l r+{-# INLINE bin #-}++{--------------------------------------------------------------------+  @tip@ assures that we never have empty bitmaps within a tree.+--------------------------------------------------------------------}+tip :: Prefix -> BitMap -> Word64Set+tip _ 0 = Nil+tip kx bm = Tip kx bm+{-# INLINE tip #-}+++{----------------------------------------------------------------------+  Functions that generate Prefix and BitMap of a Key or a Suffix.+----------------------------------------------------------------------}++suffixBitMask :: Word64+suffixBitMask = fromIntegral (finiteBitSize (undefined::Word64)) - 1+{-# INLINE suffixBitMask #-}++prefixBitMask :: Word64+prefixBitMask = complement suffixBitMask+{-# INLINE prefixBitMask #-}++prefixOf :: Word64 -> Prefix+prefixOf x = x .&. prefixBitMask+{-# INLINE prefixOf #-}++suffixOf :: Word64 -> Word64+suffixOf x = x .&. suffixBitMask+{-# INLINE suffixOf #-}++bitmapOfSuffix :: Word64 -> BitMap+bitmapOfSuffix s = 1 `shiftLL` fromIntegral s+{-# INLINE bitmapOfSuffix #-}++bitmapOf :: Word64 -> BitMap+bitmapOf x = bitmapOfSuffix (suffixOf x)+{-# INLINE bitmapOf #-}+++{--------------------------------------------------------------------+  Endian independent bit twiddling+--------------------------------------------------------------------}+-- Returns True iff the bits set in i and the Mask m are disjoint.+zero :: Word64 -> Mask -> Bool+zero i m+  = (natFromInt i) .&. (natFromInt m) == 0+{-# INLINE zero #-}++nomatch,match :: Word64 -> Prefix -> Mask -> Bool+nomatch i p m+  = (mask i m) /= p+{-# INLINE nomatch #-}++match i p m+  = (mask i m) == p+{-# INLINE match #-}++-- Suppose a is largest such that 2^a divides 2*m.+-- Then mask i m is i with the low a bits zeroed out.+mask :: Word64 -> Mask -> Prefix+mask i m+  = maskW (natFromInt i) (natFromInt m)+{-# INLINE mask #-}++{--------------------------------------------------------------------+  Big endian operations+--------------------------------------------------------------------}+maskW :: Nat -> Nat -> Prefix+maskW i m+  = intFromNat (i .&. (complement (m-1) `xor` m))+{-# INLINE maskW #-}++shorter :: Mask -> Mask -> Bool+shorter m1 m2+  = (natFromInt m1) > (natFromInt m2)+{-# INLINE shorter #-}++branchMask :: Prefix -> Prefix -> Mask+branchMask p1 p2+  = intFromNat (highestBitMask (natFromInt p1 `xor` natFromInt p2))+{-# INLINE branchMask #-}++{----------------------------------------------------------------------+  To get best performance, we provide fast implementations of+  lowestBitSet, highestBitSet and fold[lr][l]Bits for GHC.+  If the intel bsf and bsr instructions ever become GHC primops,+  this code should be reimplemented using these.++  Performance of this code is crucial for folds, toList, filter, partition.++  The signatures of methods in question are placed after this comment.+----------------------------------------------------------------------}++lowestBitSet :: Nat -> Word64+highestBitSet :: Nat -> Word64+foldlBits :: Word64 -> (a -> Word64 -> a) -> a -> Nat -> a+foldl'Bits :: Word64 -> (a -> Word64 -> a) -> a -> Nat -> a+foldrBits :: Word64 -> (Word64 -> a -> a) -> a -> Nat -> a+foldr'Bits :: Word64 -> (Word64 -> a -> a) -> a -> Nat -> a+takeWhileAntitoneBits :: Word64 -> (Word64 -> Bool) -> Nat -> Nat++{-# INLINE lowestBitSet #-}+{-# INLINE highestBitSet #-}+{-# INLINE foldlBits #-}+{-# INLINE foldl'Bits #-}+{-# INLINE foldrBits #-}+{-# INLINE foldr'Bits #-}+{-# INLINE takeWhileAntitoneBits #-}++#if defined(__GLASGOW_HASKELL__)+indexOfTheOnlyBit :: Nat -> Word64+{-# INLINE indexOfTheOnlyBit #-}+indexOfTheOnlyBit bitmask = fromIntegral $ countTrailingZeros bitmask++lowestBitSet x = fromIntegral $ countTrailingZeros x++highestBitSet x = fromIntegral $ 63 - countLeadingZeros x++lowestBitMask :: Nat -> Nat+lowestBitMask x = x .&. negate x+{-# INLINE lowestBitMask #-}++-- Reverse the order of bits in the Nat.+revNat :: Nat -> Nat+revNat x1 = case ((x1 `shiftRL` 1) .&. 0x5555555555555555) .|. ((x1 .&. 0x5555555555555555) `shiftLL` 1) of+              x2 -> case ((x2 `shiftRL` 2) .&. 0x3333333333333333) .|. ((x2 .&. 0x3333333333333333) `shiftLL` 2) of+                 x3 -> case ((x3 `shiftRL` 4) .&. 0x0F0F0F0F0F0F0F0F) .|. ((x3 .&. 0x0F0F0F0F0F0F0F0F) `shiftLL` 4) of+                   x4 -> case ((x4 `shiftRL` 8) .&. 0x00FF00FF00FF00FF) .|. ((x4 .&. 0x00FF00FF00FF00FF) `shiftLL` 8) of+                     x5 -> case ((x5 `shiftRL` 16) .&. 0x0000FFFF0000FFFF) .|. ((x5 .&. 0x0000FFFF0000FFFF) `shiftLL` 16) of+                       x6 -> ( x6 `shiftRL` 32             ) .|. ( x6               `shiftLL` 32);++foldlBits prefix f z bitmap = go bitmap z+  where go 0 acc = acc+        go bm acc = go (bm `xor` bitmask) ((f acc) $! (prefix+bi))+          where+            !bitmask = lowestBitMask bm+            !bi = indexOfTheOnlyBit bitmask++foldl'Bits prefix f z bitmap = go bitmap z+  where go 0 acc = acc+        go bm !acc = go (bm `xor` bitmask) ((f acc) $! (prefix+bi))+          where !bitmask = lowestBitMask bm+                !bi = indexOfTheOnlyBit bitmask++foldrBits prefix f z bitmap = go (revNat bitmap) z+  where go 0 acc = acc+        go bm acc = go (bm `xor` bitmask) ((f $! (prefix+63-bi)) acc)+          where !bitmask = lowestBitMask bm+                !bi = indexOfTheOnlyBit bitmask+++foldr'Bits prefix f z bitmap = go (revNat bitmap) z+  where go 0 acc = acc+        go bm !acc = go (bm `xor` bitmask) ((f $! (prefix+63-bi)) acc)+          where !bitmask = lowestBitMask bm+                !bi = indexOfTheOnlyBit bitmask++takeWhileAntitoneBits prefix predicate bitmap =+  -- Binary search for the first index where the predicate returns false, but skip a predicate+  -- call if the high half of the current range is empty. This ensures+  -- min (log2 64 + 1 = 7) (popcount bitmap) predicate calls.+  let next d h (n',b') =+        if n' .&. h /= 0 && (predicate $! prefix + fromIntegral (b'+d)) then (n' `shiftRL` d, b'+d) else (n',b')+      {-# INLINE next #-}+      (_,b) = next 1  0x2 $+              next 2  0xC $+              next 4  0xF0 $+              next 8  0xFF00 $+              next 16 0xFFFF0000 $+              next 32 0xFFFFFFFF00000000 $+              (bitmap,0)+      m = if b /= 0 || (bitmap .&. 0x1 /= 0 && predicate prefix)+          then ((2 `shiftLL` b) - 1)+          else ((1 `shiftLL` b) - 1)+  in bitmap .&. m++#else+{----------------------------------------------------------------------+  In general case we use logarithmic implementation of+  lowestBitSet and highestBitSet, which works up to bit sizes of 64.++  Folds are linear scans.+----------------------------------------------------------------------}++lowestBitSet n0 =+    let (n1,b1) = if n0 .&. 0xFFFFFFFF /= 0 then (n0,0)  else (n0 `shiftRL` 32, 32)+        (n2,b2) = if n1 .&. 0xFFFF /= 0     then (n1,b1) else (n1 `shiftRL` 16, 16+b1)+        (n3,b3) = if n2 .&. 0xFF /= 0       then (n2,b2) else (n2 `shiftRL` 8,  8+b2)+        (n4,b4) = if n3 .&. 0xF /= 0        then (n3,b3) else (n3 `shiftRL` 4,  4+b3)+        (n5,b5) = if n4 .&. 0x3 /= 0        then (n4,b4) else (n4 `shiftRL` 2,  2+b4)+        b6      = if n5 .&. 0x1 /= 0        then     b5  else                   1+b5+    in b6++highestBitSet n0 =+    let (n1,b1) = if n0 .&. 0xFFFFFFFF00000000 /= 0 then (n0 `shiftRL` 32, 32)    else (n0,0)+        (n2,b2) = if n1 .&. 0xFFFF0000 /= 0         then (n1 `shiftRL` 16, 16+b1) else (n1,b1)+        (n3,b3) = if n2 .&. 0xFF00 /= 0             then (n2 `shiftRL` 8,  8+b2)  else (n2,b2)+        (n4,b4) = if n3 .&. 0xF0 /= 0               then (n3 `shiftRL` 4,  4+b3)  else (n3,b3)+        (n5,b5) = if n4 .&. 0xC /= 0                then (n4 `shiftRL` 2,  2+b4)  else (n4,b4)+        b6      = if n5 .&. 0x2 /= 0                then                   1+b5   else     b5+    in b6++foldlBits prefix f z bm = let lb = lowestBitSet bm+                          in  go (prefix+lb) z (bm `shiftRL` lb)+  where go !_ acc 0 = acc+        go bi acc n | n `testBit` 0 = go (bi + 1) (f acc bi) (n `shiftRL` 1)+                    | otherwise     = go (bi + 1)    acc     (n `shiftRL` 1)++foldl'Bits prefix f z bm = let lb = lowestBitSet bm+                           in  go (prefix+lb) z (bm `shiftRL` lb)+  where go !_ !acc 0 = acc+        go bi acc n | n `testBit` 0 = go (bi + 1) (f acc bi) (n `shiftRL` 1)+                    | otherwise     = go (bi + 1)    acc     (n `shiftRL` 1)++foldrBits prefix f z bm = let lb = lowestBitSet bm+                          in  go (prefix+lb) (bm `shiftRL` lb)+  where go !_ 0 = z+        go bi n | n `testBit` 0 = f bi (go (bi + 1) (n `shiftRL` 1))+                | otherwise     =       go (bi + 1) (n `shiftRL` 1)++foldr'Bits prefix f z bm = let lb = lowestBitSet bm+                           in  go (prefix+lb) (bm `shiftRL` lb)+  where+        go !_ 0 = z+        go bi n | n `testBit` 0 = f bi $! go (bi + 1) (n `shiftRL` 1)+                | otherwise     =         go (bi + 1) (n `shiftRL` 1)++takeWhileAntitoneBits prefix predicate = foldl'Bits prefix f 0 -- Does not use antitone property+  where+    f acc bi | predicate bi = acc .|. bitmapOf bi+             | otherwise    = acc++#endif+++{--------------------------------------------------------------------+  Utilities+--------------------------------------------------------------------}++-- | \(O(1)\).  Decompose a set into pieces based on the structure of the underlying+-- tree.  This function is useful for consuming a set in parallel.+--+-- No guarantee is made as to the sizes of the pieces; an internal, but+-- deterministic process determines this.  However, it is guaranteed that the+-- pieces returned will be in ascending order (all elements in the first submap+-- less than all elements in the second, and so on).+--+-- Examples:+--+-- > splitRoot (fromList [1..120]) == [fromList [1..63],fromList [64..120]]+-- > splitRoot empty == []+--+--  Note that the current implementation does not return more than two subsets,+--  but you should not depend on this behaviour because it can change in the+--  future without notice. Also, the current version does not continue+--  splitting all the way to individual singleton sets -- it stops at some+--  point.+splitRoot :: Word64Set -> [Word64Set]+splitRoot Nil = []+-- NOTE: we don't currently split below Tip, but we could.+splitRoot x@(Tip _ _) = [x]+splitRoot (Bin _ m l r) | m < 0 = [r, l]+                        | otherwise = [l, r]+{-# INLINE splitRoot #-}