[commit: ghc] master: Missing Proxy instances, make U1 instance more Proxy-like (171d95d)
git at git.haskell.org
git at git.haskell.org
Mon Feb 29 12:41:14 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/171d95df24dc2d9d0c1a3af9e75f021438a7da50/ghc
>---------------------------------------------------------------
commit 171d95df24dc2d9d0c1a3af9e75f021438a7da50
Author: RyanGlScott <ryan.gl.scott at gmail.com>
Date: Mon Feb 29 12:28:18 2016 +0100
Missing Proxy instances, make U1 instance more Proxy-like
This accomplishes three things:
* Adds missing `Alternative`, `MonadPlus`, and `MonadZip` instances for
`Proxy`
* Adds a missing `MonadPlus` instance for `U1`
* Changes several existing `U1` instances to use lazy pattern-matching,
exactly how `Proxy` does it (in case we ever replace `U1` with
`Proxy`). This is technically a breaking change (albeit an extremely
minor one).
Test Plan: ./validate
Reviewers: austin, ekmett, hvr, bgamari
Reviewed By: bgamari
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D1962
GHC Trac Issues: #11650
>---------------------------------------------------------------
171d95df24dc2d9d0c1a3af9e75f021438a7da50
libraries/base/Control/Monad/Zip.hs | 7 +++++++
libraries/base/Data/Foldable.hs | 18 +++++++++++++++++-
libraries/base/Data/Proxy.hs | 8 ++++++++
libraries/base/Data/Traversable.hs | 11 ++++++++++-
libraries/base/GHC/Generics.hs | 34 ++++++++++++++++++++++++----------
libraries/base/changelog.md | 3 +++
6 files changed, 69 insertions(+), 12 deletions(-)
diff --git a/libraries/base/Control/Monad/Zip.hs b/libraries/base/Control/Monad/Zip.hs
index 771b8aa..fa44438 100644
--- a/libraries/base/Control/Monad/Zip.hs
+++ b/libraries/base/Control/Monad/Zip.hs
@@ -20,6 +20,7 @@ module Control.Monad.Zip where
import Control.Monad (liftM, liftM2)
import Data.Monoid
+import Data.Proxy
import GHC.Generics
-- | `MonadZip` type class. Minimal definition: `mzip` or `mzipWith`
@@ -78,7 +79,13 @@ instance MonadZip Last where
instance MonadZip f => MonadZip (Alt f) where
mzipWith f (Alt ma) (Alt mb) = Alt (mzipWith f ma mb)
+instance MonadZip Proxy where
+ mzipWith _ _ _ = Proxy
+
-- Instances for GHC.Generics
+instance MonadZip U1 where
+ mzipWith _ _ _ = U1
+
instance MonadZip Par1 where
mzipWith = liftM2
diff --git a/libraries/base/Data/Foldable.hs b/libraries/base/Data/Foldable.hs
index 5d758ae..0defe6c 100644
--- a/libraries/base/Data/Foldable.hs
+++ b/libraries/base/Data/Foldable.hs
@@ -425,8 +425,24 @@ instance Ord a => Monoid (Min a) where
| otherwise = Min n
-- Instances for GHC.Generics
+instance Foldable U1 where
+ foldMap _ _ = mempty
+ {-# INLINE foldMap #-}
+ fold _ = mempty
+ {-# INLINE fold #-}
+ foldr _ z _ = z
+ {-# INLINE foldr #-}
+ foldl _ z _ = z
+ {-# INLINE foldl #-}
+ foldl1 _ _ = errorWithoutStackTrace "foldl1: U1"
+ foldr1 _ _ = errorWithoutStackTrace "foldr1: U1"
+ length _ = 0
+ null _ = True
+ elem _ _ = False
+ sum _ = 0
+ product _ = 1
+
deriving instance Foldable V1
-deriving instance Foldable U1
deriving instance Foldable Par1
deriving instance Foldable f => Foldable (Rec1 f)
deriving instance Foldable (K1 i c)
diff --git a/libraries/base/Data/Proxy.hs b/libraries/base/Data/Proxy.hs
index 9f602ea..f0760e8 100644
--- a/libraries/base/Data/Proxy.hs
+++ b/libraries/base/Data/Proxy.hs
@@ -89,10 +89,18 @@ instance Applicative Proxy where
_ <*> _ = Proxy
{-# INLINE (<*>) #-}
+instance Alternative Proxy where
+ empty = Proxy
+ {-# INLINE empty #-}
+ _ <|> _ = Proxy
+ {-# INLINE (<|>) #-}
+
instance Monad Proxy where
_ >>= _ = Proxy
{-# INLINE (>>=) #-}
+instance MonadPlus Proxy
+
-- | 'asProxyTypeOf' is a type-restricted version of 'const'.
-- It is usually used as an infix operator, and its typing forces its first
-- argument (which is usually overloaded) to have the same type as the tag
diff --git a/libraries/base/Data/Traversable.hs b/libraries/base/Data/Traversable.hs
index c6a30d7..b903b1d 100644
--- a/libraries/base/Data/Traversable.hs
+++ b/libraries/base/Data/Traversable.hs
@@ -228,8 +228,17 @@ instance Traversable ZipList where
traverse f (ZipList x) = ZipList <$> traverse f x
-- Instances for GHC.Generics
+instance Traversable U1 where
+ traverse _ _ = pure U1
+ {-# INLINE traverse #-}
+ sequenceA _ = pure U1
+ {-# INLINE sequenceA #-}
+ mapM _ _ = pure U1
+ {-# INLINE mapM #-}
+ sequence _ = pure U1
+ {-# INLINE sequence #-}
+
deriving instance Traversable V1
-deriving instance Traversable U1
deriving instance Traversable Par1
deriving instance Traversable f => Traversable (Rec1 f)
deriving instance Traversable (K1 i c)
diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs
index f723127..62c3576 100644
--- a/libraries/base/GHC/Generics.hs
+++ b/libraries/base/GHC/Generics.hs
@@ -712,10 +712,10 @@ import GHC.Types
import GHC.Arr ( Ix )
import GHC.Base ( Alternative(..), Applicative(..), Functor(..)
, Monad(..), MonadPlus(..), String )
-import GHC.Classes ( Eq, Ord )
+import GHC.Classes ( Eq(..), Ord(..) )
import GHC.Enum ( Bounded, Enum )
-import GHC.Read ( Read )
-import GHC.Show ( Show )
+import GHC.Read ( Read(..), lex, readParen )
+import GHC.Show ( Show(..), showString )
-- Needed for metadata
import Data.Proxy ( Proxy(..), KProxy(..) )
@@ -736,21 +736,35 @@ deriving instance Show (V1 p)
-- | Unit: used for constructors without arguments
data U1 (p :: *) = U1
- deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)
+ deriving (Generic, Generic1)
+
+instance Eq (U1 p) where
+ _ == _ = True
+
+instance Ord (U1 p) where
+ compare _ _ = EQ
+
+instance Read (U1 p) where
+ readsPrec d = readParen (d > 10) (\r -> [(U1, s) | ("U1",s) <- lex r ])
+
+instance Show (U1 p) where
+ showsPrec _ _ = showString "U1"
+
+instance Functor U1 where
+ fmap _ _ = U1
instance Applicative U1 where
pure _ = U1
- U1 <*> U1 = U1
+ _ <*> _ = U1
instance Alternative U1 where
empty = U1
- U1 <|> U1 = U1
- -- The defaults will otherwise bottom; see #11650.
- some U1 = U1
- many U1 = U1
+ _ <|> _ = U1
instance Monad U1 where
- U1 >>= _ = U1
+ _ >>= _ = U1
+
+instance MonadPlus U1
-- | Used for marking occurrences of the parameter
newtype Par1 p = Par1 { unPar1 :: p }
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index b0ccda6..92451b9 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -49,6 +49,9 @@
`GHC.Generics` as part of making GHC generics capable of handling
unlifted types (#10868)
+ * The `Eq`, `Ord`, `Read`, and `Show` instances for `U1` now use lazier
+ pattern-matching
+
* Keep `shift{L,R}` on `Integer` with negative shift-arguments from
segfaulting (#10571)
More information about the ghc-commits
mailing list