From 9812e0a321ec0ed8f9e53eb2febfb14c79564200 Mon Sep 17 00:00:00 2001 From: ross Date: Tue, 16 Jul 2002 16:09:00 +0000 Subject: [PATCH] [project @ 2002-07-16 16:08:58 by ross] Add imports of Hugs.* modules (wrapped in #ifdef __HUGS__) to make these modules work with Hugs. --- Control/Concurrent/MVar.hs | 4 +- Control/Monad/ST.hs | 4 ++ Control/Monad/ST/Lazy.hs | 11 ++++-- Data/Array.hs | 91 ++------------------------------------------ Data/Dynamic.hs | 5 +++ Data/IORef.hs | 16 ++------ Data/Int.hs | 4 ++ Data/STRef.hs | 4 ++ Data/STRef/Lazy.hs | 5 ++- Data/Word.hs | 4 ++ Debug/Trace.hs | 4 ++ Foreign/StablePtr.hs | 3 ++ System/Cmd.hs | 8 ++++ System/Environment.hs | 8 ++++ System/Exit.hs | 6 +++ System/IO.hs | 13 +++++++ System/IO/Error.hs | 14 +++++++ System/IO/Unsafe.hs | 4 ++ System/Mem.hs | 4 ++ System/Mem/StableName.hs | 4 ++ System/Mem/Weak.hs | 9 +++-- 21 files changed, 117 insertions(+), 108 deletions(-) diff --git a/Control/Concurrent/MVar.hs b/Control/Concurrent/MVar.hs index ef1a2e6..aef8969 100644 --- a/Control/Concurrent/MVar.hs +++ b/Control/Concurrent/MVar.hs @@ -28,11 +28,13 @@ module Control.Concurrent.MVar , withMVar -- :: MVar a -> (a -> IO b) -> IO b , modifyMVar_ -- :: MVar a -> (a -> IO a) -> IO () , modifyMVar -- :: MVar a -> (a -> IO (a,b)) -> IO b +#ifndef __HUGS__ , addMVarFinalizer -- :: MVar a -> IO () -> IO () +#endif ) where #ifdef __HUGS__ -import ConcBase ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar, +import Hugs.ConcBase ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar, tryTakeMVar, tryPutMVar, isEmptyMVar, readMVar, swapMVar, ) diff --git a/Control/Monad/ST.hs b/Control/Monad/ST.hs index 59b303f..7341cef 100644 --- a/Control/Monad/ST.hs +++ b/Control/Monad/ST.hs @@ -35,6 +35,10 @@ import Prelude import Control.Monad.Fix import Data.Dynamic +#ifdef __HUGS__ +import Hugs.ST +#endif + #ifdef __GLASGOW_HASKELL__ import GHC.ST import GHC.Base ( unsafeCoerce#, RealWorld ) diff --git a/Control/Monad/ST/Lazy.hs b/Control/Monad/ST/Lazy.hs index b98316b..085075b 100644 --- a/Control/Monad/ST/Lazy.hs +++ b/Control/Monad/ST/Lazy.hs @@ -28,8 +28,10 @@ module Control.Monad.ST.Lazy ( RealWorld, ST.stToIO, +#ifndef __HUGS__ -- * Converting between strict and lazy 'ST' strictToLazyST, lazyToStrictST +#endif ) where import Prelude @@ -41,10 +43,13 @@ import GHC.Base import Control.Monad #endif +#ifdef __HUGS__ +import Hugs.LazyST as ST +#endif + #ifdef __GLASGOW_HASKELL__ newtype ST s a = ST (State s -> (a, State s)) data State s = S# (State# s) -#endif instance Functor (ST s) where fmap f m = ST $ \ s -> @@ -68,8 +73,6 @@ instance Monad (ST s) where in k_a new_s - -#ifdef __GLASGOW_HASKELL__ {-# NOINLINE runST #-} runST :: (forall s. ST s a) -> a runST st = case st of ST the_st -> let (r,_) = the_st (S# realWorld#) in r @@ -107,7 +110,7 @@ Convert a lazy 'ST' computation into a strict one. lazyToStrictST :: ST s a -> ST.ST s a lazyToStrictST (ST m) = GHC.ST.ST $ \s -> case (m (S# s)) of (a, S# s') -> (# s', a #) -#endif unsafeInterleaveST :: ST s a -> ST s a unsafeInterleaveST = strictToLazyST . ST.unsafeInterleaveST . lazyToStrictST +#endif diff --git a/Data/Array.hs b/Data/Array.hs index 301f8c8..499f791 100644 --- a/Data/Array.hs +++ b/Data/Array.hs @@ -52,92 +52,9 @@ import GHC.Arr -- Most of the hard work is done here import GHC.Err ( undefined ) #endif -#include "Dynamic.h" -INSTANCE_TYPEABLE2(Array,arrayTc,"Array") - #ifdef __HUGS__ - ------------ HUGS (rest of file) -------------------- -import PrelPrim ( PrimArray - , runST - , primNewArray - , primWriteArray - , primReadArray - , primUnsafeFreezeArray - , primIndexArray - ) -import Ix -import List( (\\) ) - -infixl 9 !, // - --- ----------------------------------------------------------------------------- --- The Array type - -data Array ix elt = Array (ix,ix) (PrimArray elt) - -array :: Ix a => (a,a) -> [(a,b)] -> Array a b -array ixs@(ix_start, ix_end) ivs = runST (do - { mut_arr <- primNewArray (rangeSize ixs) arrEleBottom - ; mapM_ (\ (i,v) -> primWriteArray mut_arr (index ixs i) v) ivs - ; arr <- primUnsafeFreezeArray mut_arr - ; return (Array ixs arr) - } - ) - where - arrEleBottom = error "(Array.!): undefined array element" - -listArray :: Ix a => (a,a) -> [b] -> Array a b -listArray b vs = array b (zipWith (\ a b -> (a,b)) (range b) vs) - -(!) :: Ix a => Array a b -> a -> b -(Array bounds arr) ! i = primIndexArray arr (index bounds i) - -bounds :: Ix a => Array a b -> (a,a) -bounds (Array b _) = b - -indices :: Ix a => Array a b -> [a] -indices = range . bounds - -elems :: Ix a => Array a b -> [b] -elems a = [a!i | i <- indices a] - -assocs :: Ix a => Array a b -> [(a,b)] -assocs a = [(i, a!i) | i <- indices a] - -(//) :: Ix a => Array a b -> [(a,b)] -> Array a b -(//) a us = array (bounds a) - ([(i,a!i) | i <- indices a \\ [i | (i,_) <- us]] - ++ us) - -accum :: Ix a => (b -> c -> b) -> Array a b -> [(a,c)] -> Array a b -accum f = foldl (\a (i,v) -> a // [(i,f (a!i) v)]) - -accumArray :: Ix a => (b -> c -> b) -> b -> (a,a) -> [(a,c)] -> Array a b -accumArray f z b = accum f (array b [(i,z) | i <- range b]) - -ixmap :: (Ix a, Ix b) => (a,a) -> (a -> b) -> Array b c -> Array a c -ixmap b f a = array b [(i, a ! f i) | i <- range b] - - -instance (Ix a) => Functor (Array a) where - fmap f a = array (bounds a) [(i, f(a!i)) | i <- indices a] - -instance (Ix a, Eq b) => Eq (Array a b) where - a == a' = assocs a == assocs a' - -instance (Ix a, Ord b) => Ord (Array a b) where - a <= a' = assocs a <= assocs a' - - -instance (Ix a, Show a, Show b) => Show (Array a b) where - showsPrec p a = showParen (p > 9) ( - showString "array " . - shows (bounds a) . showChar ' ' . - shows (assocs a) ) +import Hugs.Array +#endif -instance (Ix a, Read a, Read b) => Read (Array a b) where - readsPrec p = readParen (p > 9) - (\r -> [(array b as, u) | ("array",s) <- lex r, - (b,t) <- reads s, - (as,u) <- reads t ]) -#endif /* __HUGS__ */ +#include "Dynamic.h" +INSTANCE_TYPEABLE2(Array,arrayTc,"Array") diff --git a/Data/Dynamic.hs b/Data/Dynamic.hs index 4945e13..961355d 100644 --- a/Data/Dynamic.hs +++ b/Data/Dynamic.hs @@ -78,6 +78,11 @@ import GHC.Float import GHC.IOBase #endif +#ifdef __HUGS__ +import Hugs.IO +import Hugs.IOExts +#endif + #ifdef __GLASGOW_HASKELL__ unsafeCoerce :: a -> b unsafeCoerce = unsafeCoerce# diff --git a/Data/IORef.hs b/Data/IORef.hs index 2580df2..3607734 100644 --- a/Data/IORef.hs +++ b/Data/IORef.hs @@ -28,6 +28,10 @@ module Data.IORef import Prelude +#ifdef __HUGS__ +import Hugs.IORef +#endif + #ifdef __GLASGOW_HASKELL__ import GHC.Base ( mkWeak# ) import GHC.STRef @@ -46,18 +50,6 @@ mkWeakIORef r@(IORef (STRef r#)) f = IO $ \s -> case mkWeak# r# r f s of (# s1, w #) -> (# s1, Weak w #) #endif -#if defined __HUGS__ -data IORef a -- mutable variables containing values of type a - -primitive newIORef "newRef" :: a -> IO (IORef a) -primitive readIORef "getRef" :: IORef a -> IO a -primitive writeIORef "setRef" :: IORef a -> a -> IO () -primitive eqIORef "eqRef" :: IORef a -> IORef a -> Bool - -instance Eq (IORef a) where - (==) = eqIORef -#endif /* __HUGS__ */ - -- |Mutate the contents of an 'IORef' modifyIORef :: IORef a -> (a -> a) -> IO () modifyIORef ref f = writeIORef ref . f =<< readIORef ref diff --git a/Data/Int.hs b/Data/Int.hs index fd63589..93d84b6 100644 --- a/Data/Int.hs +++ b/Data/Int.hs @@ -29,6 +29,10 @@ import GHC.Base ( Int ) import GHC.Int ( Int8, Int16, Int32, Int64 ) #endif +#ifdef __HUGS__ +import Hugs.Int ( Int8, Int16, Int32, Int64 ) +#endif + {- $notes * All arithmetic is performed modulo 2^n, where @n@ is the number of diff --git a/Data/STRef.hs b/Data/STRef.hs index 336a61f..e25e8b5 100644 --- a/Data/STRef.hs +++ b/Data/STRef.hs @@ -27,6 +27,10 @@ import Prelude import GHC.STRef #endif +#ifdef __HUGS__ +import Hugs.ST +#endif + import Data.Dynamic #include "Dynamic.h" diff --git a/Data/STRef/Lazy.hs b/Data/STRef/Lazy.hs index daa48a0..b05fb83 100644 --- a/Data/STRef/Lazy.hs +++ b/Data/STRef/Lazy.hs @@ -21,6 +21,9 @@ module Data.STRef.Lazy ( ) where import Control.Monad.ST.Lazy +#ifdef __HUGS__ +import Hugs.LazyST as ST +#else import qualified Data.STRef as ST import qualified Control.Monad.ST as ST @@ -34,4 +37,4 @@ readSTRef = strictToLazyST . ST.readSTRef writeSTRef r a = strictToLazyST (ST.writeSTRef r a) modifySTRef r f = strictToLazyST (ST.modifySTRef r f) - +#endif /* __HUGS__ */ diff --git a/Data/Word.hs b/Data/Word.hs index 6308556..3bcc8a7 100644 --- a/Data/Word.hs +++ b/Data/Word.hs @@ -29,6 +29,10 @@ module Data.Word import GHC.Word #endif +#ifdef __HUGS__ +import Hugs.Word +#endif + {- $notes * All arithmetic is performed modulo 2^n, where n is the number of diff --git a/Debug/Trace.hs b/Debug/Trace.hs index ecaf39e..05809a0 100644 --- a/Debug/Trace.hs +++ b/Debug/Trace.hs @@ -26,6 +26,10 @@ import GHC.IOBase import GHC.Handle #endif +#ifdef __HUGS__ +import Hugs.IOExts +#endif + #ifdef __GLASGOW_HASKELL__ {-# NOINLINE trace #-} {-| diff --git a/Foreign/StablePtr.hs b/Foreign/StablePtr.hs index 17c219e..08e9ae3 100644 --- a/Foreign/StablePtr.hs +++ b/Foreign/StablePtr.hs @@ -33,6 +33,9 @@ import GHC.Stable import GHC.Err #endif +#ifdef __HUGS__ +import Hugs.StablePtr +#endif -- $cinterface -- diff --git a/System/Cmd.hs b/System/Cmd.hs index 4bd07af..ff9a316 100644 --- a/System/Cmd.hs +++ b/System/Cmd.hs @@ -19,12 +19,18 @@ module System.Cmd import Prelude import System.Exit +#ifndef __HUGS__ import Foreign.C +#endif #ifdef __GLASGOW_HASKELL__ import GHC.IOBase #endif +#ifdef __HUGS__ +import Hugs.System +#endif + -- --------------------------------------------------------------------------- -- system @@ -48,6 +54,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__ system :: String -> IO ExitCode system "" = ioException (IOError Nothing InvalidArgument "system" "null command" Nothing) system cmd = @@ -58,3 +65,4 @@ system cmd = n -> return (ExitFailure n) foreign import ccall unsafe "systemCmd" primSystem :: CString -> IO Int +#endif /* __HUGS__ */ diff --git a/System/Environment.hs b/System/Environment.hs index c20d7d7..4e9efb6 100644 --- a/System/Environment.hs +++ b/System/Environment.hs @@ -21,20 +21,27 @@ module System.Environment import Prelude +#ifndef __HUGS__ import Foreign import Foreign.C import Control.Monad +#endif #ifdef __GLASGOW_HASKELL__ import GHC.IOBase #endif +#ifdef __HUGS__ +import Hugs.System +#endif + -- --------------------------------------------------------------------------- -- getArgs, getProgName, getEnv -- Computation `getArgs' returns a list of the program's command -- line arguments (not including the program name). +#ifndef __HUGS__ getArgs :: IO [String] getArgs = alloca $ \ p_argc -> @@ -104,3 +111,4 @@ getEnv name = foreign import ccall unsafe "getenv" c_getenv :: CString -> IO (Ptr CChar) +#endif /* __HUGS__ */ diff --git a/System/Exit.hs b/System/Exit.hs index 51f619f..d311d05 100644 --- a/System/Exit.hs +++ b/System/Exit.hs @@ -25,6 +25,10 @@ import Prelude import GHC.IOBase #endif +#ifdef __HUGS__ +import Hugs.System +#endif + -- --------------------------------------------------------------------------- -- exitWith @@ -32,6 +36,7 @@ import GHC.IOBase -- program's caller. Before it terminates, any open or semi-closed -- handles are first closed. +#ifndef __HUGS__ exitWith :: ExitCode -> IO a exitWith ExitSuccess = throw (ExitException ExitSuccess) exitWith code@(ExitFailure n) @@ -40,3 +45,4 @@ exitWith code@(ExitFailure n) exitFailure :: IO a exitFailure = exitWith (ExitFailure 1) +#endif /* __HUGS__ */ diff --git a/System/IO.hs b/System/IO.hs index 904082c..e25d422 100644 --- a/System/IO.hs +++ b/System/IO.hs @@ -35,7 +35,9 @@ module System.IO ( hGetPosn, -- :: Handle -> IO HandlePosn hSetPosn, -- :: HandlePosn -> IO () hSeek, -- :: Handle -> SeekMode -> Integer -> IO () +#ifndef __HUGS__ hTell, -- :: Handle -> IO Integer +#endif hWaitForInput, -- :: Handle -> Int -> IO Bool hReady, -- :: Handle -> IO Bool hGetChar, -- :: Handle -> IO Char @@ -87,15 +89,19 @@ module System.IO ( readIO, -- :: Read a => String -> IO a readLn, -- :: Read a => IO a +#ifndef __HUGS__ hPutBuf, -- :: Handle -> Ptr a -> Int -> IO () hGetBuf, -- :: Handle -> Ptr a -> Int -> IO Int +#endif fixIO, -- :: (a -> IO a) -> IO a +#ifndef __HUGS__ hSetEcho, -- :: Handle -> Bool -> IO () hGetEcho, -- :: Handle -> IO Bool hIsTerminalDevice, -- :: Handle -> IO Bool +#endif ) where #ifdef __GLASGOW_HASKELL__ @@ -110,11 +116,17 @@ import GHC.Read import GHC.Show #endif +#ifdef __HUGS__ +import Hugs.IO +import Hugs.IOExts +#endif + import System.IO.Error -- ----------------------------------------------------------------------------- -- Standard IO +#ifndef __HUGS__ putChar :: Char -> IO () putChar c = hPutChar stdout c @@ -169,6 +181,7 @@ readIO s = case (do { (x,t) <- reads s ; [x] -> return x [] -> ioError (userError "Prelude.readIO: no parse") _ -> ioError (userError "Prelude.readIO: ambiguous parse") +#endif /* __HUGS__ */ hReady :: Handle -> IO Bool hReady h = hWaitForInput h 0 diff --git a/System/IO/Error.hs b/System/IO/Error.hs index 245487a..fd92ee1 100644 --- a/System/IO/Error.hs +++ b/System/IO/Error.hs @@ -16,11 +16,14 @@ module System.IO.Error ( IOError, -- abstract +#ifndef __HUGS__ IOErrorType, -- abstract +#endif ioError, -- :: IOError -> IO a userError, -- :: String -> IOError +#ifndef __HUGS__ mkIOError, -- :: IOErrorType -> String -> Maybe Handle -- -> Maybe FilePath -> IOError @@ -41,6 +44,7 @@ module System.IO.Error ( isIllegalOperationErrorType, isPermissionErrorType, isUserErrorType, +#endif /* __HUGS__ */ isAlreadyExistsError, -- :: IOError -> Bool isDoesNotExistError, @@ -51,7 +55,9 @@ module System.IO.Error ( isPermissionError, isUserError, +#ifndef __HUGS__ ioeGetErrorType, -- :: IOError -> IOErrorType +#endif ioeGetErrorString, -- :: IOError -> String ioeGetHandle, -- :: IOError -> Maybe Handle ioeGetFileName, -- :: IOError -> Maybe FilePath @@ -66,6 +72,11 @@ import GHC.IOBase import Text.Show #endif +#ifdef __HUGS__ +import Hugs.IO +#endif + +#ifndef __HUGS__ -- ----------------------------------------------------------------------------- -- Constructing an IOError @@ -93,6 +104,7 @@ isEOFError = isEOFErrorType . ioeGetErrorType isIllegalOperation = isIllegalOperationErrorType . ioeGetErrorType isPermissionError = isPermissionErrorType . ioeGetErrorType isUserError = isUserErrorType . ioeGetErrorType +#endif -- ----------------------------------------------------------------------------- -- IOErrorTypes @@ -115,9 +127,11 @@ userErrorType = UserError -- ----------------------------------------------------------------------------- -- IOErrorType predicates +#ifndef __HUGS__ isAlreadyExistsErrorType, isDoesNotExistErrorType, isAlreadyInUseErrorType, isFullErrorType, isEOFErrorType, isIllegalOperationErrorType, isPermissionErrorType, isUserErrorType :: IOErrorType -> Bool +#endif #ifdef __GLASGOW_HASKELL__ isAlreadyExistsErrorType AlreadyExists = True diff --git a/System/IO/Unsafe.hs b/System/IO/Unsafe.hs index 8fafec4..b86fedd 100644 --- a/System/IO/Unsafe.hs +++ b/System/IO/Unsafe.hs @@ -23,3 +23,7 @@ import Prelude #ifdef __GLASGOW_HASKELL__ import GHC.IOBase #endif + +#ifdef __HUGS__ +import Hugs.IOExts +#endif diff --git a/System/Mem.hs b/System/Mem.hs index a12847b..2391936 100644 --- a/System/Mem.hs +++ b/System/Mem.hs @@ -18,6 +18,10 @@ module System.Mem ( import Prelude +#ifdef __HUGS__ +import Hugs.IOExts +#endif + #ifdef __GLASGOW_HASKELL__ -- | Triggers an immediate garbage collection foreign import ccall {-safe-} "performGC" performGC :: IO () diff --git a/System/Mem/StableName.hs b/System/Mem/StableName.hs index 659dacb..d582dae 100644 --- a/System/Mem/StableName.hs +++ b/System/Mem/StableName.hs @@ -33,6 +33,10 @@ import Prelude import Data.Dynamic +#ifdef __HUGS__ +import Hugs.Stable +#endif + #ifdef __GLASGOW_HASKELL__ import GHC.IOBase ( IO(..) ) import GHC.Base ( Int(..), StableName#, makeStableName# diff --git a/System/Mem/Weak.hs b/System/Mem/Weak.hs index 85907b0..b51c9e2 100644 --- a/System/Mem/Weak.hs +++ b/System/Mem/Weak.hs @@ -71,14 +71,15 @@ import Prelude import Data.Dynamic +#ifdef __HUGS__ +import Hugs.Weak +#endif + #ifdef __GLASGOW_HASKELL__ import GHC.Base import GHC.IOBase import GHC.Weak -#include "Dynamic.h" -INSTANCE_TYPEABLE1(Weak,weakTc,"Weak") - {-| Dereferences a weak pointer. If the key is still alive, then @'Just' v@ is returned (where @v@ is the /value/ in the weak pointer), otherwise @@ -113,6 +114,8 @@ finalize (Weak w) = IO $ \s -> (# s1, _, f #) -> f s1 #endif +#include "Dynamic.h" +INSTANCE_TYPEABLE1(Weak,weakTc,"Weak") {- $precise -- 1.7.10.4