-- | Futhark Compiler Driver
module Futhark.CLI.Dev (main) where

import Control.Category (id)
import Control.Monad
import Control.Monad.State
import Data.Kind qualified
import Data.List (intersperse)
import Data.Maybe
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Futhark.Actions
import Futhark.Analysis.AccessPattern (Analyse)
import Futhark.Analysis.Alias qualified as Alias
import Futhark.Analysis.Metrics (OpMetrics)
import Futhark.Compiler.CLI hiding (compilerMain)
import Futhark.IR (Op, Prog, prettyString)
import Futhark.IR.Aliases (AliasableRep)
import Futhark.IR.GPU qualified as GPU
import Futhark.IR.GPUMem qualified as GPUMem
import Futhark.IR.MC qualified as MC
import Futhark.IR.MCMem qualified as MCMem
import Futhark.IR.Parse
import Futhark.IR.SOACS qualified as SOACS
import Futhark.IR.Seq qualified as Seq
import Futhark.IR.SeqMem qualified as SeqMem
import Futhark.IR.TypeCheck (Checkable, checkProg)
import Futhark.Internalise.ApplyTypeAbbrs as ApplyTypeAbbrs
import Futhark.Internalise.Defunctionalise as Defunctionalise
import Futhark.Internalise.Defunctorise as Defunctorise
import Futhark.Internalise.FullNormalise as FullNormalise
import Futhark.Internalise.LiftLambdas as LiftLambdas
import Futhark.Internalise.Monomorphise as Monomorphise
import Futhark.Internalise.ReplaceRecords as ReplaceRecords
import Futhark.Optimise.ArrayLayout
import Futhark.Optimise.ArrayShortCircuiting qualified as ArrayShortCircuiting
import Futhark.Optimise.CSE
import Futhark.Optimise.DoubleBuffer
import Futhark.Optimise.Fusion
import Futhark.Optimise.GenRedOpt
import Futhark.Optimise.HistAccs
import Futhark.Optimise.InliningDeadFun
import Futhark.Optimise.MemoryBlockMerging qualified as MemoryBlockMerging
import Futhark.Optimise.ReduceDeviceSyncs (reduceDeviceSyncs)
import Futhark.Optimise.Sink
import Futhark.Optimise.TileLoops
import Futhark.Optimise.Unstream
import Futhark.Pass
import Futhark.Pass.AD
import Futhark.Pass.ExpandAllocations
import Futhark.Pass.ExplicitAllocations.GPU qualified as GPU
import Futhark.Pass.ExplicitAllocations.MC qualified as MC
import Futhark.Pass.ExplicitAllocations.Seq qualified as Seq
import Futhark.Pass.ExtractKernels
import Futhark.Pass.ExtractMulticore
import Futhark.Pass.FirstOrderTransform
import Futhark.Pass.LiftAllocations as LiftAllocations
import Futhark.Pass.LowerAllocations as LowerAllocations
import Futhark.Pass.Simplify
import Futhark.Passes
import Futhark.Util.Log
import Futhark.Util.Options
import Futhark.Util.Pretty qualified as PP
import Language.Futhark.Core (locStr, nameFromString)
import Language.Futhark.Parser (SyntaxError (..), parseFuthark)
import System.Exit
import System.FilePath
import System.IO
import Prelude hiding (id)

-- | What to do with the program after it has been read.
data FutharkPipeline
  = -- | Just print it.
    PrettyPrint
  | -- | Run the type checker; print type errors.
    TypeCheck
  | -- | Run this pipeline.
    Pipeline [UntypedPass]
  | -- | Partially evaluate away the module language.
    Defunctorise
  | -- | Defunctorise and normalise.
    FullNormalise
  | -- | Defunctorise, normalise and monomorphise.
    Monomorphise
  | -- | Defunctorise, normalise, monomorphise and lambda-lift.
    LiftLambdas
  | -- | Defunctorise, normalise, monomorphise, lambda-lift and defunctionalise.
    Defunctionalise

data Config = Config
  { Config -> FutharkConfig
futharkConfig :: FutharkConfig,
    -- | Nothing is distinct from a empty pipeline -
    -- it means we don't even run the internaliser.
    Config -> FutharkPipeline
futharkPipeline :: FutharkPipeline,
    Config -> CompilerMode
futharkCompilerMode :: CompilerMode,
    Config -> UntypedAction
futharkAction :: UntypedAction,
    -- | If true, prints programs as raw ASTs instead
    -- of their prettyprinted form.
    Config -> Bool
futharkPrintAST :: Bool
  }

-- | Get a Futhark pipeline from the configuration - an empty one if
-- none exists.
getFutharkPipeline :: Config -> [UntypedPass]
getFutharkPipeline :: Config -> [UntypedPass]
getFutharkPipeline = FutharkPipeline -> [UntypedPass]
toPipeline (FutharkPipeline -> [UntypedPass])
-> (Config -> FutharkPipeline) -> Config -> [UntypedPass]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> FutharkPipeline
futharkPipeline
  where
    toPipeline :: FutharkPipeline -> [UntypedPass]
toPipeline (Pipeline [UntypedPass]
p) = [UntypedPass]
p
    toPipeline FutharkPipeline
_ = []

data UntypedPassState
  = SOACS (Prog SOACS.SOACS)
  | GPU (Prog GPU.GPU)
  | MC (Prog MC.MC)
  | Seq (Prog Seq.Seq)
  | GPUMem (Prog GPUMem.GPUMem)
  | MCMem (Prog MCMem.MCMem)
  | SeqMem (Prog SeqMem.SeqMem)

getSOACSProg :: UntypedPassState -> Maybe (Prog SOACS.SOACS)
getSOACSProg :: UntypedPassState -> Maybe (Prog SOACS)
getSOACSProg (SOACS Prog SOACS
prog) = Prog SOACS -> Maybe (Prog SOACS)
forall a. a -> Maybe a
Just Prog SOACS
prog
getSOACSProg UntypedPassState
_ = Maybe (Prog SOACS)
forall a. Maybe a
Nothing

class Representation s where
  -- | A human-readable description of the representation expected or
  -- contained, usable for error messages.
  representation :: s -> String

instance Representation UntypedPassState where
  representation :: UntypedPassState -> String
representation (SOACS Prog SOACS
_) = String
"SOACS"
  representation (GPU Prog GPU
_) = String
"GPU"
  representation (MC Prog MC
_) = String
"MC"
  representation (Seq Prog Seq
_) = String
"Seq"
  representation (GPUMem Prog GPUMem
_) = String
"GPUMem"
  representation (MCMem Prog MCMem
_) = String
"MCMem"
  representation (SeqMem Prog SeqMem
_) = String
"SeqMem"

instance PP.Pretty UntypedPassState where
  pretty :: forall ann. UntypedPassState -> Doc ann
pretty (SOACS Prog SOACS
prog) = Prog SOACS -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Prog SOACS -> Doc ann
PP.pretty Prog SOACS
prog
  pretty (GPU Prog GPU
prog) = Prog GPU -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Prog GPU -> Doc ann
PP.pretty Prog GPU
prog
  pretty (MC Prog MC
prog) = Prog MC -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Prog MC -> Doc ann
PP.pretty Prog MC
prog
  pretty (Seq Prog Seq
prog) = Prog Seq -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Prog Seq -> Doc ann
PP.pretty Prog Seq
prog
  pretty (SeqMem Prog SeqMem
prog) = Prog SeqMem -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Prog SeqMem -> Doc ann
PP.pretty Prog SeqMem
prog
  pretty (MCMem Prog MCMem
prog) = Prog MCMem -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Prog MCMem -> Doc ann
PP.pretty Prog MCMem
prog
  pretty (GPUMem Prog GPUMem
prog) = Prog GPUMem -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Prog GPUMem -> Doc ann
PP.pretty Prog GPUMem
prog

newtype UntypedPass
  = UntypedPass
      ( UntypedPassState ->
        PipelineConfig ->
        FutharkM UntypedPassState
      )

type BackendAction rep = FutharkConfig -> CompilerMode -> FilePath -> Action rep

data UntypedAction
  = SOACSAction (Action SOACS.SOACS)
  | GPUAction (Action GPU.GPU)
  | GPUMemAction (BackendAction GPUMem.GPUMem)
  | MCMemAction (BackendAction MCMem.MCMem)
  | SeqMemAction (BackendAction SeqMem.SeqMem)
  | PolyAction
      ( forall (rep :: Data.Kind.Type).
        ( AliasableRep rep,
          (OpMetrics (Op rep)),
          Analyse rep
        ) =>
        Action rep
      )

instance Representation UntypedAction where
  representation :: UntypedAction -> String
representation (SOACSAction Action SOACS
_) = String
"SOACS"
  representation (GPUAction Action GPU
_) = String
"GPU"
  representation (GPUMemAction BackendAction GPUMem
_) = String
"GPUMem"
  representation (MCMemAction BackendAction MCMem
_) = String
"MCMem"
  representation (SeqMemAction BackendAction SeqMem
_) = String
"SeqMem"
  representation PolyAction {} = String
"<any>"

newConfig :: Config
newConfig :: Config
newConfig = FutharkConfig
-> FutharkPipeline
-> CompilerMode
-> UntypedAction
-> Bool
-> Config
Config FutharkConfig
newFutharkConfig ([UntypedPass] -> FutharkPipeline
Pipeline []) CompilerMode
ToExecutable UntypedAction
action Bool
False
  where
    action :: UntypedAction
action = (forall rep.
 (AliasableRep rep, OpMetrics (Op rep), Analyse rep) =>
 Action rep)
-> UntypedAction
PolyAction Action rep
forall rep.
(AliasableRep rep, OpMetrics (Op rep), Analyse rep) =>
Action rep
forall rep. ASTRep rep => Action rep
printAction

changeFutharkConfig ::
  (FutharkConfig -> FutharkConfig) ->
  Config ->
  Config
changeFutharkConfig :: (FutharkConfig -> FutharkConfig) -> Config -> Config
changeFutharkConfig FutharkConfig -> FutharkConfig
f Config
cfg = Config
cfg {futharkConfig = f $ futharkConfig cfg}

type FutharkOption = FunOptDescr Config

passOption :: String -> UntypedPass -> String -> [String] -> FutharkOption
passOption :: String -> UntypedPass -> String -> [String] -> FutharkOption
passOption String
desc UntypedPass
pass String
short [String]
long =
  String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
    String
short
    [String]
