diff --git a/ghc/interpreter/lib/Prelude.hs b/ghc/interpreter/lib/Prelude.hs index e2a9302e907804cd6e9740cb15e962b8a45f0710..965fbedd3ebf1936b1616410fca8f761fde1df9c 100644 --- a/ghc/interpreter/lib/Prelude.hs +++ b/ghc/interpreter/lib/Prelude.hs @@ -117,7 +117,8 @@ module Prelude ( ,nh_stdin,nh_stdout,nh_stderr,copy_String_to_cstring,nh_open ,nh_free,nh_close,nh_errno,nh_flush,nh_read,primIntToChar ,unsafeInterleaveIO,nh_write,primCharToInt, - nullAddr, incAddr, isNullAddr, nh_filesize, nh_iseof, + nullAddr, incAddr, isNullAddr, + nh_filesize, nh_iseof, nh_system, nh_exitwith, nh_getPID, Word, primGtWord, primGeWord, primEqWord, primNeWord, @@ -1734,6 +1735,9 @@ foreign import "nHandle" "nh_load" nh_load :: Addr -> IO Char foreign import "nHandle" "nh_getenv" nh_getenv :: Addr -> IO Addr foreign import "nHandle" "nh_filesize" nh_filesize :: FILE_STAR -> IO Int foreign import "nHandle" "nh_iseof" nh_iseof :: FILE_STAR -> IO Int +foreign import "nHandle" "nh_system" nh_system :: Addr -> IO Int +foreign import "nHandle" "nh_exitwith" nh_exitwith :: Int -> IO () +foreign import "nHandle" "nh_getPID" nh_getPID :: IO Int copy_String_to_cstring :: String -> IO Addr copy_String_to_cstring s diff --git a/ghc/interpreter/nHandle.c b/ghc/interpreter/nHandle.c index 272c1055126d79480ddbe6041ced3a3ab42aac0e..4f2b22ab1e720c55576357e86817297af33a5d42 100644 --- a/ghc/interpreter/nHandle.c +++ b/ghc/interpreter/nHandle.c @@ -12,6 +12,21 @@ #include <sys/stat.h> #include <unistd.h> +int nh_getPID ( void ) +{ + return (int) getpid(); +} + +void nh_exitwith ( int code ) +{ + exit(code); +} + +int nh_system ( char* cmd ) +{ + return system ( cmd ); +} + int nh_iseof ( FILE* f ) { int c; diff --git a/ghc/lib/hugs/Prelude.hs b/ghc/lib/hugs/Prelude.hs index e2a9302e907804cd6e9740cb15e962b8a45f0710..965fbedd3ebf1936b1616410fca8f761fde1df9c 100644 --- a/ghc/lib/hugs/Prelude.hs +++ b/ghc/lib/hugs/Prelude.hs @@ -117,7 +117,8 @@ module Prelude ( ,nh_stdin,nh_stdout,nh_stderr,copy_String_to_cstring,nh_open ,nh_free,nh_close,nh_errno,nh_flush,nh_read,primIntToChar ,unsafeInterleaveIO,nh_write,primCharToInt, - nullAddr, incAddr, isNullAddr, nh_filesize, nh_iseof, + nullAddr, incAddr, isNullAddr, + nh_filesize, nh_iseof, nh_system, nh_exitwith, nh_getPID, Word, primGtWord, primGeWord, primEqWord, primNeWord, @@ -1734,6 +1735,9 @@ foreign import "nHandle" "nh_load" nh_load :: Addr -> IO Char foreign import "nHandle" "nh_getenv" nh_getenv :: Addr -> IO Addr foreign import "nHandle" "nh_filesize" nh_filesize :: FILE_STAR -> IO Int foreign import "nHandle" "nh_iseof" nh_iseof :: FILE_STAR -> IO Int +foreign import "nHandle" "nh_system" nh_system :: Addr -> IO Int +foreign import "nHandle" "nh_exitwith" nh_exitwith :: Int -> IO () +foreign import "nHandle" "nh_getPID" nh_getPID :: IO Int copy_String_to_cstring :: String -> IO Addr copy_String_to_cstring s diff --git a/ghc/lib/std/System.lhs b/ghc/lib/std/System.lhs index 0080df6e3f12aeb7f3de3f6792ce8f86c4d33281..a5d6a512186cd3472e65a8c50a2bda7f1116a121 100644 --- a/ghc/lib/std/System.lhs +++ b/ghc/lib/std/System.lhs @@ -203,12 +203,6 @@ getProgName = primGetRawArgs >>= \rawargs -> getEnv :: String -> IO String getEnv = primGetEnv -system :: String -> IO ExitCode -system s = error "System.system unimplemented" - -exitWith :: ExitCode -> IO a -exitWith c = error "System.exitWith unimplemented" - exitFailure :: IO a exitFailure = exitWith (ExitFailure 1) @@ -220,6 +214,27 @@ fromExitCode :: ExitCode -> Int fromExitCode ExitSuccess = 0 fromExitCode (ExitFailure n) = n +exitWith :: ExitCode -> IO a +exitWith c + = do nh_exitwith (fromExitCode c) + (ioError.IOError) "System.exitWith: should not return" + +system :: String -> IO ExitCode +system cmd + | null cmd + = (ioError.IOError) "System.system: null command" + | otherwise + = do str <- copy_String_to_cstring cmd + status <- nh_system str + nh_free str + case status of + 0 -> return ExitSuccess + n -> return (ExitFailure n) + +getPID :: IO Int +getPID + = nh_getPID + ----------------------------------------------------------------------------- \end{code} #endif