{-# LANGUAGE FlexibleContexts #-}

-- | All (almost) compiler pipelines end with an 'Action', which does
-- something with the result of the pipeline.
module Futhark.Actions
  ( printAction,
    printAliasesAction,
    impCodeGenAction,
    kernelImpCodeGenAction,
    multicoreImpCodeGenAction,
    metricsAction,
    compileCAction,
    compileOpenCLAction,
    compileCUDAAction,
    compileMulticoreAction,
    compilePythonAction,
    compilePyOpenCLAction,
  )
where

import Control.Monad
import Control.Monad.IO.Class
import Data.Maybe (fromMaybe)
import Futhark.Analysis.Alias
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.PyOpenCL as PyOpenCL
import qualified Futhark.CodeGen.Backends.SequentialC as SequentialC
import qualified Futhark.CodeGen.Backends.SequentialPython as SequentialPy
import qualified Futhark.CodeGen.ImpGen.Kernels as ImpGenKernels
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.KernelsMem (KernelsMem)
import Futhark.IR.MCMem (MCMem)
import Futhark.IR.Prop.Aliases
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

-- | Print the result to stdout.
printAction :: ASTLore lore => Action lore
printAction :: forall lore. ASTLore lore => Action lore
printAction =
  Action :: forall lore.
String -> String -> (Prog lore -> FutharkM ()) -> Action lore
Action
    { actionName :: String
actionName = String
"Prettyprint",
      actionDescription :: String
actionDescription = String
"Prettyprint the resulting internal representation on standard output.",
      actionProcedure :: Prog lore -> FutharkM ()
actionProcedure = IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ())
-> (Prog lore -> IO ()) -> Prog lore -> FutharkM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn (String -> IO ()) -> (Prog lore -> String) -> Prog lore -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prog lore -> String
forall a. Pretty a => a -> String
pretty
    }

-- | Print the result to stdout, alias annotations.
printAliasesAction :: (ASTLore lore, CanBeAliased (Op lore)) => Action lore
printAliasesAction :: forall lore. (ASTLore lore, CanBeAliased (Op lore)) => Action lore
printAliasesAction =
  Action :: forall lore.
String -> String -> (Prog lore -> FutharkM ()) -> Action lore
Action
    { actionName :: String
actionName = String
"Prettyprint",
      actionDescription :: String
actionDescription = String
"Prettyprint the resulting internal representation on standard output.",
      actionProcedure :: Prog lore -> FutharkM ()
actionProcedure = IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ())
-> (Prog lore -> IO ()) -> Prog lore -> FutharkM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn (String -> IO ()) -> (Prog lore -> String) -> Prog lore -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prog (Aliases lore) -> String
forall a. Pretty a => a -> String
pretty (Prog (Aliases lore) -> String)
-> (Prog lore -> Prog (Aliases lore)) -> Prog lore -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prog lore -> Prog (Aliases lore)
forall lore.
(ASTLore lore, CanBeAliased (Op lore)) =>
Prog lore -> Prog (Aliases lore)
aliasAnalysis
    }

-- | Print metrics about AST node counts to stdout.
metricsAction :: OpMetrics (Op lore) => Action lore
metricsAction :: forall lore. OpMetrics (Op lore) => Action lore
metricsAction =
  Action :: forall lore.
String -> String -> (Prog lore -> FutharkM ()) -> Action lore
Action
    { actionName :: String
actionName = String
"Compute metrics",
      actionDescription :: String
actionDescription = String
"Print metrics on the final AST.",
      actionProcedure :: Prog lore -> FutharkM ()
actionProcedure = IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ())
-> (Prog lore -> IO ()) -> Prog lore -> FutharkM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStr (String -> IO ()) -> (Prog lore -> String) -> Prog lore -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AstMetrics -> String
forall a. Show a => a -> String
show (AstMetrics -> String)
-> (Prog lore -> AstMetrics) -> Prog lore -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prog lore -> AstMetrics
forall lore. OpMetrics (Op lore) => Prog lore -> AstMetrics
progMetrics
    }

