diff options
Diffstat (limited to 'utils/runghc/runghc.hs')
-rw-r--r-- | utils/runghc/runghc.hs | 20 |
1 files changed, 11 insertions, 9 deletions
diff --git a/utils/runghc/runghc.hs b/utils/runghc/runghc.hs index ab495132cd..4424c96096 100644 --- a/utils/runghc/runghc.hs +++ b/utils/runghc/runghc.hs @@ -149,15 +149,17 @@ dieProg msg = do getExecPath :: IO (Maybe String) #if defined(mingw32_HOST_OS) -getExecPath = - allocaArray len $ \buf -> do - ret <- getModuleFileName nullPtr buf len - if ret == 0 then return Nothing - else liftM Just $ peekCString buf - where len = 2048 -- Plenty, PATH_MAX is 512 under Win32. - -foreign import stdcall unsafe "GetModuleFileNameA" - getModuleFileName :: Ptr () -> CString -> Int -> IO Int32 +getExecPath = try_size 2048 -- plenty, PATH_MAX is 512 under Win32. + where + try_size size = allocaArray (fromIntegral size) $ \buf -> do + ret <- c_GetModuleFileName nullPtr buf size + case ret of + 0 -> return Nothing + _ | ret < size -> fmap Just $ peekCWString buf + | otherwise -> try_size (size * 2) + +foreign import stdcall unsafe "windows.h GetModuleFileNameW" + c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32 #else getExecPath = return Nothing #endif |