module DDC.Build.Pipeline.Salt
( PipeSalt (..)
, pipeSalt)
where
import DDC.Build.Pipeline.Error
import DDC.Build.Pipeline.Sink
import DDC.Build.Pipeline.Llvm
import DDC.Build.Builder
import DDC.Base.Pretty
import DDC.Llvm.Pretty ()
import DDC.Core.Check (AnTEC)
import qualified DDC.Core.Transform.Reannotate as C
import qualified DDC.Core.Module as C
import qualified DDC.Core.Llvm.Convert as Llvm
import qualified DDC.Core.Salt.Transfer as Salt
import qualified DDC.Core.Salt.Platform as Salt
import qualified DDC.Core.Salt as Salt
import Control.Monad
import Control.DeepSeq
import System.Directory
data PipeSalt a where
PipeSaltId
:: ![PipeSalt a]
-> PipeSalt a
PipeSaltOutput
:: !Sink
-> PipeSalt a
PipeSaltTransfer
:: ![PipeSalt (AnTEC a Salt.Name)]
-> PipeSalt (AnTEC a Salt.Name)
PipeSaltPrint
:: !Bool
-> !Salt.Platform
-> !Sink
-> PipeSalt a
PipeSaltToLlvm
:: !Salt.Platform
-> ![PipeLlvm]
-> PipeSalt a
PipeSaltCompile
:: !Salt.Platform
-> !Builder
-> !FilePath
-> !FilePath
-> !(Maybe FilePath)
-> !Bool
-> PipeSalt a
deriving instance Show a => Show (PipeSalt a)
pipeSalt :: (Show a, Pretty a, NFData a)
=> C.Module a Salt.Name
-> PipeSalt a
-> IO [Error]
pipeSalt !mm !pp
= case pp of
PipeSaltId !pipes
->
liftM concat $ mapM (pipeSalt mm) pipes
PipeSaltOutput !sink
->
pipeSink (renderIndent $ ppr mm) sink
PipeSaltTransfer !pipes
->
case Salt.transferModule mm of
Left err -> return [ErrorSaltConvert err]
Right mm' -> liftM concat $ mapM (pipeSalt mm') pipes
PipeSaltPrint !withPrelude !platform !sink
->
case Salt.seaOfSaltModule withPrelude platform mm of
Left err
-> return $ [ErrorSaltConvert err]
Right doc
-> pipeSink (renderIndent doc) sink
PipeSaltToLlvm !platform !more
->
do let !mm_cut = C.reannotate (const ()) mm
case Llvm.convertModule platform mm_cut of
Left err -> return [ErrorSaltConvert err]
Right mm'
-> do results <- mapM (pipeLlvm mm') more
return $ concat results
PipeSaltCompile
!platform !builder !cPath !oPath !mExePath
!keepSeaFiles
->
case Salt.seaOfSaltModule True platform mm of
Left errs
-> error $ show errs
Right cDoc
-> do let cSrc = renderIndent cDoc
writeFile cPath cSrc
buildCC builder cPath oPath
(case mExePath of
Nothing -> return ()
Just exePath
-> do buildLdExe builder [oPath] exePath
return ())
when (not keepSeaFiles)
$ removeFile cPath
return []