{-# 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 ExplicitMemory
-> (()
    -> CompilerMode -> String -> Prog ExplicitMemory -> 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 ExplicitMemory
gpuPipeline ((()
  -> CompilerMode -> String -> Prog ExplicitMemory -> FutharkM ())
 -> String -> [String] -> IO ())
-> (()
    -> CompilerMode -> String -> Prog ExplicitMemory -> FutharkM ())
-> String
-> [String]
-> IO ()
forall a b. (a -> b) -> a -> b
$ \() CompilerMode
mode String
outpath Prog ExplicitMemory
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 ExplicitMemory -> FutharkM String
forall (m :: * -> *).
MonadFreshNames m =>
Maybe String -> Prog ExplicitMemory -> m String
CSOpenCL.compileProg Maybe String
class_name Prog ExplicitMemory
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