X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FEnvironment.hs;h=2b6dec272d6df2a74278c75c80e7463353181a22;hb=41e8fba828acbae1751628af50849f5352b27873;hp=3271e29422e0adaf98c46412597bc8744a3d8940;hpb=bb534f206682be14daf72b33c6105ab27295c6ac;p=ghc-base.git

diff --git a/System/Environment.hs b/System/Environment.hs
index 3271e29..2b6dec2 100644
--- a/System/Environment.hs
+++ b/System/Environment.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP, ForeignFunctionInterface #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  System.Environment
@@ -13,8 +15,8 @@
 -----------------------------------------------------------------------------
 
 module System.Environment
-    ( 
-      getArgs,	     -- :: IO [String]
+    (
+      getArgs,       -- :: IO [String]
       getProgName,   -- :: IO String
       getEnv,        -- :: String -> IO String
 #ifndef __NHC__
@@ -29,11 +31,13 @@ module System.Environment
 import Prelude
 
 #ifdef __GLASGOW_HASKELL__
+import Data.List
 import Foreign
 import Foreign.C
-import Control.Exception 	( bracket )
+import Control.Exception.Base   ( bracket )
 import Control.Monad
-import GHC.IOBase
+-- import GHC.IO
+import GHC.IO.Exception
 #endif
 
 #ifdef __HUGS__
@@ -56,15 +60,15 @@ import System
 
 #ifdef __GLASGOW_HASKELL__
 getArgs :: IO [String]
-getArgs = 
-  alloca $ \ p_argc ->  
+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 ccall unsafe "getProgArgv"
   getProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()
 
@@ -79,15 +83,15 @@ between platforms: on Windows, for example, a program invoked as foo
 is probably really @FOO.EXE@, and that is what 'getProgName' will return.
 -}
 getProgName :: IO String
-getProgName = 
+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 
+
+unpackProgName  :: Ptr (Ptr CChar) -> IO String   -- argv[0]
+unpackProgName argv = do
   s <- peekElemOff argv 0 >>= peekCString
   return (basename s)
   where
@@ -95,7 +99,7 @@ unpackProgName argv = do
    basename f = go f f
     where
       go acc [] = acc
-      go acc (x:xs) 
+      go acc (x:xs)
         | isPathSeparator x = go xs xs
         | otherwise         = go acc xs
 
@@ -120,9 +124,9 @@ getEnv name =
     withCString name $ \s -> do
       litstring <- c_getenv s
       if litstring /= nullPtr
-	then peekCString litstring
+        then peekCString litstring
         else ioException (IOError Nothing NoSuchThing "getEnv"
-			  "no environment variable" (Just name))
+                          "no environment variable" Nothing (Just name))
 
 foreign import ccall unsafe "getenv"
    c_getenv :: CString -> IO (Ptr CChar)
@@ -152,9 +156,10 @@ withArgv :: [String] -> IO a -> IO a
 withArgv new_args act = do
   pName <- System.Environment.getProgName
   existing_args <- System.Environment.getArgs
-  bracket (setArgs new_args) 
-	  (\argv -> do setArgs (pName:existing_args); freeArgv argv)
-  	  (const act)
+  bracket (setArgs new_args)
+          (\argv -> do _ <- setArgs (pName:existing_args)
+                       freeArgv argv)
+          (const act)
 
 freeArgv :: Ptr CString -> IO ()
 freeArgv argv = do
@@ -165,11 +170,11 @@ freeArgv argv = do
 setArgs :: [String] -> IO (Ptr CString)
 setArgs argv = do
   vs <- mapM newCString argv >>= newArray0 nullPtr
-  setArgsPrim (length argv) vs
+  setArgsPrim (genericLength argv) vs
   return vs
 
 foreign import ccall unsafe "setProgArgv" 
-  setArgsPrim  :: Int -> Ptr CString -> IO ()
+  setArgsPrim  :: CInt -> Ptr CString -> IO ()
 
 -- |'getEnvironment' retrieves the entire environment as a
 -- list of @(key,value)@ pairs.
@@ -185,7 +190,7 @@ getEnvironment = do
       stuff <- peekArray0 nullPtr pBlock >>= mapM peekCString
       return (map divvy stuff)
   where
-   divvy str = 
+   divvy str =
       case break (=='=') str of
         (xs,[])        -> (xs,[]) -- don't barf (like Posix.getEnvironment)
         (name,_:value) -> (name,value)