Skip to content

Commit bd7b470

Browse files
committed
Use Data.Functor.Identity
This has just entered base, and includes some optimizations that may or may not be relevant. For older versions, don't bother making Identity a Monad instance--it's not exported, and that instance is never used. Make applicativeTree slightly more readable.
1 parent ddf12fd commit bd7b470

File tree

1 file changed

+20
-20
lines changed

1 file changed

+20
-20
lines changed

Data/Sequence.hs

Lines changed: 20 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -168,6 +168,9 @@ import Data.Data
168168
#if __GLASGOW_HASKELL__ >= 709
169169
import Data.Coerce
170170
#endif
171+
#if MIN_VERSION_base(4,8,0)
172+
import Data.Functor.Identity (Identity(..))
173+
#endif
171174

172175

173176
infixr 5 `consTree`
@@ -554,19 +557,16 @@ instance NFData a => NFData (Elem a) where
554557
-------------------------------------------------------
555558
-- Applicative construction
556559
-------------------------------------------------------
560+
#if !MIN_VERSION_base(4,8,0)
561+
newtype Identity a = Identity {runIdentity :: a}
557562

558-
newtype Id a = Id {runId :: a}
559-
560-
instance Functor Id where
561-
fmap f (Id x) = Id (f x)
562-
563-
instance Monad Id where
564-
return = Id
565-
m >>= k = k (runId m)
563+
instance Functor Identity where
564+
fmap f (Identity x) = Identity (f x)
566565

567-
instance Applicative Id where
568-
pure = return
569-
(<*>) = ap
566+
instance Applicative Identity where
567+
pure = Identity
568+
Identity f <*> Identity x = Identity (f x)
569+
#endif
570570

571571
-- | This is essentially a clone of Control.Monad.State.Strict.
572572
newtype State s a = State {runState :: s -> (s, a)}
@@ -598,26 +598,26 @@ mapAccumL' f s t = runState (traverse (State . flip f) t) s
598598
-- specified. This is a generalization of 'replicateA', which itself
599599
-- is a generalization of many Data.Sequence methods.
600600
{-# SPECIALIZE applicativeTree :: Int -> Int -> State s a -> State s (FingerTree a) #-}
601-
{-# SPECIALIZE applicativeTree :: Int -> Int -> Id a -> Id (FingerTree a) #-}
602-
-- Special note: the Id specialization automatically does node sharing,
601+
{-# SPECIALIZE applicativeTree :: Int -> Int -> Identity a -> Identity (FingerTree a) #-}
602+
-- Special note: the Identity specialization automatically does node sharing,
603603
-- reducing memory usage of the resulting tree to /O(log n)/.
604604
applicativeTree :: Applicative f => Int -> Int -> f a -> f (FingerTree a)
605605
applicativeTree n mSize m = mSize `seq` case n of
606606
0 -> pure Empty
607-
1 -> liftA Single m
607+
1 -> fmap Single m
608608
2 -> deepA one emptyTree one
609609
3 -> deepA two emptyTree one
610610
4 -> deepA two emptyTree two
611611
5 -> deepA three emptyTree two
612612
6 -> deepA three emptyTree three
613613
7 -> deepA four emptyTree three
614614
8 -> deepA four emptyTree four
615-
_ -> let (q, r) = n `quotRem` 3 in q `seq` case r of
616-
0 -> deepA three (applicativeTree (q - 2) mSize' n3) three
617-
1 -> deepA four (applicativeTree (q - 2) mSize' n3) three
618-
_ -> deepA four (applicativeTree (q - 2) mSize' n3) four
615+
_ -> case n `quotRem` 3 of
616+
(q,0) -> deepA three (applicativeTree (q - 2) mSize' n3) three
617+
(q,1) -> deepA four (applicativeTree (q - 2) mSize' n3) three
618+
(q,_) -> deepA four (applicativeTree (q - 2) mSize' n3) four
619619
where
620-
one = liftA One m
620+
one = fmap One m
621621
two = liftA2 Two m m
622622
three = liftA3 Three m m m
623623
four = liftA3 Four m m m <*> m
@@ -641,7 +641,7 @@ singleton x = Seq (Single (Elem x))
641641
-- | /O(log n)/. @replicate n x@ is a sequence consisting of @n@ copies of @x@.
642642
replicate :: Int -> a -> Seq a
643643
replicate n x
644-
| n >= 0 = runId (replicateA n (Id x))
644+
| n >= 0 = runIdentity (replicateA n (Identity x))
645645
| otherwise = error "replicate takes a nonnegative integer argument"
646646

647647
-- | 'replicateA' is an 'Applicative' version of 'replicate', and makes

0 commit comments

Comments
 (0)