[project @ 2001-02-10 10:43:25 by qrczak]

Move kludgedSystem (renamed to system) to a separate module.
This avoids ugly interactions with the C preprocessor (string gaps,
__GLASGOW_HASKELL__ in strings).

3 files changed, 64 insertions, 57 deletions

diff --git a/ghc/utils/hsc2hs/KludgedSystem.hs b/ghc/utils/hsc2hs/KludgedSystem.hs
new file mode 100644
index 0000000000..a33d843e22
--- /dev/null
+++ b/ghc/utils/hsc2hs/KludgedSystem.hs
@@ -0,0 +1,30 @@
+{-# OPTIONS -cpp -fglasgow-exts #-}
+-----------------------------------------------------------------------------
+-- $Id: KludgedSystem.hs,v 1.1 2001/02/10 10:43:25 qrczak Exp $
+
+-- 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)
+
+module KludgedSystem (system) where
+
+#include "../../includes/config.h"
+
+#ifndef mingw32_TARGET_OS
+import System (system)
+#else
+
+import qualified System
+import System    (ExitCode)
+import IO        (bracket_)
+import Directory (removeFile)
+
+system :: String -> IO ExitCode
+system cmd = do
+    pid <- getProcessID
+    let tmp = "/tmp/sh"++show pid
+    writeFile tmp (cmd++"\n")
+    bracket_ (return tmp) removeFile $ System.system ("sh - "++tmp)
+
+foreign import "_getpid" unsafe getProcessID :: IO Int
+
+#endif /* mingw32_TARGET_OS */
diff --git a/ghc/utils/hsc2hs/Main.hs b/ghc/utils/hsc2hs/Main.hs
index 51faa506ac..18534df667 100644
--- a/ghc/utils/hsc2hs/Main.hs
+++ b/ghc/utils/hsc2hs/Main.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.16 2001/02/05 22:02:18 qrczak Exp $
+-- $Id: Main.hs,v 1.17 2001/02/10 10:43:25 qrczak Exp $
 --
 -- (originally "GlueHsc.hs" by Marcin 'Qrczak' Kowalczyk)
 --
@@ -11,18 +11,15 @@
 --
 -- 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 IO          (openFile, hClose, hPutStrLn, IOMode(..))
+import System        (getProgName, getArgs, ExitCode(..), exitWith, exitFailure)
+import KludgedSystem (system)
+import Directory     (removeFile)
 import Parsec
 import ParsecError
-import Monad       (liftM, liftM2, when)
-import Char        (ord, intToDigit, isSpace, isAlpha, isAlphaNum, toUpper)
-import List        (intersperse)
-import Exception   (catchAllIO)
+import Monad         (liftM, liftM2, when)
+import Char          (ord, intToDigit, isSpace, isAlpha, isAlphaNum, toUpper)
+import List          (intersperse)
 
 version :: String
 version = "hsc2hs-0.64"
@@ -230,7 +227,7 @@ output flags name toks = let
         concatMap outTokenHs toks++
         "    return 0;\n}\n"
     
-    compilerStatus <- kludgedSystem $
+    compilerStatus <- system $
         compiler++
         " -c"++
         concat [" "++f | CompFlag f <- flags]++
@@ -241,7 +238,7 @@ output flags name toks = let
         _                 -> return ()
     removeFile cProgName
     
-    linkerStatus <- kludgedSystem $
+    linkerStatus <- system $
         linker++
         concat [" "++f | LinkFlag f <- flags]++
         " "++oProgName++
@@ -251,16 +248,20 @@ output flags name toks = let
         _                 -> return ()
     removeFile oProgName
     
-    kludgedSystem (execProgName++" >"++outHsName)
+    system (execProgName++" >"++outHsName)
     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\ 
-        \#include <HsFFI.h>\n"++
+        "#ifndef "++includeGuard++"\n\
+        \#define "++includeGuard++"\n\
+        \#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 409\n\
+        \#include <Rts.h>\n\
+        \#endif\n\
+        \#include <HsFFI.h>\n\
+        \#if __NHC__\n\
+        \#undef HsChar\n\
+        \#define HsChar int\n\
+        \#endif\n"++
         concat ["#include "++n++"\n" | Include n <- flags]++
         concatMap outTokenH specials++
         "#endif\n"
@@ -290,7 +291,7 @@ outHeaderCProg =
             (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
@@ -298,9 +299,9 @@ outHeaderCProg =
 
 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
@@ -362,11 +363,11 @@ outEnum arg =
                     (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_enum ("++t++", "++f++", \ 
+                                "    hsc_enum ("++t++", "++f++", \
                                 \printf (\"%s\", \""++hsName++"\"), "++
                                 cName++");\n"
                         in this++enums rest
@@ -382,8 +383,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':' ':_ ->
-                "#ifdef __GNUC__\n\ 
-                \extern\n\ 
+                "#ifdef __GNUC__\n\
+                \extern\n\
                 \#endif\n"++
                 arg++"\n"
             _ -> "extern "++header++";\n"
@@ -399,12 +400,12 @@ outTokenC (pos, key, arg) =
             '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++
-                "\n#ifndef __GNUC__\n\ 
-                \;\n\ 
+                "\n#ifndef __GNUC__\n\
+                \;\n\
                 \#else\n"++
                 body++
                 "\n#endif\n"
@@ -461,27 +462,3 @@ showCString = concatMap showCChar
                       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 
-#endif
diff --git a/ghc/utils/hsc2hs/Makefile b/ghc/utils/hsc2hs/Makefile
index cbeac295e5..2d69501acc 100644
--- a/ghc/utils/hsc2hs/Makefile
+++ b/ghc/utils/hsc2hs/Makefile
@@ -1,5 +1,5 @@
 # -----------------------------------------------------------------------------
-# $Id: Makefile,v 1.7 2001/02/05 18:01:39 rrt Exp $
+# $Id: Makefile,v 1.8 2001/02/10 10:43:25 qrczak Exp $
 
 TOP=../..
 include $(TOP)/mk/boilerplate.mk
@@ -10,7 +10,7 @@ INCLUDE_DIR=ghc/includes
 INSTALLING=1
 
 HS_PROG           = hsc2hs-bin
-SRC_HC_OPTS      += -package util -package text -cpp -fglasgow-exts
+SRC_HC_OPTS      += -package util -package text
 
 INSTALLED_SCRIPT_PROG  = hsc2hs
 INPLACE_SCRIPT_PROG    = hsc2hs-inplace