Follow changes in GHC build system
[hsc2hs.git] / DirectCodegen.hs
1 {-# LANGUAGE CPP #-}
2 module DirectCodegen where
3
4 {-
5 The standard mode for hsc2hs: generates a C file which is
6 compiled and run; the output of that program is the .hs file.
7 -}
8
9 import Data.Char ( isAlphaNum, toUpper )
10 import Control.Monad ( when, forM_ )
11
12 import System.Exit ( ExitCode(..), exitWith )
13 import System.FilePath ( normalise )
14
15 import C
16 import Common
17 import Flags
18 import HSCParser
19 import UtilsCodegen
20
21 outputDirect :: Config -> FilePath -> FilePath -> FilePath -> String -> [Token] -> IO ()
22 outputDirect config outName outDir outBase name toks = do
23
24 let beVerbose = cVerbose config
25 flags = cFlags config
26 cProgName = outDir++outBase++"_hsc_make.c"
27 oProgName = outDir++outBase++"_hsc_make.o"
28 progName = outDir++outBase++"_hsc_make"
29 #if defined(mingw32_HOST_OS) || defined(__CYGWIN32__)
30 -- This is a real hack, but the quoting mechanism used for calling the C preprocesseor
31 -- via GHC has changed a few times, so this seems to be the only way... :-P * * *
32 ++ ".exe"
33 #endif
34 outHFile = outBase++"_hsc.h"
35 outHName = outDir++outHFile
36 outCName = outDir++outBase++"_hsc.c"
37
38 let execProgName
39 | null outDir = normalise ("./" ++ progName)
40 | otherwise = progName
41
42 let specials = [(pos, key, arg) | Special pos key arg <- toks]
43
44 let needsC = any (\(_, key, _) -> key == "def") specials
45 needsH = needsC
46 possiblyRemove = if cKeepFiles config
47 then flip const
48 else finallyRemove
49
50 let includeGuard = map fixChar outHName
51 where
52 fixChar c | isAlphaNum c = toUpper c
53 | otherwise = '_'
54
55 when (cCrossSafe config) $
56 forM_ specials (\ (SourcePos file line,key,_) ->
57 when (not $ key `elem` ["const","offset","size","peek","poke","ptr",
58 "type","enum","error","warning","include","define","undef",
59 "if","ifdef","ifndef", "elif","else","endif"]) $
60 die (file ++ ":" ++ show line ++ " directive \"" ++ key ++ "\" is not safe for cross-compilation"))
61
62 writeBinaryFile cProgName $
63 outTemplateHeaderCProg (cTemplate config)++
64 concatMap outFlagHeaderCProg flags++
65 concatMap outHeaderCProg specials++
66 "\nint main (int argc, char *argv [])\n{\n"++
67 outHeaderHs flags (if needsH then Just outHName else Nothing) specials++
68 outHsLine (SourcePos name 0)++
69 concatMap outTokenHs toks++
70 " return 0;\n}\n"
71
72 when (cNoCompile config) $ exitWith ExitSuccess
73
74 rawSystemL ("compiling " ++ cProgName) beVerbose (cCompiler config)
75 ( ["-c"]
76 ++ [cProgName]
77 ++ ["-o", oProgName]
78 ++ [f | CompFlag f <- flags]
79 )
80 possiblyRemove cProgName $
81 withUtilsObject config outDir outBase $ \oUtilsName -> do
82
83 rawSystemL ("linking " ++ oProgName) beVerbose (cLinker config)
84 ( [oProgName, oUtilsName]
85 ++ ["-o", progName]
86 ++ [f | LinkFlag f <- flags]
87 )
88 possiblyRemove oProgName $ do
89
90 rawSystemWithStdOutL ("running " ++ execProgName) beVerbose execProgName [] outName
91 possiblyRemove progName $ do
92
93 when needsH $ writeBinaryFile outHName $
94 "#ifndef "++includeGuard++"\n" ++
95 "#define "++includeGuard++"\n" ++
96 "#include <HsFFI.h>\n" ++
97 "#if __NHC__\n" ++
98 "#undef HsChar\n" ++
99 "#define HsChar int\n" ++
100 "#endif\n" ++
101 concatMap outFlagH flags++
102 concatMap outTokenH specials++
103 "#endif\n"
104
105 when needsC $ writeBinaryFile outCName $
106 "#include \""++outHFile++"\"\n"++
107 concatMap outTokenC specials
108 -- NB. outHFile not outHName; works better when processed
109 -- by gcc or mkdependC.
110