, 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,
)
import Control.Monad.Fix
import Data.Dynamic
+#ifdef __HUGS__
+import Hugs.ST
+#endif
+
#ifdef __GLASGOW_HASKELL__
import GHC.ST
import GHC.Base ( unsafeCoerce#, RealWorld )
RealWorld,
ST.stToIO,
+#ifndef __HUGS__
-- * Converting between strict and lazy 'ST'
strictToLazyST, lazyToStrictST
+#endif
) where
import Prelude
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 ->
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
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
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")
import GHC.IOBase
#endif
+#ifdef __HUGS__
+import Hugs.IO
+import Hugs.IOExts
+#endif
+
#ifdef __GLASGOW_HASKELL__
unsafeCoerce :: a -> b
unsafeCoerce = unsafeCoerce#
import Prelude
+#ifdef __HUGS__
+import Hugs.IORef
+#endif
+
#ifdef __GLASGOW_HASKELL__
import GHC.Base ( mkWeak# )
import GHC.STRef
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
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
import GHC.STRef
#endif
+#ifdef __HUGS__
+import Hugs.ST
+#endif
+
import Data.Dynamic
#include "Dynamic.h"
) 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
writeSTRef r a = strictToLazyST (ST.writeSTRef r a)
modifySTRef r f = strictToLazyST (ST.modifySTRef r f)
-
+#endif /* __HUGS__ */
import GHC.Word
#endif
+#ifdef __HUGS__
+import Hugs.Word
+#endif
+
{- $notes
* All arithmetic is performed modulo 2^n, where n is the number of
import GHC.Handle
#endif
+#ifdef __HUGS__
+import Hugs.IOExts
+#endif
+
#ifdef __GLASGOW_HASKELL__
{-# NOINLINE trace #-}
{-|
import GHC.Err
#endif
+#ifdef __HUGS__
+import Hugs.StablePtr
+#endif
-- $cinterface
--
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
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 =
n -> return (ExitFailure n)
foreign import ccall unsafe "systemCmd" primSystem :: CString -> IO Int
+#endif /* __HUGS__ */
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 ->
foreign import ccall unsafe "getenv"
c_getenv :: CString -> IO (Ptr CChar)
+#endif /* __HUGS__ */
import GHC.IOBase
#endif
+#ifdef __HUGS__
+import Hugs.System
+#endif
+
-- ---------------------------------------------------------------------------
-- exitWith
-- 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)
exitFailure :: IO a
exitFailure = exitWith (ExitFailure 1)
+#endif /* __HUGS__ */
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
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__
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
[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
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
isIllegalOperationErrorType,
isPermissionErrorType,
isUserErrorType,
+#endif /* __HUGS__ */
isAlreadyExistsError, -- :: IOError -> Bool
isDoesNotExistError,
isPermissionError,
isUserError,
+#ifndef __HUGS__
ioeGetErrorType, -- :: IOError -> IOErrorType
+#endif
ioeGetErrorString, -- :: IOError -> String
ioeGetHandle, -- :: IOError -> Maybe Handle
ioeGetFileName, -- :: IOError -> Maybe FilePath
import Text.Show
#endif
+#ifdef __HUGS__
+import Hugs.IO
+#endif
+
+#ifndef __HUGS__
-- -----------------------------------------------------------------------------
-- Constructing an IOError
isIllegalOperation = isIllegalOperationErrorType . ioeGetErrorType
isPermissionError = isPermissionErrorType . ioeGetErrorType
isUserError = isUserErrorType . ioeGetErrorType
+#endif
-- -----------------------------------------------------------------------------
-- IOErrorTypes
-- -----------------------------------------------------------------------------
-- IOErrorType predicates
+#ifndef __HUGS__
isAlreadyExistsErrorType, isDoesNotExistErrorType, isAlreadyInUseErrorType,
isFullErrorType, isEOFErrorType, isIllegalOperationErrorType,
isPermissionErrorType, isUserErrorType :: IOErrorType -> Bool
+#endif
#ifdef __GLASGOW_HASKELL__
isAlreadyExistsErrorType AlreadyExists = True
#ifdef __GLASGOW_HASKELL__
import GHC.IOBase
#endif
+
+#ifdef __HUGS__
+import Hugs.IOExts
+#endif
import Prelude
+#ifdef __HUGS__
+import Hugs.IOExts
+#endif
+
#ifdef __GLASGOW_HASKELL__
-- | Triggers an immediate garbage collection
foreign import ccall {-safe-} "performGC" performGC :: IO ()
import Data.Dynamic
+#ifdef __HUGS__
+import Hugs.Stable
+#endif
+
#ifdef __GLASGOW_HASKELL__
import GHC.IOBase ( IO(..) )
import GHC.Base ( Int(..), StableName#, makeStableName#
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
(# s1, _, f #) -> f s1
#endif
+#include "Dynamic.h"
+INSTANCE_TYPEABLE1(Weak,weakTc,"Weak")
{- $precise