Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly
Sign up
Appearance settings

Commit 54bfc62

Browse files
WIP: NonEmptySet functions
1 parent c99b359 commit 54bfc62

File tree

1 file changed

+150
-45
lines changed

1 file changed

+150
-45
lines changed

‎containers/src/Data/Set/Internal.hs

Lines changed: 150 additions & 45 deletions
Original file line numberDiff line numberDiff line change
@@ -294,6 +294,7 @@ type Size = Int
294294

295295
#if __GLASGOW_HASKELL__ >= 708
296296
type role Set nominal
297+
type role NonEmptySet nominal
297298
#endif
298299

299300
instance Ord a => Monoid (Set a) where
@@ -384,30 +385,50 @@ setDataType = mkDataType "Data.Set.Internal.Set" [fromListConstr]
384385
--------------------------------------------------------------------}
385386
-- | /O(1)/. Is this the empty set?
386387
null :: Set a -> Bool
387-
null Tip = True
388-
null (NE (Bin {})) = False
388+
null Tip = True
389+
null (NE _) = False
389390
{-# INLINE null #-}
390391

391392
-- | /O(1)/. The number of elements in the set.
392393
size :: Set a -> Int
393394
size Tip = 0
394-
size (NE (Bin sz _ _ _)) = sz
395+
size (NE ne) = sizeNE ne
395396
{-# INLINE size #-}
396397

398+
sizeNE :: NonEmptySet a -> Int
399+
sizeNE (Bin sz _ _ _) = sz
400+
{-# INLINE sizeNE #-}
401+
397402
-- | /O(log n)/. Is the element in the set?
398403
member :: Ord a => a -> Set a -> Bool
399-
member = go
404+
member = fst . makeMember
405+
406+
memberNE :: Ord a => a -> NonEmptySet a -> Bool
407+
memberNE = snd . makeMember
408+
409+
makeMember
410+
:: Ord a
411+
=> a
412+
-> ( Set a -> Bool
413+
, NonEmptySet a -> Bool
414+
)
415+
makeMember !x = (go, go')
400416
where
401-
go !_ Tip = False
402-
go x (NE (Bin _ y l r)) = case compare x y of
403-
LT -> go x l
404-
GT -> go x r
417+
go Tip = False
418+
go (NE ne) = go' ne
419+
420+
go' (Bin _ y l r) = case compare x y of
421+
LT -> go l
422+
GT -> go r
405423
EQ -> True
406424
#if __GLASGOW_HASKELL__
407425
{-# INLINABLE member #-}
426+
{-# INLINABLE memberNE #-}
408427
#else
409428
{-# INLINE member #-}
429+
{-# INLINE memberNE #-}
410430
#endif
431+
{-# INLINE makeMember #-}
411432

412433
-- | /O(log n)/. Is the element not in the set?
413434
notMember :: Ord a => a -> Set a -> Bool
@@ -418,103 +439,183 @@ notMember a t = not $ member a t
418439
{-# INLINE notMember #-}
419440
#endif
420441

442+
notMemberNE :: Ord a => a -> NonEmptySet a -> Bool
443+
notMemberNE a t = not $ memberNE a t
444+
#if __GLASGOW_HASKELL__
445+
{-# INLINABLE notMemberNE #-}
446+
#else
447+
{-# INLINE notMemberNE #-}
448+
#endif
449+
421450
-- | /O(log n)/. Find largest element smaller than the given one.
422451
--
423452
-- > lookupLT 3 (fromList [3, 5]) == Nothing
424453
-- > lookupLT 5 (fromList [3, 5]) == Just 3
425454
lookupLT :: Ord a => a -> Set a -> Maybe a
426-
lookupLT = goNothing
455+
lookupLT = fst . makeLookupLT
456+
457+
lookupLTNE :: Ord a => a -> NonEmptySet a -> Maybe a
458+
lookupLTNE = snd . makeLookupLT
459+
460+
makeLookupLT
461+
:: Ord a
462+
=> a
463+
-> ( Set a -> Maybe a
464+
, NonEmptySet a -> Maybe a
465+
)
466+
makeLookupLT !x = (goNothing, goNothing')
427467
where
428-
goNothing !_ Tip = Nothing
429-
goNothing x (NE (Bin _ y l r))
430-
| x <= y = goNothing x l
431-
| otherwise = goJust x y r
468+
goNothing Tip = Nothing
469+
goNothing (NE ne) = goNothing' ne
470+
471+
goNothing' (Bin _ y l r)
472+
| x <= y = goNothing l
473+
| otherwise = goJust y r
474+
475+
goJust best Tip = Just best
476+
goJust best (NE ne) = goJust' best ne
432477

433-
goJust !_ best Tip = Just best
434-
goJust x best (NE (Bin _ y l r))
435-
| x <= y = goJust x best l
436-
| otherwise = goJust x y r
478+
goJust' best (Bin _ y l r)
479+
| x <= y = goJust best l
480+
| otherwise = goJust y r
437481

438482
#if __GLASGOW_HASKELL__
439483
{-# INLINABLE lookupLT #-}
484+
{-# INLINABLE lookupLTNE #-}
440485
#else
441486
{-# INLINE lookupLT #-}
487+
{-# INLINE lookupLTNE #-}
442488
#endif
489+
{-# INLINE makeLookupLT #-}
443490

444491
-- | /O(log n)/. Find smallest element greater than the given one.
445492
--
446493
-- > lookupGT 4 (fromList [3, 5]) == Just 5
447494
-- > lookupGT 5 (fromList [3, 5]) == Nothing
448495
lookupGT :: Ord a => a -> Set a -> Maybe a
449-
lookupGT = goNothing
496+
lookupGT = fst . makeLookupGT
497+
498+
lookupGTNE :: Ord a => a -> NonEmptySet a -> Maybe a
499+
lookupGTNE = snd . makeLookupGT
500+
501+
makeLookupGT
502+
:: Ord a
503+
=> a
504+
-> ( Set a -> Maybe a
505+
, NonEmptySet a -> Maybe a
506+
)
507+
makeLookupGT !x = (goNothing, goNothing')
450508
where
451-
goNothing !_ Tip = Nothing
452-
goNothing x (NE (Bin _ y l r))
453-
| x < y = goJust x y l
454-
| otherwise = goNothing x r
509+
goNothing Tip = Nothing
510+
goNothing (NE ne) = goNothing' ne
455511

456-
goJust !_ best Tip = Just best
457-
goJust x best (NE (Bin _ y l r))
458-
| x < y = goJust x y l
459-
| otherwise = goJust x best r
512+
goNothing' (Bin _ y l r)
513+
| x < y = goJust y l
514+
| otherwise = goNothing r
515+
516+
goJust best Tip = Just best
517+
goJust best (NE ne) = goJust' best ne
518+
519+
goJust' best (Bin _ y l r)
520+
| x < y = goJust y l
521+
| otherwise = goJust best r
460522

461523
#if __GLASGOW_HASKELL__
462524
{-# INLINABLE lookupGT #-}
525+
{-# INLINABLE lookupGTNE #-}
463526
#else
464527
{-# INLINE lookupGT #-}
528+
{-# INLINE lookupGTNE #-}
465529
#endif
530+
{-# INLINE makeLookupGT #-}
466531

467532
-- | /O(log n)/. Find largest element smaller or equal to the given one.
468533
--
469534
-- > lookupLE 2 (fromList [3, 5]) == Nothing
470535
-- > lookupLE 4 (fromList [3, 5]) == Just 3
471536
-- > lookupLE 5 (fromList [3, 5]) == Just 5
472537
lookupLE :: Ord a => a -> Set a -> Maybe a
473-
lookupLE = goNothing
538+
lookupLE = fst . makeLookupLE
539+
540+
lookupLENE :: Ord a => a -> NonEmptySet a -> Maybe a
541+
lookupLENE = snd . makeLookupLE
542+
543+
makeLookupLE
544+
:: Ord a
545+
=> a
546+
-> ( Set a -> Maybe a
547+
, NonEmptySet a -> Maybe a
548+
)
549+
makeLookupLE !x = (goNothing, goNothing')
474550
where
475-
goNothing !_ Tip = Nothing
476-
goNothing x (NE (Bin _ y l r)) = case compare x y of
477-
LT -> goNothing x l
551+
goNothing Tip = Nothing
552+
goNothing (NE ne) = goNothing' ne
553+
554+
goNothing' (Bin _ y l r) = case compare x y of
555+
LT -> goNothing l
478556
EQ -> Just y
479-
GT -> goJust x y r
557+
GT -> goJust y r
558+
559+
goJust best Tip = Just best
560+
goJust best (NE ne) = goJust' best ne
480561

481-
goJust !_ best Tip = Just best
482-
goJust x best (NE (Bin _ y l r)) = case compare x y of
483-
LT -> goJust x best l
562+
goJust' best (Bin _ y l r) = case compare x y of
563+
LT -> goJust best l
484564
EQ -> Just y
485-
GT -> goJust x y r
565+
GT -> goJust y r
486566

487567
#if __GLASGOW_HASKELL__
488568
{-# INLINABLE lookupLE #-}
569+
{-# INLINABLE lookupLENE #-}
489570
#else
490571
{-# INLINE lookupLE #-}
572+
{-# INLINE lookupLENE #-}
491573
#endif
574+
{-# INLINE makeLookupLE #-}
492575

493576
-- | /O(log n)/. Find smallest element greater or equal to the given one.
494577
--
495578
-- > lookupGE 3 (fromList [3, 5]) == Just 3
496579
-- > lookupGE 4 (fromList [3, 5]) == Just 5
497580
-- > lookupGE 6 (fromList [3, 5]) == Nothing
498581
lookupGE :: Ord a => a -> Set a -> Maybe a
499-
lookupGE = goNothing
582+
lookupGE = fst . makeLookupGE
583+
584+
lookupGENE :: Ord a => a -> NonEmptySet a -> Maybe a
585+
lookupGENE = snd . makeLookupGE
586+
587+
makeLookupGE
588+
:: Ord a
589+
=> a
590+
-> ( Set a -> Maybe a
591+
, NonEmptySet a -> Maybe a
592+
)
593+
makeLookupGE !x = (goNothing, goNothing')
500594
where
501-
goNothing !_ Tip = Nothing
502-
goNothing x (NE (Bin _ y l r)) = case compare x y of
503-
LT -> goJust x y l
595+
goNothing Tip = Nothing
596+
goNothing (NE ne) = goNothing' ne
597+
598+
goNothing' (Bin _ y l r) = case compare x y of
599+
LT -> goJust y l
504600
EQ -> Just y
505-
GT -> goNothing x r
601+
GT -> goNothing r
602+
603+
goJust best Tip = Just best
604+
goJust best (NE ne) = goJust' best ne
506605

507-
goJust !_ best Tip = Just best
508-
goJust x best (NE (Bin _ y l r)) = case compare x y of
509-
LT -> goJust x y l
606+
goJust' best (Bin _ y l r) = case compare x y of
607+
LT -> goJust y l
510608
EQ -> Just y
511-
GT -> goJust x best r
609+
GT -> goJust best r
512610

513611
#if __GLASGOW_HASKELL__
514612
{-# INLINABLE lookupGE #-}
613+
{-# INLINABLE lookupGENE #-}
515614
#else
516615
{-# INLINE lookupGE #-}
616+
{-# INLINE lookupGENE #-}
517617
#endif
618+
{-# INLINE makeLookupGE #-}
518619

519620
{--------------------------------------------------------------------
520621
Construction
@@ -526,9 +627,13 @@ empty = Tip
526627

527628
-- | /O(1)/. Create a singleton set.
528629
singleton :: a -> Set a
529-
singleton x = NE $Bin1 x TipTip
630+
singleton = NE . singletonNE
530631
{-# INLINE singleton #-}
531632

633+
singletonNE :: a -> NonEmptySet a
634+
singletonNE x = Bin 1 x Tip Tip
635+
{-# INLINE singletonNE #-}
636+
532637
{--------------------------------------------------------------------
533638
Insertion, Deletion
534639
--------------------------------------------------------------------}

0 commit comments

Comments
(0)

AltStyle によって変換されたページ (->オリジナル) /