long
    ( Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$
        (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
cfg ->
          Config
cfg {futharkPipeline = Pipeline $ getFutharkPipeline cfg ++ [pass]}
    )
    String
desc

kernelsMemProg ::
  String ->
  UntypedPassState ->
  FutharkM (Prog GPUMem.GPUMem)
kernelsMemProg :: String -> UntypedPassState -> FutharkM (Prog GPUMem)
kernelsMemProg String
_ (GPUMem Prog GPUMem
prog) =
  Prog GPUMem -> FutharkM (Prog GPUMem)
forall a. a -> FutharkM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Prog GPUMem
prog
kernelsMemProg String
name UntypedPassState
rep =
  String -> FutharkM (Prog GPUMem)
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS (String -> FutharkM (Prog GPUMem))
-> String -> FutharkM (Prog GPUMem)
forall a b. (a -> b) -> a -> b
$
    String
"Pass '"
      String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name
      String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"' expects GPUMem representation, but got "
      String -> String -> String
forall a. Semigroup a => a -> a -> a
<> UntypedPassState -> String
forall s. Representation s => s -> String
representation UntypedPassState
rep

soacsProg :: String -> UntypedPassState -> FutharkM (Prog SOACS.SOACS)
soacsProg :: String -> UntypedPassState -> FutharkM (Prog SOACS)
soacsProg String
_ (SOACS Prog SOACS
prog) =
  Prog SOACS -> FutharkM (Prog SOACS)
forall a. a -> FutharkM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Prog SOACS
prog
soacsProg String
name UntypedPassState
rep =
  String -> FutharkM (Prog SOACS)
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS (String -> FutharkM (Prog SOACS))
-> String -> FutharkM (Prog SOACS)
forall a b. (a -> b) -> a -> b
$
    String
"Pass '"
      String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name
      String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"' expects SOACS representation, but got "
      String -> String -> String
forall a. Semigroup a => a -> a -> a
<> UntypedPassState -> String
forall s. Representation s => s -> String
representation UntypedPassState
rep

kernelsProg :: String -> UntypedPassState -> FutharkM (Prog GPU.GPU)
kernelsProg :: String -> UntypedPassState -> FutharkM (Prog GPU)
kernelsProg String
_ (GPU Prog GPU
prog) =
  Prog GPU -> FutharkM (Prog GPU)
forall a. a -> FutharkM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Prog GPU
prog
kernelsProg String
name UntypedPassState
rep =
  String -> FutharkM (Prog GPU)
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS (String -> FutharkM (Prog GPU)) -> String -> FutharkM (Prog GPU)
forall a b. (a -> b) -> a -> b
$
    String
"Pass '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"' expects GPU representation, but got " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> UntypedPassState -> String
forall s. Representation s => s -> String
representation UntypedPassState
rep

seqMemProg :: String -> UntypedPassState -> FutharkM (Prog SeqMem.SeqMem)
seqMemProg :: String -> UntypedPassState -> FutharkM (Prog SeqMem)
seqMemProg String
_ (SeqMem Prog SeqMem
prog) =
  Prog SeqMem -> FutharkM (Prog SeqMem)
forall a. a -> FutharkM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Prog SeqMem
prog
seqMemProg String
name UntypedPassState
rep =
  String -> FutharkM (Prog SeqMem)
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS (String -> FutharkM (Prog SeqMem))
-> String -> FutharkM (Prog SeqMem)
forall a b. (a -> b) -> a -> b
$
    String
"Pass '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"' expects SeqMem representation, but got " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> UntypedPassState -> String
forall s. Representation s => s -> String
representation UntypedPassState
rep

mcProg :: String -> UntypedPassState -> FutharkM (Prog MC.MC)
mcProg :: String -> UntypedPassState -> FutharkM (Prog MC)
mcProg String
_ (MC Prog MC
prog) =
  Prog MC -> FutharkM (Prog MC)
forall a. a -> FutharkM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Prog MC
prog
mcProg String
name UntypedPassState
rep =
  String -> FutharkM (Prog MC)
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS (String -> FutharkM (Prog MC)) -> String -> FutharkM (Prog MC)
forall a b. (a -> b) -> a -> b
$
    String
"Pass " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" expects MC representation, but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ UntypedPassState -> String
forall s. Representation s => s -> String
representation UntypedPassState
rep

mcMemProg :: String -> UntypedPassState -> FutharkM (Prog MCMem.MCMem)
mcMemProg :: String -> UntypedPassState -> FutharkM (Prog MCMem)
mcMemProg String
_ (MCMem Prog MCMem
prog) =
  Prog MCMem -> FutharkM (Prog MCMem)
forall a. a -> FutharkM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Prog MCMem
prog
mcMemProg String
name UntypedPassState
rep =
  String -> FutharkM (Prog MCMem)
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS (String -> FutharkM (Prog MCMem))
-> String -> FutharkM (Prog MCMem)
forall a b. (a -> b) -> a -> b
$
    String
"Pass '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"' expects MCMem representation, but got " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> UntypedPassState -> String
forall s. Representation s => s -> String
representation UntypedPassState
rep

typedPassOption ::
  (Checkable torep) =>
  (String -> UntypedPassState -> FutharkM (Prog fromrep)) ->
  (Prog torep -> UntypedPassState) ->
  Pass fromrep torep ->
  String ->
  FutharkOption
typedPassOption :: forall torep fromrep.
Checkable torep =>
(String -> UntypedPassState -> FutharkM (Prog fromrep))
-> (Prog torep -> UntypedPassState)
-> Pass fromrep torep
-> String
-> FutharkOption
typedPassOption String -> UntypedPassState -> FutharkM (Prog fromrep)
getProg Prog torep -> UntypedPassState
putProg Pass fromrep torep
pass String
short =
  String -> UntypedPass -> String -> [String] -> FutharkOption
passOption (Pass fromrep torep -> String
forall fromrep torep. Pass fromrep torep -> String
passDescription Pass fromrep torep
pass) ((UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState)
-> UntypedPass
UntypedPass UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
perform) String
short [String]
long
  where
    perform :: UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
perform UntypedPassState
s PipelineConfig
config = do
      Prog fromrep
prog <- String -> UntypedPassState -> FutharkM (Prog fromrep)
getProg (Pass fromrep torep -> String
forall fromrep torep. Pass fromrep torep -> String
passName Pass fromrep torep
pass) UntypedPassState
s
      Prog torep -> UntypedPassState
putProg (Prog torep -> UntypedPassState)
-> FutharkM (Prog torep) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
forall fromrep torep.
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (Pass fromrep torep -> Pipeline fromrep torep
forall torep fromrep.
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass Pass fromrep torep
pass) PipelineConfig
config Prog fromrep
prog

    long :: [String]
long = [Pass fromrep torep -> String
forall fromrep torep. Pass fromrep torep -> String
passLongOption Pass fromrep torep
pass]

soacsPassOption :: Pass SOACS.SOACS SOACS.SOACS -> String -> FutharkOption
soacsPassOption :: Pass SOACS SOACS -> String -> FutharkOption
soacsPassOption =
  (String -> UntypedPassState -> FutharkM (Prog SOACS))
-> (Prog SOACS -> UntypedPassState)
-> Pass SOACS SOACS
-> String
-> FutharkOption
forall torep fromrep.
Checkable torep =>
(String -> UntypedPassState -> FutharkM (Prog fromrep))
-> (Prog torep -> UntypedPassState)
-> Pass fromrep torep
-> String
-> FutharkOption
typedPassOption String -> UntypedPassState -> FutharkM (Prog SOACS)
soacsProg Prog SOACS -> UntypedPassState
SOACS

kernelsPassOption ::
  Pass GPU.GPU GPU.GPU ->
  String ->
  FutharkOption
kernelsPassOption :: Pass GPU GPU -> String -> FutharkOption
kernelsPassOption =
  (String -> UntypedPassState -> FutharkM (Prog GPU))
-> (Prog GPU -> UntypedPassState)
-> Pass GPU GPU
-> String
-> FutharkOption
forall torep fromrep.
Checkable torep =>
(String -> UntypedPassState -> FutharkM (Prog fromrep))
-> (Prog torep -> UntypedPassState)
-> Pass fromrep torep
-> String
-> FutharkOption
typedPassOption String -> UntypedPassState -> FutharkM (Prog GPU)
kernelsProg Prog GPU -> UntypedPassState
GPU

mcPassOption ::
  Pass MC.MC MC.MC ->
  String ->
  FutharkOption
mcPassOption :: Pass MC MC -> String -> FutharkOption
mcPassOption =
  (String -> UntypedPassState -> FutharkM (Prog MC))
-> (Prog MC -> UntypedPassState)
-> Pass MC MC
-> String
-> FutharkOption
forall torep fromrep.
Checkable torep =>
(String -> UntypedPassState -> FutharkM (Prog fromrep))
-> (Prog torep -> UntypedPassState)
-> Pass fromrep torep
-> String
-> FutharkOption
typedPassOption String -> UntypedPassState -> FutharkM (Prog MC)
mcProg Prog MC -> UntypedPassState
MC

seqMemPassOption ::
  Pass SeqMem.SeqMem SeqMem.SeqMem ->
  String ->
  FutharkOption
seqMemPassOption :: Pass SeqMem SeqMem -> String -> FutharkOption
seqMemPassOption =
  (String -> UntypedPassState -> FutharkM (Prog SeqMem))
-> (Prog SeqMem -> UntypedPassState)
-> Pass SeqMem SeqMem
-> String
-> FutharkOption
forall torep fromrep.
Checkable torep =>
(String -> UntypedPassState -> FutharkM (Prog fromrep))
-> (Prog torep -> UntypedPassState)
-> Pass fromrep torep
-> String
-> FutharkOption
typedPassOption String -> UntypedPassState -> FutharkM (Prog SeqMem)
seqMemProg Prog SeqMem -> UntypedPassState
SeqMem

mcMemPassOption ::
  Pass MCMem.MCMem MCMem.MCMem ->
  String ->
  FutharkOption
mcMemPassOption :: Pass MCMem MCMem -> String -> FutharkOption
mcMemPassOption =
  (String -> UntypedPassState -> FutharkM (Prog MCMem))
-> (Prog MCMem -> UntypedPassState)
-> Pass MCMem MCMem
-> String
-> FutharkOption
forall torep fromrep.
Checkable torep =>
(String -> UntypedPassState -> FutharkM (Prog fromrep))
-> (Prog torep -> UntypedPassState)
-> Pass fromrep torep
-> String
-> FutharkOption
typedPassOption String -> UntypedPassState -> FutharkM (Prog MCMem)
mcMemProg Prog MCMem -> UntypedPassState
MCMem

kernelsMemPassOption ::
  Pass GPUMem.GPUMem GPUMem.GPUMem ->
  String ->
  FutharkOption
kernelsMemPassOption :: Pass GPUMem GPUMem -> String -> FutharkOption
kernelsMemPassOption =
  (String -> UntypedPassState -> FutharkM (Prog GPUMem))
-> (Prog GPUMem -> UntypedPassState)
-> Pass GPUMem GPUMem
-> String
-> FutharkOption
forall torep fromrep.
Checkable torep =>
(String -> UntypedPassState -> FutharkM (Prog fromrep))
-> (Prog torep -> UntypedPassState)
-> Pass fromrep torep
-> String
-> FutharkOption
typedPassOption String -> UntypedPassState -> FutharkM (Prog GPUMem)
kernelsMemProg Prog GPUMem -> UntypedPassState
GPUMem

simplifyOption :: String -> FutharkOption
simplifyOption :: String -> FutharkOption
simplifyOption String
short =
  String -> UntypedPass -> String -> [String] -> FutharkOption
passOption (Pass SOACS SOACS -> String
forall fromrep torep. Pass fromrep torep -> String
passDescription Pass SOACS SOACS
pass) ((UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState)
-> UntypedPass
UntypedPass UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
perform) String
short [String]
long
  where
    perform :: UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
perform (SOACS Prog SOACS
prog) PipelineConfig
config =
      Prog SOACS -> UntypedPassState
SOACS (Prog SOACS -> UntypedPassState)
-> FutharkM (Prog SOACS) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline SOACS SOACS
-> PipelineConfig -> Prog SOACS -> FutharkM (Prog SOACS)
forall fromrep torep.
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (Pass SOACS SOACS -> Pipeline SOACS SOACS
forall torep fromrep.
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass Pass SOACS SOACS
simplifySOACS) PipelineConfig
config Prog SOACS
prog
    perform (GPU Prog GPU
prog) PipelineConfig
config =
      Prog GPU -> UntypedPassState
GPU (Prog GPU -> UntypedPassState)
-> FutharkM (Prog GPU) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline GPU GPU
-> PipelineConfig -> Prog GPU -> FutharkM (Prog GPU)
forall fromrep torep.
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (Pass GPU GPU -> Pipeline GPU GPU
forall torep fromrep.
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass Pass GPU GPU
simplifyGPU) PipelineConfig
config Prog GPU
prog
    perform (MC Prog MC
prog) PipelineConfig
config =
      Prog MC -> UntypedPassState
MC (Prog MC -> UntypedPassState)
-> FutharkM (Prog MC) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline MC MC -> PipelineConfig -> Prog MC -> FutharkM (Prog MC)
forall fromrep torep.
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (Pass MC MC -> Pipeline MC MC
forall torep fromrep.
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass Pass MC MC
simplifyMC) PipelineConfig
config Prog MC
prog
    perform (Seq Prog Seq
prog) PipelineConfig
config =
      Prog Seq -> UntypedPassState
Seq (Prog Seq -> UntypedPassState)
-> FutharkM (Prog Seq) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline Seq Seq
-> PipelineConfig -> Prog Seq -> FutharkM (Prog Seq)
forall fromrep torep.
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (Pass Seq Seq -> Pipeline Seq Seq
forall torep fromrep.
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass Pass Seq Seq
simplifySeq) PipelineConfig
config Prog Seq
prog
    perform (SeqMem Prog SeqMem
prog) PipelineConfig
config =
      Prog SeqMem -> UntypedPassState
SeqMem (Prog SeqMem -> UntypedPassState)
-> FutharkM (Prog SeqMem) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline SeqMem SeqMem
-> PipelineConfig -> Prog SeqMem -> FutharkM (Prog SeqMem)
forall fromrep torep.
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (Pass SeqMem SeqMem -> Pipeline SeqMem SeqMem
forall torep fromrep.
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass Pass SeqMem SeqMem
simplifySeqMem) PipelineConfig
config Prog SeqMem
prog
    perform (GPUMem Prog GPUMem
prog) PipelineConfig
config =
      Prog GPUMem -> UntypedPassState
GPUMem (Prog GPUMem -> UntypedPassState)
-> FutharkM (Prog GPUMem) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline GPUMem GPUMem
-> PipelineConfig -> Prog GPUMem -> FutharkM (Prog GPUMem)
forall fromrep torep.
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (Pass GPUMem GPUMem -> Pipeline GPUMem GPUMem
forall torep fromrep.
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass Pass GPUMem GPUMem
simplifyGPUMem) PipelineConfig
config Prog GPUMem
prog
    perform (MCMem Prog MCMem
prog) PipelineConfig
config =
      Prog MCMem -> UntypedPassState
MCMem (Prog MCMem -> UntypedPassState)
-> FutharkM (Prog MCMem) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline MCMem MCMem
-> PipelineConfig -> Prog MCMem -> FutharkM (Prog MCMem)
forall fromrep torep.
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (Pass MCMem MCMem -> Pipeline MCMem MCMem
forall torep fromrep.
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass Pass MCMem MCMem
simplifyMCMem) PipelineConfig
config Prog MCMem
prog

    long :: [String]
long = [Pass SOACS SOACS -> String
forall fromrep torep. Pass fromrep torep -> String
passLongOption Pass SOACS SOACS
pass]
    pass :: Pass SOACS SOACS
pass = Pass SOACS SOACS
simplifySOACS

allocateOption :: String -> FutharkOption
allocateOption :: String -> FutharkOption
allocateOption String
short =
  String -> UntypedPass -> String -> [String] -> FutharkOption
passOption (Pass Seq SeqMem -> String
forall fromrep torep. Pass fromrep torep -> String
passDescription Pass Seq SeqMem
pass) ((UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState)
-> UntypedPass
UntypedPass UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
perform) String
short [String]
long
  where
    perform :: UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
perform (GPU Prog GPU
prog) PipelineConfig
config =
      Prog GPUMem -> UntypedPassState
GPUMem
        (Prog GPUMem -> UntypedPassState)
-> FutharkM (Prog GPUMem) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline GPU GPUMem
-> PipelineConfig -> Prog GPU -> FutharkM (Prog GPUMem)
forall fromrep torep.
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (Pass GPU GPUMem -> Pipeline GPU GPUMem
forall torep fromrep.
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass Pass GPU GPUMem
GPU.explicitAllocations) PipelineConfig
config Prog GPU
prog
    perform (Seq Prog Seq
prog) PipelineConfig
config =
      Prog SeqMem -> UntypedPassState
SeqMem
        (Prog SeqMem -> UntypedPassState)
-> FutharkM (Prog SeqMem) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline Seq SeqMem
-> PipelineConfig -> Prog Seq -> FutharkM (Prog SeqMem)
forall fromrep torep.
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (Pass Seq SeqMem -> Pipeline Seq SeqMem
forall torep fromrep.
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass Pass Seq SeqMem
Seq.explicitAllocations) PipelineConfig
config Prog Seq
prog
    perform (MC Prog MC
prog) PipelineConfig
config =
      Prog MCMem -> UntypedPassState
MCMem
        (Prog MCMem -> UntypedPassState)
-> FutharkM (Prog MCMem) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline MC MCMem
-> PipelineConfig -> Prog MC -> FutharkM (Prog MCMem)
forall fromrep torep.
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (Pass MC MCMem -> Pipeline MC MCMem
forall torep fromrep.
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass Pass MC MCMem
MC.explicitAllocations) PipelineConfig
config Prog MC
prog
    perform UntypedPassState
s PipelineConfig
_ =
      String -> FutharkM UntypedPassState
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS (String -> FutharkM UntypedPassState)
-> String -> FutharkM UntypedPassState
forall a b. (a -> b) -> a -> b
$
        String
"Pass '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Pass Seq SeqMem -> String
forall fromrep torep. Pass fromrep torep -> String
passDescription Pass Seq SeqMem
pass String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"' cannot operate on " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> UntypedPassState -> String
forall s. Representation s => s -> String
representation UntypedPassState
s

    long :: [String]
long = [Pass Seq SeqMem -> String
forall fromrep torep. Pass fromrep torep -> String
passLongOption Pass Seq SeqMem
pass]
    pass :: Pass Seq SeqMem
pass = Pass Seq SeqMem
Seq.explicitAllocations

cseOption :: String -> FutharkOption
cseOption :: String -> FutharkOption
cseOption String
short =
  String -> UntypedPass -> String -> [String] -> FutharkOption
passOption (Pass SOACS SOACS -> String
forall fromrep torep. Pass fromrep torep -> String
passDescription Pass SOACS SOACS
pass) ((UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState)
-> UntypedPass
UntypedPass UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
perform) String
short [String]
long
  where
    perform :: UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
perform (SOACS Prog SOACS
prog) PipelineConfig
config =
      Prog SOACS -> UntypedPassState
SOACS (Prog SOACS -> UntypedPassState)
-> FutharkM (Prog SOACS) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline SOACS SOACS
-> PipelineConfig -> Prog SOACS -> FutharkM (Prog SOACS)
forall fromrep torep.
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (Pass SOACS SOACS -> Pipeline SOACS SOACS
forall torep fromrep.
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass (Pass SOACS SOACS -> Pipeline SOACS SOACS)
-> Pass SOACS SOACS -> Pipeline SOACS SOACS
forall a b. (a -> b) -> a -> b
$ Bool -> Pass SOACS SOACS
forall rep.
(AliasableRep rep, CSEInOp (Op (Aliases rep))) =>
Bool -> Pass rep rep
performCSE Bool
True) PipelineConfig
config Prog SOACS
prog
    perform (GPU Prog GPU
prog) PipelineConfig
config =
      Prog GPU -> UntypedPassState
GPU (Prog GPU -> UntypedPassState)
-> FutharkM (Prog GPU) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline GPU GPU
-> PipelineConfig -> Prog GPU -> FutharkM (Prog GPU)
forall fromrep torep.
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (Pass GPU GPU -> Pipeline GPU GPU
forall torep fromrep.
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass (Pass GPU GPU -> Pipeline GPU GPU)
-> Pass GPU GPU -> Pipeline GPU GPU
forall a b. (a -> b) -> a -> b
$ Bool -> Pass GPU GPU
forall rep.
(AliasableRep rep, CSEInOp (Op (Aliases rep))) =>
Bool -> Pass rep rep
performCSE Bool
True) PipelineConfig
config Prog GPU
prog
    perform (MC Prog MC
prog) PipelineConfig
config =
      Prog MC -> UntypedPassState
MC (Prog MC -> UntypedPassState)
-> FutharkM (Prog MC) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline MC MC -> PipelineConfig -> Prog MC -> FutharkM (Prog MC)
forall fromrep torep.
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (Pass MC MC -> Pipeline MC MC
forall torep fromrep.
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass (Pass MC MC -> Pipeline MC MC) -> Pass MC MC -> Pipeline MC MC
forall a b. (a -> b) -> a -> b
$ Bool -> Pass MC MC
forall rep.
(AliasableRep rep, CSEInOp (Op (Aliases rep))) =>
Bool -> Pass rep rep
performCSE Bool
True) PipelineConfig
config Prog MC
prog
    perform (Seq Prog Seq
prog) PipelineConfig
config =
      Prog Seq -> UntypedPassState
Seq (Prog Seq -> UntypedPassState)
-> FutharkM (Prog Seq) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline Seq Seq
-> PipelineConfig -> Prog Seq -> FutharkM (Prog Seq)
forall fromrep torep.
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (Pass Seq Seq -> Pipeline Seq Seq
forall torep fromrep.
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass (Pass Seq Seq -> Pipeline Seq Seq)
-> Pass Seq Seq -> Pipeline Seq Seq
forall a b. (a -> b) -> a -> b
$ Bool -> Pass Seq Seq
forall rep.
(AliasableRep rep, CSEInOp (Op (Aliases rep))) =>
Bool -> Pass rep rep
performCSE Bool
True) PipelineConfig
config Prog Seq
prog
    perform (SeqMem Prog SeqMem
prog) PipelineConfig
config =
      Prog SeqMem -> UntypedPassState
SeqMem (Prog SeqMem -> UntypedPassState)
-> FutharkM (Prog SeqMem) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline SeqMem SeqMem
-> PipelineConfig -> Prog SeqMem -> FutharkM (Prog SeqMem)
forall fromrep torep.
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (Pass SeqMem SeqMem -> Pipeline SeqMem SeqMem
forall torep fromrep.
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass (Pass SeqMem SeqMem -> Pipeline SeqMem SeqMem)
-> Pass SeqMem SeqMem -> Pipeline SeqMem SeqMem
forall a b. (a -> b) -> a -> b
$ Bool -> Pass SeqMem SeqMem
forall rep.
(AliasableRep rep, CSEInOp (Op (Aliases rep))) =>
Bool -> Pass rep rep
performCSE Bool
False) PipelineConfig
config Prog SeqMem
prog
    perform (GPUMem Prog GPUMem
prog) PipelineConfig
config =
      Prog GPUMem -> UntypedPassState
GPUMem (Prog GPUMem -> UntypedPassState)
-> FutharkM (Prog GPUMem) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline GPUMem GPUMem
-> PipelineConfig -> Prog GPUMem -> FutharkM (Prog GPUMem)
forall fromrep torep.
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (Pass GPUMem GPUMem -> Pipeline GPUMem GPUMem
forall torep fromrep.
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass (Pass GPUMem GPUMem -> Pipeline GPUMem GPUMem)
-> Pass GPUMem GPUMem -> Pipeline GPUMem GPUMem
forall a b. (a -> b) -> a -> b
$ Bool -> Pass GPUMem GPUMem
forall rep.
(AliasableRep rep, CSEInOp (Op (Aliases rep))) =>
Bool -> Pass rep rep
performCSE Bool
False) PipelineConfig
config Prog GPUMem
prog
    perform (MCMem Prog MCMem
prog) PipelineConfig
config =
      Prog MCMem -> UntypedPassState
MCMem (Prog MCMem -> UntypedPassState)
-> FutharkM (Prog MCMem) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline MCMem MCMem
-> PipelineConfig -> Prog MCMem -> FutharkM (Prog MCMem)
forall fromrep torep.
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (Pass MCMem MCMem -> Pipeline MCMem MCMem
forall torep fromrep.
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass (Pass MCMem MCMem -> Pipeline MCMem MCMem)
-> Pass MCMem MCMem -> Pipeline MCMem MCMem
forall a b. (a -> b) -> a -> b
$ Bool -> Pass MCMem MCMem
forall rep.
(AliasableRep rep, CSEInOp (Op (Aliases rep))) =>
Bool -> Pass rep rep
performCSE Bool
False) PipelineConfig
config Prog MCMem
prog

    long :: [String]
long = [Pass SOACS SOACS -> String
forall fromrep torep. Pass fromrep torep -> String
passLongOption Pass SOACS SOACS
pass]
    pass :: Pass SOACS SOACS
pass = Bool -> Pass SOACS SOACS
forall rep.
(AliasableRep rep, CSEInOp (Op (Aliases rep))) =>
Bool -> Pass rep rep
performCSE Bool
True :: Pass SOACS.SOACS SOACS.SOACS

sinkOption :: String -> FutharkOption
sinkOption :: String -> FutharkOption
sinkOption String
short =
  String -> UntypedPass -> String -> [String] -> FutharkOption
passOption (Pass GPU GPU -> String
forall fromrep torep. Pass fromrep torep -> String
passDescription Pass GPU GPU
pass) ((UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState)
-> UntypedPass
UntypedPass UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
perform) String
short [String]
long
  where
    perform :: UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
perform (GPU Prog GPU
prog) PipelineConfig
config =
      Prog GPU -> UntypedPassState
GPU (Prog GPU -> UntypedPassState)
-> FutharkM (Prog GPU) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline GPU GPU
-> PipelineConfig -> Prog GPU -> FutharkM (Prog GPU)
forall fromrep torep.
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (Pass GPU GPU -> Pipeline GPU GPU
forall torep fromrep.
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass Pass GPU GPU
sinkGPU) PipelineConfig
config Prog GPU
prog
    perform (MC Prog MC
prog) PipelineConfig
config =
      Prog MC -> UntypedPassState
MC (Prog MC -> UntypedPassState)
-> FutharkM (Prog MC) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline MC MC -> PipelineConfig -> Prog MC -> FutharkM (Prog MC)
forall fromrep torep.
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (Pass MC MC -> Pipeline MC MC
forall torep fromrep.
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass Pass MC MC
sinkMC) PipelineConfig
config Prog MC
prog
    perform UntypedPassState
s PipelineConfig
_ =
      String -> FutharkM UntypedPassState
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS (String -> FutharkM UntypedPassState)
-> String -> FutharkM UntypedPassState
forall a b. (a -> b) -> a -> b
$
        String
"Pass '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Pass GPU GPU -> String
forall fromrep torep. Pass fromrep torep -> String
passDescription Pass GPU GPU
pass String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' cannot operate on " String -> String -> String
forall a. [a] -> [a] -> [a]
++ UntypedPassState -> String
forall s. Representation s => s -> String
representation UntypedPassState
s

    long :: [String]
long = [Pass GPU GPU -> String
forall fromrep torep. Pass fromrep torep -> String
passLongOption Pass GPU GPU
pass]
    pass :: Pass GPU GPU
pass = Pass GPU GPU
sinkGPU

pipelineOption ::
  (UntypedPassState -> Maybe (Prog fromrep)) ->
  String ->
  (Prog torep -> UntypedPassState) ->
  String ->
  Pipeline fromrep torep ->
  String ->
  [String] ->
  FutharkOption
pipelineOption :: forall fromrep torep.
(UntypedPassState -> Maybe (Prog fromrep))
-> String
-> (Prog torep -> UntypedPassState)
-> String
-> Pipeline fromrep torep
-> String
-> [String]
-> FutharkOption
pipelineOption UntypedPassState -> Maybe (Prog fromrep)
getprog String
repdesc Prog torep -> UntypedPassState
repf String
desc Pipeline fromrep torep
pipeline =
  String -> UntypedPass -> String -> [String] -> FutharkOption
passOption String
desc (UntypedPass -> String -> [String] -> FutharkOption)
-> UntypedPass -> String -> [String] -> FutharkOption
forall a b. (a -> b) -> a -> b
$ (UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState)
-> UntypedPass
UntypedPass UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
pipelinePass
  where
    pipelinePass :: UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
pipelinePass UntypedPassState
rep PipelineConfig
config =
      case UntypedPassState -> Maybe (Prog fromrep)
getprog UntypedPassState
rep of
        Just Prog fromrep
prog ->
          Prog torep -> UntypedPassState
repf (Prog torep -> UntypedPassState)
-> FutharkM (Prog torep) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
forall fromrep torep.
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline Pipeline fromrep torep
pipeline PipelineConfig
config Prog fromrep
prog
        Maybe (Prog fromrep)
Nothing ->
          String -> FutharkM UntypedPassState
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS (String -> FutharkM UntypedPassState)
-> String -> FutharkM UntypedPassState
forall a b. (a -> b) -> a -> b
$
            String
"Expected "
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
repdesc
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" representation, but got "
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ UntypedPassState -> String
forall s. Representation s => s -> String
representation UntypedPassState
rep

soacsPipelineOption ::
  String ->
  Pipeline SOACS.SOACS SOACS.SOACS ->
  String ->
  [String] ->
  FutharkOption
soacsPipelineOption :: String
-> Pipeline SOACS SOACS -> String -> [String] -> FutharkOption
soacsPipelineOption = (UntypedPassState -> Maybe (Prog SOACS))
-> String
-> (Prog SOACS -> UntypedPassState)
-> String
-> Pipeline SOACS SOACS
-> String
-> [String]
-> FutharkOption
forall fromrep torep.
(UntypedPassState -> Maybe (Prog fromrep))
-> String
-> (Prog torep -> UntypedPassState)
-> String
-> Pipeline fromrep torep
-> String
-> [String]
-> FutharkOption
pipelineOption UntypedPassState -> Maybe (Prog SOACS)
getSOACSProg String
"SOACS" Prog SOACS -> UntypedPassState
SOACS

unstreamOption :: String -> FutharkOption
unstreamOption :: String -> FutharkOption
unstreamOption String
short =
  String -> UntypedPass -> String -> [String] -> FutharkOption
passOption (Pass GPU GPU -> String
forall fromrep torep. Pass fromrep torep -> String
passDescription Pass GPU GPU
pass) ((UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState)
-> UntypedPass
UntypedPass UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
perform) String
short [String]
long
  where
    perform :: UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
perform (GPU Prog GPU
prog) PipelineConfig
config =
      Prog GPU -> UntypedPassState
GPU
        (Prog GPU -> UntypedPassState)
-> FutharkM (Prog GPU) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline GPU GPU
-> PipelineConfig -> Prog GPU -> FutharkM (Prog GPU)
forall fromrep torep.
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (Pass GPU GPU -> Pipeline GPU GPU
forall torep fromrep.
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass Pass GPU GPU
unstreamGPU) PipelineConfig
config Prog GPU
prog
    perform (MC Prog MC
prog) PipelineConfig
config =
      Prog MC -> UntypedPassState
MC
        (Prog MC -> UntypedPassState)
-> FutharkM (Prog MC) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline MC MC -> PipelineConfig -> Prog MC -> FutharkM (Prog MC)
forall fromrep torep.
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (Pass MC MC -> Pipeline MC MC
forall torep fromrep.
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass Pass MC MC
unstreamMC) PipelineConfig
config Prog MC
prog
    perform UntypedPassState
s PipelineConfig
_ =
      String -> FutharkM UntypedPassState
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS (String -> FutharkM UntypedPassState)
-> String -> FutharkM UntypedPassState
forall a b. (a -> b) -> a -> b
$
        String
"Pass '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Pass GPU GPU -> String
forall fromrep torep. Pass fromrep torep -> String
passDescription Pass GPU GPU
pass String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' cannot operate on " String -> String -> String
forall a. [a] -> [a] -> [a]
++ UntypedPassState -> String
forall s. Representation s => s -> String
representation UntypedPassState
s

    long :: [String]
long = [Pass GPU GPU -> String
forall fromrep torep. Pass fromrep torep -> String
passLongOption Pass GPU GPU
pass]
    pass :: Pass GPU GPU
pass = Pass GPU GPU
unstreamGPU

commandLineOptions :: [FutharkOption]
commandLineOptions :: [FutharkOption]
commandLineOptions =
  [ String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      String
"v"
      [String
"verbose"]
      ((Maybe String -> Either (IO ()) (Config -> Config))
-> String -> ArgDescr (Either (IO ()) (Config -> Config))
forall a. (Maybe String -> a) -> String -> ArgDescr a
OptArg ((Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Maybe String -> Config -> Config)
-> Maybe String
-> Either (IO ()) (Config -> Config)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FutharkConfig -> FutharkConfig) -> Config -> Config
changeFutharkConfig ((FutharkConfig -> FutharkConfig) -> Config -> Config)
-> (Maybe String -> FutharkConfig -> FutharkConfig)
-> Maybe String
-> Config
-> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> FutharkConfig -> FutharkConfig
incVerbosity) String
"FILE")
      String
"Print verbose output on standard error; wrong program to FILE.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"Werror"]
      (Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ (FutharkConfig -> FutharkConfig) -> Config -> Config
changeFutharkConfig ((FutharkConfig -> FutharkConfig) -> Config -> Config)
-> (FutharkConfig -> FutharkConfig) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ \FutharkConfig
opts -> FutharkConfig
opts {futharkWerror = True})
      String
"Treat warnings as errors.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      String
"w"
      []
      (Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ (FutharkConfig -> FutharkConfig) -> Config -> Config
changeFutharkConfig ((FutharkConfig -> FutharkConfig) -> Config -> Config)
-> (FutharkConfig -> FutharkConfig) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ \FutharkConfig
opts -> FutharkConfig
opts {futharkWarn = False})
      String
"Disable all warnings.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      String
"t"
      [String
"type-check"]
      ( Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$
          (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts ->
            Config
opts {futharkPipeline = TypeCheck}
      )
      String
"Print on standard output the type-checked program.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"no-check"]
      ( Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$
          (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$
            (FutharkConfig -> FutharkConfig) -> Config -> Config
changeFutharkConfig ((FutharkConfig -> FutharkConfig) -> Config -> Config)
-> (FutharkConfig -> FutharkConfig) -> Config -> Config
forall a b. (a -> b) -> a -> b
$
              \FutharkConfig
opts -> FutharkConfig
opts {futharkTypeCheck = False}
      )
      String
"Disable type-checking.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"pretty-print"]
      ( Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$
          (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts ->
            Config
opts {futharkPipeline = PrettyPrint}
      )
      String
"Parse and prettyString-print the AST of the given program.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"backend"]
      ( (String -> Either (IO ()) (Config -> Config))
-> String -> ArgDescr (Either (IO ()) (Config -> Config))
forall a. (String -> a) -> String -> ArgDescr a
ReqArg
          ( \String
arg -> do
              UntypedAction
action <- case String
arg of
                String
"c" -> UntypedAction -> Either (IO ()) UntypedAction
forall a b. b -> Either a b
Right (UntypedAction -> Either (IO ()) UntypedAction)
-> UntypedAction -> Either (IO ()) UntypedAction
forall a b. (a -> b) -> a -> b
$ BackendAction SeqMem -> UntypedAction
SeqMemAction BackendAction SeqMem
compileCAction
                String
"multicore" -> UntypedAction -> Either (IO ()) UntypedAction
forall a b. b -> Either a b
Right (UntypedAction -> Either (IO ()) UntypedAction)
-> UntypedAction -> Either (IO ()) UntypedAction
forall a b. (a -> b) -> a -> b
$ BackendAction MCMem -> UntypedAction
MCMemAction BackendAction MCMem
compileMulticoreAction
                String
"opencl" -> UntypedAction -> Either (IO ()) UntypedAction
forall a b. b -> Either a b
Right (UntypedAction -> Either (IO ()) UntypedAction)
-> UntypedAction -> Either (IO ()) UntypedAction
forall a b. (a -> b) -> a -> b
$ BackendAction GPUMem -> UntypedAction
GPUMemAction BackendAction GPUMem
compileOpenCLAction
                String
"hip" -> UntypedAction -> Either (IO ()) UntypedAction
forall a b. b -> Either a b
Right (UntypedAction -> Either (IO ()) UntypedAction)
-> UntypedAction -> Either (IO ()) UntypedAction
forall a b. (a -> b) -> a -> b
$ BackendAction GPUMem -> UntypedAction
GPUMemAction BackendAction GPUMem
compileHIPAction
                String
"cuda" -> UntypedAction -> Either (IO ()) UntypedAction
forall a b. b -> Either a b
Right (UntypedAction -> Either (IO ()) UntypedAction)
-> UntypedAction -> Either (IO ()) UntypedAction
forall a b. (a -> b) -> a -> b
$ BackendAction GPUMem -> UntypedAction
GPUMemAction BackendAction GPUMem
compileCUDAAction
                String
"wasm" -> UntypedAction -> Either (IO ()) UntypedAction
forall a b. b -> Either a b
Right (UntypedAction -> Either (IO ()) UntypedAction)
-> UntypedAction -> Either (IO ()) UntypedAction
forall a b. (a -> b) -> a -> b
$ BackendAction SeqMem -> UntypedAction
SeqMemAction BackendAction SeqMem
compileCtoWASMAction
                String
"wasm-multicore" -> UntypedAction -> Either (IO ()) UntypedAction
forall a b. b -> Either a b
Right (UntypedAction -> Either (IO ()) UntypedAction)
-> UntypedAction -> Either (IO ()) UntypedAction
forall a b. (a -> b) -> a -> b
$ BackendAction MCMem -> UntypedAction
MCMemAction BackendAction MCMem
compileMulticoreToWASMAction
                String
"ispc" -> UntypedAction -> Either (IO ()) UntypedAction
forall a b. b -> Either a b
Right (UntypedAction -> Either (IO ()) UntypedAction)
-> UntypedAction -> Either (IO ()) UntypedAction
forall a b. (a -> b) -> a -> b
$ BackendAction MCMem -> UntypedAction
MCMemAction BackendAction MCMem
compileMulticoreToISPCAction
                String
"python" -> UntypedAction -> Either (IO ()) UntypedAction
forall a b. b -> Either a b
Right (UntypedAction -> Either (IO ()) UntypedAction)
-> UntypedAction -> Either (IO ()) UntypedAction
forall a b. (a -> b) -> a -> b
$ BackendAction SeqMem -> UntypedAction
SeqMemAction BackendAction SeqMem
compilePythonAction
                String
"pyopencl" -> UntypedAction -> Either (IO ()) UntypedAction
forall a b. b -> Either a b
Right (UntypedAction -> Either (IO ()) UntypedAction)
-> UntypedAction -> Either (IO ()) UntypedAction
forall a b. (a -> b) -> a -> b
$ BackendAction GPUMem -> UntypedAction
GPUMemAction BackendAction GPUMem
compilePyOpenCLAction
                String
_ -> IO () -> Either (IO ()) UntypedAction
forall a b. a -> Either a b
Left (IO () -> Either (IO ()) UntypedAction)
-> IO () -> Either (IO ()) UntypedAction
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Invalid backend: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
arg

              (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkAction = action}
          )
          String
"c|multicore|opencl|cuda|hip|python|pyopencl"
      )
      String
"Run this compiler backend on pipeline result.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"compile-imp-seq"]
      ( Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$
          (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts ->
            Config
opts {futharkAction = SeqMemAction $ \FutharkConfig
_ CompilerMode
_ String
_ -> Action SeqMem
impCodeGenAction}
      )
      String
"Translate pipeline result to ImpSequential and write it on stdout.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"compile-imp-gpu"]
      ( Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$
          (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts ->
            Config
opts {futharkAction = GPUMemAction $ \FutharkConfig
_ CompilerMode
_ String
_ -> Action GPUMem
kernelImpCodeGenAction}
      )
      String
"Translate pipeline result to ImpGPU and write it on stdout.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"compile-imp-multicore"]
      ( Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$
          (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts ->
            Config
opts {futharkAction = MCMemAction $ \FutharkConfig
_ CompilerMode
_ String
_ -> Action MCMem
multicoreImpCodeGenAction}
      )
      String
"Translate pipeline result to ImpMC write it on stdout.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      String
"p"
      [String
"print"]
      (Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkAction = PolyAction printAction})
      String
"Print the resulting IR (default action).",
    String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"print-aliases"]
      (Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkAction = PolyAction printAliasesAction})
      String
"Print the resulting IR with aliases.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"fusion-graph"]
      (Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkAction = SOACSAction printFusionGraph})
      String
"Print fusion graph.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"print-last-use-gpu"]
      ( Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$
          (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts ->
            Config
opts {futharkAction = GPUMemAction $ \FutharkConfig
_ CompilerMode
_ String
_ -> Action GPUMem
printLastUseGPU}
      )
      String
"Print last use information ss.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"print-interference-gpu"]
      ( Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$
          (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts ->
            Config
opts {futharkAction = GPUMemAction $ \FutharkConfig
_ CompilerMode
_ String
_ -> Action GPUMem
printInterferenceGPU}
      )
      String
"Print interference information.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"print-mem-alias-gpu"]
      ( Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$
          (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts ->
            Config
opts {futharkAction = GPUMemAction $ \FutharkConfig
_ CompilerMode
_ String
_ -> Action GPUMem
printMemAliasGPU}
      )
      String
"Print memory alias information.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      String
"z"
      [String
"memory-access-pattern"]
      (Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkAction = PolyAction printMemoryAccessAnalysis})
      String
"Print the result of analysing memory access patterns. Currently only for --gpu --mc.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"call-graph"]
      (Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkAction = SOACSAction callGraphAction})
      String
"Print the resulting call graph.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      String
"m"
      [String
"metrics"]
      (Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkAction = PolyAction metricsAction})
      String
"Print AST metrics of the resulting internal representation on standard output.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"defunctorise"]
      (Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkPipeline = Defunctorise})
      String
"Partially evaluate all module constructs and print the residual program.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"normalise"]
      (Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkPipeline = FullNormalise})
      String
"Fully normalise the program.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"monomorphise"]
      (Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkPipeline = Monomorphise})
      String
