Commit 3d893a10 authored by malcolm's avatar malcolm
Browse files

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

Make some more libraries buildable with nhc98.
parent e3dec53d
......@@ -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
......@@ -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
......@@ -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
......@@ -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
......@@ -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.
......
......@@ -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
......
......@@ -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__
......
......@@ -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
......@@ -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
......
......@@ -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
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
......@@ -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__ */
......@@ -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__ */
......@@ -29,6 +29,13 @@ import GHC.IOBase
import Hugs.System
#endif
#ifdef __NHC__
import System
( ExitCode(..)
, exitWith
)
#endif
-- ---------------------------------------------------------------------------
-- exitWith
......
......@@ -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
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment