>
>
>
>
>
>
>
>
>
>
> module Epic.Compiler(CompileOptions(..),
> compile,
> compileOpts,
> compileDecls,
> link) where
Brings everything together; parsing, checking, code generation
> import System.Process
> import System.Exit
> import System.IO
> import System.Directory
> import System.Environment
> import Data.Char
> import Epic.Language
> import Epic.Parser
> import Epic.Scopecheck
> import Epic.CodegenC
> import Epic.Simplify
> import Paths_epic
> 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 :: FilePath
> -> FilePath
> -> Maybe FilePath
> -> 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
> -> FilePath
> -> Maybe FilePath
> -> [CompileOptions]
> -> IO ()
> compileOpts fn outf iface opts
> = do input <- readFile fn
>
> let s = parse input fn
> case s of
> Failure err _ _ -> fail err
> Success ds -> do
> compileDecls outf iface ds opts
> compileDecls :: FilePath
> -> Maybe FilePath
> -> [Decl]
> -> [CompileOptions]
> -> IO ()
> compileDecls outf iface ds opts
> = do (tmpn,tmph) <- tempfile
> let hdr = outputHeader opts
> scchecked <- checkAll opts ds
> let simplified = simplifyAll scchecked
> checked <- docompileDecls simplified tmph hdr
> fp <- getDataFileName "evm/closure.h"
> let libdir = trimLast fp
> let dbg = if (elem Debug opts) then "-g" else "-O3"
> let cmd = "gcc -DUSE_BOEHM -c " ++ dbg ++ " -foptimize-sibling-calls -x c " ++ tmpn ++ " -I" ++ libdir ++ " -o " ++ outf ++ " " ++ addGCC opts ++ doTrace opts
>
>
> exit <- system cmd
> if (elem KeepC opts)
> then do system $ "cp " ++ tmpn ++ " " ++
> (getRoot outf) ++ ".c"
> return ()
> else return ()
>
> 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
> docompileDecls (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
> getExtra :: [CompileOptions] -> IO [String]
> getExtra ((MainInc x):xs) = do fns <- getExtra xs
> return (x:fns)
> getExtra (_:xs) = getExtra xs
> getExtra [] = return []
>
> link :: [FilePath]
> -> FilePath
> -> [CompileOptions]
> -> IO ()
> link infs outf opts = do
> extraIncs <- getExtra opts
> mainprog <- if (not (elem ExternalMain opts)) then mkMain extraIncs else return ""
> fp <- getDataFileName "evm/closure.h"
> let libdir = trimLast fp
> let dbg = if (elem Debug opts) then "-g" else "-O3"
> let cmd = "gcc -DUSE_BOEHM -x c " ++ dbg ++ " -foptimize-sibling-calls " ++ mainprog ++ " -x none -L" ++
> libdir++" -I"++libdir ++ " " ++
> (concat (map (++" ") infs)) ++
> " -levm -lgc -lpthread -lgmp -o "++outf ++ " " ++ addGCC opts
>
> 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"