module DDC.Driver.Command.Compile
(cmdCompile)
where
import DDC.Driver.Stage
import DDC.Interface.Source
import DDC.Build.Pipeline
import System.FilePath
import System.Directory
import Control.Monad
import Control.Monad.Trans.Error
import Control.Monad.IO.Class
import qualified DDC.Core.Pretty as P
cmdCompile :: Config -> FilePath -> ErrorT String IO ()
cmdCompile config filePath
= do
exists <- liftIO $ doesFileExist filePath
when (not exists)
$ throwError $ "No such file " ++ show filePath
src <- liftIO $ readFile filePath
let ext = takeExtension filePath
let source = SourceFile filePath
let make
| ext == ".dst"
= liftIO
$ pipeText (nameOfSource source) (lineStartOfSource source) src
$ stageSourceTetraLoad config source
[ PipeCoreReannotate (const ())
[ stageTetraToSalt config source pipesSalt ]]
| ext == ".dct"
= liftIO
$ pipeText (nameOfSource source) (lineStartOfSource source) src
$ stageTetraLoad config source
[ stageTetraToSalt config source pipesSalt ]
| ext == ".dcl"
= liftIO
$ pipeText (nameOfSource source) (lineStartOfSource source) src
$ stageLiteLoad config source
[ stageLiteOpt config source
[ stageLiteToSalt config source pipesSalt ]]
| ext == ".dcs"
= liftIO
$ pipeText (nameOfSource source) (lineStartOfSource source) src
$ stageSaltLoad config source pipesSalt
| otherwise
= throwError $ "Cannot compile '" ++ ext ++ "' files."
pipesSalt
= case configViaBackend config of
ViaLLVM
-> [ PipeCoreReannotate (const ())
[ stageSaltOpt config source
[ stageSaltToLLVM config source
[ stageCompileLLVM config source filePath False ]]]]
ViaC
-> [ PipeCoreReannotate (const ())
[ stageSaltOpt config source
[ stageCompileSalt config source filePath False ]]]
errs <- make
case errs of
[] -> return ()
es -> throwError $ P.renderIndent $ P.vcat $ map P.ppr es