-- | Convenient common interface for command line Futhark compilers.
-- Using this module ensures that all compilers take the same options.
-- A small amount of flexibility is provided for backend-specific
-- options.
module Futhark.Compiler.CLI
  ( compilerMain,
    CompilerOption,
    CompilerMode (..),
    module Futhark.Pipeline,
    module Futhark.Compiler,
  )
where

import Control.Monad
import Data.Maybe
import Futhark.Compiler
import Futhark.IR (Name, Prog, nameFromString)
import Futhark.IR.SOACS (SOACS)
import Futhark.Pipeline
import Futhark.Util.Options
import System.FilePath

-- | Run a parameterised Futhark compiler, where @cfg@ is a user-given
-- configuration type.  Call this from @main@.
compilerMain ::
  -- | Initial configuration.
  cfg ->
  -- | Options that affect the configuration.
  [CompilerOption cfg] ->
  -- | The short action name (e.g. "compile to C").
  String ->
  -- | The longer action description.
  String ->
  -- | The pipeline to use.
  Pipeline SOACS rep ->
  -- | The action to take on the result of the pipeline.
  ( FutharkConfig ->
    cfg ->
    CompilerMode ->
    FilePath ->
    Prog rep ->
    FutharkM ()
  ) ->
  -- | Program name
  String ->
  -- | Command line arguments.
  [String] ->
  IO ()
compilerMain :: forall {k} cfg (rep :: k).
cfg
-> [CompilerOption cfg]
-> String
-> String
-> Pipeline SOACS rep
-> (FutharkConfig
    -> cfg -> CompilerMode -> String -> Prog rep -> FutharkM ())
-> String
-> [String]
-> IO ()
compilerMain cfg
cfg [CompilerOption cfg]
cfg_opts String
name String
desc Pipeline SOACS rep
pipeline FutharkConfig
-> cfg -> CompilerMode -> String -> Prog rep -> FutharkM ()
doIt =
  forall cfg.
cfg
-> [FunOptDescr cfg]
-> String
-> ([String] -> cfg -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
mainWithOptions
    (forall cfg. cfg -> CompilerConfig cfg
newCompilerConfig cfg
cfg)
    (forall cfg. [CoreCompilerOption cfg]
commandLineOptions forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall cfg. CompilerOption cfg -> CoreCompilerOption cfg
wrapOption [CompilerOption cfg]
cfg_opts)
    String
"options... <program.fut>"
    [String] -> CompilerConfig cfg -> Maybe (IO ())
inspectNonOptions
  where
    inspectNonOptions :: [String] -> CompilerConfig cfg -> Maybe (IO ())
inspectNonOptions [String
file] CompilerConfig cfg
config = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ CompilerConfig cfg -> String -> IO ()
compile CompilerConfig cfg
config String
file
    inspectNonOptions [String]
_ CompilerConfig cfg
_ = forall a. Maybe a
Nothing

    compile :: CompilerConfig cfg -> String -> IO ()
compile CompilerConfig cfg
config String
filepath =
      forall {k} (rep :: k).
FutharkConfig
-> Pipeline SOACS rep -> Action rep -> String -> IO ()
runCompilerOnProgram
        (forall cfg. CompilerConfig cfg -> FutharkConfig
futharkConfig CompilerConfig cfg
config)
        Pipeline SOACS rep
pipeline
        (CompilerConfig cfg -> String -> Action rep
action CompilerConfig cfg
config String
filepath)
        String
filepath

    action :: CompilerConfig cfg -> String -> Action rep
action CompilerConfig cfg
config String
filepath =
      Action
        { actionName :: String
actionName = String
name,
          actionDescription :: String
actionDescription = String
desc,
          actionProcedure :: Prog rep -> FutharkM ()
actionProcedure =
            FutharkConfig
-> cfg -> CompilerMode -> String -> Prog rep -> FutharkM ()
doIt
              (forall cfg. CompilerConfig cfg -> FutharkConfig
futharkConfig CompilerConfig cfg
config)
              (forall cfg. CompilerConfig cfg -> cfg
compilerConfig CompilerConfig cfg
config)
              (forall cfg. CompilerConfig cfg -> CompilerMode
compilerMode CompilerConfig cfg
config)
              (forall cfg. String -> CompilerConfig cfg -> String
outputFilePath String
filepath CompilerConfig cfg
config)
        }

-- | An option that modifies the configuration of type @cfg@.
type CompilerOption cfg = OptDescr (Either (IO ()) (cfg -> cfg))

type CoreCompilerOption cfg =
  OptDescr
    ( Either
        (IO ())
        (CompilerConfig cfg -> CompilerConfig cfg)
    )

commandLineOptions :: [CoreCompilerOption cfg]
commandLineOptions :: forall cfg. [CoreCompilerOption cfg]
commandLineOptions =
  [ forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      String
"o"
      []
      ( forall a. (String -> a) -> String -> ArgDescr a
ReqArg
          (\String
filename -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \CompilerConfig cfg
config -> CompilerConfig cfg
config {compilerOutput :: Maybe String
compilerOutput = forall a. a -> Maybe a
Just String
filename})
          String
"FILE"
      )
      String
"Name of the compiled binary.",
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      String
"v"
      [String
"verbose"]
      (forall a. (Maybe String -> a) -> String -> ArgDescr a
OptArg (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall cfg.
Maybe String -> CompilerConfig cfg -> CompilerConfig cfg
incVerbosity) String
"FILE")
      String
"Print verbose output on standard error; wrong program to FILE.",
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"library"]
      (forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \CompilerConfig cfg
config -> CompilerConfig cfg
config {compilerMode :: CompilerMode
compilerMode = CompilerMode
ToLibrary})
      String
"Generate a library instead of an executable.",
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"executable"]
      (forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \CompilerConfig cfg
config -> CompilerConfig cfg
config {compilerMode :: CompilerMode
compilerMode = CompilerMode
ToExecutable})
      String
