[project @ 2000-04-10 12:12:27 by simonpj]

[ghc-hetmet.git] / ghc / lib / std / IO.lhs

diff --git a/ghc/lib/std/IO.lhs b/ghc/lib/std/IO.lhs
index 1a8d4b3..daf0d09 100644 (file)
--- a/ghc/lib/std/IO.lhs
+++ b/ghc/lib/std/IO.lhs
@@ -83,17 +83,33 @@ module IO (
     readIO,                   -- :: Read a => String -> IO a
     readLn,                   -- :: Read a => IO a
 
-#ifndef __HUGS__
-    -- extensions
-    hPutBuf,
-    hPutBufBA,
-#endif
-    slurpFile
-
   ) where
 
 #ifdef __HUGS__
 import Ix(Ix)
+import PrelPrim ( IORef
+               , unsafePerformIO
+               , prelCleanupAfterRunAction
+               , copy_String_to_cstring
+               , primIntToChar
+               , primWriteCharOffAddr
+               , nullAddr
+               , newIORef
+               , writeIORef
+               , readIORef
+               , nh_close
+               , nh_errno
+               , nh_stdin
+               , nh_stdout
+               , nh_stderr
+               , nh_flush
+               , nh_open
+               , nh_free
+               , nh_read
+               , nh_write
+               , nh_filesize
+               , nh_iseof
+               )
 #else
 --import PrelST
 import PrelBase
@@ -110,6 +126,7 @@ import PrelAddr             ( Addr(..), nullAddr )
 import PrelByteArr     ( ByteArray )
 import PrelPack                ( unpackNBytesAccST )
 import PrelException    ( ioError, catch )
+import PrelConc
 
 #ifndef __PARALLEL_HASKELL__
 import PrelForeign  ( ForeignObj )
@@ -157,13 +174,9 @@ blocking until a character is available.
 
 \begin{code}
 hGetChar :: Handle -> IO Char
-hGetChar handle = 
-    wantReadableHandle "hGetChar" handle $ \ handle_ -> do
-    let fo = haFO__ handle_
-    intc     <- mayBlock fo (fileGetc fo)  -- ConcHask: UNSAFE, may block
-    if intc /= ((-1)::Int)
-     then return (chr intc)
-     else constructErrorAndFail "hGetChar"
+hGetChar handle = do
+  c <- mayBlockRead "hGetChar" handle fileGetc
+  return (chr c)
 
 {-
   If EOF is reached before EOL is encountered, ignore the
@@ -202,14 +215,9 @@ character is available.
 
 \begin{code}
 hLookAhead :: Handle -> IO Char
-hLookAhead handle =
-    wantReadableHandle "hLookAhead" handle $ \ handle_ -> do
-    let fo = haFO__ handle_
-    intc    <- mayBlock fo (fileLookAhead fo)  -- ConcHask: UNSAFE, may block
-    if intc /= (-1)
-     then return (chr intc)
-     else constructErrorAndFail "hLookAhead"
-
+hLookAhead handle = do
+  rc <- mayBlockRead "hLookAhead" handle fileLookAhead
+  return (chr rc)
 \end{code}
 
 
@@ -635,65 +643,13 @@ bracket_ before after m = do
             Left  e -> ioError e
 \end{code}
 
-%*********************************************************
-%*                                                      *
-\subsection{Standard IO}
-%*                                                      *
-%*********************************************************
-
-The Prelude has from Day 1 provided a collection of common
-IO functions. We define these here, but let the Prelude
-export them.
-
-\begin{code}
-putChar         :: Char -> IO ()
-putChar c       =  hPutChar stdout c
-
-putStr          :: String -> IO ()
-putStr s        =  hPutStr stdout s
-
-putStrLn        :: String -> IO ()
-putStrLn s      =  do putStr s
-                      putChar '\n'
 
-print           :: Show a => a -> IO ()
-print x         =  putStrLn (show x)
 
-getChar         :: IO Char
-getChar         =  hGetChar stdin
-
-getLine         :: IO String
-getLine         =  hGetLine stdin
-            
-getContents     :: IO String
-getContents     =  hGetContents stdin
-
-interact        ::  (String -> String) -> IO ()
-interact f      =   do s <- getContents
-                       putStr (f s)
-
-readFile        :: FilePath -> IO String
-readFile name  =  openFile name ReadMode >>= hGetContents
-
-writeFile       :: FilePath -> String -> IO ()
-writeFile name str = do
-    hdl <- openFile name WriteMode
-    hPutStr hdl str
-    hClose hdl
-
-appendFile      :: FilePath -> String -> IO ()
-appendFile name str = do
-    hdl <- openFile name AppendMode
-    hPutStr hdl str
-    hClose hdl
-
-readLn          :: Read a => IO a
-readLn          =  do l <- getLine
-                      r <- readIO l
-                      return r
-
-
-\end{code}
+%*********************************************************
+%*                                                     *
+\subsection{The HUGS version of IO
+%*                                                     *
+%*********************************************************
 
 #else /* __HUGS__ */
 
@@ -739,24 +695,24 @@ mkErr h msg
 stdin
    = Handle {
         name = "stdin",
-        file = primRunST nh_stdin,
-        mut  = primRunST (newIORef (Handle_Mut { state = HOpen })),
+        file = unsafePerformIO nh_stdin,
+        mut  = unsafePerformIO (newIORef (Handle_Mut { state = HOpen })),
         mode = ReadMode
      }
 
 stdout
    = Handle {
         name = "stdout",
-        file = primRunST nh_stdout,
-        mut  = primRunST (newIORef (Handle_Mut { state = HOpen })),
+        file = unsafePerformIO nh_stdout,
+        mut  = unsafePerformIO (newIORef (Handle_Mut { state = HOpen })),
         mode = WriteMode
      }
 
 stderr
    = Handle {
         name = "stderr",
-        file = primRunST nh_stderr,
-        mut  = primRunST (newIORef (Handle_Mut { state = HOpen })),
+        file = unsafePerformIO nh_stderr,
+        mut  = unsafePerformIO (newIORef (Handle_Mut { state = HOpen })),
         mode = WriteMode
      }
 
@@ -798,7 +754,7 @@ data HState = HOpen | HSemiClosed | HClosed
 -- once handles appear in the list.
 
 allHandles :: IORef [Handle]
-allHandles  = primRunST (newIORef [])
+allHandles  = unsafePerformIO (newIORef [])
 
 elemWriterHandles :: FilePath -> IO Bool
 elemAllHandles    :: FilePath -> IO Bool
@@ -894,7 +850,6 @@ openFile_main f mode
 hClose :: Handle -> IO ()
 hClose h
    = do mut <- readIORef (mut h)
-        putStrLn ( "hClose: state is " ++ show mut)
         if    state mut == HClosed
          then mkErr h
                  ("hClose on closed handle " ++ show h)