{-# LANGUAGE RankNTypes #-}
-- | Futhark Compiler Driver
module Futhark.CLI.Dev (main) where

import Data.Maybe
import Data.List (intersperse)
import Control.Category (id)
import Control.Monad
import Control.Monad.State
import qualified Data.Text.IO as T
import System.IO
import System.Exit
import System.Console.GetOpt

import Prelude hiding (id)

import Futhark.Pass
import Futhark.Actions
import Futhark.Compiler
import Language.Futhark.Parser (parseFuthark)
import Futhark.Util.Options
import Futhark.Pipeline
import qualified Futhark.Representation.SOACS as SOACS
import Futhark.Representation.SOACS (SOACS)
import qualified Futhark.Representation.Kernels as Kernels
import Futhark.Representation.Kernels (Kernels)
import qualified Futhark.Representation.ExplicitMemory as ExplicitMemory
import Futhark.Representation.ExplicitMemory (ExplicitMemory)
import Futhark.Representation.AST (Prog, pretty)
import Futhark.TypeCheck (Checkable)
import qualified Futhark.Util.Pretty as PP

import Futhark.Internalise.Defunctorise as Defunctorise
import Futhark.Internalise.Monomorphise as Monomorphise
import Futhark.Internalise.Defunctionalise as Defunctionalise
import Futhark.Optimise.InliningDeadFun
import Futhark.Optimise.CSE
import Futhark.Optimise.Fusion
import Futhark.Pass.FirstOrderTransform
import Futhark.Pass.Simplify
import Futhark.Optimise.InPlaceLowering
import Futhark.Optimise.DoubleBuffer
import Futhark.Optimise.Sink
import Futhark.Optimise.TileLoops
import Futhark.Optimise.Unstream
import Futhark.Pass.KernelBabysitting
import Futhark.Pass.ExtractKernels
import Futhark.Pass.ExpandAllocations
import Futhark.Pass.ExplicitAllocations
import Futhark.Passes

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

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


-- | 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)
                      | ExplicitMemory (Prog ExplicitMemory.ExplicitMemory)

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

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

instance Representation UntypedPassState where
  representation :: UntypedPassState -> String
representation (SOACS Prog SOACS
_) = String
"SOACS"
  representation (Kernels Prog Kernels
_) = String
"Kernels"
  representation (ExplicitMemory Prog ExplicitMemory
_) = String
"ExplicitMemory"

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 (ExplicitMemory Prog ExplicitMemory
prog) = Prog ExplicitMemory -> Doc
forall a. Pretty a => a -> Doc
PP.ppr Prog ExplicitMemory
prog

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

data UntypedAction = SOACSAction (Action SOACS)
                   | KernelsAction (Action Kernels)
                   | ExplicitMemoryAction (Action ExplicitMemory)
                   | PolyAction (Action SOACS) (Action Kernels) (Action ExplicitMemory)

untypedActionName :: UntypedAction -> String
untypedActionName :: UntypedAction -> String
untypedActionName (SOACSAction Action SOACS
a) = Action SOACS -> String
forall lore. Action lore -> String
actionName Action SOACS
a
untypedActionName (KernelsAction Action Kernels
a) = Action Kernels -> String
forall lore. Action lore -> String
actionName Action Kernels
a
untypedActionName (ExplicitMemoryAction Action ExplicitMemory
a) = Action ExplicitMemory -> String
forall lore. Action lore -> String
actionName Action ExplicitMemory
a
untypedActionName (PolyAction Action SOACS
a Action Kernels
_ Action ExplicitMemory
_) = Action SOACS -> String
forall lore. Action lore -> String
actionName Action SOACS
a

instance Representation UntypedAction where
  representation :: UntypedAction -> String
representation (SOACSAction Action SOACS
_) = String
"SOACS"
  representation (KernelsAction Action Kernels
_) = String
"Kernels"
  representation (ExplicitMemoryAction Action ExplicitMemory
_) = String
"ExplicitMemory"
  representation PolyAction{} = String
"<any>"

