[commit: base] encoding: Windows fixes for argument handling code (013154a)

[Max Bolingbroke]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/base

On branch  : encoding

http://hackage.haskell.org/trac/ghc/changeset/013154aec3037331bfe7e9027a0451f764dae143

>---------------------------------------------------------------

commit 013154aec3037331bfe7e9027a0451f764dae143
Author: Max Bolingbroke <batterseapower at hotmail.com>
Date:   Tue Apr 5 17:27:34 2011 +0100

    Windows fixes for argument handling code

>---------------------------------------------------------------

 GHC/Environment.hs    |    7 ++++---
 System/Environment.hs |   11 +++++++----
 2 files changed, 11 insertions(+), 7 deletions(-)

diff --git a/GHC/Environment.hs b/GHC/Environment.hs
index 4bdd4c1..536914e 100644
--- a/GHC/Environment.hs
+++ b/GHC/Environment.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE CPP, ForeignFunctionInterface #-}
 
 module GHC.Environment (getFullArgs) where
 
@@ -11,6 +11,7 @@ import GHC.IO.Encoding
 import qualified GHC.Foreign as GHC
 
 #ifdef mingw32_HOST_OS
+import GHC.IO (finally)
 import GHC.Windows
 
 -- Ignore the arguments to hs_init on Windows for the sake of Unicode compat
@@ -30,10 +31,10 @@ foreign import stdcall unsafe "windows.h GetCommandLineW"
     c_GetCommandLine :: IO (Ptr CWString)
 
 foreign import stdcall unsafe "windows.h CommandLineToArgvW"
-    c_CommandLineToArgv :: Ptr CWString -> Ptr CInt -> IO (Ptr (Ptr CWString))
+    c_CommandLineToArgv :: Ptr CWString -> Ptr CInt -> IO (Ptr CWString)
 
 foreign import stdcall unsafe "Windows.h LocalFree"
-    c_LocalFree :: Ptr a -> Ptr a
+    c_LocalFree :: Ptr a -> IO (Ptr a)
 #else
 getFullArgs :: IO [String]
 getFullArgs =
diff --git a/System/Environment.hs b/System/Environment.hs
index 0fd0d3b..4f57058 100644
--- a/System/Environment.hs
+++ b/System/Environment.hs
@@ -203,6 +203,13 @@ withProgName nm act = do
 -- the duration of an action.
 
 withArgv :: [String] -> IO a -> IO a
+
+#ifdef mingw32_HOST_OS
+withArgv new_args act = bracket (setArgs new_args) setArgs (\_ -> act)
+
+setArgs :: [String] -> IO [String]
+setArgs argv = atomicModifyIORef argsRef $ \old_argv -> (argv, old_argv)
+#else
 withArgv new_args act = do
   pName <- System.Environment.getProgName
   existing_args <- System.Environment.getArgs
@@ -218,10 +225,6 @@ freeArgv argv = do
   free argv
 
 setArgs :: [String] -> IO (Ptr CString)
-
-#ifdef mingw32_HOST_OS
-setArgs argv = atomicModifyIORef argsRef $ \_ -> (argv, ())
-#else
 setArgs argv = do
   vs <- mapM (GHC.newCString fileSystemEncoding) argv >>= newArray0 nullPtr
   setArgsPrim (genericLength argv) vs