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

-- | Run @futhark opencl@
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 ()