newConfig :: Config
newConfig :: Config
newConfig = FutharkConfig -> FutharkPipeline -> UntypedAction -> Bool -> Config
Config FutharkConfig
newFutharkConfig ([UntypedPass] -> FutharkPipeline
Pipeline [])
            (Action SOACS
-> Action Kernels -> Action ExplicitMemory -> UntypedAction
PolyAction Action SOACS
forall lore.
(Attributes lore, CanBeAliased (Op lore)) =>
Action lore
printAction Action Kernels
forall lore.
(Attributes lore, CanBeAliased (Op lore)) =>
Action lore
printAction Action ExplicitMemory
forall lore.
(Attributes lore, CanBeAliased (Op lore)) =>
Action lore
printAction) Bool
False

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 :: String -> UntypedPass -> String -> [String] -> FutharkOption
passOption String
desc UntypedPass
pass String
short [String]
long =
  String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
short [String]
long
  (Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
cfg ->
   Config
cfg { futharkPipeline :: 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] })
  String
desc

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

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

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

typedPassOption :: Checkable tolore =>
                   (String -> UntypedPassState -> FutharkM (Prog fromlore))
                -> (Prog tolore -> UntypedPassState)
                -> Pass fromlore tolore
                -> String
                -> FutharkOption
typedPassOption :: (String -> UntypedPassState -> FutharkM (Prog fromlore))
-> (Prog tolore -> UntypedPassState)
-> Pass fromlore tolore
-> String
-> FutharkOption
typedPassOption String -> UntypedPassState -> FutharkM (Prog fromlore)
getProg Prog tolore -> UntypedPassState
putProg Pass fromlore tolore
pass String
short =
  String -> UntypedPass -> String -> [String] -> FutharkOption
passOption (Pass fromlore tolore -> String
forall fromlore tolore. Pass fromlore tolore -> String
passDescription Pass fromlore tolore
pass) ((UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState)
-> UntypedPass
UntypedPass UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
perform) String
short [String]
long
  where perform :: UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
perform UntypedPassState
s PipelineConfig
config = do
          Prog fromlore