"Monomorphise the program.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"lift-lambdas"]
      (Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkPipeline = LiftLambdas})
      String
"Lambda-lift the program.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"defunctionalise"]
      (Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkPipeline = Defunctionalise})
      String
"Defunctionalise the program.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"ast"]
      (Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkPrintAST = True})
      String
"Output ASTs instead of prettyprinted programs.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"safe"]
      (Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ (FutharkConfig -> FutharkConfig) -> Config -> Config
changeFutharkConfig ((FutharkConfig -> FutharkConfig) -> Config -> Config)
-> (FutharkConfig -> FutharkConfig) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ \FutharkConfig
opts -> FutharkConfig
opts {futharkSafe = True})
      String
"Ignore 'unsafe'.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"entry-points"]
      ( (String -> Either (IO ()) (Config -> Config))
-> String -> ArgDescr (Either (IO ()) (Config -> Config))
forall a. (String -> a) -> String -> ArgDescr a
ReqArg
          ( \String
arg -> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$
              (FutharkConfig -> FutharkConfig) -> Config -> Config
changeFutharkConfig ((FutharkConfig -> FutharkConfig) -> Config -> Config)
-> (FutharkConfig -> FutharkConfig) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ \FutharkConfig
opts ->
                FutharkConfig
opts
                  { futharkEntryPoints = nameFromString arg : futharkEntryPoints opts
                  }
          )
          String
"NAME"
      )
      String
