{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Futhark.Actions
( printAction,
printAliasesAction,
callGraphAction,
impCodeGenAction,
kernelImpCodeGenAction,
multicoreImpCodeGenAction,
metricsAction,
compileCAction,
compileCtoWASMAction,
compileOpenCLAction,
compileCUDAAction,
compileMulticoreAction,
compileMulticoreToWASMAction,
compilePythonAction,
compilePyOpenCLAction,
)
where
import Control.Monad
import Control.Monad.IO.Class
import Data.List (intercalate)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Futhark.Analysis.Alias
import Futhark.Analysis.CallGraph (buildCallGraph)
import Futhark.Analysis.Metrics
import qualified Futhark.CodeGen.Backends.CCUDA as CCUDA
import qualified Futhark.CodeGen.Backends.COpenCL as COpenCL
import qualified Futhark.CodeGen.Backends.MulticoreC as MulticoreC
import qualified Futhark.CodeGen.Backends.MulticoreWASM as MulticoreWASM
import qualified Futhark.CodeGen.Backends.PyOpenCL as PyOpenCL
import qualified Futhark.CodeGen.Backends.SequentialC as SequentialC
import qualified Futhark.CodeGen.Backends.SequentialPython as SequentialPy
import qualified Futhark.CodeGen.Backends.SequentialWASM as SequentialWASM
import qualified Futhark.CodeGen.ImpGen.GPU as ImpGenGPU
import qualified Futhark.CodeGen.ImpGen.Multicore as ImpGenMulticore
import qualified Futhark.CodeGen.ImpGen.Sequential as ImpGenSequential
import Futhark.Compiler.CLI
import Futhark.IR
import Futhark.IR.GPUMem (GPUMem)
import Futhark.IR.MCMem (MCMem)
import Futhark.IR.Prop.Aliases
import Futhark.IR.SOACS (SOACS)
import Futhark.IR.SeqMem (SeqMem)
import Futhark.Util (runProgramWithExitCode, unixEnvironment)
import Futhark.Version (versionString)
import System.Directory
import System.Exit
import System.FilePath
import qualified System.Info
printAction :: ASTRep rep => Action rep
printAction :: Action rep
printAction =
Action :: forall rep.
String -> String -> (Prog rep -> FutharkM ()) -> Action rep
Action
{ actionName :: String
actionName = String
"Prettyprint",
actionDescription :: String
actionDescription = String
"Prettyprint the resulting internal representation on standard output.",
actionProcedure :: Prog rep -> FutharkM ()
actionProcedure = IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ())
-> (Prog rep -> IO ()) -> Prog rep -> FutharkM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn (String -> IO ()) -> (Prog rep -> String) -> Prog rep -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prog rep -> String
forall a. Pretty a => a -> String
pretty
}
printAliasesAction :: (ASTRep rep, CanBeAliased (Op rep)) => Action rep
printAliasesAction :: Action rep
printAliasesAction =
Action :: forall rep.
String -> String -> (Prog rep -> FutharkM ()) -> Action rep
Action
{ actionName :: String
actionName = String
"Prettyprint",
actionDescription :: String
actionDescription = String
"Prettyprint the resulting internal representation on standard output.",
actionProcedure :: Prog rep -> FutharkM ()
actionProcedure = IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ())
-> (Prog rep -> IO ()) -> Prog rep -> FutharkM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn (String -> IO ()) -> (Prog rep -> String) -> Prog rep -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prog (Aliases rep) -> String
forall a. Pretty a => a -> String
pretty (Prog (Aliases rep) -> String)
-> (Prog rep -> Prog (Aliases rep)) -> Prog rep -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prog rep -> Prog (Aliases rep)
forall rep.
(ASTRep rep, CanBeAliased (Op rep)) =>
Prog rep -> Prog (Aliases rep)
aliasAnalysis
}
callGraphAction :: Action SOACS
callGraphAction :: Action SOACS
callGraphAction =
Action :: forall rep.
String -> String -> (Prog rep -> FutharkM ()) -> Action rep
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 = IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ())
-> (Prog SOACS -> IO ()) -> Prog SOACS -> FutharkM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn (String -> IO ()) -> (Prog SOACS -> String) -> Prog SOACS -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallGraph -> String
forall a. Pretty a => a -> String
pretty (CallGraph -> String)
-> (Prog SOACS -> CallGraph) -> Prog SOACS -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prog SOACS -> CallGraph
buildCallGraph
}
metricsAction :: OpMetrics (Op rep) => Action rep
metricsAction :: Action rep
metricsAction =
Action :: forall rep.
String -> String -> (Prog rep -> FutharkM ()) -> Action rep
Action
{ actionName :: String
actionName = String
"Compute metrics",
actionDescription :: String
actionDescription = String
"Print metrics on the final AST.",
actionProcedure :: Prog rep -> FutharkM ()
actionProcedure = IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ())
-> (Prog rep -> IO ()) -> Prog rep -> FutharkM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStr (String -> IO ()) -> (Prog rep -> String) -> Prog rep -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AstMetrics -> String
forall a. Show a => a -> String
show (AstMetrics -> String)
-> (Prog rep -> AstMetrics) -> Prog rep -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prog rep -> AstMetrics
forall rep. OpMetrics (Op rep) => Prog rep -> AstMetrics
progMetrics
}
impCodeGenAction :: Action SeqMem
impCodeGenAction :: Action SeqMem
impCodeGenAction =
Action :: forall rep.
String -> String -> (Prog rep -> FutharkM ()) -> Action rep
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 = IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ())
-> ((Warnings, Program) -> IO ())
-> (Warnings, Program)
-> FutharkM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn (String -> IO ())
-> ((Warnings, Program) -> String) -> (Warnings, Program) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> String
forall a. Pretty a => a -> String
pretty (Program -> String)
-> ((Warnings, Program) -> Program)
-> (Warnings, Program)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Warnings, Program) -> Program
forall a b. (a, b) -> b
snd ((Warnings, Program) -> FutharkM ())
-> (Prog SeqMem -> FutharkM (Warnings, Program))
-> Prog SeqMem
-> FutharkM ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Prog SeqMem -> FutharkM (Warnings, Program)
forall (m :: * -> *).
MonadFreshNames m =>
Prog SeqMem -> m (Warnings, Program)
ImpGenSequential.compileProg
}
kernelImpCodeGenAction :: Action GPUMem
kernelImpCodeGenAction :: Action GPUMem
kernelImpCodeGenAction =
Action :: forall rep.
String -> String -> (Prog rep -> FutharkM ()) -> Action rep
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 = IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ())
-> ((Warnings, Program) -> IO ())
-> (Warnings, Program)
-> FutharkM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn (String -> IO ())
-> ((Warnings, Program) -> String) -> (Warnings, Program) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> String
forall a. Pretty a => a -> String
pretty (Program -> String)
-> ((Warnings, Program) -> Program)
-> (Warnings, Program)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Warnings, Program) -> Program
forall a b. (a, b) -> b
snd ((Warnings, Program) -> FutharkM ())
-> (Prog GPUMem -> FutharkM (Warnings, Program))
-> Prog GPUMem
-> FutharkM ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Prog GPUMem -> FutharkM (Warnings, Program)
forall (m :: * -> *).
MonadFreshNames m =>
Prog GPUMem -> m (Warnings, Program)
ImpGenGPU.compileProgOpenCL
}
multicoreImpCodeGenAction :: Action MCMem
multicoreImpCodeGenAction :: Action MCMem
multicoreImpCodeGenAction =
Action :: forall rep.
String -> String -> (Prog rep -> FutharkM ()) -> Action rep
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 = IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ())
-> ((Warnings, Definitions Multicore) -> IO ())
-> (Warnings, Definitions Multicore)
-> FutharkM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn (String -> IO ())
-> ((Warnings, Definitions Multicore) -> String)
-> (Warnings, Definitions Multicore)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Definitions Multicore -> String
forall a. Pretty a => a -> String
pretty (Definitions Multicore -> String)
-> ((Warnings, Definitions Multicore) -> Definitions Multicore)
-> (Warnings, Definitions Multicore)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Warnings, Definitions Multicore) -> Definitions Multicore
forall a b. (a, b) -> b
snd ((Warnings, Definitions Multicore) -> FutharkM ())
-> (Prog MCMem -> FutharkM (Warnings, Definitions Multicore))
-> Prog MCMem
-> FutharkM ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Prog MCMem -> FutharkM (Warnings, Definitions Multicore)
forall (m :: * -> *).
MonadFreshNames m =>
Prog MCMem -> m (Warnings, Definitions Multicore)
ImpGenMulticore.compileProg
}
headerLines :: [T.Text]
= Text -> [Text]
T.lines (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text
"Generated by Futhark " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
versionString
cHeaderLines :: [T.Text]
= (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
"// " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text]
headerLines
pyHeaderLines :: [T.Text]
= (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
"# " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text]
headerLines
cPrependHeader :: T.Text -> T.Text
= ([Text] -> Text
T.unlines [Text]
cHeaderLines Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
pyPrependHeader :: T.Text -> T.Text
= ([Text] -> Text
T.unlines [Text]
pyHeaderLines Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
cmdCC :: String
cmdCC :: String
cmdCC = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"cc" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> Maybe String
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 = [String] -> (String -> [String]) -> Maybe String -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [String]
def String -> [String]
words (Maybe String -> [String]) -> Maybe String -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"CFLAGS" [(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 <-
IO (Either IOException (ExitCode, String, String))
-> FutharkM (Either IOException (ExitCode, String, String))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException (ExitCode, String, String))
-> FutharkM (Either IOException (ExitCode, String, String)))
-> IO (Either IOException (ExitCode, String, String))
-> FutharkM (Either IOException (ExitCode, String, String))
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]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
cmdCFLAGS [String]
cflags_def
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
[String]
ldflags
)
ByteString
forall a. Monoid a => a
mempty
case Either IOException (ExitCode, String, String)
ret of
Left IOException
err ->
String -> FutharkM ()
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS (String -> FutharkM ()) -> String -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ String
"Failed to run " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cmdCC String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ IOException -> String
forall a. Show a => a -> String
show IOException
err
Right (ExitFailure Int
code, String
_, String
gccerr) ->
String -> FutharkM ()
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS (String -> FutharkM ()) -> String -> FutharkM ()
forall a b. (a -> b) -> a -> b
$
String
cmdCC String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" failed with code "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
code
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
gccerr
Right (ExitCode
ExitSuccess, String
_, String
_) ->
() -> FutharkM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
compileCAction :: FutharkConfig -> CompilerMode -> FilePath -> Action SeqMem
compileCAction :: FutharkConfig -> CompilerMode -> String -> Action SeqMem
compileCAction FutharkConfig
fcfg CompilerMode
mode String
outpath =
Action :: forall rep.
String -> String -> (Prog rep -> FutharkM ()) -> Action rep
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 <- FutharkConfig -> FutharkM (Warnings, CParts) -> FutharkM CParts
forall a. FutharkConfig -> FutharkM (Warnings, a) -> FutharkM a
handleWarnings FutharkConfig
fcfg (FutharkM (Warnings, CParts) -> FutharkM CParts)
-> FutharkM (Warnings, CParts) -> FutharkM CParts
forall a b. (a -> b) -> a -> b
$ Prog SeqMem -> FutharkM (Warnings, CParts)
forall (m :: * -> *).
MonadFreshNames m =>
Prog SeqMem -> m (Warnings, CParts)
SequentialC.compileProg 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
IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
hpath (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader Text
header
IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader Text
impl
IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
jsonpath Text
manifest
CompilerMode
ToExecutable -> do
IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath (Text -> IO ()) -> Text -> IO ()
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
IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath (Text -> IO ()) -> Text -> IO ()
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 :: forall rep.
String -> String -> (Prog rep -> FutharkM ()) -> Action rep
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 <- FutharkConfig -> FutharkM (Warnings, CParts) -> FutharkM CParts
forall a. FutharkConfig -> FutharkM (Warnings, a) -> FutharkM a
handleWarnings FutharkConfig
fcfg (FutharkM (Warnings, CParts) -> FutharkM CParts)
-> FutharkM (Warnings, CParts) -> FutharkM CParts
forall a b. (a -> b) -> a -> b
$ Prog GPUMem -> FutharkM (Warnings, CParts)
forall (m :: * -> *).
MonadFreshNames m =>
Prog GPUMem -> m (Warnings, CParts)
COpenCL.compileProg 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 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"darwin" =
[String
"-framework", String
"OpenCL"]
| String
System.Info.os String -> String -> Bool
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
IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
hpath (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader Text
header
IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader Text
impl
IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
jsonpath Text
manifest
CompilerMode
ToExecutable -> do
IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader (Text -> Text) -> Text -> Text
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" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
extra_options)
CompilerMode
ToServer -> do
IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader (Text -> Text) -> Text -> Text
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" String -> [String] -> [String]
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 :: forall rep.
String -> String -> (Prog rep -> FutharkM ()) -> Action rep
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 <- FutharkConfig -> FutharkM (Warnings, CParts) -> FutharkM CParts
forall a. FutharkConfig -> FutharkM (Warnings, a) -> FutharkM a
handleWarnings FutharkConfig
fcfg (FutharkM (Warnings, CParts) -> FutharkM CParts)
-> FutharkM (Warnings, CParts) -> FutharkM CParts
forall a b. (a -> b) -> a -> b
$ Prog GPUMem -> FutharkM (Warnings, CParts)
forall (m :: * -> *).
MonadFreshNames m =>
Prog GPUMem -> m (Warnings, CParts)
CCUDA.compileProg 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
IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
hpath (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader Text
header
IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader Text
impl
IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
jsonpath Text
manifest
CompilerMode
ToExecutable -> do
IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader (Text -> Text) -> Text -> Text
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" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
extra_options)
CompilerMode
ToServer -> do
IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader (Text -> Text) -> Text -> Text
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" String -> [String] -> [String]
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 :: forall rep.
String -> String -> (Prog rep -> FutharkM ()) -> Action rep
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 <- FutharkConfig -> FutharkM (Warnings, CParts) -> FutharkM CParts
forall a. FutharkConfig -> FutharkM (Warnings, a) -> FutharkM a
handleWarnings FutharkConfig
fcfg (FutharkM (Warnings, CParts) -> FutharkM CParts)
-> FutharkM (Warnings, CParts) -> FutharkM CParts
forall a b. (a -> b) -> a -> b
$ Prog MCMem -> FutharkM (Warnings, CParts)
forall (m :: * -> *).
MonadFreshNames m =>
Prog MCMem -> m (Warnings, CParts)
MulticoreC.compileProg 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
IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
hpath (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader Text
header
IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader Text
impl
IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
jsonpath Text
manifest
CompilerMode
ToExecutable -> do
IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader (Text -> Text) -> Text -> Text
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
IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
cPrependHeader (Text -> Text) -> Text -> Text
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"]
pythonCommon ::
(CompilerMode -> String -> prog -> FutharkM (Warnings, T.Text)) ->
FutharkConfig ->
CompilerMode ->
FilePath ->
prog ->
FutharkM ()
pythonCommon :: (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 <- FutharkConfig -> FutharkM (Warnings, Text) -> FutharkM Text
forall a. FutharkConfig -> FutharkM (Warnings, a) -> FutharkM a
handleWarnings FutharkConfig
fcfg (FutharkM (Warnings, Text) -> FutharkM Text)
-> FutharkM (Warnings, Text) -> FutharkM Text
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 ->
IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile (String
outpath String -> String -> String
`addExtension` String
"py") (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
pyPrependHeader Text
pyprog
CompilerMode
_ -> IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ do
String -> Text -> IO ()
T.writeFile String
outpath (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"#!/usr/bin/env python3\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
pyPrependHeader Text
pyprog
Permissions
perms <- IO Permissions -> IO Permissions
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Permissions -> IO Permissions)
-> IO Permissions -> IO Permissions
forall a b. (a -> b) -> a -> b
$ String -> IO Permissions
getPermissions String
outpath
String -> Permissions -> IO ()
setPermissions String
outpath (Permissions -> IO ()) -> Permissions -> IO ()
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 :: forall rep.
String -> String -> (Prog rep -> FutharkM ()) -> Action rep
Action
{ actionName :: String
actionName = String
"Compile to PyOpenCL",
actionDescription :: String
actionDescription = String
"Compile to Python with OpenCL",
actionProcedure :: Prog SeqMem -> FutharkM ()
actionProcedure = (CompilerMode
-> String -> Prog SeqMem -> FutharkM (Warnings, Text))
-> FutharkConfig
-> CompilerMode
-> String
-> Prog SeqMem
-> FutharkM ()
forall prog.
(CompilerMode -> String -> prog -> FutharkM (Warnings, Text))
-> FutharkConfig -> CompilerMode -> String -> prog -> FutharkM ()
pythonCommon CompilerMode -> String -> Prog SeqMem -> FutharkM (Warnings, Text)
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 :: forall rep.
String -> String -> (Prog rep -> FutharkM ()) -> Action rep
Action
{ actionName :: String
actionName = String
"Compile to PyOpenCL",
actionDescription :: String
actionDescription = String
"Compile to Python with OpenCL",
actionProcedure :: Prog GPUMem -> FutharkM ()
actionProcedure = (CompilerMode
-> String -> Prog GPUMem -> FutharkM (Warnings, Text))
-> FutharkConfig
-> CompilerMode
-> String
-> Prog GPUMem
-> FutharkM ()
forall prog.
(CompilerMode -> String -> prog -> FutharkM (Warnings, Text))
-> FutharkConfig -> CompilerMode -> String -> prog -> FutharkM ()
pythonCommon CompilerMode -> String -> Prog GPUMem -> FutharkM (Warnings, Text)
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 = [String] -> (String -> [String]) -> Maybe String -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [String]
def String -> [String]
words (Maybe String -> [String]) -> Maybe String -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> Maybe String
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 <-
IO (Either IOException (ExitCode, String, String))
-> FutharkM (Either IOException (ExitCode, String, String))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException (ExitCode, String, String))
-> FutharkM (Either IOException (ExitCode, String, String)))
-> IO (Either IOException (ExitCode, String, String))
-> FutharkM (Either IOException (ExitCode, String, String))
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]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"-lnodefs.js"]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"-s", String
"--extern-post-js", String
classpath]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ( if Bool
lib
then [String
"-s", String
"EXPORT_NAME=loadWASM"]
else []
)
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"-s", String
"WASM_BIGINT"]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
cmdCFLAGS [String]
cflags_def
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
cmdEMCFLAGS [String
""]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"-s",
String
"EXPORTED_FUNCTIONS=["
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," (String
"'_malloc'" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
"'_free'" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
expfuns)
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ldflags
)
ByteString
forall a. Monoid a => a
mempty
case Either IOException (ExitCode, String, String)
ret of
Left IOException
err ->
String -> FutharkM ()
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS (String -> FutharkM ()) -> String -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ String
"Failed to run emcc: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ IOException -> String
forall a. Show a => a -> String
show IOException
err
Right (ExitFailure Int
code, String
_, String
emccerr) ->
String -> FutharkM ()
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS (String -> FutharkM ()) -> String -> FutharkM ()
forall a b. (a -> b) -> a -> b
$
String
"emcc failed with code "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
code
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
emccerr
Right (ExitCode
ExitSuccess, String
_, String
_) ->
() -> FutharkM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
compileCtoWASMAction :: FutharkConfig -> CompilerMode -> FilePath -> Action SeqMem
compileCtoWASMAction :: FutharkConfig -> CompilerMode -> String -> Action SeqMem
compileCtoWASMAction FutharkConfig
fcfg CompilerMode
mode String
outpath =
Action :: forall rep.
String -> String -> (Prog rep -> FutharkM ()) -> Action rep
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) <- FutharkConfig
-> FutharkM (Warnings, (CParts, Text, [String]))
-> FutharkM (CParts, Text, [String])
forall a. FutharkConfig -> FutharkM (Warnings, a) -> FutharkM a
handleWarnings FutharkConfig
fcfg (FutharkM (Warnings, (CParts, Text, [String]))
-> FutharkM (CParts, Text, [String]))
-> FutharkM (Warnings, (CParts, Text, [String]))
-> FutharkM (CParts, Text, [String])
forall a b. (a -> b) -> a -> b
$ Prog SeqMem -> FutharkM (Warnings, (CParts, Text, [String]))
forall (m :: * -> *).
MonadFreshNames m =>
Prog SeqMem -> m (Warnings, (CParts, Text, [String]))
SequentialWASM.compileProg Prog SeqMem
prog
case CompilerMode
mode of
CompilerMode
ToLibrary -> do
CParts -> Text -> FutharkM ()
forall (m :: * -> *). MonadIO m => CParts -> Text -> m ()
writeLibs CParts
cprog Text
jsprog
IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
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
CParts -> Text -> FutharkM ()
forall (m :: * -> *). MonadIO m => CParts -> Text -> m ()
writeLibs CParts
cprog Text
jsprog
IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
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
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
hpath Text
h
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath Text
imp
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
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 :: forall rep.
String -> String -> (Prog rep -> FutharkM ()) -> Action rep
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) <- FutharkConfig
-> FutharkM (Warnings, (CParts, Text, [String]))
-> FutharkM (CParts, Text, [String])
forall a. FutharkConfig -> FutharkM (Warnings, a) -> FutharkM a
handleWarnings FutharkConfig
fcfg (FutharkM (Warnings, (CParts, Text, [String]))
-> FutharkM (CParts, Text, [String]))
-> FutharkM (Warnings, (CParts, Text, [String]))
-> FutharkM (CParts, Text, [String])
forall a b. (a -> b) -> a -> b
$ Prog MCMem -> FutharkM (Warnings, (CParts, Text, [String]))
forall (m :: * -> *).
MonadFreshNames m =>
Prog MCMem -> m (Warnings, (CParts, Text, [String]))
MulticoreWASM.compileProg Prog MCMem
prog
case CompilerMode
mode of
CompilerMode
ToLibrary -> do
CParts -> Text -> FutharkM ()
forall (m :: * -> *). MonadIO m => CParts -> Text -> m ()
writeLibs CParts
cprog Text
jsprog
IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
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
CParts -> Text -> FutharkM ()
forall (m :: * -> *). MonadIO m => CParts -> Text -> m ()
writeLibs CParts
cprog Text
jsprog
IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
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
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
hpath Text
h
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
cpath Text
imp
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
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"