"Generate an executable instead of a library (set by default).",
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"server"]
      (forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \CompilerConfig cfg
config -> CompilerConfig cfg
config {compilerMode :: CompilerMode
compilerMode = CompilerMode
ToServer})
      String
"Generate a server executable instead of a library.",
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      String
"w"
      []
      (forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \CompilerConfig cfg
config -> CompilerConfig cfg
config {compilerWarn :: Bool
compilerWarn = Bool
False})
      String
"Disable all warnings.",
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"Werror"]
      (forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \CompilerConfig cfg
config -> CompilerConfig cfg
config {compilerWerror :: Bool
compilerWerror = Bool
True})
      String
"Treat warnings as errors.",
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"safe"]
      (forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \CompilerConfig cfg
config -> CompilerConfig cfg
config {compilerSafe :: Bool
compilerSafe = Bool
True})
      String
"Ignore 'unsafe' in code.",
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"entry-point"]
      ( forall a. (String -> a) -> String -> ArgDescr a
ReqArg
          ( \String
arg -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \CompilerConfig cfg
config ->
              CompilerConfig cfg
config
                { compilerEntryPoints :: [Name]
compilerEntryPoints =
                    String -> Name
nameFromString String
arg forall a. a -> [a] -> [a]
: forall cfg. CompilerConfig cfg -> [Name]
compilerEntryPoints CompilerConfig cfg
config
                }
          )
          String
"NAME"
      )
      String
"Treat this function as an additional entry point."
  ]

wrapOption :: CompilerOption cfg -> CoreCompilerOption cfg
wrapOption :: forall cfg. CompilerOption cfg -> CoreCompilerOption cfg
wrapOption = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {m :: * -> *} {t} {cfg}.
Monad m =>
m (t -> cfg) -> m (CompilerConfig t -> CompilerConfig cfg)
wrap
  where
    wrap :: m (t -> cfg) -> m (CompilerConfig t -> CompilerConfig cfg)
wrap m (t -> cfg)
f = do
      t -> cfg
g <- m (t -> cfg)
f
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ \CompilerConfig t
cfg -> CompilerConfig t
cfg {compilerConfig :: cfg
compilerConfig = t -> cfg
g (forall cfg. CompilerConfig cfg -> cfg
compilerConfig CompilerConfig t
cfg)}

incVerbosity :: Maybe FilePath -> CompilerConfig cfg -> CompilerConfig cfg
incVerbosity :: forall cfg.
Maybe String -> CompilerConfig cfg -> CompilerConfig cfg
incVerbosity Maybe String
file CompilerConfig cfg
cfg =
  CompilerConfig cfg
