{-# LANGUAGE FlexibleContexts #-}
-- | @futhark csopencl@
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

-- | Run @futhark csopencl@.
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