From 1c83695b5b9ae3175c18908c1d58aeadb1f225ae Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Fri, 29 May 2009 13:18:22 +0000 Subject: [PATCH] Changes for the new IO library, mainly base-package modules moving around --- compiler/basicTypes/UniqSupply.lhs | 4 ++++ compiler/ghci/ByteCodeAsm.lhs | 7 ++++++- compiler/ghci/RtClosureInspect.hs | 7 ++++++- compiler/main/BreakArray.hs | 6 +++++- compiler/prelude/PrelNames.lhs | 21 +++++++++++---------- compiler/utils/Binary.hs | 7 ++++++- compiler/utils/FastFunctions.lhs | 13 ++++++++++++- compiler/utils/FastMutInt.lhs | 7 ++++++- compiler/utils/FastString.lhs | 7 ++++++- configure.ac | 2 +- ghc/GhciMonad.hs | 6 +++--- ghc/InteractiveUI.hs | 13 ++++++++++++- rts/Prelude.h | 16 ++++++++-------- rts/RtsStartup.c | 5 +++++ utils/ghc-pkg/Main.hs | 4 ++++ 15 files changed, 95 insertions(+), 30 deletions(-) diff --git a/compiler/basicTypes/UniqSupply.lhs b/compiler/basicTypes/UniqSupply.lhs index cb1a1fc..9a5e803 100644 --- a/compiler/basicTypes/UniqSupply.lhs +++ b/compiler/basicTypes/UniqSupply.lhs @@ -31,7 +31,11 @@ import FastTypes import MonadUtils import Control.Monad import Control.Monad.Fix +#if __GLASGOW_HASKELL__ >= 611 +import GHC.IO (unsafeDupableInterleaveIO) +#else import GHC.IOBase (unsafeDupableInterleaveIO) +#endif \end{code} diff --git a/compiler/ghci/ByteCodeAsm.lhs b/compiler/ghci/ByteCodeAsm.lhs index 66a1500..4d360e1 100644 --- a/compiler/ghci/ByteCodeAsm.lhs +++ b/compiler/ghci/ByteCodeAsm.lhs @@ -46,9 +46,14 @@ import Data.Int ( Int64 ) import Data.Char ( ord ) import GHC.Base ( ByteArray#, MutableByteArray#, RealWorld ) -import GHC.IOBase ( IO(..) ) import GHC.Ptr ( Ptr(..) ) +#if __GLASGOW_HASKELL__ >= 611 +import GHC.IO ( IO(..) ) +#else +import GHC.IOBase ( IO(..) ) +#endif + -- ----------------------------------------------------------------------------- -- Unlinked BCOs diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs index 4996fdb..f90b1ca 100644 --- a/compiler/ghci/RtClosureInspect.hs +++ b/compiler/ghci/RtClosureInspect.hs @@ -60,7 +60,12 @@ import Constants ( wORD_SIZE ) import GHC.Arr ( Array(..) ) import GHC.Exts -import GHC.IOBase ( IO(IO) ) + +#if __GLASGOW_HASKELL__ >= 611 +import GHC.IO ( IO(..) ) +#else +import GHC.IOBase ( IO(..) ) +#endif import Control.Monad import Data.Maybe diff --git a/compiler/main/BreakArray.hs b/compiler/main/BreakArray.hs index ceae28d..f7154c1 100644 --- a/compiler/main/BreakArray.hs +++ b/compiler/main/BreakArray.hs @@ -26,7 +26,11 @@ module BreakArray ) where #ifdef GHCI import GHC.Exts -import GHC.IOBase +#if __GLASGOW_HASKELL__ >= 611 +import GHC.IO ( IO(..) ) +#else +import GHC.IOBase ( IO(..) ) +#endif import GHC.Word import Constants diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs index 513d81b..4e18f5d 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.lhs @@ -237,7 +237,7 @@ pRELUDE = mkBaseModule_ pRELUDE_NAME gHC_PRIM, gHC_TYPES, gHC_BOOL, gHC_UNIT, gHC_ORDERING, gHC_GENERICS, gHC_CLASSES, gHC_BASE, gHC_ENUM, gHC_SHOW, gHC_READ, gHC_NUM, gHC_INTEGER, gHC_INTEGER_INTERNALS, gHC_LIST, gHC_PARR, gHC_TUPLE, dATA_TUPLE, dATA_EITHER, dATA_STRING, dATA_FOLDABLE, dATA_TRAVERSABLE, - gHC_PACK, gHC_CONC, gHC_IO_BASE, + gHC_PACK, gHC_CONC, gHC_IO, gHC_IO_Exception, gHC_ST, gHC_ARR, gHC_STABLE, gHC_ADDR, gHC_PTR, gHC_ERR, gHC_REAL, gHC_FLOAT, gHC_TOP_HANDLER, sYSTEM_IO, dYNAMIC, tYPEABLE, gENERICS, dOTNET, rEAD_PREC, lEX, gHC_INT, gHC_WORD, mONAD, mONAD_FIX, aRROW, cONTROL_APPLICATIVE, @@ -266,7 +266,8 @@ dATA_FOLDABLE = mkBaseModule (fsLit "Data.Foldable") dATA_TRAVERSABLE= mkBaseModule (fsLit "Data.Traversable") gHC_PACK = mkBaseModule (fsLit "GHC.Pack") gHC_CONC = mkBaseModule (fsLit "GHC.Conc") -gHC_IO_BASE = mkBaseModule (fsLit "GHC.IOBase") +gHC_IO = mkBaseModule (fsLit "GHC.IO") +gHC_IO_Exception = mkBaseModule (fsLit "GHC.IO.Exception") gHC_ST = mkBaseModule (fsLit "GHC.ST") gHC_ARR = mkBaseModule (fsLit "GHC.Arr") gHC_STABLE = mkBaseModule (fsLit "GHC.Stable") @@ -689,7 +690,7 @@ dataClassName = clsQual gENERICS (fsLit "Data") dataClassKey -- Error module assertErrorName :: Name -assertErrorName = varQual gHC_IO_BASE (fsLit "assertError") assertErrorIdKey +assertErrorName = varQual gHC_IO_Exception (fsLit "assertError") assertErrorIdKey -- Enum module (Enum, Bounded) enumClassName, enumFromName, enumFromToName, enumFromThenName, @@ -735,15 +736,15 @@ toPName = varQual gHC_PARR (fsLit "toP") toPIdKey emptyPName = varQual gHC_PARR (fsLit "emptyP") emptyPIdKey appPName = varQual gHC_PARR (fsLit "+:+") appPIdKey --- IOBase things +-- IO things ioTyConName, ioDataConName, thenIOName, bindIOName, returnIOName, failIOName :: Name -ioTyConName = tcQual gHC_IO_BASE (fsLit "IO") ioTyConKey -ioDataConName = conName gHC_IO_BASE (fsLit "IO") ioDataConKey -thenIOName = varQual gHC_IO_BASE (fsLit "thenIO") thenIOIdKey -bindIOName = varQual gHC_IO_BASE (fsLit "bindIO") bindIOIdKey -returnIOName = varQual gHC_IO_BASE (fsLit "returnIO") returnIOIdKey -failIOName = varQual gHC_IO_BASE (fsLit "failIO") failIOIdKey +ioTyConName = tcQual gHC_IO (fsLit "IO") ioTyConKey +ioDataConName = conName gHC_IO (fsLit "IO") ioDataConKey +thenIOName = varQual gHC_IO (fsLit "thenIO") thenIOIdKey +bindIOName = varQual gHC_IO (fsLit "bindIO") bindIOIdKey +returnIOName = varQual gHC_IO (fsLit "returnIO") returnIOIdKey +failIOName = varQual gHC_IO (fsLit "failIO") failIOIdKey -- IO things printName :: Name diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index c61f8a6..cbfec74 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -83,10 +83,15 @@ import System.IO.Unsafe ( unsafeInterleaveIO ) import System.IO.Error ( mkIOError, eofErrorType ) import GHC.Real ( Ratio(..) ) import GHC.Exts -import GHC.IOBase ( IO(..) ) import GHC.Word ( Word8(..) ) import System.IO ( openBinaryFile ) +#if __GLASGOW_HASKELL__ >= 611 +import GHC.IO ( IO(..) ) +#else +import GHC.IOBase ( IO(..) ) +#endif + type BinArray = ForeignPtr Word8 --------------------------------------------------------------- diff --git a/compiler/utils/FastFunctions.lhs b/compiler/utils/FastFunctions.lhs index 86c89bd..d6a282f 100644 --- a/compiler/utils/FastFunctions.lhs +++ b/compiler/utils/FastFunctions.lhs @@ -22,8 +22,19 @@ import System.IO.Unsafe import GHC.Exts import GHC.Word -import GHC.IOBase (IO(..)) + +#if __GLASGOW_HASKELL__ >= 611 +import GHC.IO ( IO(..) ) +#else +import GHC.IOBase ( IO(..) ) +#endif + +#if __GLASGOW_HASKELL__ >= 611 +import GHC.IO (unsafeDupableInterleaveIO) +#else import GHC.IOBase (unsafeDupableInterleaveIO) +#endif + import GHC.Base (unsafeChr) -- Just like unsafePerformIO, but we inline it. diff --git a/compiler/utils/FastMutInt.lhs b/compiler/utils/FastMutInt.lhs index c29b568..dfa188e 100644 --- a/compiler/utils/FastMutInt.lhs +++ b/compiler/utils/FastMutInt.lhs @@ -25,9 +25,14 @@ module FastMutInt( #endif import GHC.Base -import GHC.IOBase import GHC.Ptr +#if __GLASGOW_HASKELL__ >= 611 +import GHC.IO ( IO(..) ) +#else +import GHC.IOBase ( IO(..) ) +#endif + #else /* ! __GLASGOW_HASKELL__ */ import Data.IORef diff --git a/compiler/utils/FastString.lhs b/compiler/utils/FastString.lhs index 62bc5d5..29c7788 100644 --- a/compiler/utils/FastString.lhs +++ b/compiler/utils/FastString.lhs @@ -103,7 +103,12 @@ import Data.IORef ( IORef, newIORef, readIORef, writeIORef ) import Data.Maybe ( isJust ) import Data.Char ( ord ) -import GHC.IOBase ( IO(..) ) +#if __GLASGOW_HASKELL__ >= 611 +import GHC.IO ( IO(..) ) +#else +import GHC.IOBase ( IO(..) ) +#endif + import GHC.Ptr ( Ptr(..) ) #if defined(__GLASGOW_HASKELL__) import GHC.Base ( unpackCString# ) diff --git a/configure.ac b/configure.ac index d2cea57..86ef969 100644 --- a/configure.ac +++ b/configure.ac @@ -738,7 +738,7 @@ fi dnl ** check for more functions dnl ** The following have been verified to be used in ghc/, but might be used somewhere else, too. -AC_CHECK_FUNCS([getclock getrusage gettimeofday setitimer siginterrupt sysconf times ctime_r, sched_setaffinity]) +AC_CHECK_FUNCS([getclock getrusage gettimeofday setitimer siginterrupt sysconf times ctime_r sched_setaffinity setlocale]) AC_TRY_RUN([ #include diff --git a/ghc/GhciMonad.hs b/ghc/GhciMonad.hs index 341e94a..ff34963 100644 --- a/ghc/GhciMonad.hs +++ b/ghc/GhciMonad.hs @@ -363,9 +363,9 @@ initInterpBuffering = do -- make sure these are linked -- ToDo: we should really look up these names properly, but -- it's a fiddle and not all the bits are exposed via the GHC -- interface. - mb_stdin_ptr <- ObjLink.lookupSymbol "base_GHCziHandle_stdin_closure" - mb_stdout_ptr <- ObjLink.lookupSymbol "base_GHCziHandle_stdout_closure" - mb_stderr_ptr <- ObjLink.lookupSymbol "base_GHCziHandle_stderr_closure" + mb_stdin_ptr <- ObjLink.lookupSymbol "base_GHCziIOziHandleziFD_stdin_closure" + mb_stdout_ptr <- ObjLink.lookupSymbol "base_GHCziIOziHandleziFD_stdout_closure" + mb_stderr_ptr <- ObjLink.lookupSymbol "base_GHCziIOziHandleziFD_stderr_closure" let f ref (Just ptr) = writeIORef ref ptr f _ Nothing = panic "interactiveUI:setBuffering2" diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index d620290..82c9aab 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -55,6 +55,11 @@ import Maybes ( orElse, expectJust ) import FastString import Encoding +#if __GLASGOW_HASKELL__ < 611 +import Foreign.C +import Encoding +#endif + #ifndef mingw32_HOST_OS import System.Posix hiding (getEnv) #else @@ -88,7 +93,13 @@ import Control.Monad as Monad import Text.Printf import Foreign import GHC.Exts ( unsafeCoerce# ) + +#if __GLASGOW_HASKELL__ >= 611 +import GHC.IO.Exception ( IOErrorType(InvalidArgument) ) +#else import GHC.IOBase ( IOErrorType(InvalidArgument) ) +#endif + import GHC.TopHandler import Data.IORef ( IORef, readIORef, writeIORef ) @@ -501,7 +512,7 @@ fileLoop hdl = do -- this can happen if the user closed stdin, or -- perhaps did getContents which closes stdin at -- EOF. - Right l -> fmap Just (Encoding.decode (BS.pack l)) + Right l -> return (Just l) mkPrompt :: GHCi String mkPrompt = do diff --git a/rts/Prelude.h b/rts/Prelude.h index 69bd3f5..b27fa27 100644 --- a/rts/Prelude.h +++ b/rts/Prelude.h @@ -35,10 +35,10 @@ extern W_ ZCMain_main_closure[]; extern StgClosure ZCMain_main_closure; #endif -PRELUDE_CLOSURE(base_GHCziIOBase_stackOverflow_closure); -PRELUDE_CLOSURE(base_GHCziIOBase_heapOverflow_closure); -PRELUDE_CLOSURE(base_GHCziIOBase_blockedOnDeadMVar_closure); -PRELUDE_CLOSURE(base_GHCziIOBase_blockedIndefinitely_closure); +PRELUDE_CLOSURE(base_GHCziIOziException_stackOverflow_closure); +PRELUDE_CLOSURE(base_GHCziIOziException_heapOverflow_closure); +PRELUDE_CLOSURE(base_GHCziIOziException_blockedOnDeadMVar_closure); +PRELUDE_CLOSURE(base_GHCziIOziException_blockedIndefinitely_closure); PRELUDE_CLOSURE(base_ControlziExceptionziBase_nonTermination_closure); PRELUDE_CLOSURE(base_ControlziExceptionziBase_nestedAtomically_closure); @@ -87,10 +87,10 @@ PRELUDE_INFO(base_GHCziStable_StablePtr_con_info); #define runFinalizerBatch_closure DLL_IMPORT_DATA_REF(base_GHCziWeak_runFinalizzerBatch_closure) #define mainIO_closure (&ZCMain_main_closure) -#define stackOverflow_closure DLL_IMPORT_DATA_REF(base_GHCziIOBase_stackOverflow_closure) -#define heapOverflow_closure DLL_IMPORT_DATA_REF(base_GHCziIOBase_heapOverflow_closure) -#define blockedOnDeadMVar_closure DLL_IMPORT_DATA_REF(base_GHCziIOBase_blockedOnDeadMVar_closure) -#define blockedIndefinitely_closure DLL_IMPORT_DATA_REF(base_GHCziIOBase_blockedIndefinitely_closure) +#define stackOverflow_closure DLL_IMPORT_DATA_REF(base_GHCziIOziException_stackOverflow_closure) +#define heapOverflow_closure DLL_IMPORT_DATA_REF(base_GHCziIOziException_heapOverflow_closure) +#define blockedOnDeadMVar_closure DLL_IMPORT_DATA_REF(base_GHCziIOziException_blockedOnDeadMVar_closure) +#define blockedIndefinitely_closure DLL_IMPORT_DATA_REF(base_GHCziIOziException_blockedIndefinitely_closure) #define nonTermination_closure DLL_IMPORT_DATA_REF(base_ControlziExceptionziBase_nonTermination_closure) #define nestedAtomically_closure DLL_IMPORT_DATA_REF(base_ControlziExceptionziBase_nestedAtomically_closure) diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c index bc8379e..c21aac7 100644 --- a/rts/RtsStartup.c +++ b/rts/RtsStartup.c @@ -63,6 +63,9 @@ #ifdef HAVE_UNISTD_H #include #endif +#ifdef HAVE_LOCALE_H +#include +#endif #if USE_PAPI #include "Papi.h" @@ -132,6 +135,8 @@ hs_init(int *argc, char **argv[]) return; } + setlocale(LC_CTYPE,""); + /* Initialise the stats department, phase 0 */ initStats0(); diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index 3babd74..19052a5 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -61,7 +61,11 @@ import System.Posix hiding (fdToHandle) import IO ( isPermissionError ) import System.Posix.Internals +#if __GLASGOW_HASKELL__ >= 611 +import GHC.IO.Handle.FD (fdToHandle) +#else import GHC.Handle (fdToHandle) +#endif #if defined(GLOB) import System.Process(runInteractiveCommand) -- 1.7.10.4