prog <- String -> UntypedPassState -> FutharkM (Prog fromlore)
getProg (Pass fromlore tolore -> String
forall fromlore tolore. Pass fromlore tolore -> String
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)
runPasses (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 :: [String]
long = [Pass fromlore tolore -> String
forall fromlore tolore. Pass fromlore tolore -> String
passLongOption Pass fromlore tolore
pass]

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

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

explicitMemoryPassOption :: Pass ExplicitMemory ExplicitMemory -> String -> FutharkOption
explicitMemoryPassOption :: Pass ExplicitMemory ExplicitMemory -> String -> FutharkOption
explicitMemoryPassOption =
  (String -> UntypedPassState -> FutharkM (Prog ExplicitMemory))
-> (Prog ExplicitMemory -> UntypedPassState)
-> Pass ExplicitMemory ExplicitMemory
-> String
-> FutharkOption
forall tolore fromlore.
Checkable tolore =>
(String -> UntypedPassState -> FutharkM (Prog fromlore))
-> (Prog tolore -> UntypedPassState)
-> Pass fromlore tolore
-> String
-> FutharkOption
typedPassOption String -> UntypedPassState -> FutharkM (Prog ExplicitMemory)
explicitMemoryProg Prog ExplicitMemory -> UntypedPassState
ExplicitMemory

simplifyOption :: String -> FutharkOption
simplifyOption :: String -> FutharkOption
simplifyOption String
short =
  String -> UntypedPass -> String -> [String] -> FutharkOption
passOption (Pass SOACS SOACS -> String
forall fromlore tolore. Pass fromlore tolore -> String
passDescription Pass SOACS SOACS
pass) ((UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState)
-> UntypedPass
UntypedPass UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
perform) String
short [String]
long
  where perform :: UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
perform (SOACS Prog SOACS
prog) PipelineConfig
config =
          Prog SOACS -> UntypedPassState
SOACS (Prog SOACS -> UntypedPassState)
-> FutharkM (Prog SOACS) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline SOACS SOACS
-> PipelineConfig -> Prog SOACS -> FutharkM (Prog SOACS)
forall fromlore tolore.
Pipeline fromlore tolore
-> PipelineConfig -> Prog fromlore -> FutharkM (Prog tolore)
runPasses (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)
runPasses (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 (ExplicitMemory Prog ExplicitMemory
prog) PipelineConfig
config =
          Prog ExplicitMemory -> UntypedPassState
ExplicitMemory (Prog ExplicitMemory -> UntypedPassState)
-> FutharkM (Prog ExplicitMemory) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline ExplicitMemory ExplicitMemory
-> PipelineConfig
-> Prog ExplicitMemory
-> FutharkM (Prog ExplicitMemory)
forall fromlore tolore.
Pipeline fromlore tolore
-> PipelineConfig -> Prog fromlore -> FutharkM (Prog tolore)
runPasses (Pass ExplicitMemory ExplicitMemory
-> Pipeline ExplicitMemory ExplicitMemory
forall tolore fromlore.
Checkable tolore =>
Pass fromlore tolore -> Pipeline fromlore tolore
onePass Pass ExplicitMemory ExplicitMemory
simplifyExplicitMemory) PipelineConfig
config Prog ExplicitMemory
prog

        long :: [String]
long = [Pass SOACS SOACS -> String
forall fromlore tolore. Pass fromlore tolore -> String
passLongOption Pass SOACS SOACS
pass]
        pass :: Pass SOACS SOACS
pass = Pass SOACS SOACS
simplifySOACS

cseOption :: String -> FutharkOption
cseOption :: String -> FutharkOption
cseOption String
short =
  String -> UntypedPass -> String -> [String] -> FutharkOption
passOption (Pass SOACS SOACS -> String
forall fromlore tolore. Pass fromlore tolore -> String
passDescription Pass SOACS SOACS
pass) ((UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState)
-> UntypedPass
UntypedPass UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
perform) String
short [String]
long
  where perform :: UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
perform (SOACS Prog SOACS
prog) PipelineConfig
config =
          Prog SOACS -> UntypedPassState
SOACS (Prog SOACS -> UntypedPassState)
-> FutharkM (Prog SOACS) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline SOACS SOACS
-> PipelineConfig -> Prog SOACS -> FutharkM (Prog SOACS)
forall fromlore tolore.
Pipeline fromlore tolore
-> PipelineConfig -> Prog fromlore -> FutharkM (Prog tolore)
runPasses (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.
(Attributes 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)
runPasses (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.
(Attributes lore, CanBeAliased (Op lore),
 CSEInOp (OpWithAliases (Op lore))) =>
Bool -> Pass lore lore
performCSE Bool
True) PipelineConfig
config Prog Kernels
prog
        perform (ExplicitMemory Prog ExplicitMemory
prog) PipelineConfig
config =
          Prog ExplicitMemory -> UntypedPassState
ExplicitMemory (Prog ExplicitMemory -> UntypedPassState)
-> FutharkM (Prog ExplicitMemory) -> FutharkM UntypedPassState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipeline ExplicitMemory ExplicitMemory
-> PipelineConfig
-> Prog ExplicitMemory
-> FutharkM (Prog ExplicitMemory)
forall fromlore tolore.
Pipeline fromlore tolore
-> PipelineConfig -> Prog fromlore -> FutharkM (Prog tolore)
runPasses (Pass ExplicitMemory ExplicitMemory
-> Pipeline ExplicitMemory ExplicitMemory
forall tolore fromlore.
Checkable tolore =>
Pass fromlore tolore -> Pipeline fromlore tolore
onePass (Pass ExplicitMemory ExplicitMemory
 -> Pipeline ExplicitMemory ExplicitMemory)
-> Pass ExplicitMemory ExplicitMemory
-> Pipeline ExplicitMemory ExplicitMemory
forall a b. (a -> b) -> a -> b
$ Bool -> Pass ExplicitMemory ExplicitMemory
forall lore.
(Attributes lore, CanBeAliased (Op lore),
 CSEInOp (OpWithAliases (Op lore))) =>
Bool -> Pass lore lore
performCSE Bool
False) PipelineConfig
config Prog ExplicitMemory
prog

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

pipelineOption :: (UntypedPassState -> Maybe (Prog fromlore))
               -> String
               -> (Prog tolore -> UntypedPassState)
               -> String
               -> Pipeline fromlore tolore
               -> String
               -> [String]
               -> FutharkOption
pipelineOption :: (UntypedPassState -> Maybe (Prog fromlore))
-> String
-> (Prog tolore -> UntypedPassState)
-> String
-> Pipeline fromlore tolore
-> String
-> [String]
-> FutharkOption
pipelineOption UntypedPassState -> Maybe (Prog fromlore)
getprog String
repdesc Prog tolore -> UntypedPassState
repf String
desc Pipeline fromlore tolore
pipeline =
  String -> UntypedPass -> String -> [String] -> FutharkOption
passOption String
desc (UntypedPass -> String -> [String] -> FutharkOption)
-> UntypedPass -> String -> [String] -> FutharkOption
forall a b. (a -> b) -> a -> b
$ (UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState)
-> UntypedPass
UntypedPass UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
pipelinePass
  where pipelinePass :: UntypedPassState -> PipelineConfig -> FutharkM UntypedPassState
pipelinePass UntypedPassState
rep PipelineConfig
config =
          case UntypedPassState -> Maybe (Prog 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)
runPasses Pipeline fromlore tolore
pipeline PipelineConfig
config Prog fromlore
prog
            Maybe (Prog fromlore)
Nothing   ->
              String -> FutharkM UntypedPassState
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS (String -> FutharkM UntypedPassState)
-> String -> FutharkM UntypedPassState
forall a b. (a -> b) -> a -> b
$ String
"Expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
repdesc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" representation, but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++
              UntypedPassState -> String
forall s. Representation s => s -> String
representation UntypedPassState
rep

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

kernelsPipelineOption :: String -> Pipeline SOACS Kernels -> String -> [String]
                    -> FutharkOption
kernelsPipelineOption :: String
-> Pipeline SOACS Kernels -> String -> [String] -> FutharkOption
kernelsPipelineOption = (UntypedPassState -> Maybe (Prog SOACS))
-> String
-> (Prog Kernels -> UntypedPassState)
-> String
-> Pipeline SOACS Kernels
-> String
-> [String]
-> FutharkOption
forall fromlore tolore.
(UntypedPassState -> Maybe (Prog fromlore))
-> String
-> (Prog tolore -> UntypedPassState)
-> String
-> Pipeline fromlore tolore
-> String
-> [String]
-> FutharkOption
pipelineOption UntypedPassState -> Maybe (Prog SOACS)
getSOACSProg String
"Kernels" Prog Kernels -> UntypedPassState
Kernels

explicitMemoryPipelineOption :: String -> Pipeline SOACS ExplicitMemory -> String -> [String]
                             -> FutharkOption
explicitMemoryPipelineOption :: String
-> Pipeline SOACS ExplicitMemory
-> String
-> [String]
-> FutharkOption
explicitMemoryPipelineOption = (UntypedPassState -> Maybe (Prog SOACS))
-> String
-> (Prog ExplicitMemory -> UntypedPassState)
-> String
-> Pipeline SOACS ExplicitMemory
-> String
-> [String]
-> FutharkOption
forall fromlore tolore.
(UntypedPassState -> Maybe (Prog fromlore))
-> String
-> (Prog tolore -> UntypedPassState)
-> String
-> Pipeline fromlore tolore
-> String
-> [String]
-> FutharkOption
pipelineOption UntypedPassState -> Maybe (Prog SOACS)
getSOACSProg String
"ExplicitMemory" Prog ExplicitMemory -> UntypedPassState
ExplicitMemory

commandLineOptions :: [FutharkOption]
commandLineOptions :: [FutharkOption]
commandLineOptions =
  [ String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"v" [String
"verbose"]
    ((Maybe String -> Either (IO ()) (Config -> Config))
-> String -> ArgDescr (Either (IO ()) (Config -> Config))
forall a. (Maybe String -> a) -> String -> ArgDescr a
OptArg ((Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Maybe String -> Config -> Config)
-> Maybe String
-> Either (IO ()) (Config -> Config)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FutharkConfig -> FutharkConfig) -> Config -> Config
changeFutharkConfig ((FutharkConfig -> FutharkConfig) -> Config -> Config)
-> (Maybe String -> FutharkConfig -> FutharkConfig)
-> Maybe String
-> Config
-> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> FutharkConfig -> FutharkConfig
incVerbosity) String
"FILE")
    String
"Print verbose output on standard error; wrong program to FILE."
  , String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"Werror"]
    (Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ (FutharkConfig -> FutharkConfig) -> Config -> Config
changeFutharkConfig ((FutharkConfig -> FutharkConfig) -> Config -> Config)
-> (FutharkConfig -> FutharkConfig) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ \FutharkConfig
opts -> FutharkConfig
opts { futharkWerror :: Bool
futharkWerror = Bool
True })
    String
"Treat warnings as errors."

  , String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"t" [String
"type-check"]
    (Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts ->
        Config
opts { futharkPipeline :: FutharkPipeline
futharkPipeline = FutharkPipeline
TypeCheck })
    String
"Print on standard output the type-checked program."

  , String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"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 })
    String
"Parse and pretty-print the AST of the given program."

  , String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"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 = Action ExplicitMemory -> UntypedAction
ExplicitMemoryAction Action ExplicitMemory
impCodeGenAction })
    String
