[commit: ghc] ghc-8.0: Missing Proxy instances, make U1 instance more Proxy-like (18e5edc)

git at git.haskell.org git at git.haskell.org
Mon Feb 29 13:49:48 UTC 2016


Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/18e5edc03fa4d7a2b934179f6971c9b5e5d180d8/ghc

>---------------------------------------------------------------

commit 18e5edc03fa4d7a2b934179f6971c9b5e5d180d8
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
    
    (cherry picked from commit 171d95df24dc2d9d0c1a3af9e75f021438a7da50)


>---------------------------------------------------------------

18e5edc03fa4d7a2b934179f6971c9b5e5d180d8
 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 c6c8f63..f9a4154 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