From 27eae85bb34e9dcce4fac4a0c07dd314edbd4689 Mon Sep 17 00:00:00 2001 From: sewardj Date: Fri, 29 Oct 1999 14:18:21 +0000 Subject: [PATCH] [project @ 1999-10-29 14:18:20 by sewardj] Minor efficiency improvements to Prelude I/O functions. --- ghc/interpreter/lib/Prelude.hs | 37 ++++++++++++++++--------------------- ghc/interpreter/nHandle.c | 5 +++-- ghc/lib/hugs/Prelude.hs | 37 ++++++++++++++++--------------------- 3 files changed, 35 insertions(+), 44 deletions(-) diff --git a/ghc/interpreter/lib/Prelude.hs b/ghc/interpreter/lib/Prelude.hs index 68a8314..8696608 100644 --- a/ghc/interpreter/lib/Prelude.hs +++ b/ghc/interpreter/lib/Prelude.hs @@ -1612,13 +1612,12 @@ catch m k e2ioe other = IOError (show other) putChar :: Char -> IO () -putChar c = nh_stdout >>= \h -> nh_write h (primCharToInt c) +putChar c = nh_stdout >>= \h -> nh_write h c putStr :: String -> IO () -putStr s = --mapM_ putChar s -- correct, but slow - nh_stdout >>= \h -> - let loop [] = return () - loop (c:cs) = nh_write h (primCharToInt c) >> loop cs +putStr s = nh_stdout >>= \h -> + let loop [] = nh_flush h + loop (c:cs) = nh_write h c >> loop cs in loop s putStrLn :: String -> IO () @@ -1652,7 +1651,7 @@ readFile fname nh_open ptr 0 >>= \h -> nh_free ptr >> nh_errno >>= \errno -> - if (h == 0 || errno /= 0) + if (isNullAddr h || errno /= 0) then (ioError.IOError) ("readFile: can't open file " ++ fname) else readfromhandle h @@ -1662,7 +1661,7 @@ writeFile fname contents nh_open ptr 1 >>= \h -> nh_free ptr >> nh_errno >>= \errno -> - if (h == 0 || errno /= 0) + if (isNullAddr h || errno /= 0) then (ioError.IOError) ("writeFile: can't create file " ++ fname) else writetohandle fname h contents @@ -1672,7 +1671,7 @@ appendFile fname contents nh_open ptr 2 >>= \h -> nh_free ptr >> nh_errno >>= \errno -> - if (h == 0 || errno /= 0) + if (isNullAddr h || errno /= 0) then (ioError.IOError) ("appendFile: can't open file " ++ fname) else writetohandle fname h contents @@ -1703,12 +1702,12 @@ instance Show Exception where data IOResult = IOResult deriving (Show) -type FILE_STAR = Int -- FILE * +type FILE_STAR = Addr -- FILE * foreign import "nHandle" "nh_stdin" nh_stdin :: IO FILE_STAR foreign import "nHandle" "nh_stdout" nh_stdout :: IO FILE_STAR foreign import "nHandle" "nh_stderr" nh_stderr :: IO FILE_STAR -foreign import "nHandle" "nh_write" nh_write :: FILE_STAR -> Int -> IO () +foreign import "nHandle" "nh_write" nh_write :: FILE_STAR -> Char -> IO () foreign import "nHandle" "nh_read" nh_read :: FILE_STAR -> IO Int foreign import "nHandle" "nh_open" nh_open :: Addr -> Int -> IO FILE_STAR foreign import "nHandle" "nh_flush" nh_flush :: FILE_STAR -> IO () @@ -1717,18 +1716,15 @@ foreign import "nHandle" "nh_errno" nh_errno :: IO Int foreign import "nHandle" "nh_malloc" nh_malloc :: Int -> IO Addr foreign import "nHandle" "nh_free" nh_free :: Addr -> IO () -foreign import "nHandle" "nh_store" nh_store :: Addr -> Int -> IO () -foreign import "nHandle" "nh_load" nh_load :: Addr -> IO Int - ---foreign import "nHandle" "nh_argc" nh_argc :: IO Int ---foreign import "nHandle" "nh_argvb" nh_argvb :: Int -> Int -> IO Int +foreign import "nHandle" "nh_store" nh_store :: Addr -> Char -> IO () +foreign import "nHandle" "nh_load" nh_load :: Addr -> IO Char foreign import "nHandle" "nh_getenv" nh_getenv :: Addr -> IO Addr copy_String_to_cstring :: String -> IO Addr copy_String_to_cstring s = nh_malloc (1 + length s) >>= \ptr0 -> - let loop ptr [] = nh_store ptr 0 >> return ptr0 - loop ptr (c:cs) = nh_store ptr (primCharToInt c) >> loop (incAddr ptr) cs + let loop ptr [] = nh_store ptr (chr 0) >> return ptr0 + loop ptr (c:cs) = nh_store ptr c >> loop (incAddr ptr) cs in if isNullAddr ptr0 then error "copy_String_to_cstring: malloc failed" @@ -1737,10 +1733,10 @@ copy_String_to_cstring s copy_cstring_to_String :: Addr -> IO String copy_cstring_to_String ptr = nh_load ptr >>= \ci -> - if ci == 0 + if ci == '\0' then return [] else copy_cstring_to_String (incAddr ptr) >>= \cs -> - return ((primIntToChar ci) : cs) + return (ci : cs) readfromhandle :: FILE_STAR -> IO String readfromhandle h @@ -1758,8 +1754,7 @@ writetohandle fname h [] then return () else error ( "writeFile/appendFile: error closing file " ++ fname) writetohandle fname h (c:cs) - = nh_write h (primCharToInt c) >> - writetohandle fname h cs + = nh_write h c >> writetohandle fname h cs primGetRawArgs :: IO [String] primGetRawArgs diff --git a/ghc/interpreter/nHandle.c b/ghc/interpreter/nHandle.c index 4076c3f..d1ff813 100644 --- a/ghc/interpreter/nHandle.c +++ b/ghc/interpreter/nHandle.c @@ -52,7 +52,9 @@ void nh_write ( FILE* f, int c ) { errno = 0; fputc(c,f); - fflush(f); + if (f==stderr) { fflush(f); } + else if (f==stdin && isspace(c)) { fflush(f); }; + } int nh_read ( FILE* f ) @@ -69,7 +71,6 @@ int nh_errno ( void ) int nh_malloc ( int n ) { char* p = malloc(n); - assert(p); return (int)p; } diff --git a/ghc/lib/hugs/Prelude.hs b/ghc/lib/hugs/Prelude.hs index 68a8314..8696608 100644 --- a/ghc/lib/hugs/Prelude.hs +++ b/ghc/lib/hugs/Prelude.hs @@ -1612,13 +1612,12 @@ catch m k e2ioe other = IOError (show other) putChar :: Char -> IO () -putChar c = nh_stdout >>= \h -> nh_write h (primCharToInt c) +putChar c = nh_stdout >>= \h -> nh_write h c putStr :: String -> IO () -putStr s = --mapM_ putChar s -- correct, but slow - nh_stdout >>= \h -> - let loop [] = return () - loop (c:cs) = nh_write h (primCharToInt c) >> loop cs +putStr s = nh_stdout >>= \h -> + let loop [] = nh_flush h + loop (c:cs) = nh_write h c >> loop cs in loop s putStrLn :: String -> IO () @@ -1652,7 +1651,7 @@ readFile fname nh_open ptr 0 >>= \h -> nh_free ptr >> nh_errno >>= \errno -> - if (h == 0 || errno /= 0) + if (isNullAddr h || errno /= 0) then (ioError.IOError) ("readFile: can't open file " ++ fname) else readfromhandle h @@ -1662,7 +1661,7 @@ writeFile fname contents nh_open ptr 1 >>= \h -> nh_free ptr >> nh_errno >>= \errno -> - if (h == 0 || errno /= 0) + if (isNullAddr h || errno /= 0) then (ioError.IOError) ("writeFile: can't create file " ++ fname) else writetohandle fname h contents @@ -1672,7 +1671,7 @@ appendFile fname contents nh_open ptr 2 >>= \h -> nh_free ptr >> nh_errno >>= \errno -> - if (h == 0 || errno /= 0) + if (isNullAddr h || errno /= 0) then (ioError.IOError) ("appendFile: can't open file " ++ fname) else writetohandle fname h contents @@ -1703,12 +1702,12 @@ instance Show Exception where data IOResult = IOResult deriving (Show) -type FILE_STAR = Int -- FILE * +type FILE_STAR = Addr -- FILE * foreign import "nHandle" "nh_stdin" nh_stdin :: IO FILE_STAR foreign import "nHandle" "nh_stdout" nh_stdout :: IO FILE_STAR foreign import "nHandle" "nh_stderr" nh_stderr :: IO FILE_STAR -foreign import "nHandle" "nh_write" nh_write :: FILE_STAR -> Int -> IO () +foreign import "nHandle" "nh_write" nh_write :: FILE_STAR -> Char -> IO () foreign import "nHandle" "nh_read" nh_read :: FILE_STAR -> IO Int foreign import "nHandle" "nh_open" nh_open :: Addr -> Int -> IO FILE_STAR foreign import "nHandle" "nh_flush" nh_flush :: FILE_STAR -> IO () @@ -1717,18 +1716,15 @@ foreign import "nHandle" "nh_errno" nh_errno :: IO Int foreign import "nHandle" "nh_malloc" nh_malloc :: Int -> IO Addr foreign import "nHandle" "nh_free" nh_free :: Addr -> IO () -foreign import "nHandle" "nh_store" nh_store :: Addr -> Int -> IO () -foreign import "nHandle" "nh_load" nh_load :: Addr -> IO Int - ---foreign import "nHandle" "nh_argc" nh_argc :: IO Int ---foreign import "nHandle" "nh_argvb" nh_argvb :: Int -> Int -> IO Int +foreign import "nHandle" "nh_store" nh_store :: Addr -> Char -> IO () +foreign import "nHandle" "nh_load" nh_load :: Addr -> IO Char foreign import "nHandle" "nh_getenv" nh_getenv :: Addr -> IO Addr copy_String_to_cstring :: String -> IO Addr copy_String_to_cstring s = nh_malloc (1 + length s) >>= \ptr0 -> - let loop ptr [] = nh_store ptr 0 >> return ptr0 - loop ptr (c:cs) = nh_store ptr (primCharToInt c) >> loop (incAddr ptr) cs + let loop ptr [] = nh_store ptr (chr 0) >> return ptr0 + loop ptr (c:cs) = nh_store ptr c >> loop (incAddr ptr) cs in if isNullAddr ptr0 then error "copy_String_to_cstring: malloc failed" @@ -1737,10 +1733,10 @@ copy_String_to_cstring s copy_cstring_to_String :: Addr -> IO String copy_cstring_to_String ptr = nh_load ptr >>= \ci -> - if ci == 0 + if ci == '\0' then return [] else copy_cstring_to_String (incAddr ptr) >>= \cs -> - return ((primIntToChar ci) : cs) + return (ci : cs) readfromhandle :: FILE_STAR -> IO String readfromhandle h @@ -1758,8 +1754,7 @@ writetohandle fname h [] then return () else error ( "writeFile/appendFile: error closing file " ++ fname) writetohandle fname h (c:cs) - = nh_write h (primCharToInt c) >> - writetohandle fname h cs + = nh_write h c >> writetohandle fname h cs primGetRawArgs :: IO [String] primGetRawArgs -- 1.7.10.4