{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}

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

import Control.Category (id)
import Control.Monad
import Control.Monad.State
import Data.List (intersperse)
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Futhark.Actions
import Futhark.Analysis.Metrics (OpMetrics)
import Futhark.Compiler.CLI
import Futhark.IR (ASTLore, Op, Prog, pretty)
import qualified Futhark.IR.Kernels as Kernels
import qualified Futhark.IR.KernelsMem as KernelsMem
import qualified Futhark.IR.MC as MC
import qualified Futhark.IR.MCMem as MCMem
import Futhark.IR.Parse
import Futhark.IR.Prop.Aliases (CanBeAliased)
import qualified Futhark.IR.SOACS as SOACS
import qualified Futhark.IR.Seq as Seq
import qualified Futhark.IR.SeqMem as SeqMem
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.CSE
import Futhark.Optimise.DoubleBuffer
import Futhark.Optimise.Fusion
import Futhark.Optimise.InPlaceLowering
import Futhark.Optimise.InliningDeadFun
import Futhark.Optimise.Sink
import Futhark.Optimise.TileLoops
import Futhark.Optimise.Unstream
import Futhark.Pass
import Futhark.Pass.ExpandAllocations
import qualified Futhark.Pass.ExplicitAllocations.Kernels as Kernels
import qualified Futhark.Pass.ExplicitAllocations.Seq as Seq
import Futhark.Pass.ExtractKernels
import Futhark.Pass.ExtractMulticore
import Futhark.Pass.FirstOrderTransform
import Futhark.Pass.KernelBabysitting
import Futhark.Pass.Simplify
import Futhark.Passes
import Futhark.TypeCheck (Checkable)
import Futhark.Util.Log
import Futhark.Util.Options
import qualified Futhark.Util.Pretty as PP
import Language.Futhark.Core (nameFromString)
import Language.Futhark.Parser (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 monomorphise.
    Monomorphise
  | -- | Defunctorise, monomorphise, and lambda-lift.
    LiftLambdas
  | -- | Defunctorise, 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 -> 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)
  | Kernels (Prog Kernels.Kernels)
  | MC (Prog MC.MC)
  | Seq (Prog Seq.Seq)
  | KernelsMem (Prog KernelsMem.KernelsMem)
  | 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 -> [Char]
representation (SOACS Prog SOACS
_) = [Char]
"SOACS"
  representation (Kernels Prog Kernels
_) = [Char]
"Kernels"
  representation (MC Prog MC
_) = [Char]
"MC"
  representation (Seq Prog Seq
_) = [Char]
"Seq"
  representation (KernelsMem Prog KernelsMem
_) = [Char]
"KernelsMem"
  representation (MCMem Prog MCMem
_) = [Char]
"MCMem"
  representation (SeqMem Prog SeqMem
_) = [Char]
"SeqMEm"

instance PP.Pretty UntypedPassState where
  ppr :: UntypedPassState -> Doc
ppr (SOACS Prog SOACS
prog) = Prog SOACS -> Doc
forall a. Pretty a => a -> Doc
PP.ppr Prog SOACS
prog
  ppr (Kernels Prog Kernels
prog) = Prog Kernels -> Doc
forall a. Pretty a => a -> Doc
PP.ppr Prog Kernels
prog
  ppr (MC Prog MC
prog) = Prog MC -> Doc
forall a. Pretty a => a -> Doc
PP.ppr Prog MC
prog
  ppr (Seq Prog Seq
prog) = Prog Seq -> Doc
forall a. Pretty a => a -> Doc
PP.ppr Prog Seq
prog
  ppr (SeqMem Prog SeqMem
prog) = Prog SeqMem -> Doc
forall a. Pretty a => a -> Doc
PP.ppr Prog SeqMem
prog
  ppr (MCMem Prog MCMem
prog) = Prog MCMem -> Doc
forall a. Pretty a => a -> Doc
PP.ppr Prog MCMem
prog
  ppr (KernelsMem Prog KernelsMem
prog) = Prog KernelsMem -> Doc
forall a. Pretty a => a -> Doc
PP.ppr Prog KernelsMem
prog

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

data UntypedAction
  = SOACSAction (Action SOACS.SOACS)
  | KernelsAction (Action Kernels.Kernels)
  | KernelsMemAction (FilePath -> Action KernelsMem.KernelsMem)
  | MCMemAction (FilePath -> Action MCMem.MCMem)
  | SeqMemAction (FilePath -> Action SeqMem.SeqMem)
  | PolyAction
      ( forall lore.
        ( ASTLore lore,
          (CanBeAliased (Op lore)),
          (OpMetrics (Op lore))
        ) =>
        Action lore
      )

untypedActionName :: UntypedAction -> String
untypedActionName :: UntypedAction -> [Char]
untypedActionName (SOACSAction Action SOACS
a) = Action SOACS -> [Char]
forall lore. Action lore -> [Char]
actionName Action SOACS
a
untypedActionName (KernelsAction Action Kernels
a) = Action Kernels -> [Char]
forall lore. Action lore -> [Char]
actionName Action Kernels
a
untypedActionName (SeqMemAction [Char] -> Action SeqMem
a) = Action SeqMem -> [Char]
forall lore. Action lore -> [Char]
actionName (Action SeqMem -> [Char]) -> Action SeqMem -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Action SeqMem
a [Char]
""
untypedActionName (KernelsMemAction [Char] -> Action KernelsMem
a) = Action KernelsMem -> [Char]
forall lore. Action lore -> [Char]
actionName (Action KernelsMem -> [Char]) -> Action KernelsMem -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Action KernelsMem
a [Char]
""
untypedActionName (MCMemAction [Char] -> Action MCMem
a) = Action MCMem -> [Char]
forall lore. Action lore -> [Char]
actionName (Action MCMem -> [Char]) -> Action MCMem -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Action MCMem
a [Char]
""
untypedActionName (PolyAction forall lore.
(ASTLore lore, CanBeAliased (Op lore), OpMetrics (Op lore)) =>
Action lore
a) = Action SOACS -> [Char]
forall lore. Action lore -> [Char]
actionName (Action SOACS
forall lore.
(ASTLore lore, CanBeAliased (Op lore), OpMetrics (Op lore)) =>
Action lore
a :: Action SOACS.SOACS)

instance Representation UntypedAction where
  representation :: UntypedAction -> [Char]
representation (SOACSAction Action SOACS
_) = [Char]
"SOACS"
  representation (KernelsAction Action Kernels
_) = [Char]
"Kernels"
  representation (KernelsMemAction [Char] -> Action KernelsMem
_) = [Char]
"KernelsMem"
  representation (MCMemAction [Char] -> Action MCMem
_) = [Char]
"MCMem"
  representation (SeqMemAction [Char] -> Action SeqMem
_) = [Char]
"SeqMem"
  representation PolyAction {} = [Char]
"<any>"

newConfig :: Config
newConfig :: Config
newConfig = FutharkConfig -> FutharkPipeline -> UntypedAction -> Bool -> Config
Config FutharkConfig
newFutharkConfig ([UntypedPass] -> FutharkPipeline
Pipeline []) UntypedAction
action Bool
False
  where
    action :: UntypedAction
action = (forall lore.
 (ASTLore lore, CanBeAliased (Op lore), OpMetrics (Op lore)) =>
 Action lore)
-> UntypedAction
PolyAction forall lore. ASTLore lore => Action lore
forall lore.
(ASTLore lore, CanBeAliased (Op lore), OpMetrics (Op lore)) =>
Action lore
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 (FutharkConfig -> FutharkConfig) -> FutharkConfig -> FutharkConfig
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 =
  [Char]
-> [[Char]]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> [Char]
-> FutharkOption
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
    [Char]
short
    [[Char]]
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 :: FutharkPipeline
futharkPipeline = [UntypedPass] -> FutharkPipeline
Pipeline ([UntypedPass] -> FutharkPipeline)
-> [UntypedPass] -> FutharkPipeline
forall a b. (a -> b) -> a -> b
$ Config -> [UntypedPass]
getFutharkPipeline Config
cfg [UntypedPass] -> [UntypedPass] -> [UntypedPass]
forall a. [a] -> [a] -> [a]
++ [UntypedPass
pass]}
    )
    [Char]
desc

kernelsMemProg ::
  String ->
  UntypedPassState ->
  FutharkM (Prog KernelsMem.KernelsMem)