"Treat this function as an additional entry point.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"library"]
      (Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkCompilerMode = ToLibrary})
      String
"Generate a library instead of an executable.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"executable"]
      (Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkCompilerMode = ToExecutable})
      String
"Generate an executable instead of a library (set by default).",
    String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"server"]
      (Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkCompilerMode = ToServer})
      String
"Generate a server executable.",
    (String -> UntypedPassState -> FutharkM (Prog SOACS))
-> (Prog Seq -> UntypedPassState)
-> Pass SOACS Seq
-> String
-> FutharkOption
forall torep fromrep.
Checkable torep =>
(String -> UntypedPassState -> FutharkM (Prog fromrep))
-> (Prog torep -> UntypedPassState)
-> Pass fromrep torep
-> String
-> FutharkOption
typedPassOption String -> UntypedPassState -> FutharkM (Prog SOACS)
soacsProg Prog Seq -> UntypedPassState
Seq Pass SOACS Seq
forall rep. FirstOrderRep rep => Pass SOACS rep
firstOrderTransform String
"f",
    Pass SOACS SOACS -> String -> FutharkOption
soacsPassOption Pass SOACS SOACS
fuseSOACs String
"o",
    Pass SOACS SOACS -> String -> FutharkOption
soacsPassOption Pass SOACS SOACS
inlineAggressively [],
    Pass SOACS SOACS -> String -> FutharkOption