cfg {compilerVerbose :: (Verbosity, Maybe String)
compilerVerbose = (Verbosity
v, Maybe String
file forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall a b. (a, b) -> b
snd (forall cfg. CompilerConfig cfg -> (Verbosity, Maybe String)
compilerVerbose CompilerConfig cfg
cfg))}
  where
    v :: Verbosity
v = case forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall cfg. CompilerConfig cfg -> (Verbosity, Maybe String)
compilerVerbose CompilerConfig cfg
cfg of
      Verbosity
NotVerbose -> Verbosity
Verbose
      Verbosity
Verbose -> Verbosity
VeryVerbose
      Verbosity
VeryVerbose -> Verbosity
VeryVerbose

data CompilerConfig cfg = CompilerConfig
  { forall cfg. CompilerConfig cfg -> Maybe String
compilerOutput :: Maybe FilePath,
    forall cfg. CompilerConfig cfg -> (Verbosity, Maybe String)
compilerVerbose :: (Verbosity, Maybe FilePath),
    forall cfg. CompilerConfig cfg -> CompilerMode
compilerMode :: CompilerMode,
    forall cfg. CompilerConfig cfg -> Bool
compilerWerror :: Bool,
    forall cfg. CompilerConfig cfg -> Bool
compilerSafe :: Bool,
    forall cfg. CompilerConfig cfg -> Bool
compilerWarn :: Bool,
    forall cfg. CompilerConfig cfg -> cfg
compilerConfig :: cfg,
    forall cfg. CompilerConfig cfg -> [Name]
compilerEntryPoints :: [Name]
  }

-- | The configuration of the compiler.
newCompilerConfig :: cfg -> CompilerConfig cfg
newCompilerConfig :: forall cfg. cfg -> CompilerConfig cfg
newCompilerConfig cfg
x =
  CompilerConfig
    { compilerOutput :: Maybe String
compilerOutput = forall a. Maybe a
Nothing,
      compilerVerbose :: (Verbosity, Maybe String)
compilerVerbose = (Verbosity
NotVerbose, forall a. Maybe a
Nothing),
      compilerMode :: CompilerMode
compilerMode = CompilerMode
ToExecutable,
      compilerWerror :: Bool
compilerWerror = Bool
False,
      compilerSafe :: Bool
compilerSafe = Bool
False,
      compilerWarn :: Bool
compilerWarn = Bool
True,
      compilerConfig :: cfg
compilerConfig = cfg
x,
      compilerEntryPoints :: [Name]
compilerEntryPoints = forall a. Monoid a => a
mempty
    }

outputFilePath :: FilePath -> CompilerConfig cfg -> FilePath
outputFilePath :: forall cfg. String -> CompilerConfig cfg -> String
outputFilePath String
srcfile =
  forall a. a -> Maybe a -> a
fromMaybe (String
srcfile String -> String -> String
`replaceExtension` String
"") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall cfg. CompilerConfig cfg -> Maybe String
compilerOutput

futharkConfig :: CompilerConfig cfg -> FutharkConfig
futharkConfig :: forall cfg. CompilerConfig cfg -> FutharkConfig
futharkConfig CompilerConfig cfg
config =
  FutharkConfig
newFutharkConfig
    { futharkVerbose :: (Verbosity, Maybe String)
futharkVerbose = forall cfg. CompilerConfig cfg -> (Verbosity, Maybe String)
compilerVerbose CompilerConfig cfg
config,
      futharkWerror :: Bool
futharkWerror = forall cfg. CompilerConfig cfg -> Bool
compilerWerror CompilerConfig cfg
config,
      futharkSafe :: Bool
futharkSafe = forall cfg. CompilerConfig cfg -> Bool
compilerSafe CompilerConfig cfg
config,
      futharkWarn :: Bool
futharkWarn = forall cfg. CompilerConfig cfg -> Bool
compilerWarn CompilerConfig cfg
config,
      futharkEntryPoints :: [Name]
futharkEntryPoints = forall cfg. CompilerConfig cfg -> [Name]
compilerEntryPoints CompilerConfig cfg
config
    }