[project @ 1998-04-30 20:02:29 by sof]

code tidyup/update

diff --git a/ghc/lib/misc/Readline.lhs b/ghc/lib/misc/Readline.lhs
index 7c1d12e..fd36aa6 100644 (file)
--- a/ghc/lib/misc/Readline.lhs
+++ b/ghc/lib/misc/Readline.lhs
@@ -56,27 +56,25 @@ type RlCallbackFunction =
 
 readline :: String ->                  -- Prompt String
            IO String                   -- Returned line
-readline prompt = 
+readline prompt =  do
 --ToDo: Get the "Live register in _casm_GC_ " bug fixed
 --      this stops us passing the prompt string to readline directly :-(
---    _casm_GC_ ``%r = readline %0;'' prompt   `thenPrimIO` \ litstr ->
-
+--    litstr <- _casm_GC_ ``%r = readline(%0);'' prompt
     _casm_ ``rl_prompt_hack = (char*)realloc(rl_prompt_hack, %1);
             strcpy (rl_prompt_hack,%0);'' 
-               prompt  (length prompt)                 `thenIO_Prim` \ () ->
-    _casm_GC_ ``%r = readline (rl_prompt_hack);''      `thenIO_Prim` \ litstr ->
-    if (litstr == ``NULL'') then 
-       fail (userError "Readline has read EOF")
-    else (
-       let str = unpackCString litstr in
-       _casm_ ``free %0;'' litstr  `thenIO_Prim` \ () ->
+               prompt  (length prompt)
+    litstr <- _casm_GC_ ``%r = readline (rl_prompt_hack);''
+    if (litstr == ``NULL'') 
+     then fail (userError "Readline has read EOF")
+     else do
+       let str = unpackCString litstr
+       _casm_ ``free(%0);'' litstr
        return str
-    )
 
 
-addHistory :: String ->                        -- String to enter in history
-             IO ()
-addHistory str = primIOToIO (_ccall_ add_history str)
+addHistory :: String           -- String to enter in history
+           -> IO ()
+addHistory str = _ccall_ add_history str
 
 
 rlBindKey :: KeyCode ->                        -- Key to Bind to
@@ -85,11 +83,9 @@ rlBindKey :: KeyCode ->                      -- Key to Bind to
 rlBindKey key cback =
     if (0 > key) || (key > 255) then
        fail (userError "Invalid ASCII Key Code, must be in range 0.255")
-    else 
-       addCbackEntry (key,cback)           `thenIO_Prim` \ _ ->
-       _casm_ `` rl_bind_key((KeyCode)%0,&genericRlCback); ''
-            key                            `thenIO_Prim` \ () ->
-       return ()
+    else  do
+       addCbackEntry (key,cback)
+       _casm_ `` rl_bind_key((KeyCode)%0,&genericRlCback); '' key
 
 \end{code}
 
@@ -107,11 +103,9 @@ rlAddDefun :: String ->                    -- Function Name
 rlAddDefun name cback key =
     if (0 > key) || (key > 255) then
        fail (userError "Invalid ASCII Key Code, must be in range 0..255")
-    else
-       addCbackEntry (key, cback)          `thenIO_Prim` \ _ ->
-       _casm_ ``rl_add_defun (%0, &genericRlCback, (KeyCode)%1);''
-       name key                            `thenIO_Prim` \ () ->
-       return ()
+    else do
+       addCbackEntry (key, cback)
+       _casm_ ``rl_add_defun (%0, &genericRlCback, (KeyCode)%1);'' name key
 
 \end{code}
 
@@ -157,9 +151,9 @@ setCbackList ls =
     error "setCbackList: not available for Parallel Haskell"
 #endif
 
-addCbackEntry :: (KeyCode,RlCallbackFunction) -> PrimIO ()
-addCbackEntry entry =
-    getCbackList >>= \ ls ->
+addCbackEntry :: (KeyCode,RlCallbackFunction) -> IO ()
+addCbackEntry entry = do
+    ls <- getCbackList
     setCbackList (entry:ls)
 \end{code}
 
@@ -168,19 +162,17 @@ Haskell.
 
 \begin{code}
 
-invokeRlCback :: PrimIO ()
-invokeRlCback =
-    _casm_ `` %r=(KeyCode)current_kc; ''    >>= \ kc ->
-    _casm_ `` %r=(int)current_narg; ''     >>= \ narg ->
-    getCbackList                           >>= \ ls ->
-    (case (dropWhile (\ (key,_) -> kc/=key) ls) of
-       [] -> -- no match
-           returnPrimIO (-1)
-       ((_,cback):_) ->
-           ioToPrimIO (cback narg kc)
-    )                                      >>= \ ret_val ->
-    _casm_ `` rl_return=(int)%0; '' ret_val >>= \ () ->
-    returnPrimIO ()
+invokeRlCback :: IO ()
+invokeRlCback = do
+    kc    <- _casm_ `` %r=(KeyCode)current_kc; ''
+    narg  <- _casm_ `` %r=(int)current_narg; ''
+    ls    <- getCbackList
+    ret_val <- 
+      (case (dropWhile (\ (key,_) -> kc/=key) ls) of
+        [] -> return (-1)
+        ((_,cback):_) -> cback narg kc
+      )
+    _casm_ `` rl_return=(int)%0; '' ret_val
 
 \end{code}
  
@@ -214,58 +206,57 @@ they be in the IO Monad, should they be Mutable Variables?
 \begin{code}
 
 rlGetLineBuffer :: IO String
-rlGetLineBuffer = 
-    _casm_ ``%r = rl_line_buffer;''    `thenIO_Prim` \ litstr ->
+rlGetLineBuffer = do
+    litstr <- _casm_ ``%r = rl_line_buffer;''
     return (unpackCString litstr)
                                
 rlSetLineBuffer :: String -> IO ()
-rlSetLineBuffer str = primIOToIO (_casm_ ``rl_line_buffer = %0;'' str)
+rlSetLineBuffer str = _casm_ ``rl_line_buffer = %0;'' str
                
 
 rlGetPoint :: IO Int
-rlGetPoint = primIOToIO (_casm_ ``%r = rl_point;'')
+rlGetPoint = _casm_ ``%r = rl_point;''
 
 rlSetPoint :: Int -> IO ()
-rlSetPoint point = primIOToIO (_casm_ ``rl_point = %0;'' point)
+rlSetPoint point = _casm_ ``rl_point = %0;'' point
         
 rlGetEnd :: IO Int
-rlGetEnd = primIOToIO (_casm_ ``%r = rl_end;'')
+rlGetEnd = _casm_ ``%r = rl_end;''
 
 rlSetEnd :: Int -> IO ()
-rlSetEnd end = primIOToIO (_casm_ ``rl_end = %0;'' end)
+rlSetEnd end = _casm_ ``rl_end = %0;'' end
 
 rlGetMark :: IO Int
-rlGetMark = primIOToIO (_casm_ ``%r = rl_mark;'')
+rlGetMark = _casm_ ``%r = rl_mark;''
 
 rlSetMark :: Int -> IO ()
-rlSetMark mark = primIOToIO (_casm_ ``rl_mark = %0;'' mark)
+rlSetMark mark = _casm_ ``rl_mark = %0;'' mark
 
 rlSetDone :: Bool -> IO ()
-rlSetDone True  = primIOToIO (_casm_ ``rl_done = %0;'' 1)
-rlSetDone False = primIOToIO (_casm_ ``rl_done = %0;'' 0)
+rlSetDone True  = _casm_ ``rl_done = %0;'' 1
+rlSetDone False = _casm_ ``rl_done = %0;'' 0
 
 rlPendingInput :: KeyCode -> IO ()
 rlPendingInput key = primIOToIO (_casm_ ``rl_pending_input = %0;'' key)
 
 rlPrompt :: IO String
-rlPrompt = 
-    _casm_ ``%r = rl_readline_name;''  `thenIO_Prim` \ litstr ->
+rlPrompt = do
+    litstr <- _casm_ ``%r = rl_readline_name;''
     return (unpackCString litstr)
 
 rlTerminalName :: IO String
-rlTerminalName = 
-    _casm_ ``%r = rl_terminal_name;''  `thenIO_Prim` \ litstr ->
+rlTerminalName = do
+    litstr <- _casm_ ``%r = rl_terminal_name;''
     return (unpackCString litstr)
 
 
 rlGetReadlineName :: IO String
-rlGetReadlineName = 
-    _casm_ ``%r = rl_readline_name;''  `thenIO_Prim` \ litstr ->
+rlGetReadlineName = do
+    litstr <- _casm_ ``%r = rl_readline_name;''
     return (unpackCString litstr)
 
 rlSetReadlineName :: String -> IO ()
-rlSetReadlineName str = primIOToIO (
-    _casm_ ``rl_readline_name = %0;'' str)
+rlSetReadlineName str = _casm_ ``rl_readline_name = %0;'' str
 \end{code}
 
 \begin{verbatim}
@@ -307,9 +298,10 @@ rlOutStream = unsafePerformPrimIO (
 -- rlStartupHook :: RlCallBackFunction -> IO ()             
 
 rlInitialize :: IO ()
-rlInitialize =
-    getProgName                                            >>= \ pname ->
-    rlSetReadlineName pname                        >>
-    _casm_ ``rl_prompt_hack = (char*)malloc(1);''   `thenIO_Prim` \ () ->
-    primIOToIO (initRlCbacks)
+rlInitialize = do
+    pname <- getProgName
+    rlSetReadlineName pname
+    _casm_ ``rl_prompt_hack = (char*)malloc(1);''
+    initRlCbacks
+
 \end{code}