{-# LANGUAGE FlexibleContexts #-}
module Futhark.CLI.CSOpenCL (main) where
import Control.Monad.IO.Class
import Data.Maybe (fromMaybe)
import System.Directory
import System.Environment
import System.Exit
import System.FilePath
import Futhark.Passes
import Futhark.Pipeline
import qualified Futhark.CodeGen.Backends.CSOpenCL as CSOpenCL
import Futhark.Compiler.CLI
import Futhark.Util
main :: String -> [String] -> IO ()
main :: String -> [String] -> IO ()
main = ()
-> [CompilerOption ()]
-> String
-> String
-> Pipeline SOACS KernelsMem
-> (() -> CompilerMode -> String -> Prog KernelsMem -> FutharkM ())
-> String
-> [String]
-> IO ()
forall cfg lore.
cfg
-> [CompilerOption cfg]
-> String
-> String
-> Pipeline SOACS lore
-> (cfg -> CompilerMode -> String -> Prog lore -> FutharkM ())
-> String
-> [String]
-> IO ()
compilerMain () []
String
"Compile OpenCL C#" String
"Generate OpenCL C# code from optimised Futhark program."
Pipeline SOACS KernelsMem
gpuPipeline ((() -> CompilerMode -> String -> Prog KernelsMem -> FutharkM ())
-> String -> [String] -> IO ())
-> (() -> CompilerMode -> String -> Prog KernelsMem -> FutharkM ())
-> String
-> [String]
-> IO ()
forall a b. (a -> b) -> a -> b
$ \() CompilerMode
mode String
outpath Prog KernelsMem
prog -> do
String
mono_libs <- IO String -> FutharkM String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> FutharkM String) -> IO String -> FutharkM String
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"." (Maybe String -> String) -> IO (Maybe String) -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
"MONO_PATH"
let class_name :: Maybe String
class_name =
case CompilerMode
mode of CompilerMode
ToLibrary -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> String
takeBaseName String
outpath
CompilerMode
ToExecutable -> Maybe String
forall a. Maybe a
Nothing
String
csprog <- Maybe String -> Prog KernelsMem -> FutharkM String
forall (m :: * -> *).
MonadFreshNames m =>
Maybe String -> Prog KernelsMem -> m String
CSOpenCL.compileProg Maybe String
class_name Prog KernelsMem
prog
let cspath :: String
cspath = String
outpath String -> String -> String
`addExtension` String
"cs"
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
cspath String
csprog
case CompilerMode
mode of
CompilerMode
ToLibrary -> () -> FutharkM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
CompilerMode
ToExecutable -> 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
"csc"
[String
"-out:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
outpath, String
"-lib:"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
mono_libs, String
"-r:Cloo.clSharp.dll,Mono.Options.dll", String
cspath, String
"/unsafe"] 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 csc: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ IOException -> String
forall a. Show a => a -> String
show IOException
err
Right (ExitFailure Int
code, String
cscwarn, String
cscerr) ->
String -> FutharkM ()
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS (String -> FutharkM ()) -> String -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ String
"csc 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
cscerr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cscwarn
Right (ExitCode
ExitSuccess, String
_, String
_) -> IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ do
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