-- | Convert the program to sequential ImpCode and print it to stdout.
impCodeGenAction :: Action SeqMem
impCodeGenAction :: Action SeqMem
impCodeGenAction =
  Action :: forall lore.
String -> String -> (Prog lore -> FutharkM ()) -> Action lore
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
    }

-- | Convert the program to GPU ImpCode and print it to stdout.
kernelImpCodeGenAction :: Action KernelsMem
kernelImpCodeGenAction :: Action KernelsMem
kernelImpCodeGenAction =
  Action :: forall lore.
String -> String -> (Prog lore -> FutharkM ()) -> Action lore
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 KernelsMem -> 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 KernelsMem -> FutharkM (Warnings, Program))
-> Prog KernelsMem
-> FutharkM ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Prog KernelsMem -> FutharkM (Warnings, Program)
forall (m :: * -> *).
MonadFreshNames m =>
Prog KernelsMem -> m (Warnings, Program)
ImpGenKernels.compileProgOpenCL
    }

-- | Convert the program to CPU multicore ImpCode and print it to stdout.
multicoreImpCodeGenAction :: Action MCMem
multicoreImpCodeGenAction :: Action MCMem
multicoreImpCodeGenAction =
  Action :: forall lore.
String -> String -> (Prog lore -> FutharkM ()) -> Action lore
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
    }

-- Lines that we prepend (in comments) to generated code.
headerLines :: [String]
headerLines :: [String]
headerLines = String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
"Generated by Futhark " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
versionString

cHeaderLines :: [String]
cHeaderLines :: [String]
cHeaderLines = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"// " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) [String]
headerLines

pyHeaderLines :: [String]
pyHeaderLines :: [String]
pyHeaderLines = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"# " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) [String]
headerLines

cPrependHeader :: String -> String
cPrependHeader :: String -> String
cPrependHeader = ([String] -> String
unlines [String]
cHeaderLines String -> String -> String
forall a. [a] -> [a] -> [a]
++)

