[commit: ghc] master: Revert "Add export lists to some modules." (f006ed7)
git at git.haskell.org
git at git.haskell.org
Mon Jan 19 12:55:12 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/f006ed7965a0fa918d720cc387b33cb8e7083854/ghc
>---------------------------------------------------------------
commit f006ed7965a0fa918d720cc387b33cb8e7083854
Author: Austin Seipp <austin at well-typed.com>
Date: Mon Jan 19 06:55:57 2015 -0600
Revert "Add export lists to some modules."
This reverts commit d6e7f5dc9db7e382ce34d649f85505176a451a04.
This commit broke the build on Windows due to CPP weirdness (#9945).
>---------------------------------------------------------------
f006ed7965a0fa918d720cc387b33cb8e7083854
libraries/base/Control/Category.hs | 2 +-
libraries/base/Control/Monad/Zip.hs | 2 +-
libraries/base/GHC/Base.hs | 33 +++++++++++---------------------
libraries/base/GHC/Num.hs | 7 +------
libraries/base/GHC/Real.hs | 14 +-------------
libraries/base/System/Posix/Internals.hs | 27 ++------------------------
libraries/ghc-prim/GHC/Classes.hs | 19 +-----------------
7 files changed, 18 insertions(+), 86 deletions(-)
diff --git a/libraries/base/Control/Category.hs b/libraries/base/Control/Category.hs
index d21d4f9..ab7740b 100644
--- a/libraries/base/Control/Category.hs
+++ b/libraries/base/Control/Category.hs
@@ -15,7 +15,7 @@
-- http://ghc.haskell.org/trac/ghc/ticket/1773
-module Control.Category ((<<<), (>>>), Category(..)) where
+module Control.Category where
import qualified GHC.Base (id,(.))
import Data.Type.Coercion
diff --git a/libraries/base/Control/Monad/Zip.hs b/libraries/base/Control/Monad/Zip.hs
index b994c47..df096b1 100644
--- a/libraries/base/Control/Monad/Zip.hs
+++ b/libraries/base/Control/Monad/Zip.hs
@@ -15,7 +15,7 @@
--
-----------------------------------------------------------------------------
-module Control.Monad.Zip (MonadZip(..)) where
+module Control.Monad.Zip where
import Control.Monad (liftM)
diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs
index e3d247e..44085a2 100644
--- a/libraries/base/GHC/Base.hs
+++ b/libraries/base/GHC/Base.hs
@@ -93,28 +93,17 @@ Other Prelude modules are much easier with fewer complex dependencies.
#include "MachDeps.h"
module GHC.Base
- (
- module GHC.Classes,
- module GHC.CString,
- module GHC.Magic,
- module GHC.Types,
- module GHC.Prim, -- Re-export GHC.Prim and [boot] GHC.Err,
- -- to avoid lots of people having to
- module GHC.Err, -- import it explicitly
-
-
- Alternative(..), Applicative(..), Functor(..), Maybe(..), Monad(..),
- MonadPlus(..), Monoid(..), Opaque(..), String,
-
-
- ($), ($!), (++), (.), (<**>), (=<<), ap, asTypeOf, assert, augment,
- bindIO, breakpoint, breakpointCond, build, const, divInt, divModInt,
- divModInt#, eqString, flip, foldr, getTag, iShiftL#, iShiftRA#,
- iShiftRL#, id, join, liftA, liftA2, liftA3, liftM, liftM2, liftM3,
- liftM4, liftM5, map, mapFB, mapM, maxInt, minInt, modInt, ord,
- otherwise, quotInt, quotRemInt, remInt, returnIO, sequence, shiftL#,
- shiftRL#, thenIO, unIO, unsafeChr, until, when
- ) where
+ (
+ module GHC.Base,
+ module GHC.Classes,
+ module GHC.CString,
+ module GHC.Magic,
+ module GHC.Types,
+ module GHC.Prim, -- Re-export GHC.Prim and [boot] GHC.Err,
+ -- to avoid lots of people having to
+ module GHC.Err -- import it explicitly
+ )
+ where
import GHC.Types
import GHC.Classes
diff --git a/libraries/base/GHC/Num.hs b/libraries/base/GHC/Num.hs
index 0b331fc..5d46dac 100644
--- a/libraries/base/GHC/Num.hs
+++ b/libraries/base/GHC/Num.hs
@@ -16,12 +16,7 @@
--
-----------------------------------------------------------------------------
-module GHC.Num
- (
- module GHC.Integer
- , Num(..)
- , subtract
- ) where
+module GHC.Num (module GHC.Num, module GHC.Integer) where
import GHC.Base
import GHC.Integer
diff --git a/libraries/base/GHC/Real.hs b/libraries/base/GHC/Real.hs
index 1a18e6a..71de0d2 100644
--- a/libraries/base/GHC/Real.hs
+++ b/libraries/base/GHC/Real.hs
@@ -18,19 +18,7 @@
--
-----------------------------------------------------------------------------
-module GHC.Real
- (
- Fractional(..), Integral(..), Ratio(..), Real(..), RealFrac(..),
-
- Rational,
-
- (%), (^), (^%^), (^^), (^^%^^), denominator, divZeroError, even,
- fromIntegral, gcd, gcdInt', gcdWord', infinity, integralEnumFrom,
- integralEnumFromThen, integralEnumFromThenTo, integralEnumFromTo, lcm,
- notANumber, numerator, numericEnumFrom, numericEnumFromThen,
- numericEnumFromThenTo, numericEnumFromTo, odd, overflowError, ratioPrec,
- ratioPrec1, ratioZeroDenominatorError, realToFrac, reduce, showSigned
- ) where
+module GHC.Real where
import GHC.Base
import GHC.Num
diff --git a/libraries/base/System/Posix/Internals.hs b/libraries/base/System/Posix/Internals.hs
index e2e32c3..c49e613 100644
--- a/libraries/base/System/Posix/Internals.hs
+++ b/libraries/base/System/Posix/Internals.hs
@@ -20,30 +20,7 @@
--
-----------------------------------------------------------------------------
-module System.Posix.Internals
- (
- CFLock, CFilePath, CGroup, CLconv, CPasswd, CSigaction, CSigset, CStat,
- CTermios, CTm, CTms, CUtimbuf, CUtsname, FD,
-
- c_access, c_chmod, c_close, c_creat, c_dup, c_dup2, c_fcntl_lock,
- c_fcntl_read, c_fcntl_write, c_fork, c_fstat, c_ftruncate, c_getpid,
- c_isatty, c_lflag, c_link, c_lseek, c_mkfifo, c_open, c_pipe, c_read,
- c_s_isblk, c_s_ischr, c_s_isdir, c_s_isfifo, c_s_isreg, c_s_issock,
- c_safe_open, c_safe_read, c_safe_write, c_sigaddset, c_sigemptyset,
- c_sigprocmask, c_stat, c_tcgetattr, c_tcsetattr, c_umask, c_unlink,
- c_utime, c_waitpid, c_write, const_echo, const_f_getfl, const_f_setfd,
- const_f_setfl, const_fd_cloexec, const_icanon, const_sig_block,
- const_sig_setmask, const_sigttou, const_tcsanow, const_vmin, const_vtime,
- dEFAULT_BUFFER_SIZE, fdFileSize, fdGetMode, fdStat, fdType, fileType,
- getEcho, get_saved_termios, ioe_unknownfiletype, lstat, newFilePath,
- o_APPEND, o_BINARY, o_CREAT, o_EXCL, o_NOCTTY, o_NONBLOCK, o_RDONLY,
- o_RDWR, o_TRUNC, o_WRONLY, peekFilePath, peekFilePathLen, poke_c_lflag,
- ptr_c_cc, puts, sEEK_CUR, sEEK_END, sEEK_SET, s_isblk, s_ischr, s_isdir,
- s_isfifo, s_isreg, s_issock, setCloseOnExec, setCooked, setEcho,
- setNonBlockingFD, set_saved_termios, sizeof_sigset_t, sizeof_stat,
- sizeof_termios, st_dev, st_ino, st_mode, st_mtime, st_size, statGetType,
- tcSetAttr, withFilePath
- ) where
+module System.Posix.Internals where
#include "HsBaseConfig.h"
@@ -65,7 +42,7 @@ import GHC.Real
import GHC.IO
import GHC.IO.IOMode
import GHC.IO.Exception
-import GHC.IO.Device hiding (getEcho, setEcho)
+import GHC.IO.Device
#ifndef mingw32_HOST_OS
import {-# SOURCE #-} GHC.IO.Encoding (getFileSystemEncoding)
import qualified GHC.Foreign as GHC
diff --git a/libraries/ghc-prim/GHC/Classes.hs b/libraries/ghc-prim/GHC/Classes.hs
index 3f09ff7..9028f6e 100644
--- a/libraries/ghc-prim/GHC/Classes.hs
+++ b/libraries/ghc-prim/GHC/Classes.hs
@@ -17,24 +17,7 @@
--
-----------------------------------------------------------------------------
-module GHC.Classes
- (
- (&&)
- , (||)
- , compareInt
- , compareInt#
- , divInt#
- , eqInt
- , geInt
- , gtInt
- , leInt
- , ltInt
- , modInt#
- , neInt
- , not
- , Eq(..)
- , Ord(..)
- ) where
+module GHC.Classes where
-- GHC.Magic is used in some derived instances
import GHC.Magic ()
More information about the ghc-commits
mailing list