X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FEnvironment.hs;h=117b7db0a3d24610838429688022ba6dfd566dc9;hb=9fa9bc17072a58c0bae2cce4764d38677e96ac29;hp=d2b0d38e541fb854b5ae6f15f18016614d3efa0c;hpb=7f1f4e7a695c402ddd3a1dc2cc7114e649a78ebc;p=ghc-base.git

diff --git a/System/Environment.hs b/System/Environment.hs
index d2b0d38..117b7db 100644
--- a/System/Environment.hs
+++ b/System/Environment.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- 
+-- |
 -- Module      :  System.Environment
 -- Copyright   :  (c) The University of Glasgow 2001
 -- License     :  BSD-style (see the file libraries/core/LICENSE)
@@ -8,7 +8,7 @@
 -- Stability   :  provisional
 -- Portability :  portable
 --
--- $Id: Environment.hs,v 1.1 2001/06/28 14:15:04 simonmar Exp $
+-- $Id: Environment.hs,v 1.6 2002/04/24 16:31:45 simonmar Exp $
 --
 -- Miscellaneous information about the system environment.
 --
@@ -25,6 +25,7 @@ import Prelude
 
 import Foreign
 import Foreign.C
+import Control.Monad
 
 #ifdef __GLASGOW_HASKELL__
 import GHC.IOBase
@@ -37,32 +38,49 @@ import GHC.IOBase
 -- 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
+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 label "prog_argv" prog_argv_label :: Ptr (Ptr (Ptr CChar))
-foreign label "prog_argc" prog_argc_label :: Ptr CInt
+   
+foreign import ccall unsafe "getProgArgv"
+  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
+  
 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
+
 
 -- Computation `getEnv var' returns the value
 -- of the environment variable {\em var}.  
@@ -72,12 +90,12 @@ unpackProgName argv = do
 
 getEnv :: String -> IO String
 getEnv name =
-    withUnsafeCString name $ \s -> do
+    withCString name $ \s -> do
       litstring <- c_getenv s
       if litstring /= nullPtr
 	then peekCString litstring
         else ioException (IOError Nothing NoSuchThing "getEnv"
 			  "no environment variable" (Just name))
 
-foreign import ccall "getenv" unsafe 
-   c_getenv :: UnsafeCString -> IO (Ptr CChar)
+foreign import ccall unsafe "getenv"
+   c_getenv :: CString -> IO (Ptr CChar)