[project @ 2001-12-20 16:39:29 by simonmar]

[ghc-hetmet.git] / ghc / lib / std / System.lhs

diff --git a/ghc/lib/std/System.lhs b/ghc/lib/std/System.lhs
index 45483b9..51029da 100644 (file)
--- a/ghc/lib/std/System.lhs
+++ b/ghc/lib/std/System.lhs
@@ -1,10 +1,11 @@
 -- -----------------------------------------------------------------------------
--- $Id: System.lhs,v 1.32 2001/08/10 13:48:06 simonmar Exp $
+-- $Id: System.lhs,v 1.37 2001/11/08 16:36:39 simonmar Exp $
 --
 -- (c) The University of Glasgow, 1994-2000
 --
 
 \begin{code}
+#include "config.h"
 module System 
     ( 
       ExitCode(ExitSuccess,ExitFailure)
@@ -22,10 +23,10 @@ import PrelCError
 import PrelCString
 import PrelCTypes
 import PrelMarshalArray
+import PrelMarshalAlloc
 import PrelPtr
 import PrelStorable
 import PrelIOBase
-import PrelConc
 
 -- ---------------------------------------------------------------------------
 -- getArgs, getProgName, getEnv
@@ -34,21 +35,28 @@ import PrelConc
 -- line arguments (not including the program name).
 
 getArgs :: IO [String]
-getArgs = do
-  argv <- peek prog_argv_label
-  argc <- peek prog_argc_label
-  peekArray (fromIntegral argc - 1) (advancePtr argv 1) >>= mapM peekCString
-
-foreign label "prog_argv" prog_argv_label :: Ptr (Ptr (Ptr CChar))
-foreign label "prog_argc" prog_argc_label :: Ptr CInt
+getArgs = 
+  alloca $ \ p_argc ->  
+  alloca $ \ p_argv -> do
+   getProgArgv p_argc p_argv
+   p    <- fromIntegral `liftM` peek p_argc
+   argv <- peek p_argv
+   peekArray (p - 1) (advancePtr argv 1) >>= mapM peekCString
+   
+   
+foreign import "getProgArgv" unsafe 
+  getProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()
 
 -- Computation `getProgName' returns the name of the program
 -- as it was invoked.
 
 getProgName :: IO String
-getProgName = do
-  argv <- peek prog_argv_label
-  unpackProgName argv
+getProgName = 
+  alloca $ \ p_argc ->
+  alloca $ \ p_argv -> do
+     getProgArgv p_argc p_argv
+     argv <- peek p_argv
+     unpackProgName argv
 
 -- Computation `getEnv var' returns the value
 -- of the environment variable {\em var}.  
@@ -114,11 +122,21 @@ exitFailure = exitWith (ExitFailure 1)
 unpackProgName :: Ptr (Ptr CChar) -> IO String   -- argv[0]
 unpackProgName argv = do 
   s <- peekElemOff argv 0 >>= peekCString
-  return (de_slash "" s)
+  return (basename s)
   where
-    -- re-start accumulating at every '/'
-    de_slash :: String -> String -> String
-    de_slash  acc []      = reverse acc
-    de_slash _acc ('/':xs) = de_slash []      xs
-    de_slash  acc (x:xs)   = de_slash (x:acc) xs
+   basename :: String -> String
+   basename f = go f f
+    where
+      go acc [] = acc
+      go acc (x:xs) 
+        | isPathSeparator x = go xs xs
+        | otherwise         = go acc xs
+
+   isPathSeparator :: Char -> Bool
+   isPathSeparator '/'  = True
+#ifdef mingw32_TARGET_OS 
+   isPathSeparator '\\' = True
+#endif
+   isPathSeparator _    = False
+
 \end{code}