module DDC.Driver.Command.ToLlvm
( cmdToLlvmFromFile
, cmdToLlvmSourceTetraFromFile
, cmdToLlvmSourceTetraFromString
, cmdToLlvmCoreFromFile
, cmdToLlvmCoreFromString)
where
import DDC.Driver.Stage
import DDC.Interface.Source
import DDC.Build.Pipeline
import DDC.Build.Language
import DDC.Core.Fragment
import DDC.Base.Pretty
import System.Directory
import System.FilePath
import Control.Monad.Trans.Error
import Control.Monad.IO.Class
import Control.Monad
cmdToLlvmFromFile
:: Config
-> FilePath
-> ErrorT String IO ()
cmdToLlvmFromFile config filePath
| ".dst" <- takeExtension filePath
= cmdToLlvmSourceTetraFromFile config filePath
| Just language <- languageOfExtension (takeExtension filePath)
= cmdToLlvmCoreFromFile config language filePath
| otherwise
= let ext = takeExtension filePath
in throwError $ "Cannot convert '" ++ ext ++ "' files to LLVM."
cmdToLlvmSourceTetraFromFile
:: Config
-> FilePath
-> ErrorT String IO ()
cmdToLlvmSourceTetraFromFile config filePath
= do
exists <- liftIO $ doesFileExist filePath
when (not exists)
$ throwError $ "No such file " ++ show filePath
src <- liftIO $ readFile filePath
cmdToLlvmSourceTetraFromString config (SourceFile filePath) src
cmdToLlvmSourceTetraFromString
:: Config
-> Source
-> String
-> ErrorT String IO ()
cmdToLlvmSourceTetraFromString config source str
= let
pipeLoad
= pipeText (nameOfSource source) (lineStartOfSource source) str
$ stageSourceTetraLoad config source
[ PipeCoreReannotate (const ())
[ stageTetraToSalt config source
[ stageSaltOpt config source
[ stageSaltToLLVM config source
[ PipeLlvmPrint SinkStdout]]]]]
in do
errs <- liftIO pipeLoad
case errs of
[] -> return ()
es -> throwError $ renderIndent $ vcat $ map ppr es
cmdToLlvmCoreFromFile
:: Config
-> Language
-> FilePath
-> ErrorT String IO ()
cmdToLlvmCoreFromFile config language filePath
= do
exists <- liftIO $ doesFileExist filePath
when (not exists)
$ throwError $ "No such file " ++ show filePath
src <- liftIO $ readFile filePath
cmdToLlvmCoreFromString config language (SourceFile filePath) src
cmdToLlvmCoreFromString
:: Config
-> Language
-> Source
-> String
-> ErrorT String IO ()
cmdToLlvmCoreFromString config language source str
| Language bundle <- language
, fragment <- bundleFragment bundle
, profile <- fragmentProfile fragment
= do
let fragName = profileName profile
let compile
| fragName == "Tetra"
= liftIO
$ pipeText (nameOfSource source) (lineStartOfSource source) str
$ stageTetraLoad config source
[ stageTetraToSalt config source
[ stageSaltOpt config source
[ stageSaltToLLVM config source
[ PipeLlvmPrint SinkStdout]]]]
| fragName == "Lite"
= liftIO
$ pipeText (nameOfSource source) (lineStartOfSource source) str
$ stageLiteLoad config source
[ stageLiteOpt config source
[ stageLiteToSalt config source
[ stageSaltOpt config source
[ stageSaltToLLVM config source
[ PipeLlvmPrint SinkStdout]]]]]
| fragName == "Salt"
= liftIO
$ pipeText (nameOfSource source) (lineStartOfSource source) str
$ stageSaltLoad config source
[ stageSaltOpt config source
[ stageSaltToLLVM config source
[ PipeLlvmPrint SinkStdout]]]
| otherwise
= throwError $ "Cannot convert '" ++ fragName ++ "' modules to LLVM."
errs <- compile
case errs of
[] -> return ()
es -> throwError $ renderIndent $ vcat $ map ppr es