From 4776e55db164b247cb38094dd34ed6426111abe6 Mon Sep 17 00:00:00 2001 From: qrczak Date: Sat, 10 Feb 2001 10:43:25 +0000 Subject: [PATCH] [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). --- ghc/utils/hsc2hs/KludgedSystem.hs | 30 +++++++++++++ ghc/utils/hsc2hs/Main.hs | 87 ++++++++++++++----------------------- ghc/utils/hsc2hs/Makefile | 4 +- 3 files changed, 64 insertions(+), 57 deletions(-) create mode 100644 ghc/utils/hsc2hs/KludgedSystem.hs diff --git a/ghc/utils/hsc2hs/KludgedSystem.hs b/ghc/utils/hsc2hs/KludgedSystem.hs new file mode 100644 index 0000000..a33d843 --- /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 51faa50..18534df 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 \n\ - \#endif\n\ - \#include \n"++ + "#ifndef "++includeGuard++"\n\ + \#define "++includeGuard++"\n\ + \#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 409\n\ + \#include \n\ + \#endif\n\ + \#include \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 cbeac29..2d69501 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 -- 1.7.10.4