Skip to content

Define a common StrictTriple for internal use #1170

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
meooow25 merged 1 commit into from
Jan 1, 2026
+44 −79
Merged

Define a common StrictTriple for internal use #1170

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 1 addition & 2 deletions containers-tests/containers-tests.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -114,13 +114,12 @@ library
Data.Tree
Utils.Containers.Internal.BitQueue
Utils.Containers.Internal.BitUtil
Utils.Containers.Internal.StrictPair

other-modules:
Utils.Containers.Internal.Prelude
Utils.Containers.Internal.PtrEquality
Utils.Containers.Internal.State
Utils.Containers.Internal.StrictMaybe
Utils.Containers.Internal.Strict
Utils.Containers.Internal.EqOrdUtil

if impl(ghc >= 8.6)
Expand Down
3 changes: 1 addition & 2 deletions containers/containers.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -81,11 +81,10 @@ Library
other-modules:
Utils.Containers.Internal.Prelude
Utils.Containers.Internal.State
Utils.Containers.Internal.StrictMaybe
Utils.Containers.Internal.Strict
Utils.Containers.Internal.PtrEquality
Utils.Containers.Internal.EqOrdUtil
Utils.Containers.Internal.BitUtil
Utils.Containers.Internal.BitQueue
Utils.Containers.Internal.StrictPair

include-dirs: include
23 changes: 12 additions & 11 deletions containers/src/Data/IntMap/Internal.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -347,7 +347,8 @@ import Data.IntSet.Internal.IntTreeCommons
, Order(..)
)
import Utils.Containers.Internal.BitUtil (shiftLL, shiftRL, iShiftRL, wordSize)
import Utils.Containers.Internal.StrictPair
import Utils.Containers.Internal.Strict
(StrictPair(..), StrictTriple(..), toPair)

#ifdef __GLASGOW_HASKELL__
import Data.Coerce
Expand Down Expand Up @@ -2974,14 +2975,14 @@ split k t =
go _ Nil = (Nil :*: Nil)


data SplitLookup a = SplitLookup !(IntMap a) !(Maybe a) !(IntMap a)
type SplitLookup a = StrictTriple (IntMap a) (Maybe a) (IntMap a)
Copy link
Contributor

@treeowl treeowl Dec 28, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Have you tried stitching to an unlifted maybe here? I don't remember if I have.

Copy link
Contributor Author

@meooow25 meooow25 Dec 28, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Would that make a difference compared to simply being strict?

But switching to an unboxed/unpacked Maybe would avoid allocating the Justs, we could try that later.

Copy link
Contributor

@treeowl treeowl Dec 28, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It's just one allocation, so probably not a big deal, but yeah, I think it'd be worth trying.


