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.Alias qualified as Alias
import Futhark.Analysis.Metrics (OpMetrics)
import Futhark.Compiler.CLI hiding (compilerMain)
import Futhark.IR (ASTRep, Op, Prog, prettyString)
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.Prop.Aliases (CanBeAliased)
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.Defunctionalise as Defunctionalise
import Futhark.Internalise.Defunctorise as Defunctorise
import Futhark.Internalise.LiftLambdas as LiftLambdas
import Futhark.Internalise.Monomorphise as Monomorphise
import Futhark.Optimise.ArrayShortCircuiting qualified as ArrayShortCircuiting
import Futhark.Optimise.CSE
import Futhark.Optimise.DoubleBuffer
import Futhark.Optimise.Fusion
import Futhark.Optimise.HistAccs
import Futhark.Optimise.InPlaceLowering
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.Seq qualified as Seq
import Futhark.Pass.ExtractKernels
import Futhark.Pass.ExtractMulticore
import Futhark.Pass.FirstOrderTransform
import Futhark.Pass.KernelBabysitting
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)
data FutharkPipeline
=
PrettyPrint
|
TypeCheck
|
Pipeline [UntypedPass]
|
Defunctorise
|
Monomorphise
|
LiftLambdas
|
Defunctionalise
data Config = Config
{ Config -> FutharkConfig
futharkConfig :: FutharkConfig,
Config -> FutharkPipeline
futharkPipeline :: FutharkPipeline,
Config -> CompilerMode
futharkCompilerMode :: CompilerMode,
Config -> UntypedAction
futharkAction :: UntypedAction,
Config -> Bool
futharkPrintAST :: Bool
}
getFutharkPipeline :: Config -> [UntypedPass]
getFutharkPipeline :: Config -> [UntypedPass]
getFutharkPipeline = FutharkPipeline -> [UntypedPass]
toPipeline 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) = forall a. a -> Maybe a
Just Prog SOACS
prog
getSOACSProg UntypedPassState
_ = forall a. Maybe a
Nothing
class Representation s where
representation :: s -> String
instance Representation UntypedPassState where
representation :: UntypedPassState -> [Char]
representation (SOACS Prog SOACS
_) = [Char]
"SOACS"
representation (GPU Prog GPU
_) = [Char]
"GPU"
representation (MC Prog MC
_) = [Char]
"MC"
representation (Seq Prog Seq
_) = [Char]
"Seq"
representation (GPUMem Prog GPUMem
_) = [Char]
"GPUMem"
representation (MCMem Prog MCMem
_) = [Char]
"MCMem"
representation (SeqMem Prog SeqMem
_) = [Char]
"SeqMem"
instance PP.Pretty UntypedPassState where
pretty :: forall ann. UntypedPassState -> Doc ann
pretty (SOACS Prog SOACS
prog) = forall a ann. Pretty a => a -> Doc ann
PP.pretty Prog SOACS
prog
pretty (GPU Prog GPU
prog) = forall a ann. Pretty a => a -> Doc ann
PP.pretty Prog GPU
prog
pretty (MC Prog MC
prog) = forall a ann. Pretty a => a -> Doc ann
PP.pretty Prog MC
prog
pretty (Seq Prog Seq
prog) = forall a ann. Pretty a => a -> Doc ann
PP.pretty Prog Seq
prog
pretty (SeqMem Prog SeqMem
prog) = forall a ann. Pretty a => a -> Doc ann
PP.pretty Prog SeqMem
prog
pretty (MCMem Prog MCMem
prog) = forall a ann. Pretty a => a -> Doc ann
PP.pretty Prog MCMem
prog
pretty (GPUMem Prog GPUMem
prog) = forall a ann. Pretty a => a -> 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).
( ASTRep rep,
(CanBeAliased (Op rep)),
(OpMetrics (Op rep))
) =>
Action rep
)
instance Representation UntypedAction where
representation :: UntypedAction -> [Char]
representation (SOACSAction Action SOACS
_) = [Char]
"SOACS"
representation (GPUAction Action GPU
_) = [Char]
"GPU"
representation (GPUMemAction BackendAction GPUMem
_) = [Char]
"GPUMem"
representation (MCMemAction BackendAction MCMem
_) = [Char]
"MCMem"
representation (SeqMemAction BackendAction SeqMem
_) = [Char]
"SeqMem"
representation PolyAction {} = [Char]
"<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.
(ASTRep rep, CanBeAliased (Op rep), OpMetrics (Op rep)) =>
Action rep)
-> UntypedAction
PolyAction forall {k} (rep :: k). ASTRep rep => Action rep
printAction
changeFutharkConfig ::
(FutharkConfig -> FutharkConfig) ->
Config ->
Config
changeFutharkConfig :: (FutharkConfig -> FutharkConfig) -> Config -> Config
changeFutharkConfig FutharkConfig -> FutharkConfig
f Config
cfg = Config
cfg {futharkConfig :: FutharkConfig
futharkConfig = FutharkConfig -> FutharkConfig
f forall a b. (a -> b) -> a -> b
$ Config -> FutharkConfig
futharkConfig Config
cfg}
type FutharkOption = FunOptDescr Config
passOption :: String -> UntypedPass -> String -> [String] -> FutharkOption
passOption :: [Char] -> UntypedPass -> [Char] -> [[Char]] -> FutharkOption
passOption [Char]
desc UntypedPass
pass [Char]
short [[Char]]
long =
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
[Char]
short
[[Char]]
long
( forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \Config
cfg ->
Config
cfg {futharkPipeline :: FutharkPipeline
futharkPipeline = [UntypedPass] -> FutharkPipeline
Pipeline forall a b. (a -> b) -> a -> b
$ Config -> [UntypedPass]
getFutharkPipeline Config
cfg forall a. [a] -> [a] -> [a]
++ [UntypedPass
pass]}
)
[Char]
desc
kernelsMemProg ::
String ->
UntypedPassState ->
FutharkM (Prog GPUMem.GPUMem)
kernelsMemProg :: [Char] -> UntypedPassState -> FutharkM (Prog GPUMem)
kernelsMemProg [Char]
_ (GPUMem Prog GPUMem
prog) =
forall (f :: * -> *) a. Applicative f => a -> f a
pure Prog GPUMem
prog
kernelsMemProg [Char]
name UntypedPassState
rep =
forall (m :: * -> *) a. MonadError CompilerError m => [Char] -> m a
externalErrorS forall a b. (a -> b) -> a -> b
$
[Char]
"Pass "
forall a. [a] -> [a] -> [a]
++ [Char]
name
forall a. [a] -> [a] -> [a]
++ [Char]
" expects GPUMem representation, but got "
forall a. [a] -> [a] -> [a]
++ forall s. Representation s => s -> [Char]
representation UntypedPassState
rep
soacsProg :: String -> UntypedPassState -> FutharkM (Prog SOACS.SOACS)
soacsProg :: [Char] -> UntypedPassState -> FutharkM (Prog SOACS)
soacsProg [Char]
_ (SOACS Prog SOACS
prog) =
forall (f :: * -> *) a. Applicative f => a -> f a
pure Prog SOACS
prog
soacsProg [Char]
name UntypedPassState
rep =
forall (m :: * -> *) a. MonadError CompilerError m => [Char] -> m a
externalErrorS forall a b. (a -> b) -> a -> b
$
[Char]
"Pass "
forall a. [a] -> [a] -> [a]
++ [Char]
name
forall a. [a] -> [a] -> [a]
++ [Char]
" expects SOACS representation, but got "
forall a. [a] -> [a] -> [a]
++ forall s. Representation s => s -> [Char]
representation UntypedPassState
rep
kernelsProg :: String -> UntypedPassState -> FutharkM (Prog GPU.GPU)
kernelsProg :: [Char] -> UntypedPassState -> FutharkM (Prog GPU)
kernelsProg [Char]
_ (GPU Prog GPU
prog) =
forall (f :: * -> *) a. Applicative f => a -> f a
pure Prog GPU
prog
kernelsProg [Char]
name UntypedPassState
rep =
forall (m :: * -> *) a. MonadError CompilerError m => [Char] -> m a
externalErrorS forall a b. (a -> b) -> a -> b
$
[Char]
"Pass " forall a. [a] -> [a] -> [a]
++ [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
" expects GPU representation, but got " forall a. [a] -> [a] -> [a]
++ forall s. Representation s => s -> [Char]
representation UntypedPassState
rep
seqMemProg :: String -> UntypedPassState -> FutharkM (Prog SeqMem.SeqMem)
seqMemProg :: [Char] -> UntypedPassState -> FutharkM (Prog SeqMem)
seqMemProg [Char]
_ (SeqMem Prog SeqMem
prog) =
forall (f :: * -> *) a. Applicative f => a -> f a
pure Prog SeqMem
prog
seqMemProg [Char]
name UntypedPassState
rep =
forall (m :: * -> *) a. MonadError CompilerError m => [Char] -> m a
externalErrorS forall a b. (a -> b) -> a -> b
$
[Char]
"Pass " forall a. [a] -> [a] -> [a]
++ [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
" expects SeqMem representation, but got " forall a. [a] -> [a] -> [a]
++ forall s. Representation s => s -> [Char]
representation UntypedPassState
rep
typedPassOption ::
Checkable torep =>
(String -> UntypedPassState -> FutharkM (Prog fromrep)) ->
(Prog torep -> UntypedPassState) ->
Pass fromrep torep ->
String ->
FutharkOption
typedPassOption :: forall {k1} {k} (torep :: k1) (fromrep :: k).
Checkable torep =>
([Char] -> UntypedPassState -> FutharkM (Prog fromrep))
-> (Prog torep -> UntypedPassState)
-> Pass fromrep torep
-> [Char]
-> FutharkOption
typedPassOption [Char] -> UntypedPassState -> FutharkM (Prog fromrep)
getProg Prog torep -> UntypedPassState
putProg Pass fromrep torep
pass [Char]
short =
[Char] -> UntypedPass -> [Char] -> [[Char]] -> FutharkOption
passOption (forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pass fromrep torep -> [Char]
passDescription Pass fromrep torep
pass) ((UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState)
-> UntypedPass
UntypedPass UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
perform) [Char]
short [[Char]]
long
where
perform :: UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
perform UntypedPassState
s PipelineConfig
config = do
Prog fromrep
prog <- [Char] -> UntypedPassState -> FutharkM (Prog fromrep)
getProg (forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pass fromrep torep -> [Char]
passName Pass fromrep torep
pass) UntypedPassState
s
Prog torep -> UntypedPassState
putProg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (forall {k1} {k2} (torep :: k1) (fromrep :: k2).
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass Pass fromrep torep
pass) PipelineConfig
config Prog fromrep
prog
long :: [[Char]]
long = [forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pass fromrep torep -> [Char]
passLongOption Pass fromrep torep
pass]
soacsPassOption :: Pass SOACS.SOACS SOACS.SOACS -> String -> FutharkOption
soacsPassOption :: Pass SOACS SOACS -> [Char] -> FutharkOption
soacsPassOption =
forall {k1} {k} (torep :: k1) (fromrep :: k).
Checkable torep =>
([Char] -> UntypedPassState -> FutharkM (Prog fromrep))
-> (Prog torep -> UntypedPassState)
-> Pass fromrep torep
-> [Char]
-> FutharkOption
typedPassOption [Char] -> UntypedPassState -> FutharkM (Prog SOACS)
soacsProg Prog SOACS -> UntypedPassState
SOACS
kernelsPassOption ::
Pass GPU.GPU GPU.GPU ->
String ->
FutharkOption
kernelsPassOption :: Pass GPU GPU -> [Char] -> FutharkOption
kernelsPassOption =
forall {k1} {k} (torep :: k1) (fromrep :: k).
Checkable torep =>
([Char] -> UntypedPassState -> FutharkM (Prog fromrep))
-> (Prog torep -> UntypedPassState)
-> Pass fromrep torep
-> [Char]
-> FutharkOption
typedPassOption [Char] -> UntypedPassState -> FutharkM (Prog GPU)
kernelsProg Prog GPU -> UntypedPassState
GPU
seqMemPassOption ::
Pass SeqMem.SeqMem SeqMem.SeqMem ->
String ->
FutharkOption
seqMemPassOption :: Pass SeqMem SeqMem -> [Char] -> FutharkOption
seqMemPassOption =
forall {k1} {k} (torep :: k1) (fromrep :: k).
Checkable torep =>
([Char] -> UntypedPassState -> FutharkM (Prog fromrep))
-> (Prog torep -> UntypedPassState)
-> Pass fromrep torep
-> [Char]
-> FutharkOption
typedPassOption [Char] -> UntypedPassState -> FutharkM (Prog SeqMem)
seqMemProg Prog SeqMem -> UntypedPassState
SeqMem
kernelsMemPassOption ::
Pass GPUMem.GPUMem GPUMem.GPUMem ->
String ->
FutharkOption
kernelsMemPassOption :: Pass GPUMem GPUMem -> [Char] -> FutharkOption
kernelsMemPassOption =
forall {k1} {k} (torep :: k1) (fromrep :: k).
Checkable torep =>
([Char] -> UntypedPassState -> FutharkM (Prog fromrep))
-> (Prog torep -> UntypedPassState)
-> Pass fromrep torep
-> [Char]
-> FutharkOption
typedPassOption [Char] -> UntypedPassState -> FutharkM (Prog GPUMem)
kernelsMemProg Prog GPUMem -> UntypedPassState
GPUMem
simplifyOption :: String -> FutharkOption
simplifyOption :: [Char] -> FutharkOption
simplifyOption [Char]
short =
[Char] -> UntypedPass -> [Char] -> [[Char]] -> FutharkOption
passOption (forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pass fromrep torep -> [Char]
passDescription Pass SOACS SOACS
pass) ((UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState)
-> UntypedPass
UntypedPass UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
perform) [Char]
short [[Char]]
long
where
perform :: UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
perform (SOACS Prog SOACS
prog) PipelineConfig
config =
Prog SOACS -> UntypedPassState
SOACS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (forall {k1} {k2} (torep :: k1) (fromrep :: k2).
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (forall {k1} {k2} (torep :: k1) (fromrep :: k2).
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (forall {k1} {k2} (torep :: k1) (fromrep :: k2).
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (forall {k1} {k2} (torep :: k1) (fromrep :: k2).
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (forall {k1} {k2} (torep :: k1) (fromrep :: k2).
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (forall {k1} {k2} (torep :: k1) (fromrep :: k2).
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (forall {k1} {k2} (torep :: k1) (fromrep :: k2).
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass Pass MCMem MCMem
simplifyMCMem) PipelineConfig
config Prog MCMem
prog
long :: [[Char]]
long = [forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pass fromrep torep -> [Char]
passLongOption Pass SOACS SOACS
pass]
pass :: Pass SOACS SOACS
pass = Pass SOACS SOACS
simplifySOACS
allocateOption :: String -> FutharkOption
allocateOption :: [Char] -> FutharkOption
allocateOption [Char]
short =
[Char] -> UntypedPass -> [Char] -> [[Char]] -> FutharkOption
passOption (forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pass fromrep torep -> [Char]
passDescription Pass Seq SeqMem
pass) ((UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState)
-> UntypedPass
UntypedPass UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
perform) [Char]
short [[Char]]
long
where
perform :: UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
perform (GPU Prog GPU
prog) PipelineConfig
config =
Prog GPUMem -> UntypedPassState
GPUMem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (forall {k1} {k2} (torep :: k1) (fromrep :: k2).
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
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (forall {k1} {k2} (torep :: k1) (fromrep :: k2).
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass Pass Seq SeqMem
Seq.explicitAllocations) PipelineConfig
config Prog Seq
prog
perform UntypedPassState
s PipelineConfig
_ =
forall (m :: * -> *) a. MonadError CompilerError m => [Char] -> m a
externalErrorS forall a b. (a -> b) -> a -> b
$
[Char]
"Pass '" forall a. [a] -> [a] -> [a]
++ forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pass fromrep torep -> [Char]
passDescription Pass Seq SeqMem
pass forall a. [a] -> [a] -> [a]
++ [Char]
"' cannot operate on " forall a. [a] -> [a] -> [a]
++ forall s. Representation s => s -> [Char]
representation UntypedPassState
s
long :: [[Char]]
long = [forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pass fromrep torep -> [Char]
passLongOption Pass Seq SeqMem
pass]
pass :: Pass Seq SeqMem
pass = Pass Seq SeqMem
Seq.explicitAllocations
iplOption :: String -> FutharkOption
iplOption :: [Char] -> FutharkOption
iplOption [Char]
short =
[Char] -> UntypedPass -> [Char] -> [[Char]] -> FutharkOption
passOption (forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pass fromrep torep -> [Char]
passDescription Pass Seq Seq
pass) ((UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState)
-> UntypedPass
UntypedPass UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
perform) [Char]
short [[Char]]
long
where
perform :: UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
perform (GPU Prog GPU
prog) PipelineConfig
config =
Prog GPU -> UntypedPassState
GPU
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (forall {k1} {k2} (torep :: k1) (fromrep :: k2).
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass Pass GPU GPU
inPlaceLoweringGPU) PipelineConfig
config Prog GPU
prog
perform (Seq Prog Seq
prog) PipelineConfig
config =
Prog Seq -> UntypedPassState
Seq
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (forall {k1} {k2} (torep :: k1) (fromrep :: k2).
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass Pass Seq Seq
inPlaceLoweringSeq) PipelineConfig
config Prog Seq
prog
perform UntypedPassState
s PipelineConfig
_ =
forall (m :: * -> *) a. MonadError CompilerError m => [Char] -> m a
externalErrorS forall a b. (a -> b) -> a -> b
$
[Char]
"Pass '" forall a. [a] -> [a] -> [a]
++ forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pass fromrep torep -> [Char]
passDescription Pass Seq Seq
pass forall a. [a] -> [a] -> [a]
++ [Char]
"' cannot operate on " forall a. [a] -> [a] -> [a]
++ forall s. Representation s => s -> [Char]
representation UntypedPassState
s
long :: [[Char]]
long = [forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pass fromrep torep -> [Char]
passLongOption Pass Seq Seq
pass]
pass :: Pass Seq Seq
pass = Pass Seq Seq
inPlaceLoweringSeq
cseOption :: String -> FutharkOption
cseOption :: [Char] -> FutharkOption
cseOption [Char]
short =
[Char] -> UntypedPass -> [Char] -> [[Char]] -> FutharkOption
passOption (forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pass fromrep torep -> [Char]
passDescription Pass SOACS SOACS
pass) ((UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState)
-> UntypedPass
UntypedPass UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
perform) [Char]
short [[Char]]
long
where
perform :: UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
perform (SOACS Prog SOACS
prog) PipelineConfig
config =
Prog SOACS -> UntypedPassState
SOACS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (forall {k1} {k2} (torep :: k1) (fromrep :: k2).
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass forall a b. (a -> b) -> a -> b
$ forall {k1} (rep :: k1).
(ASTRep rep, CanBeAliased (Op rep),
CSEInOp (OpWithAliases (Op rep))) =>
Bool -> Pass rep rep
performCSE Bool
True) PipelineConfig
config Prog SOACS
prog
perform (GPU Prog GPU
prog) PipelineConfig
config =
Prog GPU -> UntypedPassState
GPU forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (forall {k1} {k2} (torep :: k1) (fromrep :: k2).
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass forall a b. (a -> b) -> a -> b
$ forall {k1} (rep :: k1).
(ASTRep rep, CanBeAliased (Op rep),
CSEInOp (OpWithAliases (Op rep))) =>
Bool -> Pass rep rep
performCSE Bool
True) PipelineConfig
config Prog GPU
prog
perform (MC Prog MC
prog) PipelineConfig
config =
Prog MC -> UntypedPassState
MC forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (forall {k1} {k2} (torep :: k1) (fromrep :: k2).
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass forall a b. (a -> b) -> a -> b
$ forall {k1} (rep :: k1).
(ASTRep rep, CanBeAliased (Op rep),
CSEInOp (OpWithAliases (Op rep))) =>
Bool -> Pass rep rep
performCSE Bool
True) PipelineConfig
config Prog MC
prog
perform (Seq Prog Seq
prog) PipelineConfig
config =
Prog Seq -> UntypedPassState
Seq forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (forall {k1} {k2} (torep :: k1) (fromrep :: k2).
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass forall a b. (a -> b) -> a -> b
$ forall {k1} (rep :: k1).
(ASTRep rep, CanBeAliased (Op rep),
CSEInOp (OpWithAliases (Op rep))) =>
Bool -> Pass rep rep
performCSE Bool
True) PipelineConfig
config Prog Seq
prog
perform (SeqMem Prog SeqMem
prog) PipelineConfig
config =
Prog SeqMem -> UntypedPassState
SeqMem forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (forall {k1} {k2} (torep :: k1) (fromrep :: k2).
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass forall a b. (a -> b) -> a -> b
$ forall {k1} (rep :: k1).
(ASTRep rep, CanBeAliased (Op rep),
CSEInOp (OpWithAliases (Op rep))) =>
Bool -> Pass rep rep
performCSE Bool
False) PipelineConfig
config Prog SeqMem
prog
perform (GPUMem Prog GPUMem
prog) PipelineConfig
config =
Prog GPUMem -> UntypedPassState
GPUMem forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (forall {k1} {k2} (torep :: k1) (fromrep :: k2).
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass forall a b. (a -> b) -> a -> b
$ forall {k1} (rep :: k1).
(ASTRep rep, CanBeAliased (Op rep),
CSEInOp (OpWithAliases (Op rep))) =>
Bool -> Pass rep rep
performCSE Bool
False) PipelineConfig
config Prog GPUMem
prog
perform (MCMem Prog MCMem
prog) PipelineConfig
config =
Prog MCMem -> UntypedPassState
MCMem forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline (forall {k1} {k2} (torep :: k1) (fromrep :: k2).
Checkable torep =>
Pass fromrep torep -> Pipeline fromrep torep
onePass forall a b. (a -> b) -> a -> b
$ forall {k1} (rep :: k1).
(ASTRep rep, CanBeAliased (Op rep),
CSEInOp (OpWithAliases (Op rep))) =>
Bool -> Pass rep rep
performCSE Bool
False) PipelineConfig
config Prog MCMem
prog
long :: [[Char]]
long = [forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pass fromrep torep -> [Char]
passLongOption Pass SOACS SOACS
pass]
pass :: Pass SOACS SOACS
pass = forall {k1} (rep :: k1).
(ASTRep rep, CanBeAliased (Op rep),
CSEInOp (OpWithAliases (Op rep))) =>
Bool -> Pass rep rep
performCSE Bool
True :: Pass SOACS.SOACS SOACS.SOACS
pipelineOption ::
(UntypedPassState -> Maybe (Prog fromrep)) ->
String ->
(Prog torep -> UntypedPassState) ->
String ->
Pipeline fromrep torep ->
String ->
[String] ->
FutharkOption
pipelineOption :: forall {k} {k1} (fromrep :: k) (torep :: k1).
(UntypedPassState -> Maybe (Prog fromrep))
-> [Char]
-> (Prog torep -> UntypedPassState)
-> [Char]
-> Pipeline fromrep torep
-> [Char]
-> [[Char]]
-> FutharkOption
pipelineOption UntypedPassState -> Maybe (Prog fromrep)
getprog [Char]
repdesc Prog torep -> UntypedPassState
repf [Char]
desc Pipeline fromrep torep
pipeline =
[Char] -> UntypedPass -> [Char] -> [[Char]] -> FutharkOption
passOption [Char]
desc 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k1} {k2} (fromrep :: k1) (torep :: k2).
Pipeline fromrep torep
-> PipelineConfig -> Prog fromrep -> FutharkM (Prog torep)
runPipeline Pipeline fromrep torep
pipeline PipelineConfig
config Prog fromrep
prog
Maybe (Prog fromrep)
Nothing ->
forall (m :: * -> *) a. MonadError CompilerError m => [Char] -> m a
externalErrorS forall a b. (a -> b) -> a -> b
$
[Char]
"Expected "
forall a. [a] -> [a] -> [a]
++ [Char]
repdesc
forall a. [a] -> [a] -> [a]
++ [Char]
" representation, but got "
forall a. [a] -> [a] -> [a]
++ forall s. Representation s => s -> [Char]
representation UntypedPassState
rep
soacsPipelineOption ::
String ->
Pipeline SOACS.SOACS SOACS.SOACS ->
String ->
[String] ->
FutharkOption
soacsPipelineOption :: [Char]
-> Pipeline SOACS SOACS -> [Char] -> [[Char]] -> FutharkOption
soacsPipelineOption = forall {k} {k1} (fromrep :: k) (torep :: k1).
(UntypedPassState -> Maybe (Prog fromrep))
-> [Char]
-> (Prog torep -> UntypedPassState)
-> [Char]
-> Pipeline fromrep torep
-> [Char]
-> [[Char]]
-> FutharkOption
pipelineOption UntypedPassState -> Maybe (Prog SOACS)
getSOACSProg [Char]
"SOACS" Prog SOACS -> UntypedPassState
SOACS
commandLineOptions :: [FutharkOption]
commandLineOptions :: [FutharkOption]
commandLineOptions =
[ forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
[Char]
"v"
[[Char]
"verbose"]
(forall a. (Maybe [Char] -> a) -> [Char] -> ArgDescr a
OptArg (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FutharkConfig -> FutharkConfig) -> Config -> Config
changeFutharkConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [Char] -> FutharkConfig -> FutharkConfig
incVerbosity) [Char]
"FILE")
[Char]
"Print verbose output on standard error; wrong program to FILE.",
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
[]
[[Char]
"Werror"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ (FutharkConfig -> FutharkConfig) -> Config -> Config
changeFutharkConfig forall a b. (a -> b) -> a -> b
$ \FutharkConfig
opts -> FutharkConfig
opts {futharkWerror :: Bool
futharkWerror = Bool
True})
[Char]
"Treat warnings as errors.",
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
[Char]
"w"
[]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ (FutharkConfig -> FutharkConfig) -> Config -> Config
changeFutharkConfig forall a b. (a -> b) -> a -> b
$ \FutharkConfig
opts -> FutharkConfig
opts {futharkWarn :: Bool
futharkWarn = Bool
False})
[Char]
"Disable all warnings.",
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
[Char]
"t"
[[Char]
"type-check"]
( forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \Config
opts ->
Config
opts {futharkPipeline :: FutharkPipeline
futharkPipeline = FutharkPipeline
TypeCheck}
)
[Char]
"Print on standard output the type-checked program.",
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
[]
[[Char]
"no-check"]
( forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
(FutharkConfig -> FutharkConfig) -> Config -> Config
changeFutharkConfig forall a b. (a -> b) -> a -> b
$
\FutharkConfig
opts -> FutharkConfig
opts {futharkTypeCheck :: Bool
futharkTypeCheck = Bool
False}
)
[Char]
"Disable type-checking.",
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
[]
[[Char]
"prettyString-print"]
( forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \Config
opts ->
Config
opts {futharkPipeline :: FutharkPipeline
futharkPipeline = FutharkPipeline
PrettyPrint}
)
[Char]
"Parse and prettyString-print the AST of the given program.",
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
[]
[[Char]
"backend"]
( forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg
( \[Char]
arg -> do
UntypedAction
action <- case [Char]
arg of
[Char]
"c" -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ BackendAction SeqMem -> UntypedAction
SeqMemAction BackendAction SeqMem
compileCAction
[Char]
"multicore" -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ BackendAction MCMem -> UntypedAction
MCMemAction BackendAction MCMem
compileMulticoreAction
[Char]
"opencl" -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ BackendAction GPUMem -> UntypedAction
GPUMemAction BackendAction GPUMem
compileOpenCLAction
[Char]
"cuda" -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ BackendAction GPUMem -> UntypedAction
GPUMemAction BackendAction GPUMem
compileCUDAAction
[Char]
"wasm" -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ BackendAction SeqMem -> UntypedAction
SeqMemAction BackendAction SeqMem
compileCtoWASMAction
[Char]
"wasm-multicore" -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ BackendAction MCMem -> UntypedAction
MCMemAction BackendAction MCMem
compileMulticoreToWASMAction
[Char]
"ispc" -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ BackendAction MCMem -> UntypedAction
MCMemAction BackendAction MCMem
compileMulticoreToISPCAction
[Char]
"python" -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ BackendAction SeqMem -> UntypedAction
SeqMemAction BackendAction SeqMem
compilePythonAction
[Char]
"pyopencl" -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ BackendAction GPUMem -> UntypedAction
GPUMemAction BackendAction GPUMem
compilePyOpenCLAction
[Char]
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid backend: " forall a. Semigroup a => a -> a -> a
<> [Char]
arg
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkAction :: UntypedAction
futharkAction = UntypedAction
action}
)
[Char]
"c|multicore|opencl|cuda|python|pyopencl"
)
[Char]
"Run this compiler backend on pipeline result.",
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
[]
[[Char]
"compile-imp-seq"]
( forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \Config
opts ->
Config
opts {futharkAction :: UntypedAction
futharkAction = BackendAction SeqMem -> UntypedAction
SeqMemAction forall a b. (a -> b) -> a -> b
$ \FutharkConfig
_ CompilerMode
_ [Char]
_ -> Action SeqMem
impCodeGenAction}
)
[Char]
"Translate pipeline result to ImpSequential and write it on stdout.",
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
[]
[[Char]
"compile-imp-gpu"]
( forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \Config
opts ->
Config
opts {futharkAction :: UntypedAction
futharkAction = BackendAction GPUMem -> UntypedAction
GPUMemAction forall a b. (a -> b) -> a -> b
$ \FutharkConfig
_ CompilerMode
_ [Char]
_ -> Action GPUMem
kernelImpCodeGenAction}
)
[Char]
"Translate pipeline result to ImpGPU and write it on stdout.",
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
[]
[[Char]
"compile-imp-multicore"]
( forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \Config
opts ->
Config
opts {futharkAction :: UntypedAction
futharkAction = BackendAction MCMem -> UntypedAction
MCMemAction forall a b. (a -> b) -> a -> b
$ \FutharkConfig
_ CompilerMode
_ [Char]
_ -> Action MCMem
multicoreImpCodeGenAction}
)
[Char]
"Translate pipeline result to ImpMC write it on stdout.",
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
[Char]
"p"
[[Char]
"print"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkAction :: UntypedAction
futharkAction = (forall rep.
(ASTRep rep, CanBeAliased (Op rep), OpMetrics (Op rep)) =>
Action rep)
-> UntypedAction
PolyAction forall {k} (rep :: k). ASTRep rep => Action rep
printAction})
[Char]
"Print the resulting IR (default action).",
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
[]
[[Char]
"print-aliases"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkAction :: UntypedAction
futharkAction = (forall rep.
(ASTRep rep, CanBeAliased (Op rep), OpMetrics (Op rep)) =>
Action rep)
-> UntypedAction
PolyAction forall {k} (rep :: k).
(ASTRep rep, CanBeAliased (Op rep)) =>
Action rep
printAliasesAction})
[Char]
"Print the resulting IR with aliases.",
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
[]
[[Char]
"fusion-graph"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkAction :: UntypedAction
futharkAction = Action SOACS -> UntypedAction
SOACSAction Action SOACS
printFusionGraph})
[Char]
"Print fusion graph.",
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
[]
[[Char]
"print-last-use-gpu"]
( forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \Config
opts ->
Config
opts {futharkAction :: UntypedAction
futharkAction = BackendAction GPUMem -> UntypedAction
GPUMemAction forall a b. (a -> b) -> a -> b
$ \FutharkConfig
_ CompilerMode
_ [Char]
_ -> Action GPUMem
printLastUseGPU}
)
[Char]
"Print last use information.",
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
[]
[[Char]
"print-interference-gpu"]
( forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \Config
opts ->
Config
opts {futharkAction :: UntypedAction
futharkAction = BackendAction GPUMem -> UntypedAction
GPUMemAction forall a b. (a -> b) -> a -> b
$ \FutharkConfig
_ CompilerMode
_ [Char]
_ -> Action GPUMem
printInterferenceGPU}
)
[Char]
"Print interference information.",
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
[]
[[Char]
"print-mem-alias-gpu"]
( forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \Config
opts ->
Config
opts {futharkAction :: UntypedAction
futharkAction = BackendAction GPUMem -> UntypedAction
GPUMemAction forall a b. (a -> b) -> a -> b
$ \FutharkConfig
_ CompilerMode
_ [Char]
_ -> Action GPUMem
printMemAliasGPU}
)
[Char]
"Print memory alias information.",
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
[]
[[Char]
"call-graph"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkAction :: UntypedAction
futharkAction = Action SOACS -> UntypedAction
SOACSAction Action SOACS
callGraphAction})
[Char]
"Print the resulting call graph.",
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
[Char]
"m"
[[Char]
"metrics"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkAction :: UntypedAction
futharkAction = (forall rep.
(ASTRep rep, CanBeAliased (Op rep), OpMetrics (Op rep)) =>
Action rep)
-> UntypedAction
PolyAction forall {k} (rep :: k). OpMetrics (Op rep) => Action rep
metricsAction})
[Char]
"Print AST metrics of the resulting internal representation on standard output.",
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
[]
[[Char]
"defunctorise"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkPipeline :: FutharkPipeline
futharkPipeline = FutharkPipeline
Defunctorise})
[Char]
"Partially evaluate all module constructs and print the residual program.",
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
[]
[[Char]
"monomorphise"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkPipeline :: FutharkPipeline
futharkPipeline = FutharkPipeline
Monomorphise})
[Char]
"Monomorphise the program.",
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
[]
[[Char]
"lift-lambdas"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkPipeline :: FutharkPipeline
futharkPipeline = FutharkPipeline
LiftLambdas})
[Char]
"Lambda-lift the program.",
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
[]
[[Char]
"defunctionalise"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkPipeline :: FutharkPipeline
futharkPipeline = FutharkPipeline
Defunctionalise})
[Char]
"Defunctionalise the program.",
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
[]
[[Char]
"ast"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkPrintAST :: Bool
futharkPrintAST = Bool
True})
[Char]
"Output ASTs instead of prettyprinted programs.",
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
[]
[[Char]
"safe"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ (FutharkConfig -> FutharkConfig) -> Config -> Config
changeFutharkConfig forall a b. (a -> b) -> a -> b
$ \FutharkConfig
opts -> FutharkConfig
opts {futharkSafe :: Bool
futharkSafe = Bool
True})
[Char]
"Ignore 'unsafe'.",
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
[]
[[Char]
"entry-points"]
( forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg
( \[Char]
arg -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
(FutharkConfig -> FutharkConfig) -> Config -> Config
changeFutharkConfig forall a b. (a -> b) -> a -> b
$ \FutharkConfig
opts ->
FutharkConfig
opts
{ futharkEntryPoints :: [Name]
futharkEntryPoints = [Char] -> Name
nameFromString [Char]
arg forall a. a -> [a] -> [a]
: FutharkConfig -> [Name]
futharkEntryPoints FutharkConfig
opts
}
)
[Char]
"NAME"
)
[Char]
"Treat this function as an additional entry point.",
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
[]
[[Char]
"library"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkCompilerMode :: CompilerMode
futharkCompilerMode = CompilerMode
ToLibrary})
[Char]
"Generate a library instead of an executable.",
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
[]
[[Char]
"executable"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkCompilerMode :: CompilerMode
futharkCompilerMode = CompilerMode
ToExecutable})
[Char]
"Generate an executable instead of a library (set by default).",
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
[]
[[Char]
"server"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts {futharkCompilerMode :: CompilerMode
futharkCompilerMode = CompilerMode
ToServer})
[Char]
"Generate a server executable.",
forall {k1} {k} (torep :: k1) (fromrep :: k).
Checkable torep =>
([Char] -> UntypedPassState -> FutharkM (Prog fromrep))
-> (Prog torep -> UntypedPassState)
-> Pass fromrep torep
-> [Char]
-> FutharkOption
typedPassOption [Char] -> UntypedPassState -> FutharkM (Prog SOACS)
soacsProg Prog Seq -> UntypedPassState
Seq forall rep. FirstOrderRep rep => Pass SOACS rep
firstOrderTransform [Char]
"f",
Pass SOACS SOACS -> [Char] -> FutharkOption
soacsPassOption Pass SOACS SOACS
fuseSOACs [Char]
"o",
Pass SOACS SOACS -> [Char] -> FutharkOption
soacsPassOption Pass SOACS SOACS
inlineAggressively [],
Pass SOACS SOACS -> [Char] -> FutharkOption
soacsPassOption Pass SOACS SOACS
inlineConservatively [],
Pass SOACS SOACS -> [Char] -> FutharkOption
soacsPassOption Pass SOACS SOACS
removeDeadFunctions [],
Pass SOACS SOACS -> [Char] -> FutharkOption
soacsPassOption Pass SOACS SOACS
applyAD [],
Pass SOACS SOACS -> [Char] -> FutharkOption
soacsPassOption Pass SOACS SOACS
applyADInnermost [],
Pass GPU GPU -> [Char] -> FutharkOption
kernelsPassOption Pass GPU GPU
babysitKernels [],
Pass GPU GPU -> [Char] -> FutharkOption
kernelsPassOption Pass GPU GPU
tileLoops [],
Pass GPU GPU -> [Char] -> FutharkOption
kernelsPassOption Pass GPU GPU
histAccsGPU [],
Pass GPU GPU -> [Char] -> FutharkOption
kernelsPassOption Pass GPU GPU
unstreamGPU [],
Pass GPU GPU -> [Char] -> FutharkOption
kernelsPassOption Pass GPU GPU
sinkGPU [],
Pass GPU GPU -> [Char] -> FutharkOption
kernelsPassOption Pass GPU GPU
reduceDeviceSyncs [],
forall {k1} {k} (torep :: k1) (fromrep :: k).
Checkable torep =>
([Char] -> UntypedPassState -> FutharkM (Prog fromrep))
-> (Prog torep -> UntypedPassState)
-> Pass fromrep torep
-> [Char]
-> FutharkOption
typedPassOption [Char] -> UntypedPassState -> FutharkM (Prog SOACS)
soacsProg Prog GPU -> UntypedPassState
GPU Pass SOACS GPU
extractKernels [],
forall {k1} {k} (torep :: k1) (fromrep :: k).
Checkable torep =>
([Char] -> UntypedPassState -> FutharkM (Prog fromrep))
-> (Prog torep -> UntypedPassState)
-> Pass fromrep torep
-> [Char]
-> FutharkOption
typedPassOption [Char] -> UntypedPassState -> FutharkM (Prog SOACS)
soacsProg Prog MC -> UntypedPassState
MC Pass SOACS MC
extractMulticore [],
[Char] -> FutharkOption
iplOption [],
[Char] -> FutharkOption
allocateOption [Char]
"a",
Pass GPUMem GPUMem -> [Char] -> FutharkOption
kernelsMemPassOption Pass GPUMem GPUMem
doubleBufferGPU [],
Pass GPUMem GPUMem -> [Char] -> FutharkOption
kernelsMemPassOption Pass GPUMem GPUMem
expandAllocations [],
Pass GPUMem GPUMem -> [Char] -> FutharkOption
kernelsMemPassOption Pass GPUMem GPUMem
MemoryBlockMerging.optimise [],
Pass SeqMem SeqMem -> [Char] -> FutharkOption
seqMemPassOption Pass SeqMem SeqMem
LiftAllocations.liftAllocationsSeqMem [],
Pass GPUMem GPUMem -> [Char] -> FutharkOption
kernelsMemPassOption Pass GPUMem GPUMem
LiftAllocations.liftAllocationsGPUMem [],
Pass SeqMem SeqMem -> [Char] -> FutharkOption
seqMemPassOption Pass SeqMem SeqMem
LowerAllocations.lowerAllocationsSeqMem [],
Pass GPUMem GPUMem -> [Char] -> FutharkOption
kernelsMemPassOption Pass GPUMem GPUMem
LowerAllocations.lowerAllocationsGPUMem [],
Pass SeqMem SeqMem -> [Char] -> FutharkOption
seqMemPassOption Pass SeqMem SeqMem
ArrayShortCircuiting.optimiseSeqMem [],
Pass GPUMem GPUMem -> [Char] -> FutharkOption
kernelsMemPassOption Pass GPUMem GPUMem
ArrayShortCircuiting.optimiseGPUMem [],
[Char] -> FutharkOption
cseOption [],
[Char] -> FutharkOption
simplifyOption [Char]
"e",
[Char]
-> Pipeline SOACS SOACS -> [Char] -> [[Char]] -> FutharkOption
soacsPipelineOption
[Char]
"Run the default optimised pipeline"
Pipeline SOACS SOACS
standardPipeline
[Char]
"s"
[[Char]
"standard"],
forall {k} {k1} (fromrep :: k) (torep :: k1).
(UntypedPassState -> Maybe (Prog fromrep))
-> [Char]
-> (Prog torep -> UntypedPassState)
-> [Char]
-> Pipeline fromrep torep
-> [Char]
-> [[Char]]
-> FutharkOption
pipelineOption
UntypedPassState -> Maybe (Prog SOACS)
getSOACSProg
[Char]
"GPU"
Prog GPU -> UntypedPassState
GPU
[Char]
"Run the default optimised kernels pipeline"
Pipeline SOACS GPU
kernelsPipeline
[]
[[Char]
"gpu"],
forall {k} {k1} (fromrep :: k) (torep :: k1).
(UntypedPassState -> Maybe (Prog fromrep))
-> [Char]
-> (Prog torep -> UntypedPassState)
-> [Char]
-> Pipeline fromrep torep
-> [Char]
-> [[Char]]
-> FutharkOption
pipelineOption
UntypedPassState -> Maybe (Prog SOACS)
getSOACSProg
[Char]
"GPUMem"
Prog GPUMem -> UntypedPassState
GPUMem
[Char]
"Run the full GPU compilation pipeline"
Pipeline SOACS GPUMem
gpuPipeline
[]
[[Char]
"gpu-mem"],
forall {k} {k1} (fromrep :: k) (torep :: k1).
(UntypedPassState -> Maybe (Prog fromrep))
-> [Char]
-> (Prog torep -> UntypedPassState)
-> [Char]
-> Pipeline fromrep torep
-> [Char]
-> [[Char]]
-> FutharkOption
pipelineOption
UntypedPassState -> Maybe (Prog SOACS)
getSOACSProg
[Char]
"Seq"
Prog Seq -> UntypedPassState
Seq
[Char]
"Run the sequential CPU compilation pipeline"
Pipeline SOACS Seq
sequentialPipeline
[]
[[Char]
"seq"],
forall {k} {k1} (fromrep :: k) (torep :: k1).
(UntypedPassState -> Maybe (Prog fromrep))
-> [Char]
-> (Prog torep -> UntypedPassState)
-> [Char]
-> Pipeline fromrep torep
-> [Char]
-> [[Char]]
-> FutharkOption
pipelineOption
UntypedPassState -> Maybe (Prog SOACS)
getSOACSProg
[Char]
"SeqMem"
Prog SeqMem -> UntypedPassState
SeqMem
[Char]
"Run the sequential CPU+memory compilation pipeline"
Pipeline SOACS SeqMem
sequentialCpuPipeline
[]
[[Char]
"seq-mem"],
forall {k} {k1} (fromrep :: k) (torep :: k1).
(UntypedPassState -> Maybe (Prog fromrep))
-> [Char]
-> (Prog torep -> UntypedPassState)
-> [Char]
-> Pipeline fromrep torep
-> [Char]
-> [[Char]]
-> FutharkOption
pipelineOption
UntypedPassState -> Maybe (Prog SOACS)
getSOACSProg
[Char]
"MCMem"
Prog MCMem -> UntypedPassState
MCMem
[Char]
"Run the multicore compilation pipeline"
Pipeline SOACS MCMem
multicorePipeline
[]
[[Char]
"mc-mem"]
]
incVerbosity :: Maybe FilePath -> FutharkConfig -> FutharkConfig
incVerbosity :: Maybe [Char] -> FutharkConfig -> FutharkConfig
incVerbosity Maybe [Char]
file FutharkConfig
cfg =
FutharkConfig
cfg {futharkVerbose :: (Verbosity, Maybe [Char])
futharkVerbose = (Verbosity
v, Maybe [Char]
file forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall a b. (a, b) -> b
snd (FutharkConfig -> (Verbosity, Maybe [Char])
futharkVerbose FutharkConfig
cfg))}
where
v :: Verbosity
v = case forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ FutharkConfig -> (Verbosity, Maybe [Char])
futharkVerbose FutharkConfig
cfg of
Verbosity
NotVerbose -> Verbosity
Verbose
Verbosity
Verbose -> Verbosity
VeryVerbose
Verbosity
VeryVerbose -> Verbosity
VeryVerbose
main :: String -> [String] -> IO ()
main :: [Char] -> [[Char]] -> IO ()
main = forall cfg.
cfg
-> [FunOptDescr cfg]
-> [Char]
-> ([[Char]] -> cfg -> Maybe (IO ()))
-> [Char]
-> [[Char]]
-> IO ()
mainWithOptions Config
newConfig [FutharkOption]
commandLineOptions [Char]
"options... program" [[Char]] -> Config -> Maybe (IO ())
compile
where
compile :: [[Char]] -> Config -> Maybe (IO ())
compile [[Char]
file] Config
config =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
Either CompilerError ()
res <-
forall a. FutharkM a -> Verbosity -> IO (Either CompilerError a)
runFutharkM ([Char] -> Config -> FutharkM ()
m [Char]
file Config
config) forall a b. (a -> b) -> a -> b
$
forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$
FutharkConfig -> (Verbosity, Maybe [Char])
futharkVerbose 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
forall a. ExitCode -> IO a
exitWith forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
2
Right () -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
compile [[Char]]
_ Config
_ =
forall a. Maybe a
Nothing
m :: [Char] -> Config -> FutharkM ()
m [Char]
file Config
config = do
let p :: (Show a, PP.Pretty a) => [a] -> IO ()
p :: forall a. (Show a, Pretty a) => [a] -> IO ()
p =
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> IO ()
putStrLn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse [Char]
""
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (if Config -> Bool
futharkPrintAST Config
config then forall a. Show a => a -> [Char]
show else forall a. Pretty a => a -> [Char]
prettyString)
readProgram' :: FutharkM (Warnings, Imports, VNameSource)
readProgram' = forall (m :: * -> *).
(MonadError CompilerError m, MonadIO m) =>
[Name] -> [Char] -> m (Warnings, Imports, VNameSource)
readProgramFile (FutharkConfig -> [Name]
futharkEntryPoints (Config -> FutharkConfig
futharkConfig Config
config)) [Char]
file
case Config -> FutharkPipeline
futharkPipeline Config
config of
FutharkPipeline
PrettyPrint -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Either SyntaxError UncheckedProg
maybe_prog <- [Char] -> Text -> Either SyntaxError UncheckedProg
parseFuthark [Char]
file forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO Text
T.readFile [Char]
file
case Either SyntaxError UncheckedProg
maybe_prog of
Left (SyntaxError Loc
loc Text
err) ->
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Syntax error at " forall a. Semigroup a => a -> a -> a
<> forall a. Located a => a -> [Char]
locStr Loc
loc forall a. Semigroup a => a -> a -> a
<> [Char]
":\n" forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack Text
err
Right UncheckedProg
prog
| Config -> Bool
futharkPrintAST Config
config -> forall a. Show a => a -> IO ()
print UncheckedProg
prog
| Bool
otherwise -> [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> [Char]
prettyString UncheckedProg
prog
FutharkPipeline
TypeCheck -> do
(Warnings
_, Imports
imports, VNameSource
_) <- FutharkM (Warnings, Imports, VNameSource)
readProgram'
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd Imports
imports) forall a b. (a -> b) -> a -> b
$ \FileModule
fm ->
[Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$
if Config -> Bool
futharkPrintAST Config
config
then forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ FileModule -> Prog
fileProg FileModule
fm
else forall a. Pretty a => a -> [Char]
prettyString 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'
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. (Show a, Pretty a) => [a] -> IO ()
p forall a b. (a -> b) -> a -> b
$ forall s a. State s a -> s -> a
evalState (forall (m :: * -> *). MonadFreshNames m => Imports -> m [Dec]
Defunctorise.transformProg Imports
imports) VNameSource
src
FutharkPipeline
Monomorphise -> do
(Warnings
_, Imports
imports, VNameSource
src) <- FutharkM (Warnings, Imports, VNameSource)
readProgram'
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
forall a. (Show a, Pretty a) => [a] -> IO ()
p forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
evalState VNameSource
src forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *). MonadFreshNames m => Imports -> m [Dec]
Defunctorise.transformProg Imports
imports
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). MonadFreshNames m => [Dec] -> m [ValBind]
Monomorphise.transformProg
FutharkPipeline
LiftLambdas -> do
(Warnings
_, Imports
imports, VNameSource
src) <- FutharkM (Warnings, Imports, VNameSource)
readProgram'
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
forall a. (Show a, Pretty a) => [a] -> IO ()
p forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
evalState VNameSource
src forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *). MonadFreshNames m => Imports -> m [Dec]
Defunctorise.transformProg Imports
imports
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). MonadFreshNames m => [Dec] -> m [ValBind]
Monomorphise.transformProg
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). MonadFreshNames m => [ValBind] -> m [ValBind]
LiftLambdas.transformProg
FutharkPipeline
Defunctionalise -> do
(Warnings
_, Imports
imports, VNameSource
src) <- FutharkM (Warnings, Imports, VNameSource)
readProgram'
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
forall a. (Show a, Pretty a) => [a] -> IO ()
p forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
evalState VNameSource
src forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *). MonadFreshNames m => Imports -> m [Dec]
Defunctorise.transformProg Imports
imports
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). MonadFreshNames m => [Dec] -> m [ValBind]
Monomorphise.transformProg
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). MonadFreshNames m => [ValBind] -> m [ValBind]
LiftLambdas.transformProg
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). MonadFreshNames m => [ValBind] -> m [ValBind]
Defunctionalise.transformProg
Pipeline {} -> do
let ([Char]
base, [Char]
ext) = [Char] -> ([Char], [Char])
splitExtension [Char]
file
readCore :: ([Char] -> Text -> Either Text (Prog rep))
-> (Prog rep -> UntypedPassState) -> FutharkM ()
readCore [Char] -> Text -> Either Text (Prog rep)
parse Prog rep -> UntypedPassState
construct = do
Text
input <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO Text
T.readFile [Char]
file
case [Char] -> Text -> Either Text (Prog rep)
parse [Char]
file Text
input of
Left Text
err -> forall (m :: * -> *) a. MonadError CompilerError m => [Char] -> m a
externalErrorS forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
err
Right Prog rep
prog ->
case forall {k} (rep :: k).
Checkable rep =>
Prog (Aliases rep) -> Either (TypeError rep) ()
checkProg forall a b. (a -> b) -> a -> b
$ forall {k} (rep :: k).
(ASTRep rep, CanBeAliased (Op rep)) =>
Prog rep -> Prog (Aliases rep)
Alias.aliasAnalysis Prog rep
prog of
Left TypeError rep
err -> forall (m :: * -> *) a. MonadError CompilerError m => [Char] -> m a
externalErrorS forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show TypeError rep
err
Right () -> Config -> [Char] -> UntypedPassState -> FutharkM ()
runPolyPasses Config
config [Char]
base forall a b. (a -> b) -> a -> b
$ Prog rep -> UntypedPassState
construct Prog rep
prog
handlers :: [([Char], FutharkM ())]
handlers =
[ ( [Char]
".fut",
do
Prog SOACS
prog <- forall {k} (torep :: k).
FutharkConfig
-> Pipeline SOACS torep -> [Char] -> FutharkM (Prog torep)
runPipelineOnProgram (Config -> FutharkConfig
futharkConfig Config
config) forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id [Char]
file
Config -> [Char] -> UntypedPassState -> FutharkM ()
runPolyPasses Config
config [Char]
base (Prog SOACS -> UntypedPassState
SOACS Prog SOACS
prog)
),
([Char]
".fut_soacs", forall {k} {rep :: k}.
Checkable rep =>
([Char] -> Text -> Either Text (Prog rep))
-> (Prog rep -> UntypedPassState) -> FutharkM ()
readCore [Char] -> Text -> Either Text (Prog SOACS)
parseSOACS Prog SOACS -> UntypedPassState
SOACS),
([Char]
".fut_seq", forall {k} {rep :: k}.
Checkable rep =>
([Char] -> Text -> Either Text (Prog rep))
-> (Prog rep -> UntypedPassState) -> FutharkM ()
readCore [Char] -> Text -> Either Text (Prog Seq)
parseSeq Prog Seq -> UntypedPassState
Seq),
([Char]
".fut_seq_mem", forall {k} {rep :: k}.
Checkable rep =>
([Char] -> Text -> Either Text (Prog rep))
-> (Prog rep -> UntypedPassState) -> FutharkM ()
readCore [Char] -> Text -> Either Text (Prog SeqMem)
parseSeqMem Prog SeqMem -> UntypedPassState
SeqMem),
([Char]
".fut_gpu", forall {k} {rep :: k}.
Checkable rep =>
([Char] -> Text -> Either Text (Prog rep))
-> (Prog rep -> UntypedPassState) -> FutharkM ()
readCore [Char] -> Text -> Either Text (Prog GPU)
parseGPU Prog GPU -> UntypedPassState
GPU),
([Char]
".fut_gpu_mem", forall {k} {rep :: k}.
Checkable rep =>
([Char] -> Text -> Either Text (Prog rep))
-> (Prog rep -> UntypedPassState) -> FutharkM ()
readCore [Char] -> Text -> Either Text (Prog GPUMem)
parseGPUMem Prog GPUMem -> UntypedPassState
GPUMem),
([Char]
".fut_mc", forall {k} {rep :: k}.
Checkable rep =>
([Char] -> Text -> Either Text (Prog rep))
-> (Prog rep -> UntypedPassState) -> FutharkM ()
readCore [Char] -> Text -> Either Text (Prog MC)
parseMC Prog MC -> UntypedPassState
MC),
([Char]
".fut_mc_mem", forall {k} {rep :: k}.
Checkable rep =>
([Char] -> Text -> Either Text (Prog rep))
-> (Prog rep -> UntypedPassState) -> FutharkM ()
readCore [Char] -> Text -> Either Text (Prog MCMem)
parseMCMem Prog MCMem -> UntypedPassState
MCMem)
]
case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
ext [([Char], FutharkM ())]
handlers of
Just FutharkM ()
handler -> FutharkM ()
handler
Maybe (FutharkM ())
Nothing ->
forall (m :: * -> *) a. MonadError CompilerError m => [Char] -> m a
externalErrorS forall a b. (a -> b) -> a -> b
$
[[Char]] -> [Char]
unwords
[ [Char]
"Unsupported extension",
forall a. Show a => a -> [Char]
show [Char]
ext,
[Char]
". Supported extensions:",
[[Char]] -> [Char]
unwords forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [([Char], FutharkM ())]
handlers
]
runPolyPasses :: Config -> FilePath -> UntypedPassState -> FutharkM ()
runPolyPasses :: Config -> [Char] -> UntypedPassState -> FutharkM ()
runPolyPasses Config
config [Char]
base UntypedPassState
initial_prog = do
UntypedPassState
end_prog <-
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) ->
forall {k} {rep :: k}. Action rep -> Prog rep -> FutharkM ()
otherAction Action SOACS
action Prog SOACS
prog
(GPU Prog GPU
prog, GPUAction Action GPU
action) ->
forall {k} {rep :: k}. Action rep -> Prog rep -> FutharkM ()
otherAction Action GPU
action Prog GPU
prog
(SeqMem Prog SeqMem
prog, SeqMemAction BackendAction SeqMem
action) ->
forall {k} {rep :: k}.
Prog rep
-> (FutharkConfig -> CompilerMode -> [Char] -> Action rep)
-> FutharkM ()
backendAction Prog SeqMem
prog BackendAction SeqMem
action
(GPUMem Prog GPUMem
prog, GPUMemAction BackendAction GPUMem
action) ->
forall {k} {rep :: k}.
Prog rep
-> (FutharkConfig -> CompilerMode -> [Char] -> Action rep)
-> FutharkM ()
backendAction Prog GPUMem
prog BackendAction GPUMem
action
(MCMem Prog MCMem
prog, MCMemAction BackendAction MCMem
action) ->
forall {k} {rep :: k}.
Prog rep
-> (FutharkConfig -> CompilerMode -> [Char] -> Action rep)
-> FutharkM ()
backendAction Prog MCMem
prog BackendAction MCMem
action
(SOACS Prog SOACS
soacs_prog, PolyAction forall rep.
(ASTRep rep, CanBeAliased (Op rep), OpMetrics (Op rep)) =>
Action rep
acs) ->
forall {k} {rep :: k}. Action rep -> Prog rep -> FutharkM ()
otherAction forall rep.
(ASTRep rep, CanBeAliased (Op rep), OpMetrics (Op rep)) =>
Action rep
acs Prog SOACS
soacs_prog
(GPU Prog GPU
kernels_prog, PolyAction forall rep.
(ASTRep rep, CanBeAliased (Op rep), OpMetrics (Op rep)) =>
Action rep
acs) ->
forall {k} {rep :: k}. Action rep -> Prog rep -> FutharkM ()
otherAction forall rep.
(ASTRep rep, CanBeAliased (Op rep), OpMetrics (Op rep)) =>
Action rep
acs Prog GPU
kernels_prog
(MC Prog MC
mc_prog, PolyAction forall rep.
(ASTRep rep, CanBeAliased (Op rep), OpMetrics (Op rep)) =>
Action rep
acs) ->
forall {k} {rep :: k}. Action rep -> Prog rep -> FutharkM ()
otherAction forall rep.
(ASTRep rep, CanBeAliased (Op rep), OpMetrics (Op rep)) =>
Action rep
acs Prog MC
mc_prog
(Seq Prog Seq
seq_prog, PolyAction forall rep.
(ASTRep rep, CanBeAliased (Op rep), OpMetrics (Op rep)) =>
Action rep
acs) ->
forall {k} {rep :: k}. Action rep -> Prog rep -> FutharkM ()
otherAction forall rep.
(ASTRep rep, CanBeAliased (Op rep), OpMetrics (Op rep)) =>
Action rep
acs Prog Seq
seq_prog
(GPUMem Prog GPUMem
mem_prog, PolyAction forall rep.
(ASTRep rep, CanBeAliased (Op rep), OpMetrics (Op rep)) =>
Action rep
acs) ->
forall {k} {rep :: k}. Action rep -> Prog rep -> FutharkM ()
otherAction forall rep.
(ASTRep rep, CanBeAliased (Op rep), OpMetrics (Op rep)) =>
Action rep
acs Prog GPUMem
mem_prog
(SeqMem Prog SeqMem
mem_prog, PolyAction forall rep.
(ASTRep rep, CanBeAliased (Op rep), OpMetrics (Op rep)) =>
Action rep
acs) ->
forall {k} {rep :: k}. Action rep -> Prog rep -> FutharkM ()
otherAction forall rep.
(ASTRep rep, CanBeAliased (Op rep), OpMetrics (Op rep)) =>
Action rep
acs Prog SeqMem
mem_prog
(MCMem Prog MCMem
mem_prog, PolyAction forall rep.
(ASTRep rep, CanBeAliased (Op rep), OpMetrics (Op rep)) =>
Action rep
acs) ->
forall {k} {rep :: k}. Action rep -> Prog rep -> FutharkM ()
otherAction forall rep.
(ASTRep rep, CanBeAliased (Op rep), OpMetrics (Op rep)) =>
Action rep
acs Prog MCMem
mem_prog
(UntypedPassState
_, UntypedAction
action) ->
forall (m :: * -> *) a. MonadError CompilerError m => [Char] -> m a
externalErrorS forall a b. (a -> b) -> a -> b
$
[Char]
"Action expects "
forall a. [a] -> [a] -> [a]
++ forall s. Representation s => s -> [Char]
representation UntypedAction
action
forall a. [a] -> [a] -> [a]
++ [Char]
" representation, but got "
forall a. [a] -> [a] -> [a]
++ forall s. Representation s => s -> [Char]
representation UntypedPassState
end_prog
forall a. [a] -> [a] -> [a]
++ [Char]
"."
forall (m :: * -> *) a. (MonadLogger m, ToLog a) => a -> m ()
logMsg ([Char]
"Done." :: String)
where
backendAction :: Prog rep
-> (FutharkConfig -> CompilerMode -> [Char] -> Action rep)
-> FutharkM ()
backendAction Prog rep
prog FutharkConfig -> CompilerMode -> [Char] -> Action rep
actionf = do
let action :: Action rep
action = FutharkConfig -> CompilerMode -> [Char] -> Action rep
actionf (Config -> FutharkConfig
futharkConfig Config
config) (Config -> CompilerMode
futharkCompilerMode Config
config) [Char]
base
forall {k} {rep :: k}. 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
forall (m :: * -> *) a. (MonadLogger m, ToLog a) => a -> m ()
logMsg forall a b. (a -> b) -> a -> b
$ [Char]
"Running action " forall a. [a] -> [a] -> [a]
++ forall {k} (rep :: k). Action rep -> [Char]
actionName Action rep
action
forall {k} {rep :: k}. Action rep -> Prog rep -> FutharkM ()
actionProcedure Action rep
action Prog rep
prog
pipeline_config :: PipelineConfig
pipeline_config =
PipelineConfig
{ pipelineVerbose :: Bool
pipelineVerbose = forall a b. (a, b) -> a
fst (FutharkConfig -> (Verbosity, Maybe [Char])
futharkVerbose forall a b. (a -> b) -> a -> b
$ Config -> FutharkConfig
futharkConfig Config
config) forall a. Ord a => a -> a -> Bool
> Verbosity
NotVerbose,
pipelineValidate :: Bool
pipelineValidate = FutharkConfig -> Bool
futharkTypeCheck 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