[Git][ghc/ghc][master] Move Void to GHC.Base...
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed Nov 30 19:52:04 UTC 2022
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
10a2a7de by Oleg Grenrus at 2022-11-30T14:51:39-05:00
Move Void to GHC.Base...
This change would allow `Void` to be used deeper in module graph.
For example exported from `Prelude` (though that might be already
possible).
Also this change includes a change `stimes @Void _ x = x`,
https://github.com/haskell/core-libraries-committee/issues/95
While the above is not required, maintaining old stimes behavior
would be tricky as `GHC.Base` doesn't know about `Num` or `Integral`,
which would require more hs-boot files.
- - - - -
9 changed files:
- compiler/GHC/Builtin/Names.hs
- libraries/base/Data/Data.hs
- libraries/base/Data/Void.hs
- libraries/base/GHC/Base.hs
- libraries/base/GHC/Exception/Type.hs
- libraries/base/GHC/Generics.hs
- libraries/base/GHC/Ix.hs
- libraries/base/GHC/Read.hs
- libraries/base/GHC/Show.hs
Changes:
=====================================
compiler/GHC/Builtin/Names.hs
=====================================
@@ -547,7 +547,7 @@ gHC_PRIM, gHC_PRIM_PANIC,
gHC_GHCI, gHC_GHCI_HELPERS, gHC_CSTRING,
gHC_SHOW, gHC_READ, gHC_NUM, gHC_MAYBE,
gHC_NUM_INTEGER, gHC_NUM_NATURAL, gHC_NUM_BIGNAT,
- gHC_LIST, gHC_TUPLE, gHC_TUPLE_PRIM, dATA_EITHER, dATA_VOID, dATA_LIST, dATA_STRING,
+ gHC_LIST, gHC_TUPLE, gHC_TUPLE_PRIM, dATA_EITHER, dATA_LIST, dATA_STRING,
dATA_FOLDABLE, dATA_TRAVERSABLE,
gHC_CONC, gHC_IO, gHC_IO_Exception,
gHC_ST, gHC_IX, gHC_STABLE, gHC_PTR, gHC_ERR, gHC_REAL,
@@ -583,7 +583,6 @@ gHC_LIST = mkBaseModule (fsLit "GHC.List")
gHC_TUPLE = mkPrimModule (fsLit "GHC.Tuple")
gHC_TUPLE_PRIM = mkPrimModule (fsLit "GHC.Tuple.Prim")
dATA_EITHER = mkBaseModule (fsLit "Data.Either")
-dATA_VOID = mkBaseModule (fsLit "Data.Void")
dATA_LIST = mkBaseModule (fsLit "Data.List")
dATA_STRING = mkBaseModule (fsLit "Data.String")
dATA_FOLDABLE = mkBaseModule (fsLit "Data.Foldable")
@@ -964,7 +963,7 @@ leftDataConName = dcQual dATA_EITHER (fsLit "Left") leftDataConKey
rightDataConName = dcQual dATA_EITHER (fsLit "Right") rightDataConKey
voidTyConName :: Name
-voidTyConName = tcQual dATA_VOID (fsLit "Void") voidTyConKey
+voidTyConName = tcQual gHC_BASE (fsLit "Void") voidTyConKey
-- Generics (types)
v1TyConName, u1TyConName, par1TyConName, rec1TyConName,
=====================================
libraries/base/Data/Data.hs
=====================================
@@ -1187,6 +1187,9 @@ deriving instance Data Ordering
-- | @since 4.0.0.0
deriving instance (Data a, Data b) => Data (Either a b)
+-- | @since 4.8.0.0
+deriving instance Data Void
+
-- | @since 4.0.0.0
deriving instance Data ()
=====================================
libraries/base/Data/Void.hs
=====================================
@@ -1,8 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE EmptyCase #-}
-{-# LANGUAGE EmptyDataDeriving #-}
-{-# LANGUAGE Safe #-}
+{-# LANGUAGE Trustworthy #-}
-----------------------------------------------------------------------------
-- |
@@ -24,64 +20,4 @@ module Data.Void
, vacuous
) where
-import Control.Exception
-import Data.Data
-import Data.Ix
-import GHC.Generics
-import Data.Semigroup (Semigroup(..), stimesIdempotent)
-
--- $setup
--- >>> import Prelude
-
--- | Uninhabited data type
---
--- @since 4.8.0.0
-data Void deriving
- ( Eq -- ^ @since 4.8.0.0
- , Data -- ^ @since 4.8.0.0
- , Generic -- ^ @since 4.8.0.0
- , Ord -- ^ @since 4.8.0.0
- , Read -- ^ Reading a 'Void' value is always a parse error, considering
- -- 'Void' as a data type with no constructors.
- --
- -- @since 4.8.0.0
- , Show -- ^ @since 4.8.0.0
- )
-
--- | @since 4.8.0.0
-instance Ix Void where
- range _ = []
- index _ = absurd
- inRange _ = absurd
- rangeSize _ = 0
-
--- | @since 4.8.0.0
-instance Exception Void
-
--- | @since 4.9.0.0
-instance Semigroup Void where
- a <> _ = a
- stimes = stimesIdempotent
-
--- | Since 'Void' values logically don't exist, this witnesses the
--- logical reasoning tool of \"ex falso quodlibet\".
---
--- >>> let x :: Either Void Int; x = Right 5
--- >>> :{
--- case x of
--- Right r -> r
--- Left l -> absurd l
--- :}
--- 5
---
--- @since 4.8.0.0
-absurd :: Void -> a
-absurd a = case a of {}
-
--- | If 'Void' is uninhabited then any 'Functor' that holds only
--- values of type 'Void' is holding no values.
--- It is implemented in terms of @fmap absurd at .
---
--- @since 4.8.0.0
-vacuous :: Functor f => f Void -> f a
-vacuous = fmap absurd
+import GHC.Base (Void, absurd, vacuous)
=====================================
libraries/base/GHC/Base.hs
=====================================
@@ -65,6 +65,8 @@ Other Prelude modules are much easier with fewer complex dependencies.
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE EmptyCase #-}
+{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE NoImplicitPrelude #-}
@@ -199,6 +201,37 @@ build = errorWithoutStackTrace "urk"
foldr = errorWithoutStackTrace "urk"
#endif
+-- | Uninhabited data type
+--
+-- @since 4.8.0.0
+data Void deriving
+ ( Eq -- ^ @since 4.8.0.0
+ , Ord -- ^ @since 4.8.0.0
+ )
+
+-- | Since 'Void' values logically don't exist, this witnesses the
+-- logical reasoning tool of \"ex falso quodlibet\".
+--
+-- >>> let x :: Either Void Int; x = Right 5
+-- >>> :{
+-- case x of
+-- Right r -> r
+-- Left l -> absurd l
+-- :}
+-- 5
+--
+-- @since 4.8.0.0
+absurd :: Void -> a
+absurd a = case a of {}
+
+-- | If 'Void' is uninhabited then any 'Functor' that holds only
+-- values of type 'Void' is holding no values.
+-- It is implemented in terms of @fmap absurd at .
+--
+-- @since 4.8.0.0
+vacuous :: Functor f => f Void -> f a
+vacuous = fmap absurd
+
infixr 6 <>
-- | The class of semigroups (types with an associative binary operation).
@@ -328,6 +361,11 @@ instance Monoid [a] where
mconcat xss = [x | xs <- xss, x <- xs]
-- See Note: [List comprehensions and inlining]
+-- | @since 4.9.0.0
+instance Semigroup Void where
+ a <> _ = a
+ stimes _ a = a
+
{-
Note: [List comprehensions and inlining]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
libraries/base/GHC/Exception/Type.hs
=====================================
@@ -143,6 +143,9 @@ class (Typeable e, Show e) => Exception e where
displayException :: e -> String
displayException = show
+-- | @since 4.8.0.0
+instance Exception Void
+
-- | @since 3.0
instance Exception SomeException where
toException se = se
=====================================
libraries/base/GHC/Generics.hs
=====================================
@@ -746,7 +746,7 @@ import GHC.Types
import GHC.Ix ( Ix )
import GHC.Base ( Alternative(..), Applicative(..), Functor(..)
, Monad(..), MonadPlus(..), NonEmpty(..), String, coerce
- , Semigroup(..), Monoid(..) )
+ , Semigroup(..), Monoid(..), Void )
import GHC.Classes ( Eq(..), Ord(..) )
import GHC.Enum ( Bounded, Enum )
import GHC.Read ( Read(..) )
@@ -1553,6 +1553,9 @@ data Meta = MetaData Symbol Symbol Symbol Bool
-- Derived instances
--------------------------------------------------------------------------------
+-- | @since 4.8.0.0
+deriving instance Generic Void
+
-- | @since 4.6.0.0
deriving instance Generic [a]
=====================================
libraries/base/GHC/Ix.hs
=====================================
@@ -272,6 +272,14 @@ instance Ix Ordering where -- as derived
inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u
+----------------------------------------------------------------------
+-- | @since 4.8.0.0
+instance Ix Void where
+ range _ = []
+ index _ = absurd
+ inRange _ = absurd
+ rangeSize _ = 0
+
----------------------------------------------------------------------
-- | @since 2.01
instance Ix () where
=====================================
libraries/base/GHC/Read.hs
=====================================
@@ -656,6 +656,12 @@ instance (Integral a, Read a) => Read (Ratio a) where
-- Tuple instances of Read, up to size 15
------------------------------------------------------------------------
+-- | Reading a 'Void' value is always a parse error, considering
+-- 'Void' as a data type with no constructors.
+--
+-- @since 4.8.0.0
+deriving instance Read Void
+
-- | @since 2.01
instance Read () where
readPrec =
=====================================
libraries/base/GHC/Show.hs
=====================================
@@ -165,6 +165,9 @@ appPrec1 = I# 11# -- appPrec + 1
-- Simple Instances
--------------------------------------------------------------
+-- | @since 4.8.0.0
+deriving instance Show Void
+
-- | @since 2.01
deriving instance Show ()
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/10a2a7de64c52fcff07572bc0cd396393829a487
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/10a2a7de64c52fcff07572bc0cd396393829a487
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20221130/1ced4f67/attachment-0001.html>
More information about the ghc-commits
mailing list