{-# 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