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