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