"Translate program into the imperative IL and write it on standard output."
  , String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"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 = Action ExplicitMemory -> UntypedAction
ExplicitMemoryAction Action ExplicitMemory
kernelImpCodeGenAction })
    String
"Translate program into the imperative IL with kernels and write it on standard output."
  , String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"range-analysis"]
       (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 = Action SOACS
-> Action Kernels -> Action ExplicitMemory -> UntypedAction
PolyAction Action SOACS
forall lore.
(Attributes lore, CanBeRanged (Op lore)) =>
Action lore
rangeAction Action Kernels
forall lore.
(Attributes lore, CanBeRanged (Op lore)) =>
Action lore
rangeAction Action ExplicitMemory
forall lore.
(Attributes lore, CanBeRanged (Op lore)) =>
Action lore
rangeAction })
       String
"Print the program with range annotations added."
  , String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"p" [String
"print"]
    (Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts { futharkAction :: UntypedAction
futharkAction = Action SOACS
-> Action Kernels -> Action ExplicitMemory -> UntypedAction
PolyAction Action SOACS
forall lore.
(Attributes lore, CanBeAliased (Op lore)) =>
Action lore
printAction Action Kernels
forall lore.
(Attributes lore, CanBeAliased (Op lore)) =>
Action lore
printAction Action ExplicitMemory
forall lore.
(Attributes lore, CanBeAliased (Op lore)) =>
Action lore
printAction })
    String