soacsPassOption Pass SOACS SOACS
inlineConservatively [],
    Pass SOACS SOACS -> String -> FutharkOption
soacsPassOption Pass SOACS SOACS
removeDeadFunctions [],
    Pass SOACS SOACS -> String -> FutharkOption
soacsPassOption Pass SOACS SOACS
applyAD [],
    Pass SOACS SOACS -> String -> FutharkOption
soacsPassOption Pass SOACS SOACS
applyADInnermost [],
    Pass GPU GPU -> String -> FutharkOption
kernelsPassOption Pass GPU GPU
optimiseArrayLayoutGPU [],
    Pass MC MC -> String -> FutharkOption
mcPassOption Pass MC MC
optimiseArrayLayoutMC [],
    Pass GPU GPU -> String -> FutharkOption
kernelsPassOption Pass GPU GPU
optimiseGenRed [],
    Pass GPU GPU -> String -> FutharkOption
kernelsPassOption Pass GPU GPU
tileLoops [],
    Pass GPU GPU -> String -> FutharkOption
kernelsPassOption Pass GPU GPU
histAccsGPU [],
    String -> FutharkOption
unstreamOption [],
    String -> FutharkOption
sinkOption [],
    Pass GPU GPU -> String -> FutharkOption
kernelsPassOption Pass GPU GPU
reduceDeviceSyncs [],
    (String -> UntypedPassState -> FutharkM (Prog SOACS))
-> (Prog GPU -> UntypedPassState)
-> Pass SOACS GPU
-> String
-> FutharkOption
forall torep fromrep.
Checkable torep =>
(String -> UntypedPassState -> FutharkM (Prog fromrep))
-> (Prog torep -> UntypedPassState)
-> Pass fromrep torep
-> String
-> FutharkOption
typedPassOption String -> UntypedPassState -> FutharkM (Prog SOACS)
soacsProg Prog GPU -> UntypedPassState
GPU Pass SOACS GPU
extractKernels [],
    (String -> UntypedPassState -> FutharkM (Prog SOACS))
-> (Prog MC -> UntypedPassState)
-> Pass SOACS MC
-> String
-> FutharkOption
forall torep fromrep.
Checkable torep =>
(String -> UntypedPassState -> FutharkM (Prog fromrep))
-> (Prog torep -> UntypedPassState)
-> Pass fromrep torep
-> String
-> FutharkOption
typedPassOption String -> UntypedPassState -> FutharkM (Prog SOACS)
soacsProg Prog MC -> UntypedPassState
MC Pass SOACS MC
extractMulticore [],
    String -> FutharkOption
allocateOption String
"a",
    Pass GPUMem GPUMem -> String -> FutharkOption
kernelsMemPassOption Pass GPUMem GPUMem
doubleBufferGPU [],
    Pass MCMem MCMem -> String -> FutharkOption
mcMemPassOption Pass MCMem MCMem
doubleBufferMC [],
    Pass GPUMem GPUMem -> String -> FutharkOption
kernelsMemPassOption Pass GPUMem GPUMem
expandAllocations [],
    Pass GPUMem GPUMem -> String -> FutharkOption
kernelsMemPassOption Pass GPUMem GPUMem
MemoryBlockMerging.optimise [],
    Pass SeqMem SeqMem -> String -> FutharkOption
seqMemPassOption Pass SeqMem SeqMem
LiftAllocations.liftAllocationsSeqMem [],
    Pass GPUMem GPUMem -> String -> FutharkOption
kernelsMemPassOption Pass GPUMem GPUMem
LiftAllocations.liftAllocationsGPUMem [],
    Pass SeqMem SeqMem -> String -> FutharkOption
seqMemPassOption Pass SeqMem SeqMem
LowerAllocations.lowerAllocationsSeqMem [],
    Pass GPUMem GPUMem -> String -> FutharkOption
kernelsMemPassOption Pass GPUMem GPUMem
LowerAllocations.lowerAllocationsGPUMem [],
    Pass SeqMem SeqMem -> String -> FutharkOption
seqMemPassOption Pass SeqMem SeqMem
ArrayShortCircuiting.optimiseSeqMem [],
    Pass MCMem MCMem -> String -> FutharkOption
mcMemPassOption Pass MCMem MCMem
ArrayShortCircuiting.optimiseMCMem [],
    Pass GPUMem GPUMem -> String -> FutharkOption
kernelsMemPassOption Pass GPUMem GPUMem
ArrayShortCircuiting.optimiseGPUMem [],
    String -> FutharkOption
cseOption [],
    String -> FutharkOption
simplifyOption String
"e",
    String
-> Pipeline SOACS SOACS -> String -> [String] -> FutharkOption
soacsPipelineOption
      String
"Run the default optimised pipeline"
      Pipeline SOACS SOACS
standardPipeline
      String
"s"
      [String
"standard"],
    (UntypedPassState -> Maybe (Prog SOACS))
-> String
-> (Prog GPU -> UntypedPassState)
-> String
-> Pipeline SOACS GPU
-> String
-> [String]
-> FutharkOption
forall fromrep torep.
(UntypedPassState -> Maybe (Prog fromrep))
-> String
-> (Prog torep -> UntypedPassState)
-> String
-> Pipeline fromrep torep
-> String
-> [String]
-> FutharkOption
pipelineOption
      UntypedPassState -> Maybe (Prog SOACS)
getSOACSProg
      String
"GPU"
      Prog GPU -> UntypedPassState
GPU
      String
"Run the default optimised kernels pipeline"
      Pipeline SOACS GPU
gpuPipeline
      []
      [String
"gpu"],
    (UntypedPassState -> Maybe (Prog SOACS))
-> String
-> (Prog GPUMem -> UntypedPassState)
-> String
-> Pipeline SOACS GPUMem
-> String
-> [String]
-> FutharkOption
forall fromrep torep.
(UntypedPassState -> Maybe (Prog fromrep))
-> String
-> (Prog torep -> UntypedPassState)
-> String
-> Pipeline fromrep torep
-> String
-> [String]
-> FutharkOption
pipelineOption
      UntypedPassState -> Maybe (Prog SOACS)
getSOACSProg
      String
"GPUMem"
      Prog GPUMem -> UntypedPassState
GPUMem
      String
"Run the full GPU compilation pipeline"
      Pipeline SOACS GPUMem
gpumemPipeline
      []
      [String
"gpu-mem"],
    (UntypedPassState -> Maybe (Prog SOACS))
-> String
-> (Prog Seq -> UntypedPassState)
-> String
-> Pipeline SOACS Seq
-> String
-> [String]
-> FutharkOption
forall fromrep torep.
(UntypedPassState -> Maybe (Prog fromrep))
-> String
-> (Prog torep -> UntypedPassState)
-> String
-> Pipeline fromrep torep
-> String
-> [String]
-> FutharkOption
pipelineOption
      UntypedPassState -> Maybe (Prog SOACS)
