module DDC.Driver.Command.ToLlvm
(cmdToLlvm)
where
import DDC.Driver.Stage
import DDC.Driver.Source
import DDC.Build.Pipeline
import DDC.Build.Language
import DDC.Core.Fragment
import System.FilePath
import Control.Monad.Trans.Error
import Control.Monad.IO.Class
import qualified DDC.Build.Language.Salt as Salt
import qualified DDC.Build.Language.Lite as Lite
import qualified DDC.Base.Pretty as P
cmdToLlvm
:: Config
-> Language
-> Source
-> String
-> ErrorT String IO ()
cmdToLlvm config language source sourceText
| Language bundle <- language
, fragment <- bundleFragment bundle
, profile <- fragmentProfile fragment
= do let fragName = profileName profile
let mSuffix = case source of
SourceFile filePath -> Just $ takeExtension filePath
_ -> Nothing
let compile
| fragName == "Lite" || mSuffix == Just ".dcl"
= liftIO
$ pipeText (nameOfSource source) (lineStartOfSource source) sourceText
$ PipeTextLoadCore Lite.fragment
[ PipeCoreStrip
[ stageLiteOpt config source
[ stageLiteToSalt config source
[ stageSaltOpt config source
[ stageSaltToLLVM config source
[ PipeLlvmPrint SinkStdout]]]]]]
| fragName == "Salt" || mSuffix == Just ".dcs"
= liftIO
$ pipeText (nameOfSource source) (lineStartOfSource source) sourceText
$ PipeTextLoadCore Salt.fragment
[ PipeCoreStrip
[ stageSaltOpt config source
[ stageSaltToLLVM config source
[ PipeLlvmPrint SinkStdout]]]]
| otherwise
= throwError $ "Don't know how to convert this to LLVM"
errs <- compile
case errs of
[] -> return ()
es -> throwError $ P.renderIndent $ P.vcat $ map P.ppr es