kernelsMemProg :: [Char] -> UntypedPassState -> FutharkM (Prog KernelsMem)
kernelsMemProg [Char]
_ (KernelsMem Prog KernelsMem
prog) =
  Prog KernelsMem -> FutharkM (Prog KernelsMem)
forall (m :: * -> *) a. Monad m => a -> m a
return Prog KernelsMem
prog
kernelsMemProg [Char]
name UntypedPassState
rep =
  [Char] -> FutharkM (Prog KernelsMem)
forall (m :: * -> *) a. MonadError CompilerError m => [Char] -> m a
externalErrorS ([Char] -> FutharkM (Prog KernelsMem))
-> [Char] -> FutharkM (Prog KernelsMem)
forall a b. (a -> b) -> a -> b
$
    [Char]
"Pass " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name
      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" expects KernelsMem representation, but got "
      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UntypedPassState -> [Char]
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) =
  Prog SOACS -> FutharkM (Prog SOACS)
forall (m :: * -> *) a. Monad m => a -> m a
return Prog SOACS
prog
soacsProg [Char]
name UntypedPassState
rep =
  [Char] -> FutharkM (Prog SOACS)
forall (m :: * -> *) a. MonadError CompilerError m => [Char] -> m a
externalErrorS ([Char] -> FutharkM (Prog SOACS))
-> [Char] -> FutharkM (Prog SOACS)
forall a b. (a -> b) -> a -> b
$
    [Char]
"Pass " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name
      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" expects SOACS representation, but got "
      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UntypedPassState -> [Char]
forall s. Representation s => s -> [Char]
representation UntypedPassState
rep

kernelsProg :: String -> UntypedPassState -> FutharkM (Prog Kernels.Kernels)
kernelsProg :: [Char] -> UntypedPassState -> FutharkM (Prog Kernels)
kernelsProg [Char]
_ (Kernels Prog Kernels
prog) =
  Prog Kernels -> FutharkM (Prog Kernels)
forall (m :: * -> *) a. Monad m => a -> m a
return Prog Kernels
prog
kernelsProg [Char]
name UntypedPassState
rep =
  [Char] -> FutharkM (Prog Kernels)
forall (m :: * -> *) a. MonadError CompilerError m => [Char] -> m a
externalErrorS ([Char] -> FutharkM (Prog Kernels))
-> [Char] -> FutharkM (Prog Kernels)
forall a b. (a -> b) -> a -> b
$
    [Char]
"Pass " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" expects Kernels representation, but got " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UntypedPassState -> [Char]
forall s. Representation s => s -> [Char]
representation UntypedPassState
rep

typedPassOption ::
  Checkable tolore =>
  (String -> UntypedPassState -> FutharkM (Prog fromlore)) ->
  (Prog tolore -> UntypedPassState) ->
  Pass fromlore tolore ->
  String ->
  FutharkOption
typedPassOption :: forall tolore fromlore.
Checkable tolore =>
([Char] -> UntypedPassState -> FutharkM (Prog fromlore))
-> (Prog tolore -> UntypedPassState)
-> Pass fromlore tolore
-> [Char]
-> FutharkOption
typedPassOption [Char] -> UntypedPassState -> FutharkM (Prog fromlore)
getProg Prog tolore -> UntypedPassState
putProg Pass fromlore tolore
pass [Char]
short =
  [Char] -> UntypedPass -> [Char] -> [[Char]] -> FutharkOption
