module Futhark.Actions
( printAction,
printAliasesAction,
printLastUseGPU,
printFusionGraph,
printInterferenceGPU,
printMemAliasGPU,
callGraphAction,
impCodeGenAction,
kernelImpCodeGenAction,
multicoreImpCodeGenAction,
metricsAction,
compileCAction,
compileCtoWASMAction,
compileOpenCLAction,
compileCUDAAction,
compileMulticoreAction,
compileMulticoreToISPCAction,
compileMulticoreToWASMAction,
compilePythonAction,
compilePyOpenCLAction,
)
where
import Control.Monad
import Control.Monad.IO.Class
import Data.Bifunctor
import Data.List (intercalate)
import Data.Map qualified as M
import Data.Maybe (fromMaybe)
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Futhark.Analysis.Alias
import Futhark.Analysis.CallGraph (buildCallGraph)
import Futhark.Analysis.Interference qualified as Interference
import Futhark.Analysis.LastUse qualified as LastUse
import Futhark.Analysis.MemAlias qualified as MemAlias
import Futhark.Analysis.Metrics
import Futhark.CodeGen.Backends.CCUDA qualified as CCUDA
import Futhark.CodeGen.Backends.COpenCL qualified as COpenCL
import Futhark.CodeGen.Backends.MulticoreC qualified as MulticoreC
import Futhark.CodeGen.Backends.MulticoreISPC qualified as MulticoreISPC
import Futhark.CodeGen.Backends.MulticoreWASM qualified as MulticoreWASM
import Futhark.CodeGen.Backends.PyOpenCL qualified as PyOpenCL
import Futhark.CodeGen.Backends.SequentialC qualified as SequentialC
import Futhark.CodeGen.Backends.SequentialPython qualified as SequentialPy
import Futhark.CodeGen.Backends.SequentialWASM qualified as SequentialWASM
import Futhark.CodeGen.ImpGen.GPU qualified as ImpGenGPU
import Futhark.CodeGen.ImpGen.Multicore qualified as ImpGenMulticore
import Futhark.CodeGen.ImpGen.Sequential qualified as ImpGenSequential
import Futhark.Compiler.CLI
import Futhark.IR
import Futhark.IR.GPUMem (GPUMem)
import Futhark.IR.MCMem (MCMem)
import Futhark.IR.SOACS (SOACS)
import Futhark.IR.SeqMem (SeqMem)
import Futhark.Optimise.Fusion.GraphRep qualified
import Futhark.Util (runProgramWithExitCode, unixEnvironment)
import Futhark.Version (versionString)
import System.Directory
import System.Exit
import System.FilePath
import System.Info qualified
printAction :: ASTRep rep => Action rep
printAction :: forall rep. ASTRep rep => Action rep
printAction =
Action
{ actionName :: String
actionName = String
"Prettyprint",
actionDescription :: String
actionDescription = String
"Prettyprint the resulting internal representation on standard output.",
actionProcedure :: Prog rep -> FutharkM ()
actionProcedure = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> String
prettyString
}
printAliasesAction :: AliasableRep rep => Action rep
printAliasesAction :: forall rep. AliasableRep rep => Action rep
printAliasesAction =
Action
{ actionName :: String
actionName = String
"Prettyprint",
actionDescription :: String
actionDescription = String
"Prettyprint the resulting internal representation on standard output.",
actionProcedure :: Prog rep -> FutharkM ()
actionProcedure = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> String
prettyString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall rep. AliasableRep rep => Prog rep -> Prog (Aliases rep)
aliasAnalysis
}
printLastUseGPU :: Action GPUMem
printLastUseGPU :: Action GPUMem
printLastUseGPU =
Action
{ actionName :: String
actionName = String
"print last use gpu",
actionDescription :: String
actionDescription = String
"Print last use information on gpu.",
actionProcedure :: Prog GPUMem -> FutharkM ()
actionProcedure =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> String
prettyString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall k a. Map k a -> [(k, a)]
M.toList (forall k a. Map k a -> [(k, a)]
M.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k a. Map k a -> [(k, a)]
M.toList)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prog (Aliases GPUMem)
-> (Map VName Names, Map Name (Map VName Names))
LastUse.lastUseGPUMem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall rep. AliasableRep rep => Prog rep -> Prog (Aliases rep)
aliasAnalysis
}
printFusionGraph :: Action SOACS
printFusionGraph :: Action SOACS
printFusionGraph =
Action
{ actionName :: String
actionName = String
"print fusion graph",
actionDescription :: String
actionDescription = String
"Print fusion graph in Graphviz format.",
actionProcedure :: Prog SOACS -> FutharkM ()
actionProcedure =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
( String -> IO ()
putStrLn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DepGraph -> String
Futhark.Optimise.Fusion.GraphRep.pprg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunDef SOACS -> DepGraph
Futhark.Optimise.Fusion.GraphRep.mkDepGraphForFun
)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall rep. Prog rep -> [FunDef rep]
progFuns
}
printInterferenceGPU :: Action GPUMem
printInterferenceGPU :: Action GPUMem
printInterferenceGPU =
Action
{ actionName :: String
actionName = String
"print interference gpu",
actionDescription :: String
actionDescription = String
"Print interference information on gpu.",
actionProcedure :: Prog GPUMem -> FutharkM ()
actionProcedure = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> IO ()
print forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prog GPUMem -> Graph VName
Interference.analyseProgGPU
}
printMemAliasGPU :: Action GPUMem
printMemAliasGPU :: Action GPUMem
printMemAliasGPU =
Action
{ actionName :: String
actionName = String
"print mem alias gpu",
actionDescription :: String
actionDescription = String
"Print memory alias information on gpu.",
actionProcedure :: Prog GPUMem -> FutharkM ()
actionProcedure = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> IO ()
print forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prog GPUMem -> (MemAliases, Map Name MemAliases)
MemAlias.analyzeGPUMem
}
callGraphAction :: Action SOACS
callGraphAction :: Action SOACS
callGraphAction =
Action
{ actionName :: String
actionName = String
"call-graph",
actionDescription :: String
actionDescription = String
"Prettyprint the callgraph of the result to standard output.",
actionProcedure :: Prog SOACS -> FutharkM ()
actionProcedure = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> String
prettyString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prog SOACS -> CallGraph
buildCallGraph
}
metricsAction :: OpMetrics (Op rep) => Action rep
metricsAction :: forall rep. OpMetrics (Op rep) => Action rep
metricsAction =
Action
{ actionName :: String
actionName = String
"Compute metrics",
actionDescription :: String
actionDescription = String
"Print metrics on the final AST.",
actionProcedure :: Prog rep -> FutharkM ()
actionProcedure = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall rep. OpMetrics (Op rep) => Prog rep -> AstMetrics
progMetrics
}
impCodeGenAction :: Action SeqMem
impCodeGenAction :: Action SeqMem
impCodeGenAction =
Action
{ actionName :: String
actionName = String
"Compile imperative",
actionDescription :: String
actionDescription = String
"Translate program into imperative IL and write it on standard output.",
actionProcedure :: Prog SeqMem -> FutharkM ()
actionProcedure = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> String
prettyString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *).
MonadFreshNames m =>
Prog SeqMem -> m (Warnings, Program)
ImpGenSequential.compileProg
}
kernelImpCodeGenAction :: Action GPUMem
kernelImpCodeGenAction :: Action GPUMem
kernelImpCodeGenAction =
Action
{ actionName :: String
actionName = String
"Compile imperative kernels",
actionDescription :: String
actionDescription = String
"Translate program into imperative IL with kernels and write it on standard output.",
actionProcedure :: Prog GPUMem -> FutharkM ()
actionProcedure = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> String
prettyString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *).
MonadFreshNames m =>
Prog GPUMem -> m (Warnings, Program)
ImpGenGPU.compileProgOpenCL
}
multicoreImpCodeGenAction :: Action MCMem
multicoreImpCodeGenAction :: Action MCMem
multicoreImpCodeGenAction =
Action
{ actionName :: String
actionName = String
"Compile to imperative multicore",
actionDescription :: String
actionDescription = String
"Translate program into imperative multicore IL and write it on standard output.",
actionProcedure :: Prog MCMem -> FutharkM ()
actionProcedure = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> String
prettyString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *).
MonadFreshNames m =>
Prog MCMem -> m (Warnings, Definitions Multicore)
ImpGenMulticore.compileProg
}
headerLines :: [T.Text]
= Text -> [Text]
T.lines forall a b. (a -> b) -> a -> b
$ Text
"Generated by Futhark " forall a. Semigroup a => a -> a -> a
<> Text
versionString
cHeaderLines :: [T.Text]
= forall a b. (a -> b) -> [a] -> [b]
map (Text
"// " <>) [Text]
headerLines
pyHeaderLines :: [T.Text]
= forall a b. (a -> b) -> [a] -> [b]
map (Text
"# " <>) [Text]
headerLines
cPrependHeader :: T.Text -> T.Text
= ([Text] -> Text
T.unlines [Text]
cHeaderLines <>)
pyPrependHeader :: T.Text -> T.Text
= ([Text] -> Text
T.unlines [Text]
pyHeaderLines <>)
cmdCC :: String
cmdCC :: String
cmdCC = forall a. a -> Maybe a -> a
fromMaybe String
"cc" forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"CC" [(String, String)]
unixEnvironment
cmdCFLAGS :: [String] -> [String]
cmdCFLAGS :: [String] -> [String]
cmdCFLAGS [String]
def = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [String]
def String -> [String]
words forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"CFLAGS" [(String, String)]
unixEnvironment
cmdISPCFLAGS :: [String] -> [String]
cmdISPCFLAGS :: [String] -> [String]
cmdISPCFLAGS [String]
def = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [String]
def String -> [String]
words forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"ISPCFLAGS" [(String, String)]
unixEnvironment
runCC :: String -> String -> [String] -> [String] -> FutharkM ()
runCC :: String -> String -> [String] -> [String] -> FutharkM ()
runCC String
cpath String
outpath [String]
cflags_def [String]
ldflags = do
Either IOException (ExitCode, String, String)
ret <-
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
String
-> [String]
-> ByteString
-> IO (Either IOException (ExitCode, String, String))
runProgramWithExitCode
String
cmdCC
( [String
cpath, String
"-o", String
outpath]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
cmdCFLAGS [String]
cflags_def
forall a. [a] -> [a] -> [a]
++
[String]
ldflags
)
forall a. Monoid a => a
mempty
case Either IOException (ExitCode, String, String)
ret of
Left IOException
err ->
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS forall a b. (a -> b) -> a -> b
$ String
"Failed to run " forall a. [a] -> [a] -> [a]
++ String
cmdCC forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show IOException
err
Right (ExitFailure Int
code, String
_, String
gccerr) ->
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS forall a b. (a -> b) -> a -> b
$
String
cmdCC
forall a. [a] -> [a] -> [a]
++ String
" failed with code "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
code
forall a. [a] -> [a] -> [a]
++ String
":\n"
forall a. [a] -> [a] -> [a]
++ String
gccerr
Right (ExitCode
ExitSuccess, String
_, String
_) ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
runISPC :: String -> String -> String -> String -> [String] -> [String] -> [String] -> FutharkM ()
runISPC :: String
-> String
-> String
-> String
-> [String]
-> [String]
-> [String]
-> FutharkM ()
runISPC String
ispcpath String
outpath String
cpath String
ispcextension [String]
ispc_flags [String]
cflags_def [String]
ldflags = do
Either IOException (ExitCode, String, String)
ret_ispc <-
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
String
-> [String]
-> ByteString
-> IO (Either IOException (ExitCode, String, String))
runProgramWithExitCode
String
cmdISPC
( [String
ispcpath, String
"-o", String
ispcbase String -> String -> String
`addExtension` String
"o"]
forall a. [a] -> [a] -> [a]
++ [String
"--addressing=64", String
"--pic"]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
cmdISPCFLAGS [String]
ispc_flags
)
forall a. Monoid a => a
mempty
Either IOException (ExitCode, String, String)
ret <-
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
String
-> [String]
-> ByteString
-> IO (Either IOException (ExitCode, String, String))
runProgramWithExitCode
String
cmdCC
( [String
ispcbase String -> String -> String
`addExtension` String
"o"]
forall a. [a] -> [a] -> [a]
++ [String
cpath, String
"-o", String
outpath]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
cmdCFLAGS [String]
cflags_def
forall a. [a] -> [a] -> [a]
++
[String]
ldflags
)
forall a. Monoid a => a
mempty
case Either IOException (ExitCode, String, String)
ret_ispc of
Left IOException
err ->
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS forall a b. (a -> b) -> a -> b
$ String
"Failed to run " forall a. [a] -> [a] -> [a]
++ String
cmdISPC forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show IOException
err
Right (ExitFailure Int
code, String
_, String
ispcerr) -> forall {m :: * -> *} {a} {a}.
(MonadError CompilerError m, Show a) =>
String -> a -> String -> m a
throwError String
cmdISPC Int
code String
ispcerr
Right (ExitCode
ExitSuccess, String
_, String
_) ->
case Either IOException (ExitCode, String, String)
ret of
Left IOException
err ->
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS forall a b. (a -> b) -> a -> b
$ String
"Failed to run ispc: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show IOException
err
Right (ExitFailure Int
code, String
_, String
gccerr) -> forall {m :: * -> *} {a} {a}.
(MonadError CompilerError m, Show a) =>
String -> a -> String -> m a
throwError String
cmdCC Int
code String
gccerr
Right (ExitCode
ExitSuccess, String
_, String
_) ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
where
cmdISPC :: String
cmdISPC = String
"ispc"
ispcbase :: String
ispcbase = String
outpath forall a. Semigroup a => a -> a -> a
<> String
ispcextension
throwError :: String -> a -> String -> m a
throwError String
prog a
code String
err =
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS forall a b. (a -> b) -> a -> b
$
String
prog
forall a. [a] -> [a] -> [a]
++ String
" failed with code "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
code
forall a. [a] -> [a] -> [a]
++ String
":\n"
forall a. [a] -> [a] -> [a]
++ String
err
compileCAction :: FutharkConfig -> CompilerMode -> FilePath -> Action SeqMem
compileCAction :: FutharkConfig -> CompilerMode -> String -> Action SeqMem
compileCAction FutharkConfig
fcfg CompilerMode
mode String
outpath =
Action
{ actionName :: String
actionName = String
"Compile to sequential C",
actionDescription :: String
actionDescription = String
"Compile to sequential C",
actionProcedure :: Prog SeqMem -> FutharkM ()
actionProcedure = Prog SeqMem -> FutharkM ()
helper
}
where
helper :: Prog SeqMem -> FutharkM ()
helper Prog SeqMem
prog = do
CParts
cprog <- forall a. FutharkConfig -> FutharkM (Warnings, a) -> FutharkM a
handleWarnings FutharkConfig
fcfg forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadFreshNames m =>
Text -> Prog SeqMem -> m (Warnings, CParts)
SequentialC.compileProg Text
versionString Prog SeqMem
prog
let cpath :: String
cpath = String
outpath String -> String -> String
`addExtension` String
"c"
hpath :: String
hpath = String
outpath String -> String -> String
`addExtension` String
"h"
jsonpath :: String
jsonpath = String
outpath String -> String -> String
`addExtension` String
"json"
case CompilerMode
mode of
CompilerMode
ToLibrary -> do
let (Text
header, Text
impl, Text
manifest) = CParts -> (Text, Text, Text)
SequentialC.asLibrary CParts
cprog
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
hpath forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader Text
header
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader Text
impl
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
jsonpath Text
manifest
CompilerMode
ToExecutable -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath forall a b. (a -> b) -> a -> b
$ CParts -> Text
SequentialC.asExecutable CParts
cprog
String -> String -> [String] -> [String] -> FutharkM ()
runCC String
cpath String
outpath [String
"-O3", String
"-std=c99"] [String
"-lm"]
CompilerMode
ToServer -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath forall a b. (a -> b) -> a -> b
$ CParts -> Text
SequentialC.asServer CParts
cprog
String -> String -> [String] -> [String] -> FutharkM ()
runCC String
cpath String
outpath [String
"-O3", String
"-std=c99"] [String
"-lm"]
compileOpenCLAction :: FutharkConfig -> CompilerMode -> FilePath -> Action GPUMem
compileOpenCLAction :: FutharkConfig -> CompilerMode -> String -> Action GPUMem
compileOpenCLAction FutharkConfig
fcfg CompilerMode
mode String
outpath =
Action
{ actionName :: String
actionName = String
"Compile to OpenCL",
actionDescription :: String
actionDescription = String
"Compile to OpenCL",
actionProcedure :: Prog GPUMem -> FutharkM ()
actionProcedure = Prog GPUMem -> FutharkM ()
helper
}
where
helper :: Prog GPUMem -> FutharkM ()
helper Prog GPUMem
prog = do
CParts
cprog <- forall a. FutharkConfig -> FutharkM (Warnings, a) -> FutharkM a
handleWarnings FutharkConfig
fcfg forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadFreshNames m =>
Text -> Prog GPUMem -> m (Warnings, CParts)
COpenCL.compileProg Text
versionString Prog GPUMem
prog
let cpath :: String
cpath = String
outpath String -> String -> String
`addExtension` String
"c"
hpath :: String
hpath = String
outpath String -> String -> String
`addExtension` String
"h"
jsonpath :: String
jsonpath = String
outpath String -> String -> String
`addExtension` String
"json"
extra_options :: [String]
extra_options
| String
System.Info.os forall a. Eq a => a -> a -> Bool
== String
"darwin" =
[String
"-framework", String
"OpenCL"]
| String
System.Info.os forall a. Eq a => a -> a -> Bool
== String
"mingw32" =
[String
"-lOpenCL64"]
| Bool
otherwise =
[String
"-lOpenCL"]
case CompilerMode
mode of
CompilerMode
ToLibrary -> do
let (Text
header, Text
impl, Text
manifest) = CParts -> (Text, Text, Text)
COpenCL.asLibrary CParts
cprog
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
hpath forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader Text
header
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader Text
impl
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
jsonpath Text
manifest
CompilerMode
ToExecutable -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader forall a b. (a -> b) -> a -> b
$ CParts -> Text
COpenCL.asExecutable CParts
cprog
String -> String -> [String] -> [String] -> FutharkM ()
runCC String
cpath String
outpath [String
"-O", String
"-std=c99"] (String
"-lm" forall a. a -> [a] -> [a]
: [String]
extra_options)
CompilerMode
ToServer -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader forall a b. (a -> b) -> a -> b
$ CParts -> Text
COpenCL.asServer CParts
cprog
String -> String -> [String] -> [String] -> FutharkM ()
runCC String
cpath String
outpath [String
"-O", String
"-std=c99"] (String
"-lm" forall a. a -> [a] -> [a]
: [String]
extra_options)
compileCUDAAction :: FutharkConfig -> CompilerMode -> FilePath -> Action GPUMem
compileCUDAAction :: FutharkConfig -> CompilerMode -> String -> Action GPUMem
compileCUDAAction FutharkConfig
fcfg CompilerMode
mode String
outpath =
Action
{ actionName :: String
actionName = String
"Compile to CUDA",
actionDescription :: String
actionDescription = String
"Compile to CUDA",
actionProcedure :: Prog GPUMem -> FutharkM ()
actionProcedure = Prog GPUMem -> FutharkM ()
helper
}
where
helper :: Prog GPUMem -> FutharkM ()
helper Prog GPUMem
prog = do
CParts
cprog <- forall a. FutharkConfig -> FutharkM (Warnings, a) -> FutharkM a
handleWarnings FutharkConfig
fcfg forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadFreshNames m =>
Text -> Prog GPUMem -> m (Warnings, CParts)
CCUDA.compileProg Text
versionString Prog GPUMem
prog
let cpath :: String
cpath = String
outpath String -> String -> String
`addExtension` String
"c"
hpath :: String
hpath = String
outpath String -> String -> String
`addExtension` String
"h"
jsonpath :: String
jsonpath = String
outpath String -> String -> String
`addExtension` String
"json"
extra_options :: [String]
extra_options =
[ String
"-lcuda",
String
"-lcudart",
String
"-lnvrtc"
]
case CompilerMode
mode of
CompilerMode
ToLibrary -> do
let (Text
header, Text
impl, Text
manifest) = CParts -> (Text, Text, Text)
CCUDA.asLibrary CParts
cprog
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
hpath forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader Text
header
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader Text
impl
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
jsonpath Text
manifest
CompilerMode
ToExecutable -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader forall a b. (a -> b) -> a -> b
$ CParts -> Text
CCUDA.asExecutable CParts
cprog
String -> String -> [String] -> [String] -> FutharkM ()
runCC String
cpath String
outpath [String
"-O", String
"-std=c99"] (String
"-lm" forall a. a -> [a] -> [a]
: [String]
extra_options)
CompilerMode
ToServer -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader forall a b. (a -> b) -> a -> b
$ CParts -> Text
CCUDA.asServer CParts
cprog
String -> String -> [String] -> [String] -> FutharkM ()
runCC String
cpath String
outpath [String
"-O", String
"-std=c99"] (String
"-lm" forall a. a -> [a] -> [a]
: [String]
extra_options)
compileMulticoreAction :: FutharkConfig -> CompilerMode -> FilePath -> Action MCMem
compileMulticoreAction :: FutharkConfig -> CompilerMode -> String -> Action MCMem
compileMulticoreAction FutharkConfig
fcfg CompilerMode
mode String
outpath =
Action
{ actionName :: String
actionName = String
"Compile to multicore",
actionDescription :: String
actionDescription = String
"Compile to multicore",
actionProcedure :: Prog MCMem -> FutharkM ()
actionProcedure = Prog MCMem -> FutharkM ()
helper
}
where
helper :: Prog MCMem -> FutharkM ()
helper Prog MCMem
prog = do
CParts
cprog <- forall a. FutharkConfig -> FutharkM (Warnings, a) -> FutharkM a
handleWarnings FutharkConfig
fcfg forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadFreshNames m =>
Text -> Prog MCMem -> m (Warnings, CParts)
MulticoreC.compileProg Text
versionString Prog MCMem
prog
let cpath :: String
cpath = String
outpath String -> String -> String
`addExtension` String
"c"
hpath :: String
hpath = String
outpath String -> String -> String
`addExtension` String
"h"
jsonpath :: String
jsonpath = String
outpath String -> String -> String
`addExtension` String
"json"
case CompilerMode
mode of
CompilerMode
ToLibrary -> do
let (Text
header, Text
impl, Text
manifest) = CParts -> (Text, Text, Text)
MulticoreC.asLibrary CParts
cprog
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
hpath forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader Text
header
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader Text
impl
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
jsonpath Text
manifest
CompilerMode
ToExecutable -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader forall a b. (a -> b) -> a -> b
$ CParts -> Text
MulticoreC.asExecutable CParts
cprog
String -> String -> [String] -> [String] -> FutharkM ()
runCC String
cpath String
outpath [String
"-O3", String
"-std=c99"] [String
"-lm", String
"-pthread"]
CompilerMode
ToServer -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader forall a b. (a -> b) -> a -> b
$ CParts -> Text
MulticoreC.asServer CParts
cprog
String -> String -> [String] -> [String] -> FutharkM ()
runCC String
cpath String
outpath [String
"-O3", String
"-std=c99"] [String
"-lm", String
"-pthread"]
compileMulticoreToISPCAction :: FutharkConfig -> CompilerMode -> FilePath -> Action MCMem
compileMulticoreToISPCAction :: FutharkConfig -> CompilerMode -> String -> Action MCMem
compileMulticoreToISPCAction FutharkConfig
fcfg CompilerMode
mode String
outpath =
Action
{ actionName :: String
actionName = String
"Compile to multicore ISPC",
actionDescription :: String
actionDescription = String
"Compile to multicore ISPC",
actionProcedure :: Prog MCMem -> FutharkM ()
actionProcedure = Prog MCMem -> FutharkM ()
helper
}
where
helper :: Prog MCMem -> FutharkM ()
helper Prog MCMem
prog = do
let cpath :: String
cpath = String
outpath String -> String -> String
`addExtension` String
"c"
hpath :: String
hpath = String
outpath String -> String -> String
`addExtension` String
"h"
jsonpath :: String
jsonpath = String
outpath String -> String -> String
`addExtension` String
"json"
ispcpath :: String
ispcpath = String
outpath String -> String -> String
`addExtension` String
"kernels.ispc"
ispcextension :: String
ispcextension = String
"_ispc"
(CParts
cprog, Text
ispc) <- forall a. FutharkConfig -> FutharkM (Warnings, a) -> FutharkM a
handleWarnings FutharkConfig
fcfg forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadFreshNames m =>
Text -> Prog MCMem -> m (Warnings, (CParts, Text))
MulticoreISPC.compileProg Text
versionString Prog MCMem
prog
case CompilerMode
mode of
CompilerMode
ToLibrary -> do
let (Text
header, Text
impl, Text
manifest) = CParts -> (Text, Text, Text)
MulticoreC.asLibrary CParts
cprog
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
hpath forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader Text
header
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader Text
impl
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
ispcpath Text
ispc
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
jsonpath Text
manifest
CompilerMode
ToExecutable -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader forall a b. (a -> b) -> a -> b
$ CParts -> Text
MulticoreC.asExecutable CParts
cprog
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
ispcpath Text
ispc
String
-> String
-> String
-> String
-> [String]
-> [String]
-> [String]
-> FutharkM ()
runISPC String
ispcpath String
outpath String
cpath String
ispcextension [String
"-O3", String
"--woff"] [String
"-O3", String
"-std=c99"] [String
"-lm", String
"-pthread"]
CompilerMode
ToServer -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader forall a b. (a -> b) -> a -> b
$ CParts -> Text
MulticoreC.asServer CParts
cprog
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
ispcpath Text
ispc
String
-> String
-> String
-> String
-> [String]
-> [String]
-> [String]
-> FutharkM ()
runISPC String
ispcpath String
outpath String
cpath String
ispcextension [String
"-O3", String
"--woff"] [String
"-O3", String
"-std=c99"] [String
"-lm", String
"-pthread"]
pythonCommon ::
(CompilerMode -> String -> prog -> FutharkM (Warnings, T.Text)) ->
FutharkConfig ->
CompilerMode ->
FilePath ->
prog ->
FutharkM ()
pythonCommon :: forall prog.
(CompilerMode -> String -> prog -> FutharkM (Warnings, Text))
-> FutharkConfig -> CompilerMode -> String -> prog -> FutharkM ()
pythonCommon CompilerMode -> String -> prog -> FutharkM (Warnings, Text)
codegen FutharkConfig
fcfg CompilerMode
mode String
outpath prog
prog = do
let class_name :: String
class_name =
case CompilerMode
mode of
CompilerMode
ToLibrary -> String -> String
takeBaseName String
outpath
CompilerMode
_ -> String
"internal"
Text
pyprog <- forall a. FutharkConfig -> FutharkM (Warnings, a) -> FutharkM a
handleWarnings FutharkConfig
fcfg forall a b. (a -> b) -> a -> b
$ CompilerMode -> String -> prog -> FutharkM (Warnings, Text)
codegen CompilerMode
mode String
class_name prog
prog
case CompilerMode
mode of
CompilerMode
ToLibrary ->
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile (String
outpath String -> String -> String
`addExtension` String
"py") forall a b. (a -> b) -> a -> b
$ Text -> Text
pyPrependHeader Text
pyprog
CompilerMode
_ -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
String -> Text -> IO ()
T.writeFile String
outpath forall a b. (a -> b) -> a -> b
$ Text
"#!/usr/bin/env python3\n" forall a. Semigroup a => a -> a -> a
<> Text -> Text
pyPrependHeader Text
pyprog
Permissions
perms <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Permissions
getPermissions String
outpath
String -> Permissions -> IO ()
setPermissions String
outpath forall a b. (a -> b) -> a -> b
$ Bool -> Permissions -> Permissions
setOwnerExecutable Bool
True Permissions
perms
compilePythonAction :: FutharkConfig -> CompilerMode -> FilePath -> Action SeqMem
compilePythonAction :: FutharkConfig -> CompilerMode -> String -> Action SeqMem
compilePythonAction FutharkConfig
fcfg CompilerMode
mode String
outpath =
Action
{ actionName :: String
actionName = String
"Compile to PyOpenCL",
actionDescription :: String
actionDescription = String
"Compile to Python with OpenCL",
actionProcedure :: Prog SeqMem -> FutharkM ()
actionProcedure = forall prog.
(CompilerMode -> String -> prog -> FutharkM (Warnings, Text))
-> FutharkConfig -> CompilerMode -> String -> prog -> FutharkM ()
pythonCommon forall (m :: * -> *).
MonadFreshNames m =>
CompilerMode -> String -> Prog SeqMem -> m (Warnings, Text)
SequentialPy.compileProg FutharkConfig
fcfg CompilerMode
mode String
outpath
}
compilePyOpenCLAction :: FutharkConfig -> CompilerMode -> FilePath -> Action GPUMem
compilePyOpenCLAction :: FutharkConfig -> CompilerMode -> String -> Action GPUMem
compilePyOpenCLAction FutharkConfig
fcfg CompilerMode
mode String
outpath =
Action
{ actionName :: String
actionName = String
"Compile to PyOpenCL",
actionDescription :: String
actionDescription = String
"Compile to Python with OpenCL",
actionProcedure :: Prog GPUMem -> FutharkM ()
actionProcedure = forall prog.
(CompilerMode -> String -> prog -> FutharkM (Warnings, Text))
-> FutharkConfig -> CompilerMode -> String -> prog -> FutharkM ()
pythonCommon forall (m :: * -> *).
MonadFreshNames m =>
CompilerMode -> String -> Prog GPUMem -> m (Warnings, Text)
PyOpenCL.compileProg FutharkConfig
fcfg CompilerMode
mode String
outpath
}
cmdEMCFLAGS :: [String] -> [String]
cmdEMCFLAGS :: [String] -> [String]
cmdEMCFLAGS [String]
def = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [String]
def String -> [String]
words forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"EMCFLAGS" [(String, String)]
unixEnvironment
runEMCC :: String -> String -> FilePath -> [String] -> [String] -> [String] -> Bool -> FutharkM ()
runEMCC :: String
-> String
-> String
-> [String]
-> [String]
-> [String]
-> Bool
-> FutharkM ()
runEMCC String
cpath String
outpath String
classpath [String]
cflags_def [String]
ldflags [String]
expfuns Bool
lib = do
Either IOException (ExitCode, String, String)
ret <-
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
String
-> [String]
-> ByteString
-> IO (Either IOException (ExitCode, String, String))
runProgramWithExitCode
String
"emcc"
( [String
cpath, String
"-o", String
outpath]
forall a. [a] -> [a] -> [a]
++ [String
"-lnodefs.js"]
forall a. [a] -> [a] -> [a]
++ [String
"-s", String
"--extern-post-js", String
classpath]
forall a. [a] -> [a] -> [a]
++ ( if Bool
lib
then [String
"-s", String
"EXPORT_NAME=loadWASM"]
else []
)
forall a. [a] -> [a] -> [a]
++ [String
"-s", String
"WASM_BIGINT"]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
cmdCFLAGS [String]
cflags_def
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
cmdEMCFLAGS [String
""]
forall a. [a] -> [a] -> [a]
++ [ String
"-s",
String
"EXPORTED_FUNCTIONS=["
forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"," (String
"'_malloc'" forall a. a -> [a] -> [a]
: String
"'_free'" forall a. a -> [a] -> [a]
: [String]
expfuns)
forall a. [a] -> [a] -> [a]
++ String
"]"
]
forall a. [a] -> [a] -> [a]
++ [String]
ldflags
)
forall a. Monoid a => a
mempty
case Either IOException (ExitCode, String, String)
ret of
Left IOException
err ->
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS forall a b. (a -> b) -> a -> b
$ String
"Failed to run emcc: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show IOException
err
Right (ExitFailure Int
code, String
_, String
emccerr) ->
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS forall a b. (a -> b) -> a -> b
$
String
"emcc failed with code "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
code
forall a. [a] -> [a] -> [a]
++ String
":\n"
forall a. [a] -> [a] -> [a]
++ String
emccerr
Right (ExitCode
ExitSuccess, String
_, String
_) ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
compileCtoWASMAction :: FutharkConfig -> CompilerMode -> FilePath -> Action SeqMem
compileCtoWASMAction :: FutharkConfig -> CompilerMode -> String -> Action SeqMem
compileCtoWASMAction FutharkConfig
fcfg CompilerMode
mode String
outpath =
Action
{ actionName :: String
actionName = String
"Compile to sequential C",
actionDescription :: String
actionDescription = String
"Compile to sequential C",
actionProcedure :: Prog SeqMem -> FutharkM ()
actionProcedure = Prog SeqMem -> FutharkM ()
helper
}
where
helper :: Prog SeqMem -> FutharkM ()
helper Prog SeqMem
prog = do
(CParts
cprog, Text
jsprog, [String]
exps) <-
forall a. FutharkConfig -> FutharkM (Warnings, a) -> FutharkM a
handleWarnings FutharkConfig
fcfg forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadFreshNames m =>
Text -> Prog SeqMem -> m (Warnings, (CParts, Text, [String]))
SequentialWASM.compileProg Text
versionString Prog SeqMem
prog
case CompilerMode
mode of
CompilerMode
ToLibrary -> do
forall {m :: * -> *}. MonadIO m => CParts -> Text -> m ()
writeLibs CParts
cprog Text
jsprog
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.appendFile String
classpath Text
SequentialWASM.libraryExports
String
-> String
-> String
-> [String]
-> [String]
-> [String]
-> Bool
-> FutharkM ()
runEMCC String
cpath String
mjspath String
classpath [String
"-O3", String
"-msimd128"] [String
"-lm"] [String]
exps Bool
True
CompilerMode
_ -> do
forall {m :: * -> *}. MonadIO m => CParts -> Text -> m ()
writeLibs CParts
cprog Text
jsprog
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.appendFile String
classpath Text
SequentialWASM.runServer
String
-> String
-> String
-> [String]
-> [String]
-> [String]
-> Bool
-> FutharkM ()
runEMCC String
cpath String
outpath String
classpath [String
"-O3", String
"-msimd128"] [String
"-lm"] [String]
exps Bool
False
writeLibs :: CParts -> Text -> m ()
writeLibs CParts
cprog Text
jsprog = do
let (Text
h, Text
imp, Text
_) = CParts -> (Text, Text, Text)
SequentialC.asLibrary CParts
cprog
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
hpath Text
h
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath Text
imp
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
classpath Text
jsprog
cpath :: String
cpath = String
outpath String -> String -> String
`addExtension` String
"c"
hpath :: String
hpath = String
outpath String -> String -> String
`addExtension` String
"h"
mjspath :: String
mjspath = String
outpath String -> String -> String
`addExtension` String
"mjs"
classpath :: String
classpath = String
outpath String -> String -> String
`addExtension` String
".class.js"
compileMulticoreToWASMAction :: FutharkConfig -> CompilerMode -> FilePath -> Action MCMem
compileMulticoreToWASMAction :: FutharkConfig -> CompilerMode -> String -> Action MCMem
compileMulticoreToWASMAction FutharkConfig
fcfg CompilerMode
mode String
outpath =
Action
{ actionName :: String
actionName = String
"Compile to sequential C",
actionDescription :: String
actionDescription = String
"Compile to sequential C",
actionProcedure :: Prog MCMem -> FutharkM ()
actionProcedure = Prog MCMem -> FutharkM ()
helper
}
where
helper :: Prog MCMem -> FutharkM ()
helper Prog MCMem
prog = do
(CParts
cprog, Text
jsprog, [String]
exps) <-
forall a. FutharkConfig -> FutharkM (Warnings, a) -> FutharkM a
handleWarnings FutharkConfig
fcfg forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadFreshNames m =>
Text -> Prog MCMem -> m (Warnings, (CParts, Text, [String]))
MulticoreWASM.compileProg Text
versionString Prog MCMem
prog
case CompilerMode
mode of
CompilerMode
ToLibrary -> do
forall {m :: * -> *}. MonadIO m => CParts -> Text -> m ()
writeLibs CParts
cprog Text
jsprog
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.appendFile String
classpath Text
MulticoreWASM.libraryExports
String
-> String
-> String
-> [String]
-> [String]
-> [String]
-> Bool
-> FutharkM ()
runEMCC String
cpath String
mjspath String
classpath [String
"-O3", String
"-msimd128"] [String
"-lm", String
"-pthread"] [String]
exps Bool
True
CompilerMode
_ -> do
forall {m :: * -> *}. MonadIO m => CParts -> Text -> m ()
writeLibs CParts
cprog Text
jsprog
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.appendFile String
classpath Text
MulticoreWASM.runServer
String
-> String
-> String
-> [String]
-> [String]
-> [String]
-> Bool
-> FutharkM ()
runEMCC String
cpath String
outpath String
classpath [String
"-O3", String
"-msimd128"] [String
"-lm", String
"-pthread"] [String]
exps Bool
False
writeLibs :: CParts -> Text -> m ()
writeLibs CParts
cprog Text
jsprog = do
let (Text
h, Text
imp, Text
_) = CParts -> (Text, Text, Text)
MulticoreC.asLibrary CParts
cprog
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
hpath Text
h
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath Text
imp
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
classpath Text
jsprog
cpath :: String
cpath = String
outpath String -> String -> String
`addExtension` String
"c"
hpath :: String
hpath = String
outpath String -> String -> String
`addExtension` String
"h"
mjspath :: String
mjspath = String
outpath String -> String -> String
`addExtension` String
"mjs"
classpath :: String
classpath = String
outpath String -> String -> String
`addExtension` String
".class.js"