{-# LANGUAGE FlexibleContexts #-}
module Futhark.CLI.OpenCL (main) where
import Control.Monad.IO.Class
import System.FilePath
import System.Exit
import qualified System.Info
import Futhark.Pipeline
import Futhark.Passes
import qualified Futhark.CodeGen.Backends.COpenCL as COpenCL
import Futhark.Util
import Futhark.Compiler.CLI
main :: String -> [String] -> IO ()
main :: String -> [String] -> IO ()
main = ()
-> [CompilerOption ()]
-> String
-> String
-> Pipeline SOACS KernelsMem
-> (FutharkConfig
-> () -> CompilerMode -> String -> Prog KernelsMem -> FutharkM ())
-> String
-> [String]
-> IO ()
forall cfg lore.
cfg
-> [CompilerOption cfg]
-> String
-> String
-> Pipeline SOACS lore
-> (FutharkConfig
-> cfg -> CompilerMode -> String -> Prog lore -> FutharkM ())
-> String
-> [String]
-> IO ()
compilerMain () []
String
"Compile OpenCL" String
"Generate OpenCL/C code from optimised Futhark program."
Pipeline SOACS KernelsMem
gpuPipeline ((FutharkConfig
-> () -> CompilerMode -> String -> Prog KernelsMem -> FutharkM ())
-> String -> [String] -> IO ())
-> (FutharkConfig
-> () -> CompilerMode -> String -> Prog KernelsMem -> FutharkM ())
-> String
-> [String]
-> IO ()
forall a b. (a -> b) -> a -> b
$ \FutharkConfig
fcfg () CompilerMode
mode String
outpath 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
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
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
COpenCL.asExecutable CParts
cprog
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
"gcc"
([String
cpath, String
"-O", String
"-std=c99", String
"-lm", String
"-o", String
outpath] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
extra_options) 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 gcc: " 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
"gcc 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 ()