summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ghc/interpreter/lib/Prelude.hs6
-rw-r--r--ghc/interpreter/nHandle.c15
-rw-r--r--ghc/lib/hugs/Prelude.hs6
-rw-r--r--ghc/lib/std/System.lhs27
4 files changed, 46 insertions, 8 deletions
diff --git a/ghc/interpreter/lib/Prelude.hs b/ghc/interpreter/lib/Prelude.hs
index e2a9302e90..965fbedd3e 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 272c105512..4f2b22ab1e 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 e2a9302e90..965fbedd3e 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 0080df6e3f..a5d6a51218 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