[project @ 2002-07-16 16:08:58 by ross]
authorross <unknown>
Tue, 16 Jul 2002 16:09:00 +0000 (16:09 +0000)
committerross <unknown>
Tue, 16 Jul 2002 16:09:00 +0000 (16:09 +0000)
Add imports of Hugs.* modules (wrapped in #ifdef __HUGS__) to make these
modules work with Hugs.

21 files changed:
Control/Concurrent/MVar.hs
Control/Monad/ST.hs
Control/Monad/ST/Lazy.hs
Data/Array.hs
Data/Dynamic.hs
Data/IORef.hs
Data/Int.hs
Data/STRef.hs
Data/STRef/Lazy.hs
Data/Word.hs
Debug/Trace.hs
Foreign/StablePtr.hs
System/Cmd.hs
System/Environment.hs
System/Exit.hs
System/IO.hs
System/IO/Error.hs
System/IO/Unsafe.hs
System/Mem.hs
System/Mem/StableName.hs
System/Mem/Weak.hs

index ef1a2e6..aef8969 100644 (file)
@@ -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,
                )
index 59b303f..7341cef 100644 (file)
@@ -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 )
index b98316b..085075b 100644 (file)
@@ -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
index 301f8c8..499f791 100644 (file)
@@ -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")
index 4945e13..961355d 100644 (file)
@@ -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#
index 2580df2..3607734 100644 (file)
@@ -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
index fd63589..93d84b6 100644 (file)
@@ -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
index 336a61f..e25e8b5 100644 (file)
@@ -27,6 +27,10 @@ import Prelude
 import GHC.STRef
 #endif
 
+#ifdef __HUGS__
+import Hugs.ST
+#endif
+
 import Data.Dynamic
 
 #include "Dynamic.h"
index daa48a0..b05fb83 100644 (file)
@@ -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__ */
index 6308556..3bcc8a7 100644 (file)
@@ -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
index ecaf39e..05809a0 100644 (file)
@@ -26,6 +26,10 @@ import GHC.IOBase
 import GHC.Handle
 #endif
 
+#ifdef __HUGS__
+import Hugs.IOExts
+#endif
+
 #ifdef __GLASGOW_HASKELL__
 {-# NOINLINE trace #-}
 {-|
index 17c219e..08e9ae3 100644 (file)
@@ -33,6 +33,9 @@ import GHC.Stable
 import GHC.Err
 #endif
 
+#ifdef __HUGS__
+import Hugs.StablePtr
+#endif
 
 -- $cinterface
 --
index 4bd07af..ff9a316 100644 (file)
@@ -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__ */
index c20d7d7..4e9efb6 100644 (file)
@@ -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__ */
index 51f619f..d311d05 100644 (file)
@@ -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__ */
index 904082c..e25d422 100644 (file)
@@ -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
index 245487a..fd92ee1 100644 (file)
 
 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
index 8fafec4..b86fedd 100644 (file)
@@ -23,3 +23,7 @@ import Prelude
 #ifdef __GLASGOW_HASKELL__
 import GHC.IOBase
 #endif
+
+#ifdef __HUGS__
+import Hugs.IOExts
+#endif
index a12847b..2391936 100644 (file)
@@ -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 ()
index 659dacb..d582dae 100644 (file)
@@ -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#
index 85907b0..b51c9e2 100644 (file)
@@ -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