[project @ 2001-02-05 18:01:39 by rrt]

Make it work on Windows.

diff --git a/ghc/utils/hsc2hs/Main.hs b/ghc/utils/hsc2hs/Main.hs
index 8bf63e1..67a85de 100644 (file)
--- a/ghc/utils/hsc2hs/Main.hs
+++ b/ghc/utils/hsc2hs/Main.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
 -----------------------------------------------------------------------------

--- $Id: Main.hs,v 1.14 2001/01/24 22:37:15 qrczak Exp $
+-- $Id: Main.hs,v 1.15 2001/02/05 18:01:39 rrt Exp $

 --
 -- (originally "GlueHsc.hs" by Marcin 'Qrczak' Kowalczyk)
 --
 --
 -- (originally "GlueHsc.hs" by Marcin 'Qrczak' Kowalczyk)
 --

@@ -11,14 +11,21 @@
 --
 -- See the documentation in the Users' Guide for more details.
 
 --
 -- See the documentation in the Users' Guide for more details.
 

+#include "../../includes/config.h"
+

 import GetOpt
 import System      (getProgName, getArgs, ExitCode(..), system, exitWith, exitFailure)
 import Directory   (removeFile)
 import GetOpt
 import System      (getProgName, getArgs, ExitCode(..), system, exitWith, exitFailure)
 import Directory   (removeFile)

+import IO          (openFile, hClose, hPutStrLn, IOMode(..))

 import Parsec
 import ParsecError
 import Monad       (liftM, liftM2, when)
 import Char        (ord, intToDigit, isSpace, isAlpha, isAlphaNum, toUpper)
 import List        (intersperse)
 import Parsec
 import ParsecError
 import Monad       (liftM, liftM2, when)
 import Char        (ord, intToDigit, isSpace, isAlpha, isAlphaNum, toUpper)
 import List        (intersperse)

+import Exception   (catchAllIO)
+#ifndef mingw32_TARGET_OS
+import Posix
+#endif

 
 version :: String
 version = "hsc2hs-0.64"
 
 version :: String
 version = "hsc2hs-0.64"

@@ -226,7 +233,7 @@ output flags name toks = let
         concatMap outTokenHs toks++
         "    return 0;\n}\n"
     
         concatMap outTokenHs toks++
         "    return 0;\n}\n"
     

-    compilerStatus <- system $
+    compilerStatus <- kludgedSystem $

         compiler++
         " -c"++
         concat [" "++f | CompFlag f <- flags]++
         compiler++
         " -c"++
         concat [" "++f | CompFlag f <- flags]++

@@ -237,7 +244,7 @@ output flags name toks = let
         _                 -> return ()
     removeFile cProgName
     
         _                 -> return ()
     removeFile cProgName
     

-    linkerStatus <- system $
+    linkerStatus <- kludgedSystem $

         linker++
         concat [" "++f | LinkFlag f <- flags]++
         " "++oProgName++
         linker++
         concat [" "++f | LinkFlag f <- flags]++
         " "++oProgName++

@@ -247,15 +254,15 @@ output flags name toks = let
         _                 -> return ()
     removeFile oProgName
     
         _                 -> return ()
     removeFile oProgName
     

-    system (execProgName++" >"++outHsName)
+    kludgedSystem (execProgName++" >"++outHsName)

     removeFile progName
     
     when needsH $ writeFile outHName $
     removeFile progName
     
     when needsH $ writeFile outHName $

-        "#ifndef "++includeGuard++"\n\
-        \#define "++includeGuard++"\n\
-        \#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 409\n\
-        \#include <Rts.h>\n\
-        \#endif\n\
+        "#ifndef "++includeGuard++"\n\ 
+        \#define "++includeGuard++"\n\ 
+        \#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 409\n\ 
+        \#include <Rts.h>\n\ 
+        \#endif\n\ 

         \#include <HsFFI.h>\n"++
         concat ["#include "++n++"\n" | Include n <- flags]++
         concatMap outTokenH specials++
         \#include <HsFFI.h>\n"++
         concat ["#include "++n++"\n" | Include n <- flags]++
         concatMap outTokenH specials++

@@ -286,7 +293,7 @@ outHeaderCProg =
             (header, _:body) -> case break isSpace header of
                 (name, args) ->
                     outCLine pos++
             (header, _:body) -> case break isSpace header of
                 (name, args) ->
                     outCLine pos++

-                    "#define hsc_"++name++"("++dropWhile isSpace args++") \
+                    "#define hsc_"++name++"("++dropWhile isSpace args++") \ 

                     \printf ("++joinLines body++");\n"
         _ -> ""
     where
                     \printf ("++joinLines body++");\n"
         _ -> ""
     where

@@ -294,9 +301,9 @@ outHeaderCProg =
 
 outHeaderHs :: [Flag] -> Maybe String -> [(SourcePos, String, String)] -> String
 outHeaderHs flags inH toks =
 
 outHeaderHs :: [Flag] -> Maybe String -> [(SourcePos, String, String)] -> String
 outHeaderHs flags inH toks =

-    "#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 409\n\
-    \    printf (\"{-# OPTIONS -optc-D__GLASGOW_HASKELL__=%d #-}\\n\", \
-    \__GLASGOW_HASKELL__);\n\
+    "#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 409\n\ 
+    \    printf (\"{-# OPTIONS -optc-D__GLASGOW_HASKELL__=%d #-}\\n\", \ 
+    \__GLASGOW_HASKELL__);\n\ 

     \#endif\n"++
     includeH++
     concatMap outSpecial toks
     \#endif\n"++
     includeH++
     concatMap outSpecial toks