pyPrependHeader :: String -> String
pyPrependHeader :: String -> String
pyPrependHeader = ([String] -> String
unlines [String]
pyHeaderLines String -> String -> String
forall 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]
++
            -- The default LDFLAGS are always added.
            [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 ()

-- | The @futhark c@ action.
compileCAction :: FutharkConfig -> CompilerMode -> FilePath -> Action SeqMem
compileCAction :: FutharkConfig -> CompilerMode -> String -> Action SeqMem
compileCAction FutharkConfig
fcfg CompilerMode
mode String
outpath =
  Action :: forall lore.
String -> String -> (Prog lore -> FutharkM ()) -> Action lore
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"

      case CompilerMode
mode of
        CompilerMode
ToLibrary -> do
          let (String
header, String
impl) = CParts -> (String, String)
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 -> String -> IO ()
writeFile String
hpath (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
cPrependHeader String
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 -> String -> IO ()
writeFile String
cpath (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
cPrependHeader String
impl
        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 -> String -> IO ()
writeFile String
cpath (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ CParts -> String
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 -> String -> IO ()
writeFile String
cpath (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ CParts -> String
SequentialC.asServer CParts
cprog
          String -> String -> [String] -> [String] -> FutharkM ()
runCC String
cpath String
outpath [String
"-O3", String
"-std=c99"] [String
"-lm"]

-- | The @futhark opencl@ action.
compileOpenCLAction :: FutharkConfig -> CompilerMode -> FilePath -> Action KernelsMem
compileOpenCLAction :: FutharkConfig -> CompilerMode -> String -> Action KernelsMem
compileOpenCLAction FutharkConfig
fcfg CompilerMode
mode String
outpath =
  Action :: forall lore.
String -> String -> (Prog lore -> FutharkM ()) -> Action lore
Action
    { actionName :: String
actionName = String
"Compile to OpenCL",
      actionDescription :: String
actionDescription = String
"Compile to OpenCL",
      actionProcedure :: Prog KernelsMem -> FutharkM ()
actionProcedure = Prog KernelsMem -> FutharkM ()
helper
    }
  where
    helper :: Prog KernelsMem -> FutharkM ()
helper Prog KernelsMem
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 KernelsMem -> FutharkM (Warnings, CParts)
forall (m :: * -> *).
MonadFreshNames m =>
Prog KernelsMem -> m (Warnings, CParts)
COpenCL.compileProg Prog KernelsMem
prog
      let cpath :: String
cpath = String
outpath String -> String -> String
`addExtension` String
"c"
          hpath :: String
hpath = String
outpath String -> String -> String
`addExtension` String
"h"
          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 (String
header, String
impl) = CParts -> (String, String)
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 -> String -> IO ()
writeFile String
hpath (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
cPrependHeader String
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 -> String -> IO ()
writeFile String
cpath (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
cPrependHeader String
impl
        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 -> String -> IO ()
writeFile String
cpath (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
cPrependHeader (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ CParts -> String
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 -> String -> IO ()
writeFile String
cpath (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
cPrependHeader (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ CParts -> String
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)

-- | The @futhark cuda@ action.
compileCUDAAction :: FutharkConfig -> CompilerMode -> FilePath -> Action KernelsMem
compileCUDAAction :: FutharkConfig -> CompilerMode -> String -> Action KernelsMem
compileCUDAAction FutharkConfig
fcfg CompilerMode
mode String
outpath =
  Action :: forall lore.
String -> String -> (Prog lore -> FutharkM ()) -> Action lore
Action
    { actionName :: String
actionName = String
"Compile to CUDA",
      actionDescription :: String
actionDescription = String
"Compile to CUDA",
      actionProcedure :: Prog KernelsMem -> FutharkM ()
actionProcedure = Prog KernelsMem -> FutharkM ()
helper
    }
  where
    helper :: Prog KernelsMem -> FutharkM ()
helper Prog KernelsMem
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 KernelsMem -> FutharkM (Warnings, CParts)
forall (m :: * -> *).
MonadFreshNames m =>
Prog KernelsMem -> m (Warnings, CParts)
CCUDA.compileProg Prog KernelsMem
prog
      let cpath :: String
cpath = String
outpath String -> String -> String
`addExtension` String
"c"
          hpath :: String
hpath = String
outpath String -> String -> String
`addExtension` String
"h"
          extra_options :: [String]
extra_options =
            [ String
"-lcuda",
              String
"-lcudart",
              String
"-lnvrtc"
            ]
      case CompilerMode
mode of
        CompilerMode
ToLibrary -> do
          let (String
header, String
impl) = CParts -> (String, String)
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 -> String -> IO ()
writeFile String
hpath (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
cPrependHeader String
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 -> String -> IO ()
writeFile String
cpath (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
cPrependHeader String
impl
        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 -> String -> IO ()
writeFile String
cpath (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
cPrependHeader (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ CParts -> String
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 -> String -> IO ()
writeFile String
cpath (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
cPrependHeader (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ CParts -> String
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)

-- | The @futhark multicore@ action.
compileMulticoreAction :: FutharkConfig -> CompilerMode -> FilePath -> Action MCMem
compileMulticoreAction :: FutharkConfig -> CompilerMode -> String -> Action MCMem
compileMulticoreAction FutharkConfig
fcfg CompilerMode
mode String
outpath =
  Action :: forall lore.
String -> String -> (Prog lore -> FutharkM ()) -> Action lore
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"

      case CompilerMode
mode of
        CompilerMode
ToLibrary -> do
          let (String
header, String
impl) = CParts -> (String, String)
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 -> String -> IO ()
writeFile String
hpath (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
cPrependHeader String
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 -> String -> IO ()
writeFile String
cpath (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
cPrependHeader String
impl
        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 -> String -> IO ()
writeFile String
cpath (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
cPrependHeader (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ CParts -> String
MulticoreC.asExecutable CParts
cprog
          String -> String -> [String] -> [String] -> FutharkM ()
runCC String
cpath String
outpath [String
"-O", 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 -> String -> IO ()
writeFile String
cpath (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
cPrependHeader (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ CParts -> String
MulticoreC.asServer CParts
cprog
          String -> String -> [String] -> [String] -> FutharkM ()
runCC String
cpath String
outpath [String
"-O", String
"-std=c99"] [String
"-lm", String
"-pthread"]

pythonCommon ::
  (CompilerMode -> String -> prog -> FutharkM (Warnings, String)) ->
  FutharkConfig ->
  CompilerMode ->
  FilePath ->
  prog ->
  FutharkM ()
pythonCommon :: forall prog.
(CompilerMode -> String -> prog -> FutharkM (Warnings, String))
-> FutharkConfig -> CompilerMode -> String -> prog -> FutharkM ()
pythonCommon CompilerMode -> String -> prog -> FutharkM (Warnings, String)
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"
  String
pyprog <- FutharkConfig -> FutharkM (Warnings, String) -> FutharkM String
forall a. FutharkConfig -> FutharkM (Warnings, a) -> FutharkM a
handleWarnings FutharkConfig
fcfg (FutharkM (Warnings, String) -> FutharkM String)
-> FutharkM (Warnings, String) -> FutharkM String
forall a b. (a -> b) -> a -> b
$ CompilerMode -> String -> prog -> FutharkM (Warnings, String)
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 -> String -> IO ()
writeFile (String
outpath String -> String -> String
`addExtension` String
"py") (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
pyPrependHeader String
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 -> String -> IO ()
writeFile String
outpath (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"#!/usr/bin/env python3\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
pyPrependHeader String
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 lore.
String -> String -> (Prog lore -> FutharkM ()) -> Action lore
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, String))
-> FutharkConfig
-> CompilerMode
-> String
-> Prog SeqMem
-> FutharkM ()
forall prog.
(CompilerMode -> String -> prog -> FutharkM (Warnings, String))
-> FutharkConfig -> CompilerMode -> String -> prog -> FutharkM ()
pythonCommon CompilerMode
-> String -> Prog SeqMem -> FutharkM (Warnings, String)
forall (m :: * -> *).
MonadFreshNames m =>
CompilerMode -> String -> Prog SeqMem -> m (Warnings, String)
SequentialPy.compileProg FutharkConfig
fcfg CompilerMode
mode String
outpath
    }

compilePyOpenCLAction :: FutharkConfig -> CompilerMode -> FilePath -> Action KernelsMem
compilePyOpenCLAction :: FutharkConfig -> CompilerMode -> String -> Action KernelsMem
compilePyOpenCLAction FutharkConfig
fcfg CompilerMode
mode String
outpath =
  Action :: forall lore.
String -> String -> (Prog lore -> FutharkM ()) -> Action lore
Action
    { actionName :: String
actionName = String
"Compile to PyOpenCL",
      actionDescription :: String
actionDescription = String
"Compile to Python with OpenCL",
      actionProcedure :: Prog KernelsMem -> FutharkM ()
actionProcedure = (CompilerMode
 -> String -> Prog KernelsMem -> FutharkM (Warnings, String))
-> FutharkConfig
-> CompilerMode
-> String
-> Prog KernelsMem
-> FutharkM ()
forall prog.
(CompilerMode -> String -> prog -> FutharkM (Warnings, String))
-> FutharkConfig -> CompilerMode -> String -> prog -> FutharkM ()
pythonCommon CompilerMode
-> String -> Prog KernelsMem -> FutharkM (Warnings, String)
forall (m :: * -> *).
MonadFreshNames m =>
CompilerMode -> String -> Prog KernelsMem -> m (Warnings, String)
PyOpenCL.compileProg FutharkConfig
fcfg CompilerMode
mode String
outpath
    }