passOption (Pass fromlore tolore -> [Char]
forall fromlore tolore. Pass fromlore tolore -> [Char]
passDescription Pass fromlore tolore
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 fromlore
prog <- [Char] -> UntypedPassState -> FutharkM (Prog fromlore)
getProg (Pass fromlore tolore -> [Char]
forall fromlore tolore. Pass fromlore tolore -> [Char]
passName Pass fromlore tolore
pass) UntypedPassState
s
      Prog tolore -> UntypedPassState
putProg (Prog tolore -> UntypedPassState)
-> FutharkM (Prog tolore) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline fromlore tolore
-> PipelineConfig -> Prog fromlore -> FutharkM (Prog tolore)
forall fromlore tolore.
Pipeline fromlore tolore
-> PipelineConfig -> Prog fromlore -> FutharkM (Prog tolore)
runPipeline (Pass fromlore tolore -> Pipeline fromlore tolore
forall tolore fromlore.
Checkable tolore =>
Pass fromlore tolore -> Pipeline fromlore tolore
onePass Pass fromlore tolore
pass) PipelineConfig
config Prog fromlore
prog

    long :: [[Char]]
long = [Pass fromlore tolore -> [Char]
forall fromlore tolore. Pass fromlore tolore -> [Char]
passLongOption Pass fromlore tolore
pass]

soacsPassOption :: Pass SOACS.SOACS SOACS.SOACS -> String -> FutharkOption
soacsPassOption :: Pass SOACS SOACS -> [Char] -> FutharkOption
soacsPassOption =
  ([Char] -> UntypedPassState -> FutharkM (Prog SOACS))
-> (Prog SOACS -> UntypedPassState)
-> Pass SOACS SOACS
-> [Char]
-> FutharkOption
forall tolore fromlore.
Checkable tolore =>
([Char] -> UntypedPassState -> FutharkM (Prog fromlore))
-> (Prog tolore -> UntypedPassState)
-> Pass fromlore tolore
-> [Char]
-> FutharkOption
typedPassOption [Char] -> UntypedPassState -> FutharkM (Prog SOACS)
soacsProg Prog SOACS -> UntypedPassState
SOACS

kernelsPassOption ::
  Pass Kernels.Kernels Kernels.Kernels ->
  String ->
  FutharkOption
kernelsPassOption :: Pass Kernels Kernels -> [Char] -> FutharkOption
kernelsPassOption =
  ([Char] -> UntypedPassState -> FutharkM (Prog Kernels))
-> (Prog Kernels -> UntypedPassState)
-> Pass Kernels Kernels
-> [Char]
-> FutharkOption
forall tolore fromlore.
Checkable tolore =>
([Char] -> UntypedPassState -> FutharkM (Prog fromlore))
-> (Prog tolore -> UntypedPassState)
-> Pass fromlore tolore
-> [Char]
-> FutharkOption
typedPassOption [Char] -> UntypedPassState -> FutharkM (Prog Kernels)
kernelsProg Prog Kernels -> UntypedPassState
Kernels

kernelsMemPassOption ::
  Pass KernelsMem.KernelsMem KernelsMem.KernelsMem ->
  String ->
  FutharkOption
kernelsMemPassOption :: Pass KernelsMem KernelsMem -> [Char] -> FutharkOption
kernelsMemPassOption =
  ([Char] -> UntypedPassState -> FutharkM (Prog KernelsMem))
-> (Prog KernelsMem -> UntypedPassState)
-> Pass KernelsMem KernelsMem
-> [Char]
-> FutharkOption
forall tolore fromlore.
Checkable tolore =>
([Char] -> UntypedPassState -> FutharkM (Prog fromlore))
-> (Prog tolore -> UntypedPassState)
-> Pass fromlore tolore
-> [Char]
-> FutharkOption
typedPassOption [Char] -> UntypedPassState -> FutharkM (Prog KernelsMem)
kernelsMemProg Prog KernelsMem -> UntypedPassState
KernelsMem

simplifyOption :: String -> FutharkOption
simplifyOption :: [Char] -> FutharkOption
simplifyOption [Char]
short =
  [Char] -> UntypedPass -> [Char] -> [[Char]] -> FutharkOption
passOption (Pass SOACS SOACS -> [Char]
forall fromlore tolore. Pass fromlore tolore -> [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 (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 fromlore tolore.
Pipeline fromlore tolore
-> PipelineConfig -> Prog fromlore -> FutharkM (Prog tolore)
runPipeline (Pass SOACS SOACS -> Pipeline SOACS SOACS
forall tolore fromlore.
Checkable tolore =>
Pass fromlore tolore -> Pipeline fromlore tolore
onePass Pass SOACS SOACS
simplifySOACS) PipelineConfig
config Prog SOACS
prog
    perform (Kernels Prog Kernels
prog) PipelineConfig
config =
      Prog Kernels -> UntypedPassState
Kernels (Prog Kernels -> UntypedPassState)
-> FutharkM (Prog Kernels) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline Kernels Kernels
-> PipelineConfig -> Prog Kernels -> FutharkM (Prog Kernels)
forall fromlore tolore.
Pipeline fromlore tolore
-> PipelineConfig -> Prog fromlore -> FutharkM (Prog tolore)
runPipeline (Pass Kernels Kernels -> Pipeline Kernels Kernels
forall tolore fromlore.
Checkable tolore =>
Pass fromlore tolore -> Pipeline fromlore tolore
onePass Pass Kernels Kernels
simplifyKernels) PipelineConfig
config Prog Kernels
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 fromlore tolore.
Pipeline fromlore tolore
-> PipelineConfig -> Prog fromlore -> FutharkM (Prog tolore)
runPipeline (Pass MC MC -> Pipeline MC MC
forall tolore fromlore.
Checkable tolore =>
Pass fromlore tolore -> Pipeline fromlore tolore
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 fromlore tolore.
Pipeline fromlore tolore
-> PipelineConfig -> Prog fromlore -> FutharkM (Prog tolore)
runPipeline (Pass Seq Seq -> Pipeline Seq Seq
forall tolore fromlore.
Checkable tolore =>
Pass fromlore tolore -> Pipeline fromlore tolore
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 fromlore tolore.
Pipeline fromlore tolore
-> PipelineConfig -> Prog fromlore -> FutharkM (Prog tolore)
runPipeline (Pass SeqMem SeqMem -> Pipeline SeqMem SeqMem
forall tolore fromlore.
Checkable tolore =>
Pass fromlore tolore -> Pipeline fromlore tolore
onePass Pass SeqMem SeqMem
simplifySeqMem) PipelineConfig
config Prog SeqMem
prog
    perform (KernelsMem Prog KernelsMem
prog) PipelineConfig
config =
      Prog KernelsMem -> UntypedPassState
KernelsMem (Prog KernelsMem -> UntypedPassState)
-> FutharkM (Prog KernelsMem) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline KernelsMem KernelsMem
-> PipelineConfig -> Prog KernelsMem -> FutharkM (Prog KernelsMem)
forall fromlore tolore.
Pipeline fromlore tolore
-> PipelineConfig -> Prog fromlore -> FutharkM (Prog tolore)
runPipeline (Pass KernelsMem KernelsMem -> Pipeline KernelsMem KernelsMem
forall tolore fromlore.
Checkable tolore =>
Pass fromlore tolore -> Pipeline fromlore tolore
onePass Pass KernelsMem KernelsMem
simplifyKernelsMem) PipelineConfig
config Prog KernelsMem
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 fromlore tolore.
Pipeline fromlore tolore
-> PipelineConfig -> Prog fromlore -> FutharkM (Prog tolore)
runPipeline (Pass MCMem MCMem -> Pipeline MCMem MCMem
forall tolore fromlore.
Checkable tolore =>
Pass fromlore tolore -> Pipeline fromlore tolore
onePass Pass MCMem MCMem
simplifyMCMem) PipelineConfig
config Prog MCMem
prog

    long :: [[Char]]
long = [Pass SOACS SOACS -> [Char]
forall fromlore tolore. Pass fromlore tolore -> [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 (Pass Seq SeqMem -> [Char]
forall fromlore tolore. Pass fromlore tolore -> [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 (Kernels Prog Kernels
prog) PipelineConfig
config =
      Prog KernelsMem -> UntypedPassState
KernelsMem
        (Prog KernelsMem -> UntypedPassState)
-> FutharkM (Prog KernelsMem) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline Kernels KernelsMem
-> PipelineConfig -> Prog Kernels -> FutharkM (Prog KernelsMem)
forall fromlore tolore.
Pipeline fromlore tolore
-> PipelineConfig -> Prog fromlore -> FutharkM (Prog tolore)
runPipeline (Pass Kernels KernelsMem -> Pipeline Kernels KernelsMem
forall tolore fromlore.
Checkable tolore =>
Pass fromlore tolore -> Pipeline fromlore tolore
onePass Pass Kernels KernelsMem
Kernels.explicitAllocations) PipelineConfig
config Prog Kernels
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 fromlore tolore.
Pipeline fromlore tolore
-> PipelineConfig -> Prog fromlore -> FutharkM (Prog tolore)
runPipeline (Pass Seq SeqMem -> Pipeline Seq SeqMem
forall tolore fromlore.
Checkable tolore =>
Pass fromlore tolore -> Pipeline fromlore tolore
onePass Pass Seq SeqMem
Seq.explicitAllocations) PipelineConfig
config Prog Seq
prog
    perform UntypedPassState
s PipelineConfig
_ =
      [Char] -> FutharkM UntypedPassState
forall (m :: * -> *) a. MonadError CompilerError m => [Char] -> m a
externalErrorS ([Char] -> FutharkM UntypedPassState)
-> [Char] -> FutharkM UntypedPassState
forall a b. (a -> b) -> a -> b
$
        [Char]
"Pass '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Pass Seq SeqMem -> [Char]
forall fromlore tolore. Pass fromlore tolore -> [Char]
passDescription Pass Seq SeqMem
pass [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' cannot operate on " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UntypedPassState -> [Char]
forall s. Representation s => s -> [Char]
representation UntypedPassState
s

    long :: [[Char]]
long = [Pass Seq SeqMem -> [Char]
forall fromlore tolore. Pass fromlore tolore -> [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 (Pass Seq Seq -> [Char]
forall fromlore tolore. Pass fromlore tolore -> [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 (Kernels Prog Kernels
prog) PipelineConfig
config =
      Prog Kernels -> UntypedPassState
Kernels
        (Prog Kernels -> UntypedPassState)
-> FutharkM (Prog Kernels) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline Kernels Kernels
-> PipelineConfig -> Prog Kernels -> FutharkM (Prog Kernels)
forall fromlore tolore.
Pipeline fromlore tolore
-> PipelineConfig -> Prog fromlore -> FutharkM (Prog tolore)
runPipeline (Pass Kernels Kernels -> Pipeline Kernels Kernels
forall tolore fromlore.
Checkable tolore =>
Pass fromlore tolore -> Pipeline fromlore tolore
onePass Pass Kernels Kernels
inPlaceLoweringKernels) PipelineConfig
config Prog Kernels
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 fromlore tolore.
Pipeline fromlore tolore
-> PipelineConfig -> Prog fromlore -> FutharkM (Prog tolore)
runPipeline (Pass Seq Seq -> Pipeline Seq Seq
forall tolore fromlore.
Checkable tolore =>
Pass fromlore tolore -> Pipeline fromlore tolore
onePass Pass Seq Seq
inPlaceLoweringSeq) PipelineConfig
config Prog Seq
prog
    perform UntypedPassState
s PipelineConfig
_ =
      [Char] -> FutharkM UntypedPassState
forall (m :: * -> *) a. MonadError CompilerError m => [Char] -> m a
externalErrorS ([Char] -> FutharkM UntypedPassState)
-> [Char] -> FutharkM UntypedPassState
forall a b. (a -> b) -> a -> b
$
        [Char]
"Pass '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Pass Seq Seq -> [Char]
forall fromlore tolore. Pass fromlore tolore -> [Char]
passDescription Pass Seq Seq
pass [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' cannot operate on " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UntypedPassState -> [Char]
forall s. Representation s => s -> [Char]
representation UntypedPassState
s

    long :: [[Char]]
long = [Pass Seq Seq -> [Char]
forall fromlore tolore. Pass fromlore tolore -> [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 (Pass SOACS SOACS -> [Char]
forall fromlore tolore. Pass fromlore tolore -> [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 (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 fromlore tolore.
Pipeline fromlore tolore
-> PipelineConfig -> Prog fromlore -> FutharkM (Prog tolore)
runPipeline (Pass SOACS SOACS -> Pipeline SOACS SOACS
forall tolore fromlore.
Checkable tolore =>
Pass fromlore tolore -> Pipeline fromlore tolore
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 lore.
(ASTLore lore, CanBeAliased (Op lore),
 CSEInOp (OpWithAliases (Op lore))) =>
Bool -> Pass lore lore
performCSE Bool
True) PipelineConfig
config Prog SOACS
prog
    perform (Kernels Prog Kernels
prog) PipelineConfig
config =
      Prog Kernels -> UntypedPassState
Kernels (Prog Kernels -> UntypedPassState)
-> FutharkM (Prog Kernels) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline Kernels Kernels
-> PipelineConfig -> Prog Kernels -> FutharkM (Prog Kernels)
forall fromlore tolore.
Pipeline fromlore tolore
-> PipelineConfig -> Prog fromlore -> FutharkM (Prog tolore)
runPipeline (Pass Kernels Kernels -> Pipeline Kernels Kernels
forall tolore fromlore.
Checkable tolore =>
Pass fromlore tolore -> Pipeline fromlore tolore
onePass (Pass Kernels Kernels -> Pipeline Kernels Kernels)
-> Pass Kernels Kernels -> Pipeline Kernels Kernels
forall a b. (a -> b) -> a -> b
$ Bool -> Pass Kernels Kernels
forall lore.
(ASTLore lore, CanBeAliased (Op lore),
 CSEInOp (OpWithAliases (Op lore))) =>
Bool -> Pass lore lore
performCSE Bool
True) PipelineConfig
config Prog Kernels
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 fromlore tolore.
Pipeline fromlore tolore
-> PipelineConfig -> Prog fromlore -> FutharkM (Prog tolore)
runPipeline (Pass MC MC -> Pipeline MC MC
forall tolore fromlore.
Checkable tolore =>
Pass fromlore tolore -> Pipeline fromlore tolore
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 lore.
(ASTLore lore, CanBeAliased (Op lore),
 CSEInOp (OpWithAliases (Op lore))) =>
Bool -> Pass lore lore
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 fromlore tolore.
Pipeline fromlore tolore
-> PipelineConfig -> Prog fromlore -> FutharkM (Prog tolore)
runPipeline (Pass Seq Seq -> Pipeline Seq Seq
forall tolore fromlore.
Checkable tolore =>
Pass fromlore tolore -> Pipeline fromlore tolore
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 lore.
(ASTLore lore, CanBeAliased (Op lore),
 CSEInOp (OpWithAliases (Op lore))) =>
Bool -> Pass lore lore
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 fromlore tolore.
Pipeline fromlore tolore
-> PipelineConfig -> Prog fromlore -> FutharkM (Prog tolore)
runPipeline (Pass SeqMem SeqMem -> Pipeline SeqMem SeqMem
forall tolore fromlore.
Checkable tolore =>
Pass fromlore tolore -> Pipeline fromlore tolore
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 lore.
(ASTLore lore, CanBeAliased (Op lore),
 CSEInOp (OpWithAliases (Op lore))) =>
Bool -> Pass lore lore
performCSE Bool
False) PipelineConfig
config Prog SeqMem
prog
    perform (KernelsMem Prog KernelsMem
prog) PipelineConfig
config =
      Prog KernelsMem -> UntypedPassState
KernelsMem (Prog KernelsMem -> UntypedPassState)
-> FutharkM (Prog KernelsMem) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline KernelsMem KernelsMem
-> PipelineConfig -> Prog KernelsMem -> FutharkM (Prog KernelsMem)
forall fromlore tolore.
Pipeline fromlore tolore
-> PipelineConfig -> Prog fromlore -> FutharkM (Prog tolore)
runPipeline (Pass KernelsMem KernelsMem -> Pipeline KernelsMem KernelsMem
forall tolore fromlore.
Checkable tolore =>
Pass fromlore tolore -> Pipeline fromlore tolore
onePass (Pass KernelsMem KernelsMem -> Pipeline KernelsMem KernelsMem)
-> Pass KernelsMem KernelsMem -> Pipeline KernelsMem KernelsMem
forall a b. (a -> b) -> a -> b
$ Bool -> Pass KernelsMem KernelsMem
forall lore.
(ASTLore lore, CanBeAliased (Op lore),
 CSEInOp (OpWithAliases (Op lore))) =>
Bool -> Pass lore lore
performCSE Bool
False) PipelineConfig
config Prog KernelsMem
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 fromlore tolore.
Pipeline fromlore tolore
-> PipelineConfig -> Prog fromlore -> FutharkM (Prog tolore)
runPipeline (Pass MCMem MCMem -> Pipeline MCMem MCMem
forall tolore fromlore.
Checkable tolore =>
Pass fromlore tolore -> Pipeline fromlore tolore
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 lore.
(ASTLore lore, CanBeAliased (Op lore),
 CSEInOp (OpWithAliases (Op lore))) =>
Bool -> Pass lore lore
performCSE Bool
False) PipelineConfig
config Prog MCMem
prog

    long :: [[Char]]
long = [Pass SOACS SOACS -> [Char]
forall fromlore tolore. Pass fromlore tolore -> [Char]
passLongOption Pass SOACS SOACS
pass]
    pass :: Pass SOACS SOACS
pass = Bool -> Pass SOACS SOACS
forall lore.
(ASTLore lore, CanBeAliased (Op lore),
 CSEInOp (OpWithAliases (Op lore))) =>
Bool -> Pass lore lore
performCSE Bool
True :: Pass SOACS.SOACS SOACS.SOACS

pipelineOption ::
  (UntypedPassState -> Maybe (Prog fromlore)) ->
  String ->
  (Prog tolore -> UntypedPassState) ->
  String ->
  Pipeline fromlore tolore ->
  String ->
  [String] ->
  FutharkOption
pipelineOption :: forall fromlore tolore.
(UntypedPassState -> Maybe (Prog fromlore))
-> [Char]
-> (Prog tolore -> UntypedPassState)
-> [Char]
-> Pipeline fromlore tolore
-> [Char]
-> [[Char]]
-> FutharkOption
pipelineOption UntypedPassState -> Maybe (Prog fromlore)
getprog [Char]
repdesc Prog tolore -> UntypedPassState
repf [Char]
desc Pipeline fromlore tolore
pipeline =
  [Char] -> UntypedPass -> [Char] -> [[Char]] -> FutharkOption
passOption [Char]
desc (UntypedPass -> [Char] -> [[Char]] -> FutharkOption)
-> UntypedPass -> [Char] -> [[Char]] -> 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 fromlore)
getprog UntypedPassState
rep of
        Just Prog fromlore
prog ->
          Prog tolore -> UntypedPassState
repf (Prog tolore -> UntypedPassState)
-> FutharkM (Prog tolore) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline fromlore tolore
-> PipelineConfig -> Prog fromlore -> FutharkM (Prog tolore)
forall fromlore tolore.
Pipeline fromlore tolore
-> PipelineConfig -> Prog fromlore -> FutharkM (Prog tolore)
runPipeline Pipeline fromlore tolore
pipeline PipelineConfig
config Prog fromlore
prog
        Maybe (Prog fromlore)
Nothing ->
          [Char] -> FutharkM UntypedPassState
forall (m :: * -> *) a. MonadError CompilerError m => [Char] -> m a
externalErrorS ([Char] -> FutharkM UntypedPassState)
-> [Char] -> FutharkM UntypedPassState
forall a b. (a -> b) -> a -> b
$
            [Char]
"Expected " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
repdesc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" representation, but got "
              [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UntypedPassState -> [Char]
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 = (UntypedPassState -> Maybe (Prog SOACS))
-> [Char]
-> (Prog SOACS -> UntypedPassState)
-> [Char]
-> Pipeline SOACS SOACS
-> [Char]
-> [[Char]]
-> FutharkOption
forall fromlore tolore.
(UntypedPassState -> Maybe (Prog fromlore))
-> [Char]
-> (Prog tolore -> UntypedPassState)
-> [Char]
-> Pipeline fromlore tolore
-> [Char]
-> [[Char]]
-> FutharkOption
pipelineOption UntypedPassState -> Maybe (Prog SOACS)
getSOACSProg [Char]
"SOACS" Prog SOACS -> UntypedPassState
SOACS

commandLineOptions :: [FutharkOption]
commandLineOptions :: [FutharkOption]
commandLineOptions =
  [ [Char]
-> [[Char]]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> [Char]
-> FutharkOption
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
      [Char]
"v"
      [[Char]
"verbose"]
      ((Maybe [Char] -> Either (IO ()) (Config -> Config))
-> [Char] -> ArgDescr (Either (IO ()) (Config -> Config))
forall a. (Maybe [Char] -> a) -> [Char] -> ArgDescr a
OptArg ((Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Maybe [Char] -> Config -> Config)
-> Maybe [Char]
-> Either (IO ()) (Config -> Config)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FutharkConfig -> FutharkConfig) -> Config -> Config
changeFutharkConfig ((FutharkConfig -> FutharkConfig) -> Config -> Config)
-> (Maybe [Char] -> FutharkConfig -> FutharkConfig)
-> Maybe [Char]
-> Config
-> Config
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.",
    [Char]
-> [[Char]]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> [Char]
-> FutharkOption
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
      []
      [[Char]
"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 :: Bool
futharkWerror = Bool
True})
      [Char]
"Treat warnings as errors.",
    [Char]
-> [[Char]]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> [Char]
-> FutharkOption
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
      [Char]
"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 :: Bool
futharkWarn = Bool
False})
      [Char]
"Disable all warnings.",
    [Char]
-> [[Char]]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> [Char]
-> FutharkOption
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
      [Char]
"t"
      [[Char]
"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 :: FutharkPipeline
futharkPipeline = FutharkPipeline
TypeCheck}
      )
      [Char]
"Print on standard output the type-checked program.",
    [Char]
-> [[Char]]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> [Char]
-> FutharkOption
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
      []
      [[Char]
"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 :: Bool
futharkTypeCheck = Bool
False}
      )
      [Char]
"Disable type-checking.",
    [Char]
-> [[Char]]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> [Char]
-> FutharkOption
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
      []
      [[Char]
"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 :: FutharkPipeline
futharkPipeline = FutharkPipeline
PrettyPrint}
      )
      [Char]
"Parse and pretty-print the AST of the given program.",
    [Char]
-> [[Char]]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> [Char]
-> FutharkOption
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
      []
      [[Char]
"compile-imperative"]
      ( 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 :: UntypedAction
futharkAction = ([Char] -> Action SeqMem) -> UntypedAction
SeqMemAction (([Char] -> Action SeqMem) -> UntypedAction)
-> ([Char] -> Action SeqMem) -> UntypedAction
forall a b. (a -> b) -> a -> b
$ Action SeqMem -> [Char] -> Action SeqMem
forall a b. a -> b -> a
const Action SeqMem
impCodeGenAction}
      )
      [Char]
"Translate program into the imperative IL and write it on standard output.",
    [Char]
-> [[Char]]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> [Char]
-> FutharkOption
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
      []
      [[Char]
"compile-imperative-kernels"]
      ( 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 :: UntypedAction
futharkAction = ([Char] -> Action KernelsMem) -> UntypedAction
KernelsMemAction (([Char] -> Action KernelsMem) -> UntypedAction)
-> ([Char] -> Action KernelsMem) -> UntypedAction
forall a b. (a -> b) -> a -> b
$ Action KernelsMem -> [Char] -> Action KernelsMem
forall a b. a -> b -> a
const Action KernelsMem
kernelImpCodeGenAction}
      )
      [Char]
"Translate program into the imperative IL with kernels and write it on standard output.",
    [Char]
-> [[Char]]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> [Char]
-> FutharkOption
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
      []
      [[Char]
"compile-imperative-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 :: UntypedAction
futharkAction = ([Char] -> Action MCMem) -> UntypedAction
MCMemAction (([Char] -> Action MCMem) -> UntypedAction)
-> ([Char] -> Action MCMem) -> UntypedAction
forall a b. (a -> b) -> a -> b
$ Action MCMem -> [Char] -> Action MCMem
forall a b. a -> b -> a
const Action MCMem
multicoreImpCodeGenAction}
      )
      [Char]
"Translate program into the imperative IL with kernels and write it on standard output.",
    [Char]
-> [[Char]]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> [Char]
-> FutharkOption
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
      []
      [[Char]
"compile-opencl"]
      ( 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 :: UntypedAction
futharkAction = ([Char] -> Action KernelsMem) -> UntypedAction
KernelsMemAction (([Char] -> Action KernelsMem) -> UntypedAction)
-> ([Char] -> Action KernelsMem) -> UntypedAction
forall a b. (a -> b) -> a -> b
$ FutharkConfig -> CompilerMode -> [Char] -> Action KernelsMem
compileOpenCLAction FutharkConfig
newFutharkConfig CompilerMode
ToExecutable}
      )
      [Char]
"Compile the program using the OpenCL backend.",
    [Char]
-> [[Char]]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> [Char]
-> FutharkOption
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
      []
      [[Char]
"compile-c"]
      ( 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 :: UntypedAction
futharkAction = ([Char] -> Action SeqMem) -> UntypedAction
SeqMemAction (([Char] -> Action SeqMem) -> UntypedAction)
-> ([Char] -> Action SeqMem) -> UntypedAction
forall a b. (a -> b) -> a -> b
$ FutharkConfig -> CompilerMode -> [Char] -> Action SeqMem
compileCAction FutharkConfig
newFutharkConfig CompilerMode
ToExecutable}
      )
      [Char]
"Compile the program using the C backend.",
    [Char]
-> [[Char]]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> [Char]
-> FutharkOption
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
      [Char]
"p"
      [[Char]
"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 :: UntypedAction
futharkAction = (forall lore.
 (ASTLore lore, CanBeAliased (Op lore), OpMetrics (Op lore)) =>
 Action lore)
-> UntypedAction
PolyAction forall lore. ASTLore lore => Action lore
forall lore.
(ASTLore lore, CanBeAliased (Op lore), OpMetrics (Op lore)) =>
Action lore
printAction})
      [Char]
"Print the resulting IR (default action).",
    [Char]
-> [[Char]]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> [Char]
-> FutharkOption
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
      []
      [[Char]
"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 :: UntypedAction
futharkAction = (forall lore.
 (ASTLore lore, CanBeAliased (Op lore), OpMetrics (Op lore)) =>
 Action lore)
-> UntypedAction
PolyAction forall lore. (ASTLore lore, CanBeAliased (Op lore)) => Action lore
forall lore.
(ASTLore lore, CanBeAliased (Op lore), OpMetrics (Op lore)) =>
Action lore
printAliasesAction})
      [Char]
"Print the resulting IR with aliases.",
    [Char]
-> [[Char]]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> [Char]
-> FutharkOption
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
      [Char]
"m"
      [[Char]
"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 :: UntypedAction
futharkAction = (forall lore.
 (ASTLore lore, CanBeAliased (Op lore), OpMetrics (Op lore)) =>
 Action lore)
-> UntypedAction
PolyAction forall lore.
(ASTLore lore, CanBeAliased (Op lore), OpMetrics (Op lore)) =>
Action lore
forall lore. OpMetrics (Op lore) => Action lore
metricsAction})
      [Char]
"Print AST metrics of the resulting internal representation on standard output.",
    [Char]
-> [[Char]]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> [Char]
-> FutharkOption
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
      []
      [[Char]
"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 :: FutharkPipeline
futharkPipeline = FutharkPipeline
Defunctorise})
      [Char]
"Partially evaluate all module constructs and print the residual program.",
    [Char]
-> [[Char]]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> [Char]
-> FutharkOption
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
      []
      [[Char]
"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 :: FutharkPipeline
futharkPipeline = FutharkPipeline
Monomorphise})
      [Char]
"Monomorphise the program.",
    [Char]
-> [[Char]]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> [Char]
-> FutharkOption
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
      []
      [[Char]
"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 :: FutharkPipeline
futharkPipeline = FutharkPipeline
LiftLambdas})
      [Char]
"Lambda-lift the program.",
    [Char]
-> [[Char]]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> [Char]
-> FutharkOption
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
      []
      [[Char]
"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 :: FutharkPipeline
futharkPipeline = FutharkPipeline
Defunctionalise})
      [Char]
"Defunctionalise the program.",
    [Char]
-> [[Char]]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> [Char]
-> FutharkOption
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
      []
      [[Char]
"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 :: Bool
futharkPrintAST = Bool
True})
      [Char]
"Output ASTs instead of prettyprinted programs.",
    [Char]
-> [[Char]]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> [Char]
-> FutharkOption
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
      []
      [[Char]
"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 :: Bool
futharkSafe = Bool
True})
      [Char]
"Ignore 'unsafe'.",
    [Char]
-> [[Char]]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> [Char]
-> FutharkOption
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option
      []
      [[Char]
"entry-points"]
      ( ([Char] -> Either (IO ()) (Config -> Config))
-> [Char] -> ArgDescr (Either (IO ()) (Config -> Config))
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg
          ( \[Char]
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 :: [Name]
futharkEntryPoints = [Char] -> Name
nameFromString [Char]
arg Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: FutharkConfig -> [Name]
futharkEntryPoints FutharkConfig
opts
                  }
          )
          [Char]
"NAME"
      )
      [Char]
"Treat this function as an additional entry point.",
    ([Char] -> UntypedPassState -> FutharkM (Prog SOACS))
-> (Prog Seq -> UntypedPassState)
-> Pass SOACS Seq
-> [Char]
-> FutharkOption
forall tolore fromlore.
Checkable tolore =>
([Char] -> UntypedPassState -> FutharkM (Prog fromlore))
-> (Prog tolore -> UntypedPassState)
-> Pass fromlore tolore
-> [Char]
-> FutharkOption
typedPassOption [Char] -> UntypedPassState -> FutharkM (Prog SOACS)
soacsProg Prog Seq -> UntypedPassState
Seq Pass SOACS Seq
forall lore. FirstOrderLore lore => Pass SOACS lore
firstOrderTransform [Char]
"f",
    Pass SOACS SOACS -> [Char] -> FutharkOption
soacsPassOption Pass SOACS SOACS
fuseSOACs [Char]
"o",
    Pass SOACS SOACS -> [Char] -> FutharkOption
soacsPassOption Pass SOACS SOACS
inlineFunctions [],
    Pass Kernels Kernels -> [Char] -> FutharkOption
kernelsPassOption Pass Kernels Kernels
babysitKernels [],
    Pass Kernels Kernels -> [Char] -> FutharkOption
kernelsPassOption Pass Kernels Kernels
tileLoops [],
    Pass Kernels Kernels -> [Char] -> FutharkOption
kernelsPassOption Pass Kernels Kernels
unstreamKernels [],
    Pass Kernels Kernels -> [Char] -> FutharkOption
kernelsPassOption Pass Kernels Kernels
sinkKernels [],
    ([Char] -> UntypedPassState -> FutharkM (Prog SOACS))
-> (Prog Kernels -> UntypedPassState)
-> Pass SOACS Kernels
-> [Char]
-> FutharkOption
forall tolore fromlore.
Checkable tolore =>
([Char] -> UntypedPassState -> FutharkM (Prog fromlore))
-> (Prog tolore -> UntypedPassState)
-> Pass fromlore tolore
-> [Char]
-> FutharkOption
typedPassOption [Char] -> UntypedPassState -> FutharkM (Prog SOACS)
soacsProg Prog Kernels -> UntypedPassState
Kernels Pass SOACS Kernels
extractKernels [],
    ([Char] -> UntypedPassState -> FutharkM (Prog SOACS))
-> (Prog MC -> UntypedPassState)
-> Pass SOACS MC
-> [Char]
-> FutharkOption
forall tolore fromlore.
Checkable tolore =>
([Char] -> UntypedPassState -> FutharkM (Prog fromlore))
-> (Prog tolore -> UntypedPassState)
-> Pass fromlore tolore
-> [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 KernelsMem KernelsMem -> [Char] -> FutharkOption
kernelsMemPassOption Pass KernelsMem KernelsMem
doubleBufferKernels [],
    Pass KernelsMem KernelsMem -> [Char] -> FutharkOption
kernelsMemPassOption Pass KernelsMem KernelsMem
expandAllocations [],
    [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"],
    (UntypedPassState -> Maybe (Prog SOACS))
-> [Char]
-> (Prog Kernels -> UntypedPassState)
-> [Char]
-> Pipeline SOACS Kernels
-> [Char]
-> [[Char]]
-> FutharkOption
forall fromlore tolore.
(UntypedPassState -> Maybe (Prog fromlore))
-> [Char]
-> (Prog tolore -> UntypedPassState)
-> [Char]
-> Pipeline fromlore tolore
-> [Char]
-> [[Char]]
-> FutharkOption
pipelineOption
      UntypedPassState -> Maybe (Prog SOACS)
getSOACSProg
      [Char]
"Kernels"
      Prog Kernels -> UntypedPassState
Kernels
      [Char]
"Run the default optimised kernels pipeline"
      Pipeline SOACS Kernels
kernelsPipeline
      []
      [[Char]
"kernels"],
    (UntypedPassState -> Maybe (Prog SOACS))
-> [Char]
-> (Prog KernelsMem -> UntypedPassState)
-> [Char]
-> Pipeline SOACS KernelsMem
-> [Char]
-> [[Char]]
-> FutharkOption
forall fromlore tolore.
(UntypedPassState -> Maybe (Prog fromlore))
-> [Char]
-> (Prog tolore -> UntypedPassState)
-> [Char]
-> Pipeline fromlore tolore
-> [Char]
-> [[Char]]
-> FutharkOption
pipelineOption
      UntypedPassState -> Maybe (Prog SOACS)
getSOACSProg
      [Char]
"KernelsMem"
      Prog KernelsMem -> UntypedPassState
KernelsMem
      [Char]
"Run the full GPU compilation pipeline"
      Pipeline SOACS KernelsMem
gpuPipeline
      []
      [[Char]
"gpu"],
    (UntypedPassState -> Maybe (Prog SOACS))
-> [Char]
-> (Prog SeqMem -> UntypedPassState)
-> [Char]
-> Pipeline SOACS SeqMem
-> [Char]
-> [[Char]]
-> FutharkOption
forall fromlore tolore.
(UntypedPassState -> Maybe (Prog fromlore))
-> [Char]
-> (Prog tolore -> UntypedPassState)
-> [Char]
-> Pipeline fromlore tolore
-> [Char]
-> [[Char]]
-> FutharkOption
pipelineOption
      UntypedPassState -> Maybe (Prog SOACS)
getSOACSProg
      [Char]
"KernelsMem"
      Prog SeqMem -> UntypedPassState
SeqMem
      [Char]
"Run the sequential CPU compilation pipeline"
      Pipeline SOACS SeqMem
sequentialCpuPipeline
      []
      [[Char]
"cpu"],
    (UntypedPassState -> Maybe (Prog SOACS))
-> [Char]
-> (Prog MCMem -> UntypedPassState)
-> [Char]
-> Pipeline SOACS MCMem
-> [Char]
-> [[Char]]
-> FutharkOption
forall fromlore tolore.
(UntypedPassState -> Maybe (Prog fromlore))
-> [Char]
-> (Prog tolore -> UntypedPassState)
-> [Char]
-> Pipeline fromlore tolore
-> [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]
"multicore"]
  ]

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 Maybe [Char] -> Maybe [Char] -> Maybe [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (Verbosity, Maybe [Char]) -> Maybe [Char]
forall a b. (a, b) -> b
snd (FutharkConfig -> (Verbosity, Maybe [Char])
futharkVerbose FutharkConfig
cfg))}
  where
    v :: Verbosity
v = case (Verbosity, Maybe [Char]) -> Verbosity
forall a b. (a, b) -> a
fst ((Verbosity, Maybe [Char]) -> Verbosity)
-> (Verbosity, Maybe [Char]) -> Verbosity
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

-- | Entry point.  Non-interactive, except when reading interpreter
-- input from standard input.
main :: String -> [String] -> IO ()
main :: [Char] -> [[Char]] -> IO ()
main = Config
-> [FutharkOption]
-> [Char]
-> ([[Char]] -> Config -> Maybe (IO ()))
-> [Char]
-> [[Char]]
-> IO ()
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 =
      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 ([Char] -> Config -> FutharkM ()
m [Char]
file Config
config) (Verbosity -> IO (Either CompilerError ()))
-> Verbosity -> IO (Either CompilerError ())
forall a b. (a -> b) -> a -> b
$
            (Verbosity, Maybe [Char]) -> Verbosity
forall a b. (a, b) -> a
fst ((Verbosity, Maybe [Char]) -> Verbosity)
-> (Verbosity, Maybe [Char]) -> Verbosity
forall a b. (a -> b) -> a -> b
$ FutharkConfig -> (Verbosity, Maybe [Char])
futharkVerbose (FutharkConfig -> (Verbosity, Maybe [Char]))
-> FutharkConfig -> (Verbosity, Maybe [Char])
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 (m :: * -> *) a. Monad m => a -> m a
return ()
    compile [[Char]]
_ Config
_ =
      Maybe (IO ())
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 =
            ([Char] -> IO ()) -> [[Char]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> IO ()
putStrLn
              ([[Char]] -> IO ()) -> ([a] -> [[Char]]) -> [a] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
intersperse [Char]
""
              ([[Char]] -> [[Char]]) -> ([a] -> [[Char]]) -> [a] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [Char]) -> [a] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (if Config -> Bool
futharkPrintAST Config
config then a -> [Char]
forall a. Show a => a -> [Char]
show else a -> [Char]
forall a. Pretty a => a -> [Char]
pretty)

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

      case Config -> FutharkPipeline
futharkPipeline Config
config of
        FutharkPipeline
PrettyPrint -> IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ do
          Either ParseError UncheckedProg
maybe_prog <- [Char] -> Text -> Either ParseError UncheckedProg
parseFuthark [Char]
file (Text -> Either ParseError UncheckedProg)
-> IO Text -> IO (Either ParseError UncheckedProg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO Text
T.readFile [Char]
file
          case Either ParseError UncheckedProg
maybe_prog of
            Left ParseError
err -> [Char] -> IO ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ ParseError -> [Char]
forall a. Show a => a -> [Char]
show ParseError
err
            Right UncheckedProg
prog
              | Config -> Bool
futharkPrintAST Config
config -> UncheckedProg -> IO ()
forall a. Show a => a -> IO ()
print UncheckedProg
prog
              | Bool
otherwise -> [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ UncheckedProg -> [Char]
forall a. Pretty a => a -> [Char]
pretty UncheckedProg
prog
        FutharkPipeline
TypeCheck -> do
          (Warnings
_, Imports
imports, VNameSource
_) <- FutharkM (Warnings, Imports, VNameSource)
readProgram'
          IO () -> FutharkM ()
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_ ((([Char], FileModule) -> FileModule) -> Imports -> [FileModule]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], 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 ->
              [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
                if Config -> Bool
futharkPrintAST Config
config
                  then Prog -> [Char]
forall a. Show a => a -> [Char]
show (Prog -> [Char]) -> Prog -> [Char]
forall a b. (a -> b) -> a -> b
$ FileModule -> Prog
fileProg FileModule
fm
                  else Prog -> [Char]
forall a. Pretty a => a -> [Char]
pretty (Prog -> [Char]) -> Prog -> [Char]
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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ()) -> IO () -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ [Dec] -> IO ()
forall a. (Show a, Pretty a) => [a] -> IO ()
p ([Dec] -> IO ()) -> [Dec] -> IO ()
forall a b. (a -> b) -> a -> b
$ State VNameSource [Dec] -> VNameSource -> [Dec]
forall s a. State s a -> s -> a
evalState (Imports -> State VNameSource [Dec]
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'
          IO () -> FutharkM ()
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 -> State VNameSource [Dec]
forall (m :: * -> *). MonadFreshNames m => Imports -> m [Dec]
Defunctorise.transformProg Imports
imports
                  State VNameSource [Dec]
-> ([Dec] -> State VNameSource [ValBind])
-> State VNameSource [ValBind]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Dec] -> State VNameSource [ValBind]
forall (m :: * -> *). MonadFreshNames m => [Dec] -> m [ValBind]
Monomorphise.transformProg
        FutharkPipeline
LiftLambdas -> do
          (Warnings
_, Imports
imports, VNameSource
src) <- FutharkM (Warnings, Imports, VNameSource)
readProgram'
          IO () -> FutharkM ()
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 -> State VNameSource [Dec]
forall (m :: * -> *). MonadFreshNames m => Imports -> m [Dec]
Defunctorise.transformProg Imports
imports
                  State VNameSource [Dec]
-> ([Dec] -> State VNameSource [ValBind])
-> State VNameSource [ValBind]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Dec] -> State VNameSource [ValBind]
forall (m :: * -> *). MonadFreshNames m => [Dec] -> m [ValBind]
Monomorphise.transformProg
                  State VNameSource [ValBind]
-> ([ValBind] -> State VNameSource [ValBind])
-> State VNameSource [ValBind]
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
Defunctionalise -> do
          (Warnings
_, Imports
imports, VNameSource
src) <- FutharkM (Warnings, Imports, VNameSource)
readProgram'
          IO () -> FutharkM ()
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 -> State VNameSource [Dec]
forall (m :: * -> *). MonadFreshNames m => Imports -> m [Dec]
Defunctorise.transformProg Imports
imports
                  State VNameSource [Dec]
-> ([Dec] -> State VNameSource [ValBind])
-> State VNameSource [ValBind]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Dec] -> State VNameSource [ValBind]
forall (m :: * -> *). MonadFreshNames m => [Dec] -> m [ValBind]
Monomorphise.transformProg
                  State VNameSource [ValBind]
-> ([ValBind] -> State VNameSource [ValBind])
-> State VNameSource [ValBind]
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 (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 ([Char]
base, [Char]
ext) = [Char] -> ([Char], [Char])
splitExtension [Char]
file

              readCore :: ([Char] -> Text -> Either Text t)
-> (t -> UntypedPassState) -> FutharkM ()
readCore [Char] -> Text -> Either Text t
parse t -> UntypedPassState
construct = do
                Text
input <- IO Text -> FutharkM Text
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
$ [Char] -> IO Text
T.readFile [Char]
file
                case [Char] -> Text -> Either Text t
parse [Char]
file Text
input of
                  Left Text
err -> [Char] -> FutharkM ()
forall (m :: * -> *) a. MonadError CompilerError m => [Char] -> m a
externalErrorS ([Char] -> FutharkM ()) -> [Char] -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
err
                  Right t
prog -> Config -> [Char] -> UntypedPassState -> FutharkM ()
runPolyPasses Config
config [Char]
base (UntypedPassState -> FutharkM ())
-> UntypedPassState -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ t -> UntypedPassState
construct t
prog

              handlers :: [([Char], FutharkM ())]
handlers =
                [ ( [Char]
".fut",
                    do
                      Prog SOACS
prog <- FutharkConfig
-> Pipeline SOACS SOACS -> [Char] -> FutharkM (Prog SOACS)
forall tolore.
FutharkConfig
-> Pipeline SOACS tolore -> [Char] -> FutharkM (Prog tolore)
runPipelineOnProgram (Config -> FutharkConfig
futharkConfig Config
config) Pipeline SOACS SOACS
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", ([Char] -> Text -> Either Text (Prog SOACS))
-> (Prog SOACS -> UntypedPassState) -> FutharkM ()
forall {t}.
([Char] -> Text -> Either Text t)
-> (t -> UntypedPassState) -> FutharkM ()
readCore [Char] -> Text -> Either Text (Prog SOACS)
parseSOACS Prog SOACS -> UntypedPassState
SOACS),
                  ([Char]
".fut_seq", ([Char] -> Text -> Either Text (Prog Seq))
-> (Prog Seq -> UntypedPassState) -> FutharkM ()
forall {t}.
([Char] -> Text -> Either Text t)
-> (t -> UntypedPassState) -> FutharkM ()
readCore [Char] -> Text -> Either Text (Prog Seq)
parseSeq Prog Seq -> UntypedPassState
Seq),
                  ([Char]
".fut_seq_mem", ([Char] -> Text -> Either Text (Prog SeqMem))
-> (Prog SeqMem -> UntypedPassState) -> FutharkM ()
forall {t}.
([Char] -> Text -> Either Text t)
-> (t -> UntypedPassState) -> FutharkM ()
readCore [Char] -> Text -> Either Text (Prog SeqMem)
parseSeqMem Prog SeqMem -> UntypedPassState
SeqMem),
                  ([Char]
".fut_kernels", ([Char] -> Text -> Either Text (Prog Kernels))
-> (Prog Kernels -> UntypedPassState) -> FutharkM ()
forall {t}.
([Char] -> Text -> Either Text t)
-> (t -> UntypedPassState) -> FutharkM ()
readCore [Char] -> Text -> Either Text (Prog Kernels)
parseKernels Prog Kernels -> UntypedPassState
Kernels),
                  ([Char]
".fut_kernels_mem", ([Char] -> Text -> Either Text (Prog KernelsMem))
-> (Prog KernelsMem -> UntypedPassState) -> FutharkM ()
forall {t}.
([Char] -> Text -> Either Text t)
-> (t -> UntypedPassState) -> FutharkM ()
readCore [Char] -> Text -> Either Text (Prog KernelsMem)
parseKernelsMem Prog KernelsMem -> UntypedPassState
KernelsMem),
                  ([Char]
".fut_mc", ([Char] -> Text -> Either Text (Prog MC))
-> (Prog MC -> UntypedPassState) -> FutharkM ()
forall {t}.
([Char] -> Text -> Either Text t)
-> (t -> UntypedPassState) -> FutharkM ()
readCore [Char] -> Text -> Either Text (Prog MC)
parseMC Prog MC -> UntypedPassState
MC),
                  ([Char]
".fut_mc_mem", ([Char] -> Text -> Either Text (Prog MCMem))
-> (Prog MCMem -> UntypedPassState) -> FutharkM ()
forall {t}.
([Char] -> Text -> Either Text t)
-> (t -> UntypedPassState) -> FutharkM ()
readCore [Char] -> Text -> Either Text (Prog MCMem)
parseMCMem Prog MCMem -> UntypedPassState
MCMem)
                ]
          case [Char] -> [([Char], FutharkM ())] -> Maybe (FutharkM ())
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 ->
              [Char] -> FutharkM ()
forall (m :: * -> *) a. MonadError CompilerError m => [Char] -> m a
externalErrorS ([Char] -> FutharkM ()) -> [Char] -> FutharkM ()
forall a b. (a -> b) -> a -> b
$
                [[Char]] -> [Char]
unwords
                  [ [Char]
"Unsupported extension",
                    [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
ext,
                    [Char]
". Supported extensions:",
                    [[Char]] -> [Char]
unwords ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (([Char], FutharkM ()) -> [Char])
-> [([Char], FutharkM ())] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], FutharkM ()) -> [Char]
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 <-
    (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)
  [Char] -> FutharkM ()
forall (m :: * -> *) a. (MonadLogger m, ToLog a) => a -> m ()
logMsg ([Char] -> FutharkM ()) -> [Char] -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Running action " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UntypedAction -> [Char]
untypedActionName (Config -> UntypedAction
futharkAction 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 lore. Action lore -> Prog lore -> FutharkM ()
actionProcedure Action SOACS
action Prog SOACS
prog
    (Kernels Prog Kernels
prog, KernelsAction Action Kernels
action) ->
      Action Kernels -> Prog Kernels -> FutharkM ()
forall lore. Action lore -> Prog lore -> FutharkM ()
actionProcedure Action Kernels
action Prog Kernels
prog
    (SeqMem Prog SeqMem
prog, SeqMemAction [Char] -> Action SeqMem
action) ->
      Action SeqMem -> Prog SeqMem -> FutharkM ()
forall lore. Action lore -> Prog lore -> FutharkM ()
actionProcedure ([Char] -> Action SeqMem
action [Char]
base) Prog SeqMem
prog
    (KernelsMem Prog KernelsMem
prog, KernelsMemAction [Char] -> Action KernelsMem
action) ->
      Action KernelsMem -> Prog KernelsMem -> FutharkM ()
forall lore. Action lore -> Prog lore -> FutharkM ()
actionProcedure ([Char] -> Action KernelsMem
action [Char]
base) Prog KernelsMem
prog
    (MCMem Prog MCMem
prog, MCMemAction [Char] -> Action MCMem
action) ->
      Action MCMem -> Prog MCMem -> FutharkM ()
forall lore. Action lore -> Prog lore -> FutharkM ()
actionProcedure ([Char] -> Action MCMem
action [Char]
base) Prog MCMem
prog
    (SOACS Prog SOACS
soacs_prog, PolyAction forall lore.
(ASTLore lore, CanBeAliased (Op lore), OpMetrics (Op lore)) =>
Action lore
acs) ->
      Action SOACS -> Prog SOACS -> FutharkM ()
forall lore. Action lore -> Prog lore -> FutharkM ()
actionProcedure Action SOACS
forall lore.
(ASTLore lore, CanBeAliased (Op lore), OpMetrics (Op lore)) =>
Action lore
acs Prog SOACS
soacs_prog
    (Kernels Prog Kernels
kernels_prog, PolyAction forall lore.
(ASTLore lore, CanBeAliased (Op lore), OpMetrics (Op lore)) =>
Action lore
acs) ->
      Action Kernels -> Prog Kernels -> FutharkM ()
forall lore. Action lore -> Prog lore -> FutharkM ()
actionProcedure Action Kernels
forall lore.
(ASTLore lore, CanBeAliased (Op lore), OpMetrics (Op lore)) =>
Action lore
acs Prog Kernels
kernels_prog
    (MC Prog MC
mc_prog, PolyAction forall lore.
(ASTLore lore, CanBeAliased (Op lore), OpMetrics (Op lore)) =>
Action lore
acs) ->
      Action MC -> Prog MC -> FutharkM ()
forall lore. Action lore -> Prog lore -> FutharkM ()
actionProcedure Action MC
forall lore.
(ASTLore lore, CanBeAliased (Op lore), OpMetrics (Op lore)) =>
Action lore
acs Prog MC
mc_prog
    (Seq Prog Seq
seq_prog, PolyAction forall lore.
(ASTLore lore, CanBeAliased (Op lore), OpMetrics (Op lore)) =>
Action lore
acs) ->
      Action Seq -> Prog Seq -> FutharkM ()
forall lore. Action lore -> Prog lore -> FutharkM ()
actionProcedure Action Seq
forall lore.
(ASTLore lore, CanBeAliased (Op lore), OpMetrics (Op lore)) =>
Action lore
acs Prog Seq
seq_prog
    (KernelsMem Prog KernelsMem
mem_prog, PolyAction forall lore.
(ASTLore lore, CanBeAliased (Op lore), OpMetrics (Op lore)) =>
Action lore
acs) ->
      Action KernelsMem -> Prog KernelsMem -> FutharkM ()
forall lore. Action lore -> Prog lore -> FutharkM ()
actionProcedure Action KernelsMem
forall lore.
(ASTLore lore, CanBeAliased (Op lore), OpMetrics (Op lore)) =>
Action lore
acs Prog KernelsMem
mem_prog
    (SeqMem Prog SeqMem
mem_prog, PolyAction forall lore.
(ASTLore lore, CanBeAliased (Op lore), OpMetrics (Op lore)) =>
Action lore
acs) ->
      Action SeqMem -> Prog SeqMem -> FutharkM ()
forall lore. Action lore -> Prog lore -> FutharkM ()
actionProcedure Action SeqMem
forall lore.
(ASTLore lore, CanBeAliased (Op lore), OpMetrics (Op lore)) =>
Action lore
acs Prog SeqMem
mem_prog
    (MCMem Prog MCMem
mem_prog, PolyAction forall lore.
(ASTLore lore, CanBeAliased (Op lore), OpMetrics (Op lore)) =>
Action lore
acs) ->
      Action MCMem -> Prog MCMem -> FutharkM ()
forall lore. Action lore -> Prog lore -> FutharkM ()
actionProcedure Action MCMem
forall lore.
(ASTLore lore, CanBeAliased (Op lore), OpMetrics (Op lore)) =>
Action lore
acs Prog MCMem
mem_prog
    (UntypedPassState
_, UntypedAction
action) ->
      [Char] -> FutharkM ()
forall (m :: * -> *) a. MonadError CompilerError m => [Char] -> m a
externalErrorS ([Char] -> FutharkM ()) -> [Char] -> FutharkM ()
forall a b. (a -> b) -> a -> b
$
        [Char]
"Action "
          [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> UntypedAction -> [Char]
untypedActionName UntypedAction
action
          [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" expects "
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UntypedAction -> [Char]
forall s. Representation s => s -> [Char]
representation UntypedAction
action
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" representation, but got "
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UntypedPassState -> [Char]
forall s. Representation s => s -> [Char]
representation UntypedPassState
end_prog
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"."
  [Char] -> FutharkM ()
forall (m :: * -> *) a. (MonadLogger m, ToLog a) => a -> m ()
logMsg ([Char]
"Done." :: String)
  where
    pipeline_config :: PipelineConfig
pipeline_config =
      PipelineConfig :: Bool -> Bool -> PipelineConfig
PipelineConfig
        { pipelineVerbose :: Bool
pipelineVerbose = (Verbosity, Maybe [Char]) -> Verbosity
forall a b. (a, b) -> a
fst (FutharkConfig -> (Verbosity, Maybe [Char])
futharkVerbose (FutharkConfig -> (Verbosity, Maybe [Char]))
-> FutharkConfig -> (Verbosity, Maybe [Char])
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