@@ -358,11 +365,11 @@ outEnum arg =
                     (enum, rest) -> let
                         this = case break (== '=') $ dropWhile isSpace enum of
                             (name, []) ->
                     (enum, rest) -> let
                         this = case break (== '=') $ dropWhile isSpace enum of
                             (name, []) ->

-                                "    hsc_enum ("++t++", "++f++", \
+                                "    hsc_enum ("++t++", "++f++", \ 

                                 \hsc_haskellize (\""++name++"\"), "++
                                 name++");\n"
                             (hsName, _:cName) ->
                                 \hsc_haskellize (\""++name++"\"), "++
                                 name++");\n"
                             (hsName, _:cName) ->

-                                "    hsc_enum ("++t++", "++f++", \
+                                "    hsc_enum ("++t++", "++f++", \ 

                                 \printf (\"%s\", \""++hsName++"\"), "++
                                 cName++");\n"
                         in this++enums rest
                                 \printf (\"%s\", \""++hsName++"\"), "++
                                 cName++");\n"
                         in this++enums rest

@@ -378,8 +385,8 @@ outTokenH (pos, key, arg) =
             's':'t':'r':'u':'c':'t':' ':_ -> arg++"\n"
             't':'y':'p':'e':'d':'e':'f':' ':_ -> arg++"\n"
             'i':'n':'l':'i':'n':'e':' ':_ ->
             's':'t':'r':'u':'c':'t':' ':_ -> arg++"\n"
             't':'y':'p':'e':'d':'e':'f':' ':_ -> arg++"\n"
             'i':'n':'l':'i':'n':'e':' ':_ ->

-                "#ifdef __GNUC__\n\
-                \extern\n\
+                "#ifdef __GNUC__\n\ 
+                \extern\n\ 

                 \#endif\n"++
                 arg++"\n"
             _ -> "extern "++header++";\n"
                 \#endif\n"++
                 arg++"\n"
             _ -> "extern "++header++";\n"

@@ -395,12 +402,12 @@ outTokenC (pos, key, arg) =
             't':'y':'p':'e':'d':'e':'f':' ':_ -> ""
             'i':'n':'l':'i':'n':'e':' ':_ ->
                 outCLine pos++
             't':'y':'p':'e':'d':'e':'f':' ':_ -> ""
             'i':'n':'l':'i':'n':'e':' ':_ ->
                 outCLine pos++

-                "#ifndef __GNUC__\n\
-                \extern\n\
+                "#ifndef __GNUC__\n\ 
+                \extern\n\ 

                 \#endif\n"++
                 header++
                 \#endif\n"++
                 header++

-                "\n#ifndef __GNUC__\n\
-                \;\n\
+                "\n#ifndef __GNUC__\n\ 
+                \;\n\ 

                 \#else\n"++
                 body++
                 "\n#endif\n"
                 \#else\n"++
                 body++
                 "\n#endif\n"

@@ -457,3 +464,30 @@ showCString = concatMap showCChar
                       intToDigit (ord c `quot` 64),
                       intToDigit (ord c `quot` 8 `mod` 8),
                       intToDigit (ord c          `mod` 8)]
                       intToDigit (ord c `quot` 64),
                       intToDigit (ord c `quot` 8 `mod` 8),
                       intToDigit (ord c          `mod` 8)]

+
+-- system that works feasibly under Windows (i.e. passes the command line to sh,
+-- because system() under Windows doesn't look at SHELL, and always uses CMD.EXE)
+kludgedSystem cmd
+ = do
+#ifndef mingw32_TARGET_OS
+   exit_code <- system cmd `catchAllIO` 
+                  (\_ -> exitFailure)
+#else
+   pid <- myGetProcessID
+   let tmp = "/tmp/sh" ++ show pid
+   h <- openFile tmp WriteMode
+   hPutStrLn h cmd
+   hClose h
+   exit_code <- system ("sh - " ++ tmp) `catchAllIO` 
+                  (\_ -> removeFile tmp >>
+                          exitFailure)
+   removeFile tmp
+#endif
+   return exit_code
+
+#ifdef mingw32_TARGET_OS
+foreign import "_getpid" myGetProcessID :: IO Int 
+#else
+myGetProcessID :: IO Int
+myGetProcessID = Posix.getProcessID
+#endif

diff --git a/ghc/utils/hsc2hs/Makefile b/ghc/utils/hsc2hs/Makefile
index 371c976..cbeac29 100644 (file)
--- a/ghc/utils/hsc2hs/Makefile
+++ b/ghc/utils/hsc2hs/Makefile
@@ -1,5 +1,5 @@
 # -----------------------------------------------------------------------------
 # -----------------------------------------------------------------------------

-# $Id: Makefile,v 1.6 2001/01/14 10:48:34 panne Exp $
+# $Id: Makefile,v 1.7 2001/02/05 18:01:39 rrt Exp $

 
 TOP=../..
 include $(TOP)/mk/boilerplate.mk
 
 TOP=../..
 include $(TOP)/mk/boilerplate.mk

@@ -10,7 +10,7 @@ INCLUDE_DIR=ghc/includes
 INSTALLING=1
 
 HS_PROG           = hsc2hs-bin
 INSTALLING=1
 
 HS_PROG           = hsc2hs-bin

-SRC_HC_OPTS      += -syslib util -syslib text
+SRC_HC_OPTS      += -package util -package text -cpp -fglasgow-exts

 
 INSTALLED_SCRIPT_PROG  = hsc2hs
 INPLACE_SCRIPT_PROG    = hsc2hs-inplace
 
 INSTALLED_SCRIPT_PROG  = hsc2hs
 INPLACE_SCRIPT_PROG    = hsc2hs-inplace