X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Futils%2Fhsc2hs%2FMain.hs;h=f6f8ecb9ef5466c0f32851080b0bdac9ff28d8d6;hb=153b9cb9b11e05c4edb1b6bc0a7b972660e41f70;hp=0ad0a038c8ab22aecaebaf94b6e2706d4db13b47;hpb=26f9e593087c3b738a1961d37f4c4a0a6bab0a0c;p=ghc-hetmet.git diff --git a/ghc/utils/hsc2hs/Main.hs b/ghc/utils/hsc2hs/Main.hs index 0ad0a03..f6f8ecb 100644 --- a/ghc/utils/hsc2hs/Main.hs +++ b/ghc/utils/hsc2hs/Main.hs @@ -1,7 +1,7 @@ {-# OPTIONS -fffi -cpp #-} ------------------------------------------------------------------------ --- $Id: Main.hs,v 1.61 2005/01/05 10:26:45 simonmar Exp $ +-- $Id: Main.hs,v 1.69 2005/01/28 12:56:26 simonmar Exp $ -- -- Program for converting .hsc files to .hs files, by converting the -- file into a C program which is run to generate the Haskell source. @@ -11,14 +11,16 @@ -- -- See the documentation in the Users' Guide for more details. -#if __GLASGOW_HASKELL__ >= 504 || __NHC__ >= 114 +#if defined(__GLASGOW_HASKELL__) && !defined(BUILD_NHC) +#include "../../includes/ghcconfig.h" +#endif + +#if __GLASGOW_HASKELL__ >= 504 || __NHC__ >= 114 || __HUGS__ import System.Console.GetOpt #else import GetOpt #endif -import Compat.RawSystem ( rawSystem ) - import System (getProgName, getArgs, ExitCode(..), exitWith, system) import Directory (removeFile,doesFileExist) import Monad (MonadPlus(..), liftM, liftM2, when) @@ -26,7 +28,7 @@ import Char (isAlpha, isAlphaNum, isSpace, isDigit, toUpper, intToDigit import List (intersperse, isSuffixOf) import IO (hPutStr, hPutStrLn, stderr) -#if defined(mingw32_HOST_OS) +#if defined(mingw32_HOST_OS) && !__HUGS__ import Foreign #if __GLASGOW_HASKELL__ >= 504 || __NHC__ >= 114 import Foreign.C.String @@ -36,6 +38,14 @@ import CString #endif +#if defined(__GLASGOW_HASKELL__) && !defined(BUILD_NHC) +import Compat.RawSystem ( rawSystem ) +#elif __HUGS__ || __NHC__ >= 117 || __GLASGOW_HASKELL__ >= 600 +import System.Cmd ( rawSystem ) +#else +rawSystem prog args = system (prog++" "++unwords args) +#endif + version :: String version = "hsc2hs version 0.66\n" @@ -106,12 +116,16 @@ main = do -- If there is no Template flag explicitly specified, try -- to find one by looking near the executable. This only - -- works on Win32 (getExecDir). On Unix, there's a wrapper + -- works on Win32 or Hugs (getExecDir). On Unix, there's a wrapper -- script which specifies an explicit template flag. flags_w_tpl <- if any template_flag flags then return flags else +#ifdef __HUGS__ + do mb_path <- getExecDir "/Main.hs" +#else do mb_path <- getExecDir "/bin/hsc2hs.exe" +#endif add_opt <- case mb_path of Nothing -> return id @@ -523,6 +537,17 @@ output flags name toks = do fixChar c | isAlphaNum c = toUpper c | otherwise = '_' +#ifdef __HUGS__ + compiler <- case [c | Compiler c <- flags] of + [] -> return "gcc" + [c] -> return c + _ -> onlyOne "compiler" + + linker <- case [l | Linker l <- flags] of + [] -> return compiler + [l] -> return l + _ -> onlyOne "linker" +#else -- Try locating GHC..on Win32, look in the vicinity of hsc2hs. -- Returns a native-format path locateGhc def = do @@ -555,6 +580,7 @@ output flags name toks = do [] -> locateGhc compiler [l] -> return l _ -> onlyOne "linker" +#endif writeFile cProgName $ concatMap outFlagHeaderCProg flags++ @@ -638,7 +664,7 @@ onlyOne what = die ("Only one "++what++" may be specified\n") outFlagHeaderCProg :: Flag -> String outFlagHeaderCProg (Template t) = "#include \""++t++"\"\n" outFlagHeaderCProg (Include f) = "#include "++f++"\n" -outFlagHeaderCProg (Define n Nothing) = "#define "++n++"\n" +outFlagHeaderCProg (Define n Nothing) = "#define "++n++" 1\n" outFlagHeaderCProg (Define n (Just v)) = "#define "++n++" "++v++"\n" outFlagHeaderCProg _ = "" @@ -740,7 +766,7 @@ outEnum arg = outFlagH :: Flag -> String outFlagH (Include f) = "#include "++f++"\n" -outFlagH (Define n Nothing) = "#define "++n++"\n" +outFlagH (Define n Nothing) = "#define "++n++" 1\n" outFlagH (Define n (Just v)) = "#define "++n++" "++v++"\n" outFlagH _ = "" @@ -832,21 +858,29 @@ showCString = concatMap showCChar -- Cut and pasted from ghc/compiler/SysTools -- Convert paths foo/baz to foo\baz on Windows -dosifyPath :: String -> String +dosifyPath, unDosifyPath :: String -> String #if defined(mingw32_HOST_OS) dosifyPath xs = subst '/' '\\' xs - -unDosifyPath :: String -> String unDosifyPath xs = subst '\\' '/' xs subst :: Eq a => a -> a -> [a] -> [a] subst a b ls = map (\ x -> if x == a then b else x) ls +#else +dosifyPath xs = xs +unDosifyPath xs = xs +#endif getExecDir :: String -> IO (Maybe String) -- (getExecDir cmd) returns the directory in which the current -- executable, which should be called 'cmd', is running -- So if the full path is /a/b/c/d/e, and you pass "d/e" as cmd, -- you'll get "/a/b/c" back as the result +#ifdef __HUGS__ +getExecDir cmd + = do + s <- getProgName + return (Just (reverse (drop (length cmd) (reverse (unDosifyPath s))))) +#elif defined(mingw32_HOST_OS) getExecDir cmd = allocaArray len $ \buf -> do ret <- getModuleFileName nullPtr buf len @@ -861,8 +895,5 @@ foreign import stdcall unsafe "GetModuleFileNameA" getModuleFileName :: Ptr () -> CString -> Int -> IO Int32 #else -dosifyPath xs = xs - -getExecDir :: String -> IO (Maybe String) getExecDir _ = return Nothing #endif