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

Make some more libraries buildable with nhc98.

diff --git a/Data/Array.hs b/Data/Array.hs
index 499f791..230e94a 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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