getSOACSProg
      String
"Seq"
      Prog Seq -> UntypedPassState
Seq
      String
"Run the sequential CPU compilation pipeline"
      Pipeline SOACS Seq
seqPipeline
      []
      [String
"seq"],
    (UntypedPassState -> Maybe (Prog SOACS))
-> String
-> (Prog SeqMem -> UntypedPassState)
-> String
-> Pipeline SOACS SeqMem
-> String
-> [String]
-> FutharkOption
forall fromrep torep.
(UntypedPassState -> Maybe (Prog fromrep))
-> String
-> (Prog torep -> UntypedPassState)
-> String
-> Pipeline fromrep torep
-> String
-> [String]
-> FutharkOption
pipelineOption
      UntypedPassState -> Maybe (Prog SOACS)
getSOACSProg
      String
"SeqMem"
      Prog SeqMem -> UntypedPassState
SeqMem
      String
"Run the sequential CPU+memory compilation pipeline"
      Pipeline SOACS SeqMem
seqmemPipeline
      []
      [String
"seq-mem"],
    (UntypedPassState -> Maybe (Prog SOACS))
-> String
-> (Prog MC -> UntypedPassState)
-> String
-> Pipeline SOACS MC
-> String
-> [String]
-> FutharkOption
forall fromrep torep.
(UntypedPassState -> Maybe (Prog fromrep))
-> String
-> (Prog torep -> UntypedPassState)
-> String
-> Pipeline fromrep torep
-> String
-> [String]
-> FutharkOption
pipelineOption
      UntypedPassState -> Maybe (Prog SOACS)
getSOACSProg
      String
"MC"
      Prog MC -> UntypedPassState
MC
      String
"Run the multicore compilation pipeline"
      Pipeline SOACS MC
mcPipeline
      []
      [String
"mc"],
    (UntypedPassState -> Maybe (Prog SOACS))
-> String
-> (Prog MCMem -> UntypedPassState)
-> String
-> Pipeline SOACS MCMem
-> String
-> [String]
-> FutharkOption
forall fromrep torep.
(UntypedPassState -> Maybe (Prog fromrep))
-> String
-> (Prog torep -> UntypedPassState)
-> String
-> Pipeline fromrep torep
-> String
-> [String]
-> FutharkOption
pipelineOption
      UntypedPassState -> Maybe (Prog SOACS)
getSOACSProg
      String
"MCMem"
      Prog MCMem -> UntypedPassState
MCMem
      String
"Run the multicore+memory compilation pipeline"
      Pipeline SOACS MCMem
mcmemPipeline
      []
      [String
"mc-mem"]
  ]

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

-- | Entry point.  Non-interactive, except when reading interpreter
-- input from standard input.
main :: String -> [String] -> IO ()
main :: String -> [String] -> IO ()
main = Config
-> [FutharkOption]
-> String
-> ([String] -> Config -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
forall cfg.
cfg
-> [FunOptDescr cfg]
-> String
-> ([String] -> cfg -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
mainWithOptions Config
newConfig [FutharkOption]
commandLineOptions String
"options... program" [String] -> Config -> Maybe (IO ())
compile
  where
    compile :: [String] -> Config -> Maybe (IO ())
compile [String
file] Config
config =
      IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ do
        Either CompilerError ()
res <-
          FutharkM () -> Verbosity -> IO (Either CompilerError ())
forall a. FutharkM a -> Verbosity -> IO (Either CompilerError a)
runFutharkM (String -> Config -> FutharkM ()
m String
file Config
config) (Verbosity -> IO (Either CompilerError ()))
-> Verbosity -> IO (Either CompilerError ())
forall a b. (a -> b) -> a -> b
$
            (Verbosity, Maybe String) -> Verbosity
forall a b. (a, b) -> a
fst ((Verbosity, Maybe String) -> Verbosity)
-> (Verbosity, Maybe String) -> Verbosity
forall a b. (a -> b) -> a -> b
$
              FutharkConfig -> (Verbosity, Maybe String)
futharkVerbose (FutharkConfig -> (Verbosity, Maybe String))
-> FutharkConfig -> (Verbosity, Maybe String)
forall a b. (a -> b) -> a -> b
$
                Config -> FutharkConfig
futharkConfig Config
config
        case Either CompilerError ()
res of
          Left CompilerError
err -> do
            FutharkConfig -> CompilerError -> IO ()
dumpError (Config -> FutharkConfig
futharkConfig Config
config) CompilerError
err
            ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (ExitCode -> IO ()) -> ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
2
          Right () -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    compile [String]
_ Config
_ =
      Maybe (IO ())
forall a. Maybe a
Nothing
    m :: String -> Config -> FutharkM ()
m String
file Config
config = do
      let p :: (Show a, PP.Pretty a) => [a] -> IO ()
          p :: forall a. (Show a, Pretty a) => [a] -> IO ()
p =
            (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn
              ([String] -> IO ()) -> ([a] -> [String]) -> [a] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
""
              ([String] -> [String]) -> ([a] -> [String]) -> [a] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (if Config -> Bool
futharkPrintAST Config
config then a -> String
forall a. Show a => a -> String
show else a -> String
forall a. Pretty a => a -> String
prettyString)

          readProgram' :: FutharkM (Warnings, Imports, VNameSource)
readProgram' = [Name] -> String -> FutharkM (Warnings, Imports, VNameSource)
forall (m :: * -> *).
(MonadError CompilerError m, MonadIO m) =>
[Name] -> String -> m (Warnings, Imports, VNameSource)
readProgramFile (FutharkConfig -> [Name]
futharkEntryPoints (Config -> FutharkConfig
futharkConfig Config
config)) String
file

      case Config -> FutharkPipeline
futharkPipeline Config
config of
        FutharkPipeline
PrettyPrint -> IO () -> FutharkM ()
forall a. IO a -> FutharkM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ do
          Either SyntaxError UncheckedProg
maybe_prog <- String -> Text -> Either SyntaxError UncheckedProg
parseFuthark String
file (Text -> Either SyntaxError UncheckedProg)
-> IO Text -> IO (Either SyntaxError UncheckedProg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
T.readFile String
file
          case Either SyntaxError UncheckedProg
maybe_prog of
            Left (SyntaxError Loc
loc Text
err) ->
              String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Syntax error at " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Loc -> String
forall a. Located a => a -> String
locStr Loc
loc String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
":\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
err
            Right UncheckedProg
prog
              | Config -> Bool
futharkPrintAST Config
config -> UncheckedProg -> IO ()
forall a. Show a => a -> IO ()
print UncheckedProg
prog
              | Bool
otherwise -> String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ UncheckedProg -> String
forall a. Pretty a => a -> String
prettyString UncheckedProg
prog
        FutharkPipeline
TypeCheck -> do
          (Warnings
_, Imports
imports, VNameSource
_) <- FutharkM (Warnings, Imports, VNameSource)
readProgram'
          IO () -> FutharkM ()
forall a. IO a -> FutharkM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$
            [FileModule] -> (FileModule -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (((ImportName, FileModule) -> FileModule) -> Imports -> [FileModule]
forall a b. (a -> b) -> [a] -> [b]
map (ImportName, FileModule) -> FileModule
forall a b. (a, b) -> b
snd Imports
imports) ((FileModule -> IO ()) -> IO ()) -> (FileModule -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FileModule
fm ->
              String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
                if Config -> Bool
futharkPrintAST Config
config
                  then Prog -> String
forall a. Show a => a -> String
show (Prog -> String) -> Prog -> String
forall a b. (a -> b) -> a -> b
$ FileModule -> Prog
fileProg FileModule
fm
                  else Prog -> String
forall a. Pretty a => a -> String
prettyString (Prog -> String) -> Prog -> String
forall a b. (a -> b) -> a -> b
$ FileModule -> Prog
fileProg FileModule
fm
        FutharkPipeline
Defunctorise -> do
          (Warnings
_, Imports
imports, VNameSource
src) <- FutharkM (Warnings, Imports, VNameSource)
readProgram'
          IO () -> FutharkM ()
forall a. IO a -> FutharkM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$
            [ValBind] -> IO ()
forall a. (Show a, Pretty a) => [a] -> IO ()
p ([ValBind] -> IO ()) -> [ValBind] -> IO ()
forall a b. (a -> b) -> a -> b
$
              (State VNameSource [ValBind] -> VNameSource -> [ValBind])
-> VNameSource -> State VNameSource [ValBind] -> [ValBind]
forall a b c. (a -> b -> c) -> b -> a -> c
flip State VNameSource [ValBind] -> VNameSource -> [ValBind]
forall s a. State s a -> s -> a
evalState VNameSource
src (State VNameSource [ValBind] -> [ValBind])
-> State VNameSource [ValBind] -> [ValBind]
forall a b. (a -> b) -> a -> b
$
                Imports -> StateT VNameSource Identity [Dec]
forall (m :: * -> *). MonadFreshNames m => Imports -> m [Dec]
Defunctorise.transformProg Imports
imports
                  StateT VNameSource Identity [Dec]
-> ([Dec] -> State VNameSource [ValBind])
-> State VNameSource [ValBind]
forall a b.
StateT VNameSource Identity a
-> (a -> StateT VNameSource Identity b)
-> StateT VNameSource Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Dec] -> State VNameSource [ValBind]
forall (m :: * -> *). Monad m => [Dec] -> m [ValBind]
ApplyTypeAbbrs.transformProg
        FutharkPipeline
FullNormalise -> do
          (Warnings
_, Imports
imports, VNameSource
src) <- FutharkM (Warnings, Imports, VNameSource)
readProgram'
          IO () -> FutharkM ()
forall a. IO a -> FutharkM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$
            [ValBind] -> IO ()
forall a. (Show a, Pretty a) => [a] -> IO ()
p ([ValBind] -> IO ()) -> [ValBind] -> IO ()
forall a b. (a -> b) -> a -> b
$
              (State VNameSource [ValBind] -> VNameSource -> [ValBind])
-> VNameSource -> State VNameSource [ValBind] -> [ValBind]
forall a b c. (a -> b -> c) -> b -> a -> c
flip State VNameSource [ValBind] -> VNameSource -> [ValBind]
forall s a. State s a -> s -> a
evalState VNameSource
src (State VNameSource [ValBind] -> [ValBind])
-> State VNameSource [ValBind] -> [ValBind]
forall a b. (a -> b) -> a -> b
$
                Imports -> StateT VNameSource Identity [Dec]
forall (m :: * -> *). MonadFreshNames m => Imports -> m [Dec]
Defunctorise.transformProg Imports
imports
                  StateT VNameSource Identity [Dec]
-> ([Dec] -> State VNameSource [ValBind])
-> State VNameSource [ValBind]
forall a b.
StateT VNameSource Identity a
-> (a -> StateT VNameSource Identity b)
-> StateT VNameSource Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Dec] -> State VNameSource [ValBind]
forall (m :: * -> *). Monad m => [Dec] -> m [ValBind]
ApplyTypeAbbrs.transformProg
                  State VNameSource [ValBind]
-> ([ValBind] -> State VNameSource [ValBind])
-> State VNameSource [ValBind]
forall a b.
StateT VNameSource Identity a
-> (a -> StateT VNameSource Identity b)
-> StateT VNameSource Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ValBind] -> State VNameSource [ValBind]
forall (m :: * -> *). MonadFreshNames m => [ValBind] -> m [ValBind]
FullNormalise.transformProg
        FutharkPipeline
LiftLambdas -> do
          (Warnings
_, Imports
imports, VNameSource
src) <- FutharkM (Warnings, Imports, VNameSource)
readProgram'
          IO () -> FutharkM ()
forall a. IO a -> FutharkM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$
            [ValBind] -> IO ()
forall a. (Show a, Pretty a) => [a] -> IO ()
p ([ValBind] -> IO ()) -> [ValBind] -> IO ()
forall a b. (a -> b) -> a -> b
$
              (State VNameSource [ValBind] -> VNameSource -> [ValBind])
-> VNameSource -> State VNameSource [ValBind] -> [ValBind]
forall a b c. (a -> b -> c) -> b -> a -> c
flip State VNameSource [ValBind] -> VNameSource -> [ValBind]
forall s a. State s a -> s -> a
evalState VNameSource
src (State VNameSource [ValBind] -> [ValBind])
-> State VNameSource [ValBind] -> [ValBind]
forall a b. (a -> b) -> a -> b
$
                Imports -> StateT VNameSource Identity [Dec]
forall (m :: * -> *). MonadFreshNames m => Imports -> m [Dec]
Defunctorise.transformProg Imports
imports
                  StateT VNameSource Identity [Dec]
-> ([Dec] -> State VNameSource [ValBind])
-> State VNameSource [ValBind]
forall a b.
StateT VNameSource Identity a
-> (a -> StateT VNameSource Identity b)
-> StateT VNameSource Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Dec] -> State VNameSource [ValBind]
forall (m :: * -> *). Monad m => [Dec] -> m [ValBind]
ApplyTypeAbbrs.transformProg
                  State VNameSource [ValBind]
-> ([ValBind] -> State VNameSource [ValBind])
-> State VNameSource [ValBind]
forall a b.
StateT VNameSource Identity a
-> (a -> StateT VNameSource Identity b)
-> StateT VNameSource Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ValBind] -> State VNameSource [ValBind]
forall (m :: * -> *). MonadFreshNames m => [ValBind] -> m [ValBind]
FullNormalise.transformProg
                  State VNameSource [ValBind]
-> ([ValBind] -> State VNameSource [ValBind])
-> State VNameSource [ValBind]
forall a b.
StateT VNameSource Identity a
-> (a -> StateT VNameSource Identity b)
-> StateT VNameSource Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ValBind] -> State VNameSource [ValBind]
forall (m :: * -> *). MonadFreshNames m => [ValBind] -> m [ValBind]
ReplaceRecords.transformProg
                  State VNameSource [ValBind]