mapLT :: (IntMap a -> IntMap a) -> SplitLookup a -> SplitLookup a
mapLT f (SplitLookup lt fnd gt) = SplitLookup (f lt) fnd gt
mapLT f (TripleS lt fnd gt) = TripleS (f lt) fnd gt
{-# INLINE mapLT #-}

mapGT :: (IntMap a -> IntMap a) -> SplitLookup a -> SplitLookup a
mapGT f (SplitLookup lt fnd gt) = SplitLookup lt fnd (f gt)
mapGT f (TripleS lt fnd gt) = TripleS lt fnd (f gt)
{-# INLINE mapGT #-}

-- | \(O(\min(n,W))\). Performs a 'split' but also returns whether the pivot
Expand All @@ -3003,20 +3004,20 @@ splitLookup k t =
then mapLT (\l' -> binCheckL p l' r) (go k l)
else mapGT (binCheckR p l) (go k r)
_ -> go k t
of SplitLookup lt fnd gt -> (lt, fnd, gt)
of TripleS lt fnd gt -> (lt, fnd, gt)
where
go !k' t'@(Bin p l r)
| nomatch k' p =
if k' < unPrefix p
then SplitLookup Nil Nothing t'
else SplitLookup t' Nothing Nil
then TripleS Nil Nothing t'
else TripleS t' Nothing Nil
| left k' p = mapGT (\l' -> binCheckL p l' r) (go k' l)
| otherwise = mapLT (binCheckR p 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
| k' > ky = TripleS t' Nothing Nil
| k' < ky = TripleS Nil Nothing t'
| otherwise = TripleS Nil (Just y) Nil
go _ Nil = TripleS Nil Nothing Nil

{--------------------------------------------------------------------
Fold
Expand Down
2 changes: 1 addition & 1 deletion containers/src/Data/IntMap/Strict/Internal.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -329,7 +329,7 @@ import Data.IntMap.Internal
)
import qualified Data.IntSet.Internal as IntSet
import Utils.Containers.Internal.BitUtil (iShiftRL, shiftLL, shiftRL)
import Utils.Containers.Internal.StrictPair
import Utils.Containers.Internal.Strict (StrictPair(..), toPair)
import qualified Data.Foldable as Foldable
import Data.Functor.Identity (Identity (..))

Expand Down
2 changes: 1 addition & 1 deletion containers/src/Data/IntSet/Internal.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -203,7 +203,7 @@ import Utils.Containers.Internal.Prelude hiding
import Prelude ()

import Utils.Containers.Internal.BitUtil (iShiftRL, shiftLL, shiftRL)
import Utils.Containers.Internal.StrictPair
import Utils.Containers.Internal.Strict (StrictPair(..), toPair)
import Data.IntSet.Internal.IntTreeCommons
( Key
, Prefix(..)
Expand Down
35 changes: 16 additions & 19 deletions containers/src/Data/Map/Internal.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -365,7 +365,6 @@ module Data.Map.Internal (
, ascLinkAll
, descLinkTop
, descLinkAll
, MaybeS(..)
, Identity(..)
, Stack(..)
, foldl'Stack
Expand Down Expand Up @@ -403,8 +402,8 @@ import Prelude ()
import qualified Data.Set.Internal as Set
import Data.Set.Internal (Set)
import Utils.Containers.Internal.PtrEquality (ptrEq)
import Utils.Containers.Internal.StrictPair
import Utils.Containers.Internal.StrictMaybe
import Utils.Containers.Internal.Strict
(StrictPair(..), StrictTriple(..), toPair)
import Utils.Containers.Internal.BitQueue
import Utils.Containers.Internal.EqOrdUtil (EqM(..), OrdM(..))
#ifdef DEFINE_ALTERF_FALLBACK
Expand Down Expand Up @@ -3976,20 +3975,20 @@ split !k0 t0 = toPair $ go k0 t0
-- > splitLookup 6 (fromList [(5,"a"), (3,"b")]) == (fromList [(3,"b"), (5,"a")], Nothing, empty)
splitLookup :: Ord k => k -> Map k a -> (Map k a,Maybe a,Map k a)
splitLookup k0 m = case go k0 m of
StrictTriple l mv r -> (l, mv, r)
TripleS l mv r -> (l, mv, r)
where
go :: Ord k => k -> Map k a -> StrictTriple (Map k a) (Maybe a) (Map k a)
go !k t =
case t of
Tip -> StrictTriple Tip Nothing Tip
Tip -> TripleS Tip Nothing Tip
Bin _ kx x l r -> case compare k kx of
LT -> let StrictTriple lt z gt = go k l
LT -> let TripleS lt z gt = go k l
!gt' = linkR kx x gt r
in StrictTriple lt z gt'
GT -> let StrictTriple lt z gt = go k r
in TripleS lt z gt'
GT -> let TripleS lt z gt = go k r
!lt' = linkL kx x l lt
in StrictTriple lt' z gt
EQ -> StrictTriple l (Just x) r
in TripleS lt' z gt
EQ -> TripleS l (Just x) r
#if __GLASGOW_HASKELL__
{-# INLINABLE splitLookup #-}
#endif
Expand All @@ -4000,26 +3999,24 @@ splitLookup k0 m = case go k0 m of
-- constructors.
splitMember :: Ord k => k -> Map k a -> (Map k a,Bool,Map k a)
splitMember k0 m = case go k0 m of
StrictTriple l mv r -> (l, mv, r)
TripleS l mv r -> (l, mv, r)
where
go :: Ord k => k -> Map k a -> StrictTriple (Map k a) Bool (Map k a)
go !k t =
case t of
Tip -> StrictTriple Tip False Tip
Tip -> TripleS Tip False Tip
Bin _ kx x l r -> case compare k kx of
LT -> let StrictTriple lt z gt = go k l
LT -> let TripleS lt z gt = go k l
!gt' = linkR kx x gt r
in StrictTriple lt z gt'
GT -> let StrictTriple lt z gt = go k r
in TripleS lt z gt'
GT -> let TripleS lt z gt = go k r
!lt' = linkL kx x l lt
in StrictTriple lt' z gt
EQ -> StrictTriple l True r
in TripleS lt' z gt
EQ -> TripleS l True r
#if __GLASGOW_HASKELL__
{-# INLINABLE splitMember #-}
#endif

data StrictTriple a b c = StrictTriple !a !b !c

{--------------------------------------------------------------------
MapBuilder
--------------------------------------------------------------------}
Expand Down
2 changes: 1 addition & 1 deletion containers/src/Data/Map/Strict/Internal.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -415,7 +415,7 @@ import Control.Applicative (Const (..), liftA3)
import Data.Semigroup (Arg (..))
import qualified Data.Set.Internal as Set
import qualified Data.Map.Internal as L
import Utils.Containers.Internal.StrictPair
import Utils.Containers.Internal.Strict (StrictPair(..), toPair)

#ifdef __GLASGOW_HASKELL__
import Data.Coerce
Expand Down
2 changes: 1 addition & 1 deletion containers/src/Data/Sequence/Internal.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -232,7 +232,7 @@ import qualified Data.Array

import Data.Functor.Identity (Identity(..))

import Utils.Containers.Internal.StrictPair (StrictPair (..), toPair)
import Utils.Containers.Internal.Strict (StrictPair (..), toPair)
import Control.Monad.Zip (MonadZip (..))
import Control.Monad.Fix (MonadFix (..), fix)

Expand Down
2 changes: 1 addition & 1 deletion containers/src/Data/Set/Internal.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -241,7 +241,7 @@ import qualified Data.Foldable as Foldable
import Control.DeepSeq (NFData(rnf),NFData1(liftRnf))
import Data.List.NonEmpty (NonEmpty(..))

import Utils.Containers.Internal.StrictPair
import Utils.Containers.Internal.Strict (StrictPair(..), toPair)
import Utils.Containers.Internal.PtrEquality
import Utils.Containers.Internal.EqOrdUtil (EqM(..), OrdM(..))

Expand Down
2 changes: 1 addition & 1 deletion containers/src/Utils/Containers/Internal/EqOrdUtil.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@ module Utils.Containers.Internal.EqOrdUtil
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup (Semigroup(..))
#endif
import Utils.Containers.Internal.StrictPair
import Utils.Containers.Internal.Strict (StrictPair(..))

newtype EqM a = EqM { runEqM :: a -> StrictPair Bool a }

Expand Down
18 changes: 8 additions & 10 deletions ...c/Utils/Containers/Internal/StrictPair.hs → ...s/src/Utils/Containers/Internal/Strict.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,13 +1,9 @@
{-# LANGUAGE CPP #-}
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE Safe #-}
#endif

#include "containers.h"

-- | A strict pair

module Utils.Containers.Internal.StrictPair (StrictPair(..), toPair) where
-- | Simple strict types for internal use.
module Utils.Containers.Internal.Strict
( StrictPair(..)
, toPair
, StrictTriple(..)
) where

-- | The same as a regular Haskell pair, but
--
Expand All @@ -22,3 +18,5 @@ infixr 1 :*:
toPair :: StrictPair a b -> (a, b)
toPair (x :*: y) = (x, y)
{-# INLINE toPair #-}

data StrictTriple a b c = TripleS !a !b !c
29 changes: 0 additions & 29 deletions containers/src/Utils/Containers/Internal/StrictMaybe.hs
View file
Open in desktop

This file was deleted.