"Prettyprint the resulting internal representation on standard output (default action)."
  , String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"m" [String
"metrics"]
    (Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts { futharkAction :: UntypedAction
futharkAction = Action SOACS
-> Action Kernels -> Action ExplicitMemory -> UntypedAction
PolyAction Action SOACS
forall lore. OpMetrics (Op lore) => Action lore
metricsAction Action Kernels
forall lore. OpMetrics (Op lore) => Action lore
metricsAction Action ExplicitMemory
forall lore. OpMetrics (Op lore) => Action lore
metricsAction })
    String
"Print AST metrics of the resulting internal representation on standard output."
  , String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"defunctorise"]
    (Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts { futharkPipeline :: FutharkPipeline
futharkPipeline = FutharkPipeline
Defunctorise })
    String
"Partially evaluate all module constructs and print the residual program."
  , String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"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 })
    String
"Monomorphise the program."
  , String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"defunctionalise"]
    (Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts { futharkPipeline :: FutharkPipeline
futharkPipeline = FutharkPipeline
Defunctionalise })
    String
"Defunctionalise the program."
  , String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"ast"]
    (Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ \Config
opts -> Config
opts { futharkPrintAST :: Bool
futharkPrintAST = Bool
True })
    String
"Output ASTs instead of prettyprinted programs."
  , String
-> [String]
-> ArgDescr (Either (IO ()) (Config -> Config))
-> String
-> FutharkOption
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"safe"]
    (Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (Config -> Config)
 -> ArgDescr (Either (IO ()) (Config -> Config)))
