[project @ 2005-01-28 12:55:17 by simonmar]

[ghc-hetmet.git] / ghc / utils / hsc2hs / Main.hs

diff --git a/ghc/utils/hsc2hs/Main.hs b/ghc/utils/hsc2hs/Main.hs
index 0ad0a03..f6f8ecb 100644 (file)
--- 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