-> ([ValBind] -> State VNameSource [ValBind])
-> State VNameSource [ValBind]
forall a b.
StateT VNameSource Identity a
-> (a -> StateT VNameSource Identity b)
-> StateT VNameSource Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ValBind] -> State VNameSource [ValBind]
forall (m :: * -> *). MonadFreshNames m => [ValBind] -> m [ValBind]
LiftLambdas.transformProg
        FutharkPipeline
Monomorphise -> do
          (Warnings
_, Imports
imports, VNameSource
src) <- FutharkM (Warnings, Imports, VNameSource)
readProgram'
          IO () -> FutharkM ()
forall a. IO a -> FutharkM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$
            [ValBind] -> IO ()
forall a. (Show a, Pretty a) => [a] -> IO ()
p ([ValBind] -> IO ()) -> [ValBind] -> IO ()
forall a b. (a -> b) -> a -> b
$
              (State VNameSource [ValBind] -> VNameSource -> [ValBind])
-> VNameSource -> State VNameSource [ValBind] -> [ValBind]
forall a b c. (a -> b -> c) -> b -> a -> c
flip State VNameSource [ValBind] -> VNameSource -> [ValBind]
forall s a. State s a -> s -> a
evalState VNameSource
src (State VNameSource [ValBind] -> [ValBind])
-> State VNameSource [ValBind] -> [ValBind]
forall a b. (a -> b) -> a -> b
$
                Imports -> StateT VNameSource Identity [Dec]
forall (m :: * -> *). MonadFreshNames m => Imports -> m [Dec]
Defunctorise.transformProg Imports
imports
                  StateT VNameSource Identity [Dec]
-> ([Dec] -> State VNameSource [ValBind])
-> State VNameSource [ValBind]
forall a b.
StateT VNameSource Identity a
-> (a -> StateT VNameSource Identity b)
-> StateT VNameSource Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Dec] -> State VNameSource [ValBind]
forall (m :: * -> *). Monad m => [Dec] -> m [ValBind]
ApplyTypeAbbrs.transformProg
                  State VNameSource [ValBind]
-> ([ValBind] -> State VNameSource [ValBind])
-> State VNameSource [ValBind]
forall a b.
StateT VNameSource Identity a
-> (a -> StateT VNameSource Identity b)
-> StateT VNameSource Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ValBind] -> State VNameSource [ValBind]
forall (m :: * -> *). MonadFreshNames m => [ValBind] -> m [ValBind]
FullNormalise.transformProg
                  State VNameSource [ValBind]
-> ([ValBind] -> State VNameSource [ValBind])
-> State VNameSource [ValBind]
forall a b.
StateT VNameSource Identity a
-> (a -> StateT VNameSource Identity b)
-> StateT VNameSource Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ValBind] -> State VNameSource [ValBind]
forall (m :: * -> *). MonadFreshNames m => [ValBind] -> m [ValBind]
ReplaceRecords.transformProg
                  State VNameSource [ValBind]
-> ([ValBind] -> State VNameSource [ValBind])
-> State VNameSource [ValBind]
forall a b.
StateT VNameSource Identity a
-> (a -> StateT VNameSource Identity b)
-> StateT VNameSource Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ValBind] -> State VNameSource [ValBind]
forall (m :: * -> *). MonadFreshNames m => [ValBind] -> m [ValBind]
LiftLambdas.transformProg
                  State VNameSource [ValBind]
-> ([ValBind] -> State VNameSource [ValBind])
-> State VNameSource [ValBind]
forall a b.
StateT VNameSource Identity a
-> (a -> StateT VNameSource Identity b)
-> StateT VNameSource Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ValBind] -> State VNameSource [ValBind]
forall (m :: * -> *). MonadFreshNames m => [ValBind] -> m [ValBind]
Monomorphise.transformProg
        FutharkPipeline
Defunctionalise -> do
          (Warnings
_, Imports
imports, VNameSource
src) <- FutharkM (Warnings, Imports, VNameSource)
readProgram'
          IO () -> FutharkM ()
forall a. IO a -> FutharkM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$
            [ValBind] -> IO ()
forall a. (Show a, Pretty a) => [a] -> IO ()
p ([ValBind] -> IO ()) -> [ValBind] -> IO ()
forall a b. (a -> b) -> a -> b
$
              (State VNameSource [ValBind] -> VNameSource -> [ValBind])
-> VNameSource -> State VNameSource [ValBind] -> [ValBind]
forall a b c. (a -> b -> c) -> b -> a -> c
flip State VNameSource [ValBind] -> VNameSource -> [ValBind]
forall s a. State s a -> s -> a
evalState VNameSource
src (State VNameSource [ValBind] -> [ValBind])
-> State VNameSource [ValBind] -> [ValBind]
forall a b. (a -> b) -> a -> b
$
                Imports -> StateT VNameSource Identity [Dec]
forall (m :: * -> *). MonadFreshNames m => Imports -> m [Dec]
Defunctorise.transformProg Imports
imports
                  StateT VNameSource Identity [Dec]
-> ([Dec] -> State VNameSource [ValBind])
-> State VNameSource [ValBind]
forall a b.
StateT VNameSource Identity a
-> (a -> StateT VNameSource Identity b)
-> StateT VNameSource Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Dec] -> State VNameSource [ValBind]
forall (m :: * -> *). Monad m => [Dec] -> m [ValBind]
ApplyTypeAbbrs.transformProg
                  State VNameSource [ValBind]
-> ([ValBind] -> State VNameSource [ValBind])
-> State VNameSource [ValBind]
forall a b.
StateT VNameSource Identity a
-> (a -> StateT VNameSource Identity b)
-> StateT VNameSource Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ValBind] -> State VNameSource [ValBind]
forall (m :: * -> *). MonadFreshNames m => [ValBind] -> m [ValBind]
FullNormalise.transformProg
                  State VNameSource [ValBind]
-> ([ValBind] -> State VNameSource [ValBind])
-> State VNameSource [ValBind]
forall a b.
StateT VNameSource Identity a
-> (a -> StateT VNameSource Identity b)
-> StateT VNameSource Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ValBind] -> State VNameSource [ValBind]
forall (m :: * -> *). MonadFreshNames m => [ValBind] -> m [ValBind]
ReplaceRecords.transformProg
                  State VNameSource [ValBind]
-> ([ValBind] -> State VNameSource [ValBind])
-> State VNameSource [ValBind]
forall a b.
StateT VNameSource Identity a
-> (a -> StateT VNameSource Identity b)
-> StateT VNameSource Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ValBind] -> State VNameSource [ValBind]
forall (m :: * -> *). MonadFreshNames m => [ValBind] -> m [ValBind]
LiftLambdas.transformProg
                  State VNameSource [ValBind]
-> ([ValBind] -> State VNameSource [ValBind])
-> State VNameSource [ValBind]
forall a b.
StateT VNameSource Identity a
-> (a -> StateT VNameSource Identity b)
-> StateT VNameSource Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ValBind] -> State VNameSource [ValBind]
forall (m :: * -> *). MonadFreshNames m => [ValBind] -> m [ValBind]
Monomorphise.transformProg
                  State VNameSource [ValBind]
-> ([ValBind] -> State VNameSource [ValBind])
-> State VNameSource [ValBind]
forall a b.
StateT VNameSource Identity a
-> (a -> StateT VNameSource Identity b)
-> StateT VNameSource Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ValBind] -> State VNameSource [ValBind]
forall (m :: * -> *). MonadFreshNames m => [ValBind] -> m [ValBind]
Defunctionalise.transformProg
        Pipeline {} -> do
          let (String
base, String
ext) = String -> (String, String)
splitExtension String
file

              readCore :: (String -> Text -> Either Text (Prog rep))
-> (Prog rep -> UntypedPassState) -> FutharkM ()
readCore String -> Text -> Either Text (Prog rep)
parse Prog rep -> UntypedPassState
construct = do
                String -> FutharkM ()
forall a. ToLog a => a -> FutharkM ()
forall (m :: * -> *) a. (MonadLogger m, ToLog a) => a -> m ()
logMsg (String -> FutharkM ()) -> String -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ String
"Reading " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
file String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"..."
                Text
input <- IO Text -> FutharkM Text
forall a. IO a -> FutharkM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> FutharkM Text) -> IO Text -> FutharkM Text
forall a b. (a -> b) -> a -> b
$ String -> IO Text
T.readFile String
file
                Text -> FutharkM ()
forall a. ToLog a => a -> FutharkM ()
forall (m :: * -> *) a. (MonadLogger m, ToLog a) => a -> m ()
logMsg (Text
"Parsing..." :: T.Text)
                case String -> Text -> Either Text (Prog rep)
parse String
file Text
input of
                  Left Text
err -> String -> FutharkM ()
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS (String -> FutharkM ()) -> String -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
err
                  Right Prog rep
prog -> do
                    Text -> FutharkM ()
forall a. ToLog a => a -> FutharkM ()
forall (m :: * -> *) a. (MonadLogger m, ToLog a) => a -> m ()
logMsg (Text
"Typechecking..." :: T.Text)
                    case Prog (Aliases rep) -> Either (TypeError rep) ()
forall rep.
Checkable rep =>
Prog (Aliases rep) -> Either (TypeError rep) ()
checkProg (Prog (Aliases rep) -> Either (TypeError rep) ())
-> Prog (Aliases rep) -> Either (TypeError rep) ()
forall a b. (a -> b) -> a -> b
$ Prog rep -> Prog (Aliases rep)
forall rep. AliasableRep rep => Prog rep -> Prog (Aliases rep)
Alias.aliasAnalysis Prog rep
prog of
                      Left TypeError rep
err -> String -> FutharkM ()
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS (String -> FutharkM ()) -> String -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ TypeError rep -> String
forall a. Show a => a -> String
show TypeError rep
err
                      Right () -> Config -> String -> UntypedPassState -> FutharkM ()
runPolyPasses Config
config String
base (UntypedPassState -> FutharkM ())
-> UntypedPassState -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ Prog rep -> UntypedPassState
construct Prog rep
prog

              handlers :: [(String, FutharkM ())]