-> Either (IO ()) (Config -> Config)
-> ArgDescr (Either (IO ()) (Config -> Config))
forall a b. (a -> b) -> a -> b
$ (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. b -> Either a b
Right ((Config -> Config) -> Either (IO ()) (Config -> Config))
-> (Config -> Config) -> Either (IO ()) (Config -> Config)
forall a b. (a -> b) -> a -> b
$ (FutharkConfig -> FutharkConfig) -> Config -> Config
changeFutharkConfig ((FutharkConfig -> FutharkConfig) -> Config -> Config)
-> (FutharkConfig -> FutharkConfig) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ \FutharkConfig
opts -> FutharkConfig
opts { futharkSafe :: Bool
futharkSafe = Bool
True })
    String
"Ignore 'unsafe'."
  , (String -> UntypedPassState -> FutharkM (Prog SOACS))
-> (Prog Kernels -> UntypedPassState)
-> Pass SOACS Kernels
-> String
-> FutharkOption
forall tolore fromlore.
Checkable tolore =>
(String -> UntypedPassState -> FutharkM (Prog fromlore))
-> (Prog tolore -> UntypedPassState)
-> Pass fromlore tolore
-> String
-> FutharkOption
typedPassOption String -> UntypedPassState -> FutharkM (Prog SOACS)
soacsProg Prog Kernels -> UntypedPassState
Kernels Pass SOACS Kernels
firstOrderTransform String
"f"
  , Pass SOACS SOACS -> String -> FutharkOption
soacsPassOption Pass SOACS SOACS
fuseSOACs String
"o"
  , Pass SOACS SOACS -> String -> FutharkOption
soacsPassOption Pass SOACS SOACS
inlineFunctions []
  , Pass Kernels Kernels -> String -> FutharkOption
kernelsPassOption Pass Kernels Kernels
inPlaceLowering []
  , Pass Kernels Kernels -> String -> FutharkOption
kernelsPassOption Pass Kernels Kernels
babysitKernels []
  , Pass Kernels Kernels -> String -> FutharkOption
kernelsPassOption Pass Kernels Kernels
tileLoops []
  , Pass Kernels Kernels -> String -> FutharkOption
kernelsPassOption Pass Kernels Kernels
unstream []
  , Pass Kernels Kernels -> String -> FutharkOption
kernelsPassOption Pass Kernels Kernels
sink []
  , (String -> UntypedPassState -> FutharkM (Prog SOACS))
-> (Prog Kernels -> UntypedPassState)
-> Pass SOACS Kernels
-> String
-> FutharkOption
forall tolore fromlore.
Checkable tolore =>
(String -> UntypedPassState -> FutharkM (Prog fromlore))
-> (Prog tolore -> UntypedPassState)
-> Pass fromlore tolore
-> String
-> FutharkOption
typedPassOption String -> UntypedPassState -> FutharkM (Prog SOACS)
soacsProg Prog Kernels -> UntypedPassState
Kernels Pass SOACS Kernels
extractKernels []

  , (String -> UntypedPassState -> FutharkM (Prog Kernels))
-> (Prog ExplicitMemory -> UntypedPassState)
-> Pass Kernels ExplicitMemory
-> String
-> FutharkOption
forall tolore fromlore.
Checkable tolore =>
(String -> UntypedPassState -> FutharkM (Prog fromlore))
-> (Prog tolore -> UntypedPassState)
-> Pass fromlore tolore
-> String
-> FutharkOption
typedPassOption String -> UntypedPassState -> FutharkM (Prog Kernels)
kernelsProg Prog ExplicitMemory -> UntypedPassState
ExplicitMemory Pass Kernels ExplicitMemory
explicitAllocations String
"a"

  , Pass ExplicitMemory ExplicitMemory -> String -> FutharkOption
explicitMemoryPassOption Pass ExplicitMemory ExplicitMemory
doubleBuffer []
  , Pass ExplicitMemory ExplicitMemory -> String -> FutharkOption
explicitMemoryPassOption Pass ExplicitMemory ExplicitMemory
expandAllocations []

  , String -> FutharkOption
cseOption []
  , String -> FutharkOption
