forked from avsm/EpiVM
-
Notifications
You must be signed in to change notification settings - Fork 10
/
Compiler.lhs
165 lines (143 loc) · 5.86 KB
/
Compiler.lhs
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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
> -- |
> -- Module : EMachine.Compiler
> -- Copyright : Edwin Brady
> -- Licence : BSD-style (see LICENSE in the distribution)
> --
> -- Maintainer : eb@dcs.st-and.ac.uk
> -- Stability : experimental
> -- Portability : portable
> --
> -- Public interface for Epigram Supercombinator Compiler
> module Epic.Compiler(CompileOptions(..),
> compile,
> compileOpts,
> link) where
Brings everything together; parsing, checking, code generation
> import System
> import System.IO
> import System.Directory
> import System.Environment
> import Char
> import Epic.Language
> import Epic.Parser
> import Epic.Scopecheck
> import Epic.CodegenC
> import Paths_epic
> -- | (Debugging) options to give to compiler
> data CompileOptions = KeepC -- ^ Keep intermediate C file
> | Trace -- ^ Generate trace at run-time (debug)
> | ShowBytecode -- ^ Show generated code
> | ShowParseTree -- ^ Show parse tree
> | MakeHeader FilePath -- ^ Output a .h file too
> | GCCOpt String -- ^ Extra GCC option
> deriving Eq
> addGCC :: [CompileOptions] -> String
> addGCC [] = ""
> addGCC ((GCCOpt s):xs) = s ++ " " ++ addGCC xs
> addGCC (_:xs) = addGCC xs
> outputHeader :: [CompileOptions] -> Maybe FilePath
> outputHeader [] = Nothing
> outputHeader ((MakeHeader f):_) = Just f
> outputHeader (_:xs) = outputHeader xs
> doTrace opts | elem Trace opts = " -DTRACEON"
> | otherwise = ""
> -- |Compile a source file in supercombinator language to a .o
> compile :: FilePath -- ^ Input file name
> -> FilePath -- ^ Output file name
> -> Maybe FilePath -- ^ Interface (.ei) file name, if desired
> -> IO ()
> compile fn outf iface
> = compileOpts fn outf iface []
Chop off everything after the last / - get the directory a file is in
> trimLast f = case span (\x -> x /= '/') (reverse f) of
> (eman, htap) -> reverse htap
> compileOpts :: FilePath -- ^ Input file name
> -> FilePath -- ^ Output file name
> -> Maybe FilePath -- ^ Interface (.ei) file name, if desired
> -> [CompileOptions] -- Keep the C file
> -> IO ()
> compileOpts fn outf iface opts
> = do input <- readFile fn
> -- prelude <- readFile (libdir ++ "/Prelude.e")
> let s = parse input fn
> case s of
> Failure err _ _ -> fail err
> Success ds -> do
> (tmpn,tmph) <- tempfile
> let hdr = outputHeader opts
> checked <- compileDecls (checkAll ds) tmph hdr
> fp <- getDataFileName "evm/closure.h"
> let libdir = trimLast fp
> let cmd = "gcc -c -O2 -foptimize-sibling-calls -x c " ++ tmpn ++ " -I" ++ libdir ++ " -o " ++ outf ++ " " ++ addGCC opts ++ doTrace opts
> -- putStrLn $ cmd
> -- putStrLn $ fp
> exit <- system cmd
> if (elem KeepC opts)
> then do system $ "cp " ++ tmpn ++ " " ++
> (getRoot fn) ++ ".c"
> return ()
> else return ()
> -- removeFile tmpn
> if (exit /= ExitSuccess)
> then fail $ "gcc failed"
> else return ()
> case iface of
> Nothing -> return ()
> (Just fn) -> do writeFile fn (writeIFace checked)
> getRoot fn = case span (/='.') fn of
> (stem,_) -> stem
> compileDecls (Success (ctxt, decls)) outh hdr
> = do hPutStr outh $ codegenC ctxt decls
> case hdr of
> Just fpath ->
> do let hout = codegenH (filter isAlpha (map toUpper (getRoot fpath))) decls
> writeFile fpath hout
> Nothing -> return ()
> hFlush outh
> hClose outh
> return decls
> compileDecls (Failure err _ _) _ _ = fail err
> -- |Link a collection of .o files into an executable
> link :: [FilePath] -- ^ Object files
> -> [FilePath] -- ^ Extra include files for main program
> -> FilePath -- ^ Executable filename
> -> Bool -- ^ Generate a 'main' (False if externally defined)
> -> IO ()
> link infs extraIncs outf genmain = do
> mainprog <- if genmain then mkMain extraIncs else return ""
> fp <- getDataFileName "evm/closure.h"
> let libdir = trimLast fp
> let cmd = "gcc -x c -O2 -foptimize-sibling-calls " ++ mainprog ++ " -x none -L" ++
> libdir++" -I"++libdir ++ " " ++
> (concat (map (++" ") infs)) ++
> " -levm -lgc -lpthread -lgmp -o "++outf
> -- putStrLn $ cmd
> exit <- system cmd
> if (exit /= ExitSuccess)
> then fail $ "Linking failed"
> else return ()
Output the main progam, adding any extra includes needed.
(Some libraries need the extra includes, notably SDL, to compile correctly.
Grr.)
> mkMain :: [FilePath] -> IO FilePath
> mkMain extra =
> do mppath <- getDataFileName "evm/mainprog.c"
> mp <- readFile mppath
> (tmp, tmpH) <- tempfile
> hPutStr tmpH (concat (map (\x -> "#include <" ++ x ++ ">\n") extra))
> hPutStr tmpH mp
> hClose tmpH
> return tmp
-- |Get the path where the required C libraries and include files are stored
libdir :: FilePath
libdir = libprefix ++ "/lib/evm"
> tempfile :: IO (FilePath, Handle)
> tempfile = do env <- environment "TMPDIR"
> let dir = case env of
> Nothing -> "/tmp"
> (Just d) -> d
> openTempFile dir "esc"
> environment :: String -> IO (Maybe String)
> environment x = catch (do e <- getEnv x
> return (Just e))
> (\_ -> return Nothing)