handlers =
                [ ( String
".fut",
                    do
                      Prog SOACS
prog <- FutharkConfig
-> Pipeline SOACS SOACS -> String -> FutharkM (Prog SOACS)
forall torep.
FutharkConfig
-> Pipeline SOACS torep -> String -> FutharkM (Prog torep)
runPipelineOnProgram (Config -> FutharkConfig
futharkConfig Config
config) Pipeline SOACS SOACS
forall a. Pipeline a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id String
file
                      Config -> String -> UntypedPassState -> FutharkM ()
runPolyPasses Config
config String
base (Prog SOACS -> UntypedPassState
SOACS Prog SOACS
prog)
                  ),
                  (String
".fut_soacs", (String -> Text -> Either Text (Prog SOACS))
-> (Prog SOACS -> UntypedPassState) -> FutharkM ()
forall {rep}.
Checkable rep =>
(String -> Text -> Either Text (Prog rep))
-> (Prog rep -> UntypedPassState) -> FutharkM ()
readCore String -> Text -> Either Text (Prog SOACS)
parseSOACS Prog SOACS -> UntypedPassState
SOACS),
                  (String
".fut_seq", (String -> Text -> Either Text (Prog Seq))
-> (Prog Seq -> UntypedPassState) -> FutharkM ()
forall {rep}.
Checkable rep =>
(String -> Text -> Either Text (Prog rep))
-> (Prog rep -> UntypedPassState) -> FutharkM ()
readCore String -> Text -> Either Text (Prog Seq)
parseSeq Prog Seq -> UntypedPassState
Seq),
                  (String
".fut_seq_mem", (String -> Text -> Either Text (Prog SeqMem))
-> (Prog SeqMem -> UntypedPassState) -> FutharkM ()
forall {rep}.
Checkable rep =>
(String -> Text -> Either Text (Prog rep))
-> (Prog rep -> UntypedPassState) -> FutharkM ()
readCore String -> Text -> Either Text (Prog SeqMem)
parseSeqMem Prog SeqMem -> UntypedPassState
SeqMem),
                  (String
".fut_gpu", (String -> Text -> Either Text (Prog GPU))
-> (Prog GPU -> UntypedPassState) -> FutharkM ()
forall {rep}.
Checkable rep =>
(String -> Text -> Either Text (Prog rep))
-> (Prog rep -> UntypedPassState) -> FutharkM ()
readCore String -> Text -> Either Text (Prog GPU)
parseGPU Prog GPU -> UntypedPassState
GPU),
                  (String
".fut_gpu_mem", (String -> Text -> Either Text (Prog GPUMem))
-> (Prog GPUMem -> UntypedPassState) -> FutharkM ()
forall {rep}.
Checkable rep =>
(String -> Text -> Either Text (Prog rep))
-> (Prog rep -> UntypedPassState) -> FutharkM ()
readCore String -> Text -> Either Text (Prog GPUMem)
parseGPUMem Prog GPUMem -> UntypedPassState
GPUMem),
                  (String
".fut_mc", (String -> Text -> Either Text (Prog MC))
-> (Prog MC -> UntypedPassState) -> FutharkM ()
forall {rep}.
Checkable rep =>
(String -> Text -> Either Text (Prog rep))
-> (Prog rep -> UntypedPassState) -> FutharkM ()
readCore String -> Text -> Either Text (Prog MC)
parseMC Prog MC -> UntypedPassState
MC),
                  (String
".fut_mc_mem", (String -> Text -> Either Text (Prog MCMem))
-> (Prog MCMem -> UntypedPassState) -> FutharkM ()
forall {rep}.
Checkable rep =>
(String -> Text -> Either Text (Prog rep))
-> (Prog rep -> UntypedPassState) -> FutharkM ()
readCore String -> Text -> Either Text (Prog MCMem)
parseMCMem Prog MCMem -> UntypedPassState
MCMem)
                ]
          case String -> [(String, FutharkM ())] -> Maybe (FutharkM ())
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
ext [(String, FutharkM ())]
handlers of
            Just FutharkM ()
handler -> FutharkM ()
handler
            Maybe (FutharkM ())
Nothing ->
              String -> FutharkM ()
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS (String -> FutharkM ()) -> String -> FutharkM ()
forall a b. (a -> b) -> a -> b
$
                [String] -> String
unwords
                  [ String
"Unsupported extension",
                    String -> String
forall a. Show a => a -> String
show String
ext,
                    String
". Supported extensions:",
                    [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((String, FutharkM ()) -> String)
-> [(String, FutharkM ())] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, FutharkM ()) -> String
forall a b. (a, b) -> a
fst [(String, FutharkM ())]
handlers
                  ]

runPolyPasses :: Config -> FilePath -> UntypedPassState -> FutharkM ()
runPolyPasses :: Config -> String -> UntypedPassState -> FutharkM ()
runPolyPasses Config
config String
base UntypedPassState
initial_prog = do
  UntypedPassState
end_prog <-
    (UntypedPassState -> UntypedPass -> FutharkM UntypedPassState)
-> UntypedPassState -> [UntypedPass] -> FutharkM UntypedPassState
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
      (PipelineConfig
-> UntypedPassState -> UntypedPass -> FutharkM UntypedPassState
runPolyPass PipelineConfig
pipeline_config)
      UntypedPassState
initial_prog
      (Config -> [UntypedPass]
getFutharkPipeline Config
config)
  case (UntypedPassState
end_prog, Config -> UntypedAction
futharkAction Config
config) of
    (SOACS Prog SOACS
prog, SOACSAction Action SOACS
action) ->
      Action SOACS -> Prog SOACS -> FutharkM ()
forall {rep}. Action rep -> Prog rep -> FutharkM ()
otherAction Action SOACS
action Prog SOACS
prog
    (GPU Prog GPU
prog, GPUAction Action GPU
action) ->
      Action GPU -> Prog GPU -> FutharkM ()
forall {rep}. Action rep -> Prog rep -> FutharkM ()
otherAction Action GPU
action Prog GPU
prog
    (SeqMem Prog SeqMem
prog, SeqMemAction BackendAction SeqMem
action) ->
      Prog SeqMem -> BackendAction SeqMem -> FutharkM ()
forall {rep}.
Prog rep
-> (FutharkConfig -> CompilerMode -> String -> Action rep)
-> FutharkM ()
backendAction Prog SeqMem
prog BackendAction SeqMem
action
    (GPUMem Prog GPUMem
prog, GPUMemAction BackendAction GPUMem
action) ->
      Prog GPUMem -> BackendAction GPUMem -> FutharkM ()
forall {rep}.
Prog rep
-> (FutharkConfig -> CompilerMode -> String -> Action rep)
-> FutharkM ()
backendAction Prog GPUMem
prog BackendAction GPUMem
action
    (MCMem Prog MCMem
prog, MCMemAction BackendAction MCMem
action) ->
      Prog MCMem -> BackendAction MCMem -> FutharkM ()
forall {rep}.
Prog rep
-> (FutharkConfig -> CompilerMode -> String -> Action rep)
-> FutharkM ()
backendAction Prog MCMem
prog BackendAction MCMem
action
    (SOACS Prog SOACS
soacs_prog, PolyAction forall rep.
(AliasableRep rep, OpMetrics (Op rep), Analyse rep) =>
Action rep
acs) ->
      Action SOACS -> Prog SOACS -> FutharkM ()
forall {rep}. Action rep -> Prog rep -> FutharkM ()
otherAction Action SOACS
forall rep.
(AliasableRep rep, OpMetrics (Op rep), Analyse rep) =>
Action rep
acs Prog SOACS
soacs_prog
    (GPU Prog GPU
kernels_prog, PolyAction forall rep.
(AliasableRep rep, OpMetrics (Op rep), Analyse rep) =>
Action rep
acs) ->
      Action GPU -> Prog GPU -> FutharkM ()
forall {rep}. Action rep -> Prog rep -> FutharkM ()
otherAction Action GPU
forall rep.
(AliasableRep rep, OpMetrics (Op rep), Analyse rep) =>
Action rep
acs Prog GPU
kernels_prog
    (MC Prog MC
mc_prog, PolyAction forall rep.
(AliasableRep rep, OpMetrics (Op rep), Analyse rep) =>
Action rep
acs) ->
      Action MC -> Prog MC -> FutharkM ()
forall {rep}. Action rep -> Prog rep -> FutharkM ()
otherAction Action MC
forall rep.
(AliasableRep rep, OpMetrics (Op rep), Analyse rep) =>
Action rep
acs Prog MC
mc_prog
    (Seq Prog Seq
seq_prog, PolyAction forall rep.
(AliasableRep rep, OpMetrics (Op rep), Analyse rep) =>
Action rep
acs) ->
      Action Seq -> Prog Seq -> FutharkM ()
forall {rep}. Action rep -> Prog rep -> FutharkM ()
otherAction Action Seq
forall rep.
(AliasableRep rep, OpMetrics (Op rep), Analyse rep) =>
Action rep
acs Prog Seq
seq_prog
    (GPUMem Prog GPUMem
mem_prog, PolyAction forall rep.
(AliasableRep rep, OpMetrics (Op rep), Analyse rep) =>
Action rep
acs) ->
      Action GPUMem -> Prog GPUMem -> FutharkM ()
forall {rep}. Action rep -> Prog rep -> FutharkM ()
otherAction Action GPUMem
forall rep.
(AliasableRep rep, OpMetrics (Op rep), Analyse rep) =>
Action rep
acs Prog GPUMem
mem_prog
    (SeqMem Prog SeqMem
mem_prog, PolyAction forall rep.
(AliasableRep rep, OpMetrics (Op rep), Analyse rep) =>
Action rep
acs) ->
      Action SeqMem -> Prog SeqMem -> FutharkM ()
forall {rep}. Action rep -> Prog rep -> FutharkM ()
otherAction Action SeqMem
forall rep.
(AliasableRep rep, OpMetrics (Op rep), Analyse rep) =>
Action rep
acs Prog SeqMem
mem_prog
    (MCMem Prog MCMem
mem_prog, PolyAction forall rep.
(AliasableRep rep, OpMetrics (Op rep), Analyse rep) =>
Action rep
acs) ->
      Action MCMem -> Prog MCMem -> FutharkM ()
forall {rep}. Action rep -> Prog rep -> FutharkM ()
otherAction Action MCMem
forall rep.
(AliasableRep rep, OpMetrics (Op rep), Analyse rep) =>
Action rep
acs Prog MCMem
mem_prog
    (UntypedPassState
_, UntypedAction
action) ->
      String -> FutharkM ()
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS (String -> FutharkM ()) -> String -> FutharkM ()
forall a b. (a -> b) -> a -> b
$
        String
"Action expects "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ UntypedAction -> String
forall s. Representation s => s -> String
representation UntypedAction
action
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" representation, but got "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ UntypedPassState -> String
forall s. Representation s => s -> String
representation UntypedPassState
end_prog
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
  String -> FutharkM ()
forall a. ToLog a => a -> FutharkM ()
forall (m :: * -> *) a. (MonadLogger m, ToLog a) => a -> m ()
logMsg (String
"Done." :: String)
  where
    backendAction :: Prog rep
-> (FutharkConfig -> CompilerMode -> String -> Action rep)
-> FutharkM ()
backendAction Prog rep
prog FutharkConfig -> CompilerMode -> String -> Action rep
actionf = do
      let action :: Action rep
action = FutharkConfig -> CompilerMode -> String -> Action rep
actionf (Config -> FutharkConfig
futharkConfig Config
config) (Config -> CompilerMode
futharkCompilerMode Config
config) String
base
      Action rep -> Prog rep -> FutharkM ()
forall {rep}. Action rep -> Prog rep -> FutharkM ()
otherAction Action rep
action Prog rep
prog

    otherAction :: Action rep -> Prog rep -> FutharkM ()
otherAction Action rep
action Prog rep
prog = do
      String -> FutharkM ()
forall a. ToLog a => a -> FutharkM ()
forall (m :: * -> *) a. (MonadLogger m, ToLog a) => a -> m ()
logMsg (String -> FutharkM ()) -> String -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ String
"Running action " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Action rep -> String
forall rep. Action rep -> String
actionName Action rep
action
      Action rep -> Prog rep -> FutharkM ()
forall {rep}. Action rep -> Prog rep -> FutharkM ()
actionProcedure Action rep
action Prog rep
prog

    pipeline_config :: PipelineConfig
pipeline_config =
      PipelineConfig
        { pipelineVerbose :: Bool
pipelineVerbose = (Verbosity, Maybe String) -> Verbosity
forall a b. (a, b) -> a
fst (FutharkConfig -> (Verbosity, Maybe String)
futharkVerbose (FutharkConfig -> (Verbosity, Maybe String))
-> FutharkConfig -> (Verbosity, Maybe String)
forall a b. (a -> b) -> a -> b
$ Config -> FutharkConfig
futharkConfig Config
config) Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
> Verbosity
NotVerbose,
          pipelineValidate :: Bool
pipelineValidate = FutharkConfig -> Bool
futharkTypeCheck (FutharkConfig -> Bool) -> FutharkConfig -> Bool
forall a b. (a -> b) -> a -> b
$ Config -> FutharkConfig
futharkConfig Config
config
        }

runPolyPass ::
  PipelineConfig ->
  UntypedPassState ->
  UntypedPass ->
  FutharkM UntypedPassState
runPolyPass :: PipelineConfig
-> UntypedPassState -> UntypedPass -> FutharkM UntypedPassState
runPolyPass PipelineConfig
pipeline_config UntypedPassState
s (UntypedPass UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
f) =
  UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
f UntypedPassState
s PipelineConfig
pipeline_config