From 29246dd4eb44d03cc48cbd894821d3c9501d8829 Mon Sep 17 00:00:00 2001 From: malcolm Date: Fri, 11 Oct 2002 11:05:20 +0000 Subject: [PATCH] [project @ 2002-10-11 11:05:20 by malcolm] Make some more libraries buildable with nhc98. --- Data/Array.hs | 9 ++++++++ Debug/Trace.hs | 5 +++++ Foreign/C/Types.hs | 16 +++++++++++++ Foreign/C/TypesISO.hs | 15 +++++++++++++ Foreign/ForeignPtr.hs | 18 +++++++++++++-- Foreign/Marshal/Alloc.hs | 12 +++++----- Foreign/Marshal/Utils.hs | 2 +- Foreign/Ptr.hs | 22 +++++++++++++++++- Foreign/StablePtr.hs | 11 +++++++++ Foreign/Storable.hs | 6 +++++ Makefile.nhc98 | 56 +++++++++++++++++++++++++++++++++++++++++----- System/Cmd.hs | 15 +++++++------ System/Environment.hs | 19 ++++++++++------ System/Exit.hs | 7 ++++++ System/Mem.hs | 4 ++++ 15 files changed, 188 insertions(+), 29 deletions(-) diff --git a/Data/Array.hs b/Data/Array.hs index 499f791..230e94a 100644 --- a/Data/Array.hs +++ b/Data/Array.hs @@ -44,7 +44,9 @@ module Data.Array ) where +#ifndef __NHC__ import Data.Dynamic +#endif #ifdef __GLASGOW_HASKELL__ import Data.Ix @@ -56,5 +58,12 @@ import GHC.Err ( undefined ) import Hugs.Array #endif +#ifdef __NHC__ +import Array -- Haskell'98 arrays +import Data.Ix +#endif + +#ifndef __NHC__ #include "Dynamic.h" INSTANCE_TYPEABLE2(Array,arrayTc,"Array") +#endif diff --git a/Debug/Trace.hs b/Debug/Trace.hs index 05809a0..19e8ac6 100644 --- a/Debug/Trace.hs +++ b/Debug/Trace.hs @@ -50,3 +50,8 @@ trace string expr = unsafePerformIO $ do foreign import ccall "PostTraceHook" postTraceHook :: Int -> IO () #endif + +#ifdef __NHC__ +trace :: String -> a -> a +trace str expr = unsafePerformIO $ do hPutStr stderr str; return expr +#endif diff --git a/Foreign/C/Types.hs b/Foreign/C/Types.hs index 5c69a4f..7fe89ee 100644 --- a/Foreign/C/Types.hs +++ b/Foreign/C/Types.hs @@ -36,12 +36,27 @@ module Foreign.C.Types , CFile, CFpos, CJmpBuf ) where +#ifdef __NHC__ +import NHC.FFI + ( CChar(..), CSChar(..), CUChar(..) + , CShort(..), CUShort(..), CInt(..), CUInt(..) + , CLong(..), CULong(..), CLLong(..), CULLong(..) + , CPtrdiff(..), CSize(..), CWchar(..), CSigAtomic(..) + , CClock(..), CTime(..) + , CFloat(..), CDouble(..), CLDouble(..) + , CFile, CFpos, CJmpBuf + , Storable(..) + ) +#else + import Foreign.C.TypesISO import Foreign.Storable import Data.Bits ( Bits(..) ) import Data.Int ( Int8, Int16, Int32, Int64 ) import Data.Word ( Word8, Word16, Word32, Word64 ) +#ifndef __NHC__ import Data.Dynamic +#endif #ifdef __GLASGOW_HASKELL__ import GHC.Base @@ -108,3 +123,4 @@ FLOATING_TYPE(CDouble,tyConCDouble,"CDouble",HTYPE_DOUBLE) -- HACK: Currently no long double in the FFI, so we simply re-use double FLOATING_TYPE(CLDouble,tyConCLDouble,"CLDouble",HTYPE_DOUBLE) +#endif diff --git a/Foreign/C/TypesISO.hs b/Foreign/C/TypesISO.hs index ae7c21c..65aa789 100644 --- a/Foreign/C/TypesISO.hs +++ b/Foreign/C/TypesISO.hs @@ -27,6 +27,20 @@ module Foreign.C.TypesISO , CFile, CFpos, CJmpBuf ) where +#ifdef __NHC__ +import NHC.FFI + ( CPtrdiff(..) + , CSize(..) + , CWchar(..) + , CSigAtomic(..) + , CClock(..) + , CTime(..) + , CFile + , CFpos + , CJmpBuf + ) +#else + import Data.Bits ( Bits(..) ) import Data.Int import Data.Word @@ -76,3 +90,4 @@ data CJmpBuf = CJmpBuf -- C99 types which are still missing include: -- intptr_t, uintptr_t, intmax_t, uintmax_t, wint_t, wctrans_t, wctype_t +#endif diff --git a/Foreign/ForeignPtr.hs b/Foreign/ForeignPtr.hs index 586cd4f..b0dd4d5 100644 --- a/Foreign/ForeignPtr.hs +++ b/Foreign/ForeignPtr.hs @@ -26,17 +26,19 @@ module Foreign.ForeignPtr , touchForeignPtr -- :: ForeignPtr a -> IO () , castForeignPtr -- :: ForeignPtr a -> ForeignPtr b +#ifdef __GLASGOW_HASKELL__ -- * GHC extensions , mallocForeignPtr -- :: Storable a => IO (ForeignPtr a) , mallocForeignPtrBytes -- :: Int -> IO (ForeignPtr a) +#endif ) where +#ifdef __GLASGOW_HASKELL__ import Foreign.Ptr import Foreign.Storable import Data.Dynamic -#ifdef __GLASGOW_HASKELL__ import GHC.Base import GHC.IOBase import GHC.Num @@ -44,10 +46,22 @@ import GHC.Ptr ( Ptr(..) ) import GHC.Err #endif +#ifdef __NHC__ +import NHC.FFI + ( ForeignPtr + , newForeignPtr + , addForeignPtrFinalizer + , withForeignPtr + , foreignPtrToPtr + , touchForeignPtr + , castForeignPtr + ) +#endif + +#ifdef __GLASGOW_HASKELL__ #include "Dynamic.h" INSTANCE_TYPEABLE1(ForeignPtr,foreignPtrTc,"ForeignPtr") -#ifdef __GLASGOW_HASKELL__ -- |The type 'ForeignPtr' represents references to objects that are -- maintained in a foreign language, i.e., that are not part of the -- data structures usually managed by the Haskell storage manager. diff --git a/Foreign/Marshal/Alloc.hs b/Foreign/Marshal/Alloc.hs index ce167b5..900c917 100644 --- a/Foreign/Marshal/Alloc.hs +++ b/Foreign/Marshal/Alloc.hs @@ -24,17 +24,15 @@ module Foreign.Marshal.Alloc ( realloc, -- :: Storable b => Ptr a -> IO (Ptr b) reallocBytes, -- :: Ptr a -> Int -> IO (Ptr a) -#ifdef __HUGS__ - free, -- :: Ptr a -> IO () - finalizerFree -- :: FunPtr (Ptr a -> IO ()) -#else free -- :: Ptr a -> IO () +#ifdef __HUGS__ + , finalizerFree -- :: FunPtr (Ptr a -> IO ()) #endif ) where import Data.Maybe import Foreign.Ptr ( Ptr, nullPtr, FunPtr ) -import Foreign.C.TypesISO ( CSize ) +import Foreign.C.Types ( CSize, CInt(..) ) import Foreign.Storable ( Storable(sizeOf) ) #ifdef __GLASGOW_HASKELL__ @@ -44,8 +42,10 @@ import GHC.Real import GHC.Ptr import GHC.Err import GHC.Base -#else +#elsif defined(__HUGS__) import Control.Exception ( bracket ) +#else +import System.IO ( bracket ) #endif diff --git a/Foreign/Marshal/Utils.hs b/Foreign/Marshal/Utils.hs index f4a3f73..06528b2 100644 --- a/Foreign/Marshal/Utils.hs +++ b/Foreign/Marshal/Utils.hs @@ -53,7 +53,7 @@ module Foreign.Marshal.Utils ( import Data.Maybe import Foreign.Ptr ( Ptr, nullPtr ) import Foreign.Storable ( Storable(poke) ) -import Foreign.C.TypesISO ( CSize ) +import Foreign.C.Types ( CSize, CInt(..) ) import Foreign.Marshal.Alloc ( malloc, alloca ) #ifdef __GLASGOW_HASKELL__ diff --git a/Foreign/Ptr.hs b/Foreign/Ptr.hs index 125759e..0079828 100644 --- a/Foreign/Ptr.hs +++ b/Foreign/Ptr.hs @@ -50,9 +50,27 @@ import GHC.Show import Numeric #endif -#include "MachDeps.h" +#ifdef __NHC__ +import NHC.FFI + ( Ptr + , nullPtr + , castPtr + , plusPtr + , alignPtr + , minusPtr + , FunPtr + , nullFunPtr + , castFunPtr + , castFunPtrToPtr + , castPtrToFunPtr + , freeHaskellFunPtr + ) +#endif + #ifdef __GLASGOW_HASKELL__ +#include "MachDeps.h" + #if (WORD_SIZE_IN_BITS == 32 || WORD_SIZE_IN_BITS == 64) instance Show (Ptr a) where showsPrec p (Ptr a) rs = pad_out (showHex (word2Integer(int2Word#(addr2Int# a))) "") rs @@ -69,5 +87,7 @@ instance Show (FunPtr a) where #endif #endif +#ifndef __NHC__ foreign import ccall unsafe "freeHaskellFunctionPtr" freeHaskellFunPtr :: FunPtr a -> IO () +#endif diff --git a/Foreign/StablePtr.hs b/Foreign/StablePtr.hs index 08e9ae3..ad3b6ee 100644 --- a/Foreign/StablePtr.hs +++ b/Foreign/StablePtr.hs @@ -37,6 +37,17 @@ import GHC.Err import Hugs.StablePtr #endif +#ifdef __NHC__ +import NHC.FFI + ( StablePtr + , newStablePtr + , deRefStablePtr + , freeStablePtr + , castStablePtrToPtr + , castPtrToStablePtr + ) +#endif + -- $cinterface -- -- The following definition is available to C programs inter-operating with diff --git a/Foreign/Storable.hs b/Foreign/Storable.hs index 73a651d..b225eb7 100644 --- a/Foreign/Storable.hs +++ b/Foreign/Storable.hs @@ -29,6 +29,10 @@ module Foreign.Storable ) where +#ifdef __NHC__ +import NHC.FFI (Storable(..)) +#else + import Control.Monad ( liftM ) #include "MachDeps.h" @@ -237,3 +241,5 @@ STORABLE(Int32,SIZEOF_INT32,ALIGNMENT_INT32, STORABLE(Int64,SIZEOF_INT64,ALIGNMENT_INT64, readInt64OffPtr,writeInt64OffPtr) + +#endif diff --git a/Makefile.nhc98 b/Makefile.nhc98 index 48772da..dd3e5da 100644 --- a/Makefile.nhc98 +++ b/Makefile.nhc98 @@ -1,17 +1,29 @@ THISPKG = base SEARCH = -DIRS = Data Control Debug System System/IO +DIRS = Data Control Control/Monad Debug System System/IO \ + Foreign Foreign/C Foreign/Marshal SRCS = \ Data/Bits.hs Data/Bool.hs Data/Char.hs Data/Complex.hs \ Data/Either.hs Data/FiniteMap.hs Data/IORef.hs Data/Int.hs \ Data/Ix.hs Data/List.hs Data/Maybe.hs Data/PackedString.hs \ - Data/Set.hs Data/Tuple.hs Data/Word.hs \ - Control/Monad.hs \ - System/IO.hs System/IO/Error.hs System/IO/Unsafe.hs + Data/Set.hs Data/Tuple.hs Data/Word.hs Data/Array.hs \ + Control/Monad.hs Control/Monad/Fix.hs Control/Monad/Identity.hs \ + Control/Monad/Trans.hs \ + Debug/Trace.hs \ + System/IO.hs System/IO/Error.hs System/IO/Unsafe.hs \ + System/Environment.hs System/Exit.hs System/Locale.hs \ + System/Mem.hs System/Cmd.hs \ + Foreign/Ptr.hs Foreign/StablePtr.hs Foreign/Storable.hs \ + Foreign/ForeignPtr.hs Foreign/C/Types.hs Foreign/C/TypesISO.hs \ + Foreign/Marshal/Alloc.hs Foreign/Marshal/Array.hs \ + Foreign/Marshal/Utils.hs Foreign/Marshal/Error.hs \ + Foreign/C/String.hs -# Debug/Trace.hs Debug/QuickCheck.hs +# Data/Ratio.hs +# System/Random.hs +# Debug/QuickCheck.hs # Here are the main rules. @@ -21,9 +33,43 @@ include ../Makefile.common # Here are the dependencies. $(OBJDIR)/Data/FiniteMap.$O: $(OBJDIR)/Data/Maybe.$O $(OBJDIR)/Data/Set.$O: $(OBJDIR)/Data/Maybe.$O $(OBJDIR)/Data/FiniteMap.$O +$(OBJDIR)/Data/Array.$O: $(OBJDIR)/Data/Ix.$O $(OBJDIR)/System/IO.$O: $(OBJDIR)/System/IO/Error.$O +$(OBJDIR)/System/Random.$O: $(OBJDIR)/Data/Char.$O $(OBJDIR)/Data/IORef.$O \ + $(OBJDIR)/System/IO/Unsafe.$O +$(OBJDIR)/Debug/Trace.$O: $(OBJDIR)/System/IO.$O $(OBJDIR)/System/IO/Unsafe.$O +$(OBJDIR)/Control/Monad/Fix.$O: $(OBJDIR)/System/IO.$O +$(OBJDIR)/Control/Monad/Identity.$O: $(OBJDIR)/Control/Monad.$O \ + $(OBJDIR)/Control/Monad/Fix.$O +$(OBJDIR)/Foreign/Marshal/Alloc.$O: $(OBJDIR)/Data/Maybe.$O \ + $(OBJDIR)/Foreign/Ptr.$O $(OBJDIR)/Foreign/Storable.$O \ + $(OBJDIR)/Foreign/C/Types.$O +$(OBJDIR)/Foreign/Marshal/Array.$O: $(OBJDIR)/Control/Monad.$O \ + $(OBJDIR)/Foreign/Ptr.$O $(OBJDIR)/Foreign/Storable.$O \ + $(OBJDIR)/Foreign/Marshal/Alloc.$O $(OBJDIR)/Foreign/Marshal/Utils.$O +$(OBJDIR)/Foreign/Marshal/Utils.$O: $(OBJDIR)/Data/Maybe.$O \ + $(OBJDIR)/Foreign/Ptr.$O $(OBJDIR)/Foreign/Storable.$O \ + $(OBJDIR)/Foreign/Marshal/Alloc.$O $(OBJDIR)/Foreign/C/Types.$O +$(OBJDIR)/Foreign/Marshal/Error.$O: $(OBJDIR)/Foreign/Ptr.$O +$(OBJDIR)/Foreign/C/String.$O: $(OBJDIR)/Data/Word.$O $(OBJDIR)/Foreign/Ptr.$O \ + $(OBJDIR)/Foreign/Marshal/Array.$O $(OBJDIR)/Foreign/C/Types.$O # C-files dependencies. Data/FiniteMap.$C: Data/Maybe.$C Data/Set.$C: Data/Maybe.$C Data/FiniteMap.$C +Data/Array.$C: Data/Ix.$C System/IO.$C: System/IO/Error.$C +System/Random.$C: Data/Char.$C Data/IORef.$C System/IO/Unsafe.$C +Debug/Trace.$C: System/IO.$C System/IO/Unsafe.$C +Control/Monad/Fix.$C: System/IO.$C +Control/Monad/Identity.$C: Control/Monad.$C Control/Monad/Fix.$C +Control/Monad/Trans.$C: System/IO.$C +Foreign/Marshal/Alloc.$C: Data/Maybe.$C Foreign/Ptr.$C Foreign/Storable.$C \ + Foreign/C/Types.$C +Foreign/Marshal/Array.$C: Control/Monad.$C Foreign/Ptr.$C Foreign/Storable.$C \ + Foreign/Marshal/Alloc.$C Foreign/Marshal/Utils.$C +Foreign/Marshal/Utils.$C: Data/Maybe.$C Foreign/Ptr.$C Foreign/Storable.$C \ + Foreign/C/Types.$C Foreign/Marshal/Alloc.$C +Foreign/Marshal/Error.$C: Foreign/Ptr.$C +Foreign/C/String.$C: Data/Word.$C Foreign/Ptr.$C Foreign/C/Types.$C \ + Foreign/Marshal/Array.$C diff --git a/System/Cmd.hs b/System/Cmd.hs index f5c85ec..b1492e0 100644 --- a/System/Cmd.hs +++ b/System/Cmd.hs @@ -14,19 +14,16 @@ module System.Cmd ( system, -- :: String -> IO ExitCode -#ifndef __HUGS__ +#ifdef __GLASGOW_HASKELL__ rawSystem, -- :: String -> IO ExitCode #endif ) where import Prelude +#ifdef __GLASGOW_HASKELL__ import System.Exit -#ifndef __HUGS__ import Foreign.C -#endif - -#ifdef __GLASGOW_HASKELL__ import GHC.IOBase #endif @@ -34,6 +31,10 @@ import GHC.IOBase import Hugs.System #endif +#ifdef __NHC__ +import System (system) +#endif + -- --------------------------------------------------------------------------- -- system @@ -57,7 +58,7 @@ call, which ignores the @SHELL@ environment variable, and always passes the command to the Windows command interpreter (@CMD.EXE@ or @COMMAND.COM@), hence Unixy shell tricks will not work. -} -#ifndef __HUGS__ +#ifdef __GLASGOW_HASKELL__ system :: String -> IO ExitCode system "" = ioException (IOError Nothing InvalidArgument "system" "null command" Nothing) system cmd = @@ -85,4 +86,4 @@ rawSystem cmd = foreign import ccall unsafe "rawSystemCmd" primRawSystem :: CString -> IO Int -#endif /* __HUGS__ */ +#endif /* __GLASGOW_HASKELL__ */ diff --git a/System/Environment.hs b/System/Environment.hs index 99b25bb..0ab0214 100644 --- a/System/Environment.hs +++ b/System/Environment.hs @@ -17,7 +17,7 @@ module System.Environment getArgs, -- :: IO [String] getProgName, -- :: IO String getEnv, -- :: String -> IO String -#ifndef __HUGS__ +#ifdef __GLASGOW_HASKELL__ withArgs, withProgName, #endif @@ -26,13 +26,10 @@ module System.Environment import Prelude import System.IO ( bracket ) -#ifndef __HUGS__ +#ifdef __GLASGOW_HASKELL__ import Foreign import Foreign.C import Control.Monad -#endif - -#ifdef __GLASGOW_HASKELL__ import GHC.IOBase #endif @@ -40,13 +37,21 @@ import GHC.IOBase import Hugs.System #endif +#ifdef __NHC__ +import System + ( getArgs + , getProgName + , getEnv + ) +#endif + -- --------------------------------------------------------------------------- -- getArgs, getProgName, getEnv -- Computation `getArgs' returns a list of the program's command -- line arguments (not including the program name). -#ifndef __HUGS__ +#ifdef __GLASGOW_HASKELL__ getArgs :: IO [String] getArgs = alloca $ \ p_argc -> @@ -156,4 +161,4 @@ setArgs argv = do foreign import ccall unsafe "setProgArgv" setArgsPrim :: Int -> Ptr CString -> IO () -#endif /* __HUGS__ */ +#endif /* __GLASGOW_HASKELL__ */ diff --git a/System/Exit.hs b/System/Exit.hs index db37a7f..3c0ecb8 100644 --- a/System/Exit.hs +++ b/System/Exit.hs @@ -29,6 +29,13 @@ import GHC.IOBase import Hugs.System #endif +#ifdef __NHC__ +import System + ( ExitCode(..) + , exitWith + ) +#endif + -- --------------------------------------------------------------------------- -- exitWith diff --git a/System/Mem.hs b/System/Mem.hs index 2391936..ec5b136 100644 --- a/System/Mem.hs +++ b/System/Mem.hs @@ -26,3 +26,7 @@ import Hugs.IOExts -- | Triggers an immediate garbage collection foreign import ccall {-safe-} "performGC" performGC :: IO () #endif + +#ifdef __NHC__ +import NHC.IOExtras (performGC) +#endif -- 1.7.10.4