X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=utils%2Frunghc%2Frunghc.hs;h=4424c96096332d4c594d73c008f19ffe842d1ef3;hp=47615def3a29fb6f0ea34dba08f11b56e768cdac;hb=b2524b3960999fffdb3767900f58825903f6560f;hpb=bb57db143d9c0207e4c2c4c24ceb688714c2980d

diff --git a/utils/runghc/runghc.hs b/utils/runghc/runghc.hs
index 47615de..4424c96 100644
--- a/utils/runghc/runghc.hs
+++ b/utils/runghc/runghc.hs
@@ -1,9 +1,5 @@
 {-# LANGUAGE CPP, ForeignFunctionInterface #-}
-#if __GLASGOW_HASKELL__ < 603
-#include "config.h"
-#else
 #include "ghcconfig.h"
-#endif
 -----------------------------------------------------------------------------
 --
 -- (c) The University of Glasgow, 2004
@@ -22,13 +18,8 @@
 
 module Main (main) where
 
-import Paths_runghc
-
 import Control.Exception
-import Data.Char
-import Data.List
 import Data.Monoid
-import Data.Version
 import System.Cmd
 import System.Directory
 import System.Environment
@@ -85,7 +76,7 @@ parseRunGhcFlags = f mempty
 
 printVersion :: IO ()
 printVersion = do
-    putStrLn ("runghc " ++ showVersion version)
+    putStrLn ("runghc " ++ VERSION)
 
 printUsage :: IO ()
 printUsage = do
@@ -158,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