X-Git-Url: http://git.megacz.com/?p=ghc-base.git;a=blobdiff_plain;f=GHC%2FEnvironment.hs;h=73f85ed52d07d811da0947866cdb8f7cf37c4a9b;hp=60325b36118923a9a7009d7cbfeca141926b0b4c;hb=509f28cc93b980d30aca37008cbe66c677a0d6f6;hpb=b751723d882e51241f04d6d2ec46fce70f0e0817 diff --git a/GHC/Environment.hs b/GHC/Environment.hs index 60325b3..73f85ed 100644 --- a/GHC/Environment.hs +++ b/GHC/Environment.hs @@ -1,12 +1,42 @@ -{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE CPP, ForeignFunctionInterface #-} module GHC.Environment (getFullArgs) where import Prelude import Foreign import Foreign.C + +#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 +getFullArgs :: IO [String] +getFullArgs = do + p_arg_string <- c_GetCommandLine + alloca $ \p_argc -> do + p_argv <- c_CommandLineToArgv p_arg_string p_argc + if p_argv == nullPtr + then throwGetLastError "getFullArgs" + else flip finally (c_LocalFree p_argv) $ do + argc <- peek p_argc + p_argvs <- peekArray (fromIntegral argc) p_argv + mapM peekCWString p_argvs + +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 CWString) + +foreign import stdcall unsafe "Windows.h LocalFree" + c_LocalFree :: Ptr a -> IO (Ptr a) +#else import Control.Monad +import GHC.IO.Encoding +import qualified GHC.Foreign as GHC + getFullArgs :: IO [String] getFullArgs = alloca $ \ p_argc -> @@ -14,8 +44,8 @@ getFullArgs = getFullProgArgv p_argc p_argv p <- fromIntegral `liftM` peek p_argc argv <- peek p_argv - peekArray (p - 1) (advancePtr argv 1) >>= mapM peekCString + peekArray (p - 1) (advancePtr argv 1) >>= mapM (GHC.peekCString fileSystemEncoding) foreign import ccall unsafe "getFullProgArgv" getFullProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO () - +#endif \ No newline at end of file