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
|
module UtilsCodegen where
{-
Generate the utility code for hsc2hs.
We don't want to include C headers in template-hsc.h
See GHC trac #2897
-}
import Control.Monad
import C
import Common
import Flags
withUtilsObject :: Config -> FilePath -> FilePath
-> (FilePath -> IO a)
-> IO a
withUtilsObject config outDir outBase f = do
let beVerbose = cVerbose config
flags = cFlags config
possiblyRemove = if cKeepFiles config
then flip const
else finallyRemove
cUtilsName = outDir ++ outBase ++ "_hsc_utils.c"
oUtilsName = outDir ++ outBase ++ "_hsc_utils.o"
possiblyRemove cUtilsName $ do
writeBinaryFile cUtilsName $ unlines $
-- These header will cause a mismatch with any mingw-w64 header by
-- including system headers before user headers in the hsc file.
-- We *MUST* include user headers *BEFORE* automatic ones. */
[outTemplateHeaderCProg (cTemplate config),
"",
"#include <stddef.h>",
"#include <string.h>",
"#include <stdio.h>",
"#include <stdarg.h>",
"#include <ctype.h>",
"",
"int hsc_printf(const char *format, ...) {",
" int r;",
" va_list argp;",
" va_start(argp, format);",
" r = vprintf(format, argp);",
" va_end(argp);",
" return r;",
"}",
"",
"int hsc_toupper(int c) {",
" return toupper(c);",
"}",
"",
"int hsc_tolower(int c) {",
" return tolower(c);",
"}",
"",
"int hsc_putchar(int c) {",
" return putchar(c);",
"}",
"",
-- "void" should really be "FILE", but we aren't able to
-- refer to "FILE" in template-hsc.h as we don't want to
-- include <stdio.h> there. We cast to FILE * so as to
-- allow compiling with g++.
"int hsc_fputs(const char *s, void *stream) {",
" return fputs(s, (FILE *)stream);",
"}",
"",
-- "void" should really be "FILE", but we aren't able to
-- refer to "FILE" in template-hsc.h as we don't want to
-- include <stdio.h> there. We explicitly cast to void *
-- to allow compiling with g++.
"void *hsc_stdout(void) {",
" return (void *)stdout;",
"}"
]
possiblyRemove oUtilsName $ do
unless (cNoCompile config) $
rawSystemL outDir (outBase ++ "_utils") ("compiling " ++ cUtilsName)
beVerbose
(cCompiler config)
(["-c", cUtilsName, "-o", oUtilsName] ++
[cFlag | CompFlag cFlag <- flags])
f oUtilsName
|
