8f767ff0d4
This makes sure that we catch all leftover instances of using SYB to do generic operations that we should be using Polyplate for instead. Most modules should only import Data, and possibly Typeable.
518 lines
22 KiB
Haskell
518 lines
22 KiB
Haskell
{-
|
|
Tock: a compiler for parallel languages
|
|
Copyright (C) 2007 University of Kent
|
|
|
|
This program is free software; you can redistribute it and/or modify it
|
|
under the terms of the GNU General Public License as published by the
|
|
Free Software Foundation, either version 2 of the License, or (at your
|
|
option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful, but
|
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License along
|
|
with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
-}
|
|
|
|
-- | Driver for the compiler.
|
|
module Main (main) where
|
|
|
|
import Control.Monad.Error
|
|
import Control.Monad.Identity
|
|
import Control.Monad.State
|
|
import Control.Monad.Writer
|
|
import Data.Either
|
|
import Data.Generics (Data)
|
|
import Data.Maybe
|
|
import qualified Data.Set as Set
|
|
import List
|
|
import System
|
|
import System.Console.GetOpt
|
|
import System.Directory
|
|
import System.Exit
|
|
import System.IO
|
|
import System.Process
|
|
|
|
import AnalyseAsm
|
|
import qualified AST as A
|
|
import CompilerCommands
|
|
import CompState
|
|
import Errors
|
|
import FlowGraph
|
|
import GenerateC
|
|
import GenerateCHP
|
|
import GenerateCPPCSP
|
|
import LexOccam
|
|
import Metadata
|
|
import ParseOccam
|
|
import ParseRain
|
|
import Pass
|
|
import PassList
|
|
import Paths
|
|
import PreprocessOccam
|
|
import PrettyShow
|
|
import ShowCode
|
|
import Utils
|
|
|
|
-- Either gives back options, or an exact string to print out:
|
|
type OptFunc = CompState -> ErrorT String IO CompState
|
|
|
|
printString :: String -> ErrorT String IO a
|
|
printString = throwError
|
|
|
|
optionsNoWarnings :: [OptDescr OptFunc]
|
|
optionsNoWarnings =
|
|
[ Option [] ["backend"] (ReqArg optBackend "BACKEND")
|
|
"code-generating backend (options: c, cppcsp, dumpast, src)"
|
|
, Option ['h'] ["help"] (NoArg optPrintHelp) "print this help"
|
|
, Option [] ["help-warnings"] (NoArg optPrintWarningHelp)
|
|
"print help about warning options"
|
|
, Option ['k'] ["keep-temporaries"] (NoArg $ optKeepTemporaries) "keep temporary files"
|
|
, Option ['f'] ["compiler-flags"] (ReqArg optCompilerFlags "FLAGS") "flags for C/C++ compiler"
|
|
, Option [] ["external-link"] (ReqArg optCompilerLinkFlags "FLAGS") "link flags for C/C++ compiler"
|
|
, Option [] ["run-indent"] (NoArg $ optRunIndent) "run indent on source before compilation (will full mode)"
|
|
, Option [] ["frontend"] (ReqArg optFrontend "FRONTEND") "language frontend (options: occam, rain)"
|
|
, Option ['u'] ["implicit-module"] (ReqArg optImplicitModule "MODULE") "implicitly use this module"
|
|
, Option [] ["include-path"] (NoArg $ optPrintPath tockIncludeDir) "print include path"
|
|
, Option [] ["lib-path"] (NoArg $ optPrintPath tockLibDir) "print lib path"
|
|
, Option [] ["mode"] (ReqArg optMode "MODE") "select mode (options: flowgraph, lex, html, parse, compile, post-c, full)"
|
|
, Option [] ["module-path"] (NoArg $ optPrintPath tockModuleDir) "print module path"
|
|
, Option ['c'] ["no-main"] (NoArg optNoMain) "file has no main process; do not link either"
|
|
, Option ['o'] ["output"] (ReqArg optOutput "FILE") "output file (default \"-\")"
|
|
, Option [] ["sanity-check"] (ReqArg optSanityCheck "SETTING") "internal sanity check (options: on, off)"
|
|
, Option ['I'] ["add-to-search-path"] (ReqArg optSearchPath "PATHS") "paths to search for #INCLUDE, #USE"
|
|
, Option [] ["occam2-mobility"] (ReqArg optClassicOccamMobility "SETTING") "occam2 implicit mobility (EXPERIMENTAL) (options: on, off)"
|
|
, Option [] ["usage-checking"] (ReqArg optUsageChecking "SETTING") "usage checking (options: on, off)"
|
|
, Option [] ["unknown-stack-size"] (ReqArg optStackSize "BYTES")
|
|
"stack amount to allocate for unknown C functions"
|
|
, Option ['v'] ["verbose"] (NoArg $ optVerbose) "be more verbose (use multiple times for more detail)"
|
|
]
|
|
|
|
optionsWarnings :: [OptDescr OptFunc]
|
|
optionsWarnings = concat
|
|
[[Option [] ["w" ++ show w] (NoArg $ optEnableWarning w)
|
|
("Enable warning " ++ show w ++ " (" ++ describeWarning w ++ ")")]
|
|
++ [Option [] ["wno" ++ show w] (NoArg $ optDisableWarning w)
|
|
("Disable warning " ++ show w ++ " (" ++ describeWarning w ++ ")")]
|
|
| w <- [minBound .. maxBound]]
|
|
|
|
optMode :: String -> OptFunc
|
|
optMode s ps
|
|
= do mode <- case s of
|
|
"compile" -> return ModeCompile
|
|
"flowgraph" -> return ModeFlowGraph
|
|
"full" -> return ModeFull
|
|
"parse" -> return ModeParse
|
|
"post-c" -> return ModePostC
|
|
"lex" -> return ModeLex
|
|
"html" -> return ModeHTML
|
|
_ -> dieIO (Nothing, "Unknown mode: " ++ s)
|
|
return $ ps { csMode = mode }
|
|
|
|
optBackend :: String -> OptFunc
|
|
optBackend s ps
|
|
= do backend <- case s of
|
|
"c" -> return BackendC
|
|
"chp" -> return BackendCHP
|
|
"cppcsp" -> return BackendCPPCSP
|
|
"dumpast" -> return BackendDumpAST
|
|
"src" -> return BackendSource
|
|
_ -> dieIO (Nothing, "Unknown backend: " ++ s)
|
|
return $ ps { csBackend = backend }
|
|
|
|
optFrontend :: String -> OptFunc
|
|
optFrontend s ps
|
|
= do frontend <- case s of
|
|
"occam" -> return FrontendOccam
|
|
"rain" -> return FrontendRain
|
|
_ -> dieIO (Nothing, "Unknown frontend: " ++ s)
|
|
return $ ps { csFrontend = frontend }
|
|
|
|
optSearchPath :: String -> OptFunc
|
|
optSearchPath s ps = return $ ps { csSearchPath = csSearchPath ps ++ splitOnColons s }
|
|
where
|
|
splitOnColons :: String -> [String]
|
|
splitOnColons [] = []
|
|
splitOnColons s = case span (/= ':') s of
|
|
(p, _:more) -> p : splitOnColons more
|
|
(p, []) -> [p]
|
|
|
|
optImplicitModule :: String -> OptFunc
|
|
optImplicitModule s ps = return $ ps { csImplicitModules = csImplicitModules ps ++ [s] }
|
|
|
|
optCompilerFlags :: String -> OptFunc
|
|
optCompilerFlags flags ps = return $ ps { csCompilerFlags = flags ++ " " ++ csCompilerFlags ps}
|
|
|
|
optCompilerLinkFlags :: String -> OptFunc
|
|
optCompilerLinkFlags flags ps = return $ ps { csCompilerLinkFlags = flags ++ " " ++ csCompilerLinkFlags ps}
|
|
|
|
optVerbose :: OptFunc
|
|
optVerbose ps = return $ ps { csVerboseLevel = csVerboseLevel ps + 1 }
|
|
|
|
optKeepTemporaries :: OptFunc
|
|
optKeepTemporaries ps = return $ ps { csKeepTemporaries = True }
|
|
|
|
optRunIndent :: OptFunc
|
|
optRunIndent ps = return $ ps { csRunIndent = True }
|
|
|
|
optNoMain :: OptFunc
|
|
optNoMain ps = return $ ps { csHasMain = False }
|
|
|
|
optStackSize :: String -> OptFunc
|
|
optStackSize s ps = return $ ps { csUnknownStackSize = read s }
|
|
|
|
optOutput :: String -> OptFunc
|
|
optOutput s ps = return $ ps { csOutputFile = s }
|
|
|
|
optPrintPath :: String -> OptFunc
|
|
optPrintPath path _ = printString path
|
|
|
|
optPrintHelp :: OptFunc
|
|
optPrintHelp _ = printString $ usageInfo "Usage: tock [OPTION...] SOURCEFILE" optionsNoWarnings
|
|
|
|
optPrintWarningHelp :: OptFunc
|
|
optPrintWarningHelp _ = printString $ usageInfo "Usage: tock [OPTION...] SOURCEFILE" optionsWarnings
|
|
|
|
optOnOff :: (String, Bool -> CompState -> CompState) -> String -> OptFunc
|
|
optOnOff (n, f) s ps
|
|
= do mode <- case s of
|
|
"on" -> return True
|
|
"off" -> return False
|
|
_ -> dieIO (Nothing, "Unknown " ++ n ++ " mode: " ++ s)
|
|
return $ f mode ps
|
|
|
|
optUsageChecking :: String -> OptFunc
|
|
optUsageChecking = optOnOff ("usage checking", \m ps -> ps { csUsageChecking = m })
|
|
|
|
optSanityCheck :: String -> OptFunc
|
|
optSanityCheck = optOnOff ("sanity checking", \m ps -> ps { csSanityCheck = m })
|
|
|
|
optClassicOccamMobility :: String -> OptFunc
|
|
optClassicOccamMobility = optOnOff ("occam 2 mobility", \m ps -> ps { csClassicOccamMobility = m })
|
|
|
|
optEnableWarning :: WarningType -> OptFunc
|
|
optEnableWarning w ps = return $ ps { csEnabledWarnings = Set.insert w (csEnabledWarnings ps) }
|
|
|
|
optDisableWarning :: WarningType -> OptFunc
|
|
optDisableWarning w ps = return $ ps { csEnabledWarnings = Set.delete w (csEnabledWarnings ps) }
|
|
|
|
|
|
getOpts :: [String] -> IO ([OptFunc], [String])
|
|
getOpts argv =
|
|
case getOpt RequireOrder (optionsNoWarnings ++ optionsWarnings) argv of
|
|
(o,n,[] ) -> return (o,n)
|
|
(_,_,errs) -> error (concat errs ++ usageInfo header optionsNoWarnings)
|
|
where header = "Usage: tock [OPTION...] SOURCEFILE"
|
|
|
|
main :: IO ()
|
|
main = do
|
|
argv <- getArgs
|
|
(opts, args) <- getOpts argv
|
|
|
|
let fn = case args of
|
|
[fn] -> fn
|
|
_ -> error "Must specify a single input file (use \"tock --help\" to see options)"
|
|
|
|
-- Try to guess the filename from the extension. Since this function is
|
|
-- applied before the options are applied, it will be overriden by the
|
|
-- --frontend=x command-line option
|
|
let (frontendGuess, fileStem)
|
|
= if ".occ" `isSuffixOf` fn
|
|
then (\ps -> ps {csFrontend = FrontendOccam},
|
|
Just $ take (length fn - length ".occ") fn)
|
|
else if ".rain" `isSuffixOf` fn
|
|
then (\ps -> ps {csFrontend = FrontendRain},
|
|
Just $ take (length fn - length ".rain") fn)
|
|
else (id, Nothing)
|
|
|
|
res <- runErrorT $ foldl (>>=) (return $ frontendGuess emptyState) opts
|
|
case res of
|
|
Left str -> putStrLn str
|
|
Right initState -> do
|
|
let operation = case csMode initState of
|
|
ModePostC -> useOutputOptions (postCAnalyse fn) >> return ()
|
|
ModeFull -> evalStateT (compileFull fn fileStem) []
|
|
mode -> useOutputOptions (compile mode fn)
|
|
|
|
-- Run the compiler.
|
|
v <- runPassM initState operation
|
|
case v of
|
|
(Left e, cs) -> showWarnings (csWarnings cs) >> dieIO e
|
|
(Right r, cs) -> showWarnings (csWarnings cs)
|
|
|
|
removeFiles :: [FilePath] -> IO ()
|
|
removeFiles = mapM_ (\file -> catch (removeFile file) doNothing)
|
|
where
|
|
doNothing :: IOError -> IO ()
|
|
doNothing _ = return ()
|
|
|
|
-- When we die inside the StateT [FilePath] monad, we should delete all the
|
|
-- temporary files listed in the state, then die in the PassM monad:
|
|
-- TODO: Not totally sure this technique works if functions inside the PassM
|
|
-- monad die, but there will only be temp files to clean up if postCAnalyse
|
|
-- dies
|
|
instance Die (StateT [FilePath] PassM) where
|
|
dieReport err
|
|
= do files <- get
|
|
-- If removing the files fails, we don't want to die with that
|
|
-- error; we want the user to see the original error, so ignore
|
|
-- errors arising from removing the files:
|
|
optsPS <- lift $ getCompState
|
|
when (not $ csKeepTemporaries optsPS) $
|
|
liftIO $ removeFiles files
|
|
lift $ dieReport err
|
|
|
|
compileFull :: String -> Maybe String -> StateT [FilePath] PassM ()
|
|
compileFull inputFile moutputFile
|
|
= do optsPS <- lift get
|
|
outputFile <- case (csOutputFile optsPS, moutputFile) of
|
|
-- If the user hasn't given an output file, we guess by
|
|
-- using a stem (input file minus known extension).
|
|
-- If the extension isn't known, the user must specify
|
|
-- the output file
|
|
("-", Just file) -> return $ file
|
|
("-", Nothing) -> dieReport (Nothing, "Must specify an output file when using full-compile mode")
|
|
(file, _) -> return file
|
|
|
|
let (cExtension, hExtension)
|
|
= case csBackend optsPS of
|
|
BackendC -> (".tock.c", ".tock.h")
|
|
BackendCPPCSP -> (".tock.cpp", ".tock.hpp")
|
|
BackendCHP -> (".hs", error "CHP backend")
|
|
_ -> ("", "")
|
|
|
|
-- Translate input file to C/C++
|
|
let cFile = outputFile ++ cExtension
|
|
hFile = outputFile ++ hExtension
|
|
iFile = outputFile ++ ".tock.inc"
|
|
lift $ modify $ \cs -> cs { csOutputIncFile = Just iFile }
|
|
lift $ withOutputFile cFile $ \hb ->
|
|
withOutputFile hFile $ \hh ->
|
|
compile ModeCompile inputFile ((hb, hh), hFile)
|
|
noteFile cFile
|
|
when (csRunIndent optsPS) $
|
|
exec $ "indent " ++ cFile
|
|
|
|
case csBackend optsPS of
|
|
BackendC ->
|
|
let sFile = outputFile ++ ".tock.s"
|
|
oFile = outputFile ++ ".tock.o"
|
|
sizesFile = outputFile ++ ".tock.sizes"
|
|
postCFile = outputFile ++ ".tock_post.c"
|
|
postOFile = outputFile ++ ".tock_post.o"
|
|
in
|
|
do sequence_ $ map noteFile $ [sFile, postCFile, postOFile]
|
|
++ if csHasMain optsPS then [oFile] else []
|
|
-- The object file is a temporary to-be-removed
|
|
-- iff we are also linking the end product
|
|
|
|
-- Compile the C into assembly, and assembly into an object file
|
|
exec $ cAsmCommand cFile sFile (csCompilerFlags optsPS)
|
|
exec $ cCommand sFile oFile (csCompilerFlags optsPS)
|
|
-- Analyse the assembly for stack sizes, and output a
|
|
-- "post" H file
|
|
sizes <- lift $ withOutputFile sizesFile $ \h -> postCAnalyse sFile ((h,intErr),intErr)
|
|
|
|
cs <- lift getCompState
|
|
when (csHasMain optsPS) $ do
|
|
withOutputFile postCFile $ \h ->
|
|
computeFinalStackSizes searchReadFile (csUnknownStackSize cs)
|
|
sizes >>= (liftIO . hPutStr h)
|
|
|
|
-- Compile this new "post" C file into an object file
|
|
exec $ cCommand postCFile postOFile (csCompilerFlags optsPS)
|
|
|
|
let otherOFiles = [usedFile ++ ".tock.o"
|
|
| usedFile <- Set.toList $ csUsedFiles cs]
|
|
|
|
-- Link the object files into a binary
|
|
exec $ cLinkCommand (oFile : postOFile : otherOFiles) outputFile (csCompilerLinkFlags optsPS)
|
|
|
|
-- For C++, just compile the source file directly into a binary
|
|
BackendCPPCSP ->
|
|
do cs <- lift getCompState
|
|
if csHasMain optsPS
|
|
then let otherOFiles = [usedFile ++ ".tock.o"
|
|
| usedFile <- Set.toList $ csUsedFiles cs]
|
|
in exec $ cxxCommand cFile outputFile
|
|
(concat (intersperse " " otherOFiles) ++ " " ++ csCompilerFlags optsPS ++ " " ++ csCompilerLinkFlags optsPS)
|
|
else exec $ cxxCommand cFile (outputFile ++ ".tock.o")
|
|
("-c " ++ csCompilerFlags optsPS)
|
|
|
|
BackendCHP ->
|
|
exec $ hCommand cFile outputFile
|
|
_ -> dieReport (Nothing, "Cannot use specified backend: "
|
|
++ show (csBackend optsPS)
|
|
++ " with full-compile mode")
|
|
|
|
-- Finally, remove the temporary files:
|
|
tempFiles <- get
|
|
when (not $ csKeepTemporaries optsPS) $
|
|
liftIO $ removeFiles tempFiles
|
|
|
|
where
|
|
intErr :: a
|
|
intErr = error "Internal error involving handles"
|
|
|
|
noteFile :: Monad m => FilePath -> StateT [FilePath] m ()
|
|
noteFile fp = modify (\fps -> (fp:fps))
|
|
|
|
withOutputFile :: MonadIO m => FilePath -> (Handle -> m a) -> m a
|
|
withOutputFile path func
|
|
= do handle <- liftIO $ openFile path WriteMode
|
|
x <- func handle
|
|
liftIO $ hClose handle
|
|
return x
|
|
|
|
exec :: String -> StateT [FilePath] PassM ()
|
|
exec cmd = do lift $ progress $ "Executing command: " ++ cmd
|
|
p <- liftIO $ runCommand cmd
|
|
exitCode <- liftIO $ waitForProcess p
|
|
case exitCode of
|
|
ExitSuccess -> return ()
|
|
ExitFailure n -> dieReport (Nothing, "Command \"" ++ cmd ++ "\" failed: exited with code: " ++ show n)
|
|
|
|
searchReadFile :: String -> StateT [FilePath] PassM String
|
|
searchReadFile fn = do (h, _) <- lift $ searchFile emptyMeta (fn++".tock.sizes")
|
|
liftIO $ hGetContents h
|
|
-- Don't use hClose because hGetContents is lazy
|
|
|
|
-- | Picks out the handle from the options and passes it to the function:
|
|
useOutputOptions :: (((Handle, Handle), String) -> PassM a) -> PassM a
|
|
useOutputOptions func
|
|
= do optsPS <- get
|
|
withHandleFor (csOutputFile optsPS) $ \hb ->
|
|
withHandleFor (csOutputHeaderFile optsPS) $ \hh ->
|
|
func ((hb, hh), csOutputHeaderFile optsPS)
|
|
where
|
|
withHandleFor "-" func = func stdout
|
|
withHandleFor file func =
|
|
do progress $ "Writing output file " ++ file
|
|
f <- liftIO $ openFile file WriteMode
|
|
x <- func f
|
|
liftIO $ hClose f
|
|
return x
|
|
|
|
|
|
showTokens :: Bool -> [Token] -> String
|
|
showTokens html ts = evalState (mapM showToken ts >>* spaceOut) 0
|
|
where
|
|
spaceOut = foldl join ""
|
|
join prev (Right str) = prev ++ " " ++ str
|
|
join prev (Left spacing)
|
|
| spacing >= 0 = prev ++ concat (replicate spacing space)
|
|
| spacing < 0 = foldl (.) id (replicate (length space * negate spacing) init) $ prev
|
|
|
|
showToken (Token _ tt) = showTokenType tt
|
|
|
|
showTokenType :: TokenType -> State Int (Either Int String)
|
|
showTokenType (TokReserved s) = ret $ h s
|
|
showTokenType (TokIdentifier s) = ret s
|
|
showTokenType (TokStringCont s) = ret s
|
|
showTokenType (TokStringLiteral s) = ret s
|
|
showTokenType (TokCharLiteral s) = ret s
|
|
showTokenType (TokIntLiteral s) = ret s
|
|
showTokenType (TokHexLiteral s) = ret s
|
|
showTokenType (TokRealLiteral s) = ret s
|
|
showTokenType (TokPreprocessor s) = ret $ h s
|
|
showTokenType (IncludeFile s) = ret $ h "#INCLUDE \"" ++ s ++ "\""
|
|
showTokenType (Pragma s) = ret $ h "#PRAGMA " ++ s
|
|
showTokenType (Indent) = modify (+2) >> return (Left 2)
|
|
showTokenType (Outdent) = modify (subtract 2) >> return (Left (-2))
|
|
showTokenType (EndOfLine)
|
|
= do indentation <- get
|
|
ret $ newline ++ concat (replicate indentation space)
|
|
ret :: String -> State Int (Either Int String)
|
|
ret = return . Right
|
|
|
|
(space, newline, h) = if html
|
|
then (" ", "<br/>\n", \s -> "<b>" ++ s ++ "</b>")
|
|
else (" ", "\n", id)
|
|
|
|
|
|
-- | Compile a file.
|
|
-- This is written in the PassM monad -- as are most of the things it calls --
|
|
-- because then it's very easy to pass the state around.
|
|
compile :: CompMode -> String -> ((Handle, Handle), String) -> PassM ()
|
|
compile mode fn (outHandles@(outHandle, _), headerName)
|
|
= do optsPS <- get
|
|
|
|
debug "{{{ Parse"
|
|
progress "Parse"
|
|
(ast1, lexed) <- case csFrontend optsPS of
|
|
FrontendOccam ->
|
|
do lexed <- preprocessOccamProgram fn
|
|
case mode of
|
|
-- In lex mode, don't parse, because it will probably fail anyway:
|
|
ModeLex -> return (A.Only emptyMeta (), lexed)
|
|
ModeHTML -> return (A.Only emptyMeta (), lexed)
|
|
_ -> do parsed <- parseOccamProgram lexed
|
|
return (parsed, lexed)
|
|
FrontendRain -> do parsed <- liftIO (readFile fn) >>= parseRainProgram fn
|
|
return (parsed, [])
|
|
debugAST ast1
|
|
debug "}}}"
|
|
|
|
case mode of
|
|
ModeLex -> liftIO $ hPutStr outHandle $ pshow lexed
|
|
ModeHTML -> liftIO $ hPutStr outHandle $ showTokens True lexed
|
|
ModeParse -> liftIO $ hPutStr outHandle $ pshow ast1
|
|
{-
|
|
ModeFlowGraph ->
|
|
do procs <- findAllProcesses
|
|
let fs :: Data t => t -> PassM String
|
|
fs = ((liftM $ (take 20) . (filter ((/=) '\"'))) . pshowCode)
|
|
let labelFuncs = mkLabelFuncsGeneric fs
|
|
graphs <- mapM
|
|
((liftM $ either (const Nothing) Just) . (buildFlowGraphP labelFuncs) )
|
|
(map (A.Only emptyMeta) (snd $ unzip $ procs))
|
|
|
|
-- We need this line to enforce the type of the mAlter monad (Identity)
|
|
-- since it is never used. Then we used graphsTyped (rather than graphs)
|
|
-- to prevent a compiler warning at graphsTyped being unused;
|
|
-- graphs is of course identical to graphsTyped, as you can see here:
|
|
let (graphsTyped :: [Maybe (FlowGraph' Identity String A.Process)])
|
|
= map (transformMaybe $ \(x,_,_) -> x) graphs
|
|
-- TODO: output each process to a separate file, rather than just taking the first:
|
|
liftIO $ hPutStr outHandle $ head $ map makeFlowGraphInstr (catMaybes graphsTyped)
|
|
-}
|
|
ModeCompile ->
|
|
do progress "Passes:"
|
|
|
|
passes <- calculatePassList
|
|
ast2 <- runPasses passes ast1
|
|
|
|
debug "{{{ Generate code"
|
|
progress $ "- Backend: " ++ (show $ csBackend optsPS)
|
|
let generator :: A.AST -> PassM ()
|
|
generator
|
|
= case csBackend optsPS of
|
|
BackendC -> generateC outHandles headerName
|
|
BackendCHP -> generateCHP outHandle
|
|
BackendCPPCSP -> generateCPPCSP outHandles headerName
|
|
|
|
BackendDumpAST -> liftIO . hPutStr outHandle . pshow
|
|
BackendSource -> (liftIO . hPutStr outHandle) <.< showCode
|
|
generator ast2
|
|
debug "}}}"
|
|
|
|
progress "Done"
|
|
|
|
-- | Analyse an assembly file.
|
|
postCAnalyse :: String -> ((Handle, Handle), String) -> PassM String
|
|
postCAnalyse fn ((outHandle, _), _)
|
|
= do asm <- liftIO $ readFile fn
|
|
|
|
names <- needStackSizes
|
|
cs <- getCompState
|
|
|
|
progress "Analysing assembly"
|
|
output <- analyseAsm (Just $ map A.nameName names) (Set.toList $ csUsedFiles cs) asm
|
|
|
|
liftIO $ hPutStr outHandle output
|
|
|
|
return output
|
|
|