[project @ 2002-10-11 11:05:20 by malcolm]

Make some more libraries buildable with nhc98.

libraries/base/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

libraries/base/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

libraries/base/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

libraries/base/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

libraries/base/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.

libraries/base/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
 
 

libraries/base/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__

libraries/base/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

libraries/base/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

libraries/base/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

libraries/base/Makefile.nhc98

 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

libraries/base/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__ */

libraries/base/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__ */

libraries/base/System/Exit.hs

@@ -29,6 +29,13 @@ import GHC.IOBase
 import Hugs.System
 #endif
 
+#ifdef __NHC__
+import System
+  ( ExitCode(..)
+  , exitWith
+  )
+#endif
+
 -- ---------------------------------------------------------------------------
 -- exitWith
 

libraries/base/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