simplifyOption String
"e"

  , String
-> Pipeline SOACS SOACS -> String -> [String] -> FutharkOption
soacsPipelineOption String
"Run the default optimised pipeline"
    Pipeline SOACS SOACS
standardPipeline String
"s" [String
"standard"]
  , String
-> Pipeline SOACS Kernels -> String -> [String] -> FutharkOption
kernelsPipelineOption String
"Run the default optimised kernels pipeline"
    Pipeline SOACS Kernels
kernelsPipeline [] [String
"kernels"]
  , String
-> Pipeline SOACS ExplicitMemory
-> String
-> [String]
-> FutharkOption
explicitMemoryPipelineOption String
"Run the full GPU compilation pipeline"
    Pipeline SOACS ExplicitMemory
gpuPipeline [] [String
"gpu"]
  , String
-> Pipeline SOACS ExplicitMemory
-> String
-> [String]
-> FutharkOption
explicitMemoryPipelineOption String
"Run the sequential CPU compilation pipeline"
    Pipeline SOACS ExplicitMemory
sequentialCpuPipeline [] [String
"cpu"]
  ]

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

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

          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 <- String -> Text -> Either ParseError UncheckedProg
parseFuthark String
file (Text -> Either ParseError UncheckedProg)
-> IO Text -> IO (Either ParseError UncheckedProg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
T.readFile String
file
              case Either ParseError UncheckedProg
maybe_prog of
                Left ParseError
err  -> String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
err
                Right UncheckedProg
prog | Config -> Bool
futharkPrintAST Config
config -> UncheckedProg -> IO ()
forall a. Show a => a -> IO ()
print UncheckedProg
prog
                           | Bool
otherwise -> String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ UncheckedProg -> String
forall a. Pretty a => a -> String
pretty UncheckedProg
prog
            FutharkPipeline
TypeCheck -> do
              (Warnings
_, Imports
imports, VNameSource
_) <- String -> FutharkM (Warnings, Imports, VNameSource)
forall (m :: * -> *).
(MonadError CompilerError m, MonadIO m) =>
String -> m (Warnings, Imports, VNameSource)
readProgram String
file
              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_ (((String, FileModule) -> FileModule) -> Imports -> [FileModule]
forall a b. (a -> b) -> [a] -> [b]
map (String, FileModule) -> FileModule
forall a b. (a, b) -> b
snd Imports
imports) ((FileModule -> IO ()) -> IO ()) -> (FileModule -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FileModule
fm ->
                String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ if Config -> Bool
futharkPrintAST Config
config
                           then Prog -> String
forall a. Show a => a -> String
show (Prog -> String) -> Prog -> String
forall a b. (a -> b) -> a -> b
$ FileModule -> Prog
fileProg FileModule
fm
                           else Prog -> String
forall a. Pretty a => a -> String
pretty (Prog -> String) -> Prog -> String
forall a b. (a -> b) -> a -> b
$ FileModule -> Prog
fileProg FileModule
fm
            FutharkPipeline
Defunctorise -> do
              (Warnings
_, Imports
imports, VNameSource
src) <- String -> FutharkM (Warnings, Imports, VNameSource)
forall (m :: * -> *).
(MonadError CompilerError m, MonadIO m) =>
String -> m (Warnings, Imports, VNameSource)
readProgram String
file
              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) <- String -> FutharkM (Warnings, Imports, VNameSource)
forall (m :: * -> *).
(MonadError CompilerError m, MonadIO m) =>
String -> m (Warnings, Imports, VNameSource)
readProgram String
file
              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
Defunctionalise -> do
              (Warnings
_, Imports
imports, VNameSource
src) <- String -> FutharkM (Warnings, Imports, VNameSource)
forall (m :: * -> *).
(MonadError CompilerError m, MonadIO m) =>
String -> m (Warnings, Imports, VNameSource)
readProgram String
file
              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]
Defunctionalise.transformProg
            Pipeline{} -> do
              Prog SOACS
prog <- FutharkConfig
-> Pipeline SOACS SOACS -> String -> FutharkM (Prog SOACS)
forall tolore.
FutharkConfig
-> Pipeline SOACS tolore -> String -> 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 String
file
              Config -> Prog SOACS -> FutharkM ()
