[project @ 1999-11-22 10:56:03 by sewardj]

Implement System.system, System.exitWith for Hugs.

diff --git a/ghc/interpreter/lib/Prelude.hs b/ghc/interpreter/lib/Prelude.hs
index e2a9302..965fbed 100644 (file)
--- 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 272c105..4f2b22a 100644 (file)
--- 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 e2a9302..965fbed 100644 (file)
--- 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 0080df6..a5d6a51 100644 (file)
--- 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