projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fix hsc2hs finding its template file on Windows
[ghc-hetmet.git]
/
utils
/
hsc2hs
/
Main.hs
diff --git
a/utils/hsc2hs/Main.hs
b/utils/hsc2hs/Main.hs
index
77b948f
..
b422986
100644
(file)
--- a/
utils/hsc2hs/Main.hs
+++ b/
utils/hsc2hs/Main.hs
@@
-1,4
+1,4
@@
-{-# OPTIONS -fffi -cpp #-}
+{-# LANGUAGE CPP, ForeignFunctionInterface #-}
------------------------------------------------------------------------
-- Program for converting .hsc files to .hs files, by converting the
------------------------------------------------------------------------
-- Program for converting .hsc files to .hs files, by converting the
@@
-42,11
+42,7
@@
import System.IO ( openFile, IOMode(..), hClose )
#endif
#if defined(__GLASGOW_HASKELL__) && !defined(BUILD_NHC)
#endif
#if defined(__GLASGOW_HASKELL__) && !defined(BUILD_NHC)
-#ifdef USING_COMPAT
-import Compat.RawSystem ( rawSystem )
-#else
import System.Cmd ( rawSystem )
import System.Cmd ( rawSystem )
-#endif
#define HAVE_rawSystem
#elif __NHC__ >= 117
import System.Cmd ( rawSystem )
#define HAVE_rawSystem
#elif __NHC__ >= 117
import System.Cmd ( rawSystem )
@@
-62,6
+58,9
@@
import System ( system )
#endif
#endif
#endif
#endif
+import Distribution.Text
+import qualified Paths_hsc2hs
+
version :: String
version = "hsc2hs version 0.66\n"
version :: String
version = "hsc2hs version 0.66\n"
@@
-133,7
+132,7
@@
main = do
-- to find one by looking near the executable. This only
-- works on Win32 or Hugs (getExecDir). On Unix, there's a wrapper
-- script which specifies an explicit template flag.
-- to find one by looking near the executable. This only
-- 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
+ flags_w_tpl0 <- if any template_flag flags then
return flags
else
do mb_path <- getExecDir "/bin/hsc2hs.exe"
return flags
else
do mb_path <- getExecDir "/bin/hsc2hs.exe"
@@
-141,12
+140,21
@@
main = do
case mb_path of
Nothing -> return id
Just path -> do
case mb_path of
Nothing -> return id
Just path -> do
- let templ = path ++ "/template-hsc.h"
+ -- Euch, this is horrible. Unfortunately
+ -- Paths_hsc2hs isn't too useful for a
+ -- relocatable binary, though.
+ let templ = path ++ "/hsc2hs-" ++ display Paths_hsc2hs.version ++ "/template-hsc.h"
flg <- doesFileExist templ
if flg
then return ((Template templ):)
else return id
return (add_opt flags)
flg <- doesFileExist templ
if flg
then return ((Template templ):)
else return id
return (add_opt flags)
+
+ -- take only the last --template flag on the cmd line
+ let
+ (before,tpl:after) = break template_flag (reverse flags_w_tpl0)
+ flags_w_tpl = reverse (before ++ tpl : filter (not.template_flag) after)
+
case (files, errs) of
(_, _)
| any isHelp flags_w_tpl -> bye (usageInfo header options)
case (files, errs) of
(_, _)
| any isHelp flags_w_tpl -> bye (usageInfo header options)
@@
-573,13
+581,11
@@
output flags name toks = do
-- (called hsc2hs-inplace, generated from hsc2hs.sh)
compiler <- case [c | Compiler c <- flags] of
[] -> locateGhc "ghc"
-- (called hsc2hs-inplace, generated from hsc2hs.sh)
compiler <- case [c | Compiler c <- flags] of
[] -> locateGhc "ghc"
- [c] -> return c
- _ -> onlyOne "compiler"
+ cs -> return (last cs)
linker <- case [l | Linker l <- flags] of
[] -> locateGhc compiler
linker <- case [l | Linker l <- flags] of
[] -> locateGhc compiler
- [l] -> return l
- _ -> onlyOne "linker"
+ ls -> return (last ls)
writeFile cProgName $
concatMap outFlagHeaderCProg flags++
writeFile cProgName $
concatMap outFlagHeaderCProg flags++