runPolyPasses Config
config Prog SOACS
prog

runPolyPasses :: Config -> Prog SOACS -> FutharkM ()
runPolyPasses :: Config -> Prog SOACS -> FutharkM ()
runPolyPasses Config
config Prog SOACS
prog = do
    UntypedPassState
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) (Prog SOACS -> UntypedPassState
SOACS Prog SOACS
prog) (Config -> [UntypedPass]
getFutharkPipeline Config
config)
    case (UntypedPassState
prog', Config -> UntypedAction
futharkAction Config
config) of
      (SOACS Prog SOACS
soacs_prog, SOACSAction Action SOACS
action) ->
        Action SOACS -> Prog SOACS -> FutharkM ()
forall lore. Action lore -> Prog lore -> FutharkM ()
actionProcedure Action SOACS
action Prog SOACS
soacs_prog
      (Kernels Prog Kernels
kernels_prog, KernelsAction Action Kernels
action) ->
        Action Kernels -> Prog Kernels -> FutharkM ()
forall lore. Action lore -> Prog lore -> FutharkM ()
actionProcedure Action Kernels
action Prog Kernels
kernels_prog
      (ExplicitMemory Prog ExplicitMemory
mem_prog, ExplicitMemoryAction Action ExplicitMemory
action) ->
        Action ExplicitMemory -> Prog ExplicitMemory -> FutharkM ()
forall lore. Action lore -> Prog lore -> FutharkM ()
actionProcedure Action ExplicitMemory
action Prog ExplicitMemory
mem_prog

      (SOACS Prog SOACS
soacs_prog, PolyAction Action SOACS
soacs_action Action Kernels
_ Action ExplicitMemory
_) ->
        Action SOACS -> Prog SOACS -> FutharkM ()
forall lore. Action lore -> Prog lore -> FutharkM ()
actionProcedure Action SOACS
soacs_action Prog SOACS
soacs_prog
      (Kernels Prog Kernels
kernels_prog, PolyAction Action SOACS
_ Action Kernels
kernels_action Action ExplicitMemory
_) ->
        Action Kernels -> Prog Kernels -> FutharkM ()
forall lore. Action lore -> Prog lore -> FutharkM ()
actionProcedure Action Kernels
kernels_action Prog Kernels
kernels_prog
      (ExplicitMemory Prog ExplicitMemory
mem_prog, PolyAction Action SOACS
_ Action Kernels
_ Action ExplicitMemory
mem_action) ->
        Action ExplicitMemory -> Prog ExplicitMemory -> FutharkM ()
forall lore. Action lore -> Prog lore -> FutharkM ()
actionProcedure Action ExplicitMemory
mem_action Prog ExplicitMemory
mem_prog

      (UntypedPassState
_, UntypedAction
action) ->
        String -> FutharkM ()
forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS (String -> FutharkM ()) -> String -> FutharkM ()
forall a b. (a -> b) -> a -> b
$ String
"Action " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
        UntypedAction -> String
untypedActionName UntypedAction
action String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
        String
" expects " String -> String -> String
forall a. [a] -> [a] -> [a]
++ UntypedAction -> String
forall s. Representation s => s -> String
representation UntypedAction
action String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" representation, but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++
        UntypedPassState -> String
forall s. Representation s => s -> String
representation UntypedPassState
prog' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
  where pipeline_config :: PipelineConfig
pipeline_config =
          PipelineConfig :: Bool -> Bool -> PipelineConfig
PipelineConfig { pipelineVerbose :: Bool
pipelineVerbose = (Verbosity, Maybe String) -> Verbosity
forall a b. (a, b) -> a
fst (FutharkConfig -> (Verbosity, Maybe String)
futharkVerbose (FutharkConfig -> (Verbosity, Maybe String))
-> FutharkConfig -> (Verbosity, Maybe String)
forall a b. (a -> b) -> a -> b
$ Config -> FutharkConfig
futharkConfig Config
config) Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
> Verbosity
NotVerbose
                         , pipelineValidate :: Bool
pipelineValidate = Bool
True
                         }

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