Follow changes in GHC build system
[hsc2hs.git] / UtilsCodegen.hs
1 {-# LANGUAGE CPP #-}
2 module UtilsCodegen where
3
4 {-
5 Generate the utility code for hsc2hs.
6
7 We don't want to include C headers in template-hsc.h
8 See GHC trac #2897
9 -}
10
11 import Control.Monad
12
13 import C
14 import Common
15 import Flags
16
17 withUtilsObject :: Config -> FilePath -> FilePath
18 -> (FilePath -> IO a)
19 -> IO a
20 withUtilsObject config outDir outBase f = do
21
22 let beVerbose = cVerbose config
23 flags = cFlags config
24 possiblyRemove = if cKeepFiles config
25 then flip const
26 else finallyRemove
27 cUtilsName = outDir ++ outBase ++ "_hsc_utils.c"
28 oUtilsName = outDir ++ outBase ++ "_hsc_utils.o"
29
30 possiblyRemove cUtilsName $ do
31 writeBinaryFile cUtilsName $ unlines $
32 ["#include <stddef.h>",
33 "#include <string.h>",
34 "#include <stdio.h>",
35 "#include <stdarg.h>",
36 "#include <ctype.h>",
37 "",
38 outTemplateHeaderCProg (cTemplate config),
39 "",
40 "int hsc_printf(const char *format, ...) {",
41 " int r;",
42 " va_list argp;",
43 " va_start(argp, format);",
44 " r = vprintf(format, argp);",
45 " va_end(argp);",
46 " return r;",
47 "}",
48 "",
49 "int hsc_toupper(int c) {",
50 " return toupper(c);",
51 "}",
52 "",
53 "int hsc_tolower(int c) {",
54 " return tolower(c);",
55 "}",
56 "",
57 "int hsc_putchar(int c) {",
58 " return putchar(c);",
59 "}",
60 "",
61 -- "void" should really be "FILE", but we aren't able to
62 -- refer to "FILE" in template-hsc.h as we don't want to
63 -- include <stdio.h> there. We cast to FILE * so as to
64 -- allow compiling with g++.
65 "int hsc_fputs(const char *s, void *stream) {",
66 " return fputs(s, (FILE *)stream);",
67 "}",
68 "",
69 -- "void" should really be "FILE", but we aren't able to
70 -- refer to "FILE" in template-hsc.h as we don't want to
71 -- include <stdio.h> there. We explicitly cast to void *
72 -- to allow compiling with g++.
73 "void *hsc_stdout(void) {",
74 " return (void *)stdout;",
75 "}"
76 ]
77
78 possiblyRemove oUtilsName $ do
79 unless (cNoCompile config) $
80 rawSystemL ("compiling " ++ cUtilsName)
81 beVerbose
82 (cCompiler config)
83 (["-c", cUtilsName, "-o", oUtilsName] ++
84 [cFlag | CompFlag cFlag <- flags])
85
86 f oUtilsName
87