module Feldspar.Compiler.Compiler
( compile
, standaloneCompile
, icompile
, icompile'
, defaultOptions
, tic64xPlatformOptions
, unrollOptions
, noSimplification
, noPrimitiveInstructionHandling
, fixFunctionName
, c99Options
) where
import Data.Map
import Feldspar.Core.Reify (reify)
import Feldspar.Core.Reify as Reify
import Feldspar.Core.Graph
import qualified Feldspar.Core.Expr as Expr
import Feldspar.Core.Types
import Feldspar.Compiler.Options
import Feldspar.Compiler.Platforms
import Feldspar.Compiler.Transformation.GraphToImperative
import Feldspar.Compiler.Transformation.Lifting
import Feldspar.Compiler.PluginArchitecture
import Feldspar.Compiler.Plugins.BackwardPropagation
import Feldspar.Compiler.Plugins.ForwardPropagation
import Feldspar.Compiler.Plugins.Precompilation
import Feldspar.Compiler.Plugins.HandlePrimitives
import Feldspar.Compiler.Plugins.PrettyPrint
import Feldspar.Compiler.Plugins.Unroll
import Feldspar.Compiler.Transformation.GraphUtils
import Feldspar.Compiler.Imperative.Semantics
import Feldspar.Compiler.Imperative.Representation
import Feldspar.Compiler.Imperative.CodeGeneration
import qualified Feldspar.Compiler.Precompiler.Precompiler as Precompiler
import System.IO
type Writer t = (CompilationMode -> t -> FilePath -> Precompiler.OriginalFeldsparFunctionSignature -> Options -> IO ())
replace :: Eq a => [a] -> [a] -> [a] -> [a]
replace [] _ _ = []
replace s find repl | take (length find) s == find = repl ++ (replace (drop (length find) s) find repl)
| otherwise = [head s] ++ (replace (tail s) find repl)
fixFunctionName :: String -> String
fixFunctionName functionName = replace (replace functionName "_" "__") "'" "_prime"
coreCompile :: (Reify.Program t) =>
Writer t -> CompilationMode -> t -> FilePath -> FilePath -> Precompiler.OriginalFeldsparFunctionSignature -> Options -> IO ()
coreCompile write compilationMode prg inputFileName outputFileName originalFeldsparFunctionSignature opts =
write compilationMode prg outputFileName originalFeldsparFunctionSignature {
Precompiler.originalFeldsparFunctionName = fixFunctionName $ Precompiler.originalFeldsparFunctionName originalFeldsparFunctionSignature
} opts
standaloneWrite :: (Reify.Program t) => Writer t
standaloneWrite compilationMode prg outFileName originalFeldsparFunctionSignature opts
= appendFile outFileName $ compToC (platform opts) $ executePluginChain compilationMode prg originalFeldsparFunctionSignature opts
standaloneCompile :: (Reify.Program t) => t -> FilePath -> FilePath -> Precompiler.OriginalFeldsparFunctionSignature -> Options -> IO ()
standaloneCompile prg inputFileName outputFileName originalFeldsparFunctionSignature opts
= coreCompile standaloneWrite Standalone prg inputFileName outputFileName originalFeldsparFunctionSignature opts
fileWrite :: (Reify.Program t) => Writer t
fileWrite compilationMode prg fileName originalFeldsparFunctionSignature opts
= writeFile fileName $ (incList $ includes $ platform $ opts) ++ (compToC (platform opts) $ executePluginChain compilationMode prg originalFeldsparFunctionSignature opts)
compile :: (Reify.Program t) => t -> FilePath -> String -> Options -> IO ()
compile prg fileName functionName opts
= coreCompile fileWrite Interactive prg "" fileName (Precompiler.OriginalFeldsparFunctionSignature functionName []) opts
writeOut :: (Reify.Program t) => Writer t
writeOut compilationMode prg fileName functionName opts
= putStrLn $ (incList $ includes $ platform $ opts) ++ (compToC (platform opts) $ executePluginChain compilationMode prg functionName opts)
icompile :: (Reify.Program t) => t -> IO ()
icompile prg
= coreCompile writeOut Interactive prg "" "" (Precompiler.OriginalFeldsparFunctionSignature "test" []) defaultOptions
icompile' :: (Reify.Program t) => t -> String -> Options -> IO ()
icompile' prg functionName opts
= coreCompile writeOut Interactive prg "" "" (Precompiler.OriginalFeldsparFunctionSignature functionName []) opts
incList :: [String] -> String
incList [] = "\n"
incList (x:xs) = "#include " ++ x ++ "\n" ++ (incList xs)
defaultOptions
= Options
{ platform = c99
, unroll = NoUnroll
, debug = NoDebug
, defaultArraySize = 16
}
c99Options = defaultOptions
tic64xPlatformOptions
= defaultOptions { platform = tic64x }
unrollOptions
= defaultOptions { unroll = Unroll 8 }
noSimplification
= defaultOptions { debug = NoSimplification }
noPrimitiveInstructionHandling
= defaultOptions { debug = NoPrimitiveInstructionHandling }
pluginChain :: ExternalInfoCollection -> Procedure InitSemInf -> Procedure PrettyPrintSemanticInfo
pluginChain externalInfo
= (executePlugin PrettyPrint (prettyPrintExternalInfo externalInfo))
. (executePlugin UnrollPlugin (unrollExternalInfo externalInfo))
. (executePlugin Precompilation (precompilationExternalInfo externalInfo))
. (executePlugin ForwardPropagation (forwardPropagationExternalInfo externalInfo))
. (executePlugin HandlePrimitives (handlePrimitivesExternalInfo externalInfo))
. (executePlugin BackwardPropagation (backwardPropagationExternalInfo externalInfo))
data ExternalInfoCollection = ExternalInfoCollection {
precompilationExternalInfo :: ExternalInfo Precompilation,
prettyPrintExternalInfo :: ExternalInfo PrettyPrint,
unrollExternalInfo :: ExternalInfo UnrollPlugin,
handlePrimitivesExternalInfo :: ExternalInfo HandlePrimitives,
forwardPropagationExternalInfo :: ExternalInfo ForwardPropagation,
backwardPropagationExternalInfo :: ExternalInfo BackwardPropagation
}
executePluginChain :: (Reify.Program p) => CompilationMode -> p -> Precompiler.OriginalFeldsparFunctionSignature -> Options -> [Procedure PrettyPrintSemanticInfo]
executePluginChain compilationMode prg originalFeldsparFunctionSignatureParam opt =
Prelude.map (pluginChain ExternalInfoCollection {
precompilationExternalInfo = PrecompilationExternalInfo {
originalFeldsparFunctionSignature = originalFeldsparFunctionSignatureParam,
graphInputInterfaceType = interfaceInputType $ hierGraphInterface hierarchicalGraph,
numberOfFunctionArguments = Reify.numArgs (mkT prg),
compilationMode = compilationMode
},
prettyPrintExternalInfo = (platform opt, defaultArraySize opt),
unrollExternalInfo = unroll opt,
handlePrimitivesExternalInfo = (defaultArraySize opt, debug opt, platform opt),
forwardPropagationExternalInfo = debug opt,
backwardPropagationExternalInfo = debug opt
})
(graphToImperative hierarchicalGraph)
where
hierarchicalGraph = replaceNoInlines $ makeHierarchical $ reify prg