{-# LANGUAGE FlexibleContexts #-}
-- | All (almost) compiler pipelines end with an 'Action', which does
-- something with the result of the pipeline.
module Futhark.Actions
  ( printAction
  , impCodeGenAction
  , kernelImpCodeGenAction
  , rangeAction
  , metricsAction
  )
where

import Control.Monad
import Control.Monad.IO.Class

import Futhark.Pipeline
import Futhark.Analysis.Alias
import Futhark.Analysis.Range
import Futhark.IR
import Futhark.IR.Prop.Aliases
import Futhark.IR.KernelsMem (KernelsMem)
import Futhark.IR.SeqMem (SeqMem)
import qualified Futhark.CodeGen.ImpGen.Sequential as ImpGenSequential
import qualified Futhark.CodeGen.ImpGen.Kernels as ImpGenKernels
import Futhark.IR.Prop.Ranges (CanBeRanged)
import Futhark.Analysis.Metrics

-- | Print the result to stdout, with alias annotations.
printAction :: (ASTLore lore, CanBeAliased (Op lore)) => Action lore
printAction :: Action lore
printAction =
  Action :: forall lore.
String -> String -> (Prog lore -> FutharkM ()) -> Action lore
Action { actionName :: String
actionName = String
"Prettyprint"
         , actionDescription :: String
actionDescription = String
"Prettyprint the resulting internal representation on standard output."
         , actionProcedure :: Prog lore -> FutharkM ()
actionProcedure = IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ())
-> (Prog lore -> IO ()) -> Prog lore -> FutharkM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn (String -> IO ()) -> (Prog lore -> String) -> Prog lore -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prog (Aliases lore) -> String
forall a. Pretty a => a -> String
pretty (Prog (Aliases lore) -> String)
-> (Prog lore -> Prog (Aliases lore)) -> Prog lore -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prog lore -> Prog (Aliases lore)
forall lore.
(ASTLore lore, CanBeAliased (Op lore)) =>
Prog lore -> Prog (Aliases lore)
aliasAnalysis
         }

-- | Print the result to stdout, with range annotations.
rangeAction :: (ASTLore lore, CanBeRanged (Op lore)) => Action lore
rangeAction :: Action lore
rangeAction =
    Action :: forall lore.
String -> String -> (Prog lore -> FutharkM ()) -> Action lore
Action { actionName :: String
actionName = String
"Range analysis"
           , actionDescription :: String
actionDescription = String
"Print the program with range annotations added."
           , actionProcedure :: Prog lore -> FutharkM ()
actionProcedure = IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ())
-> (Prog lore -> IO ()) -> Prog lore -> FutharkM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn (String -> IO ()) -> (Prog lore -> String) -> Prog lore -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prog (Ranges lore) -> String
forall a. Pretty a => a -> String
pretty (Prog (Ranges lore) -> String)
-> (Prog lore -> Prog (Ranges lore)) -> Prog lore -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prog lore -> Prog (Ranges lore)
forall lore.
(ASTLore lore, CanBeRanged (Op lore)) =>
Prog lore -> Prog (Ranges lore)
rangeAnalysis
           }

-- | Print metrics about AST node counts to stdout.
metricsAction :: OpMetrics (Op lore) => Action lore
metricsAction :: Action lore
metricsAction =
  Action :: forall lore.
String -> String -> (Prog lore -> FutharkM ()) -> Action lore
Action { actionName :: String
actionName = String
"Compute metrics"
         , actionDescription :: String
actionDescription = String
"Print metrics on the final AST."
         , actionProcedure :: Prog lore -> FutharkM ()
actionProcedure = IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ())
-> (Prog lore -> IO ()) -> Prog lore -> FutharkM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStr (String -> IO ()) -> (Prog lore -> String) -> Prog lore -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AstMetrics -> String
forall a. Show a => a -> String
show (AstMetrics -> String)
-> (Prog lore -> AstMetrics) -> Prog lore -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prog lore -> AstMetrics
forall lore. OpMetrics (Op lore) => Prog lore -> AstMetrics
progMetrics
         }

-- | Convert the program to sequential ImpCode and print it to stdout.
impCodeGenAction :: Action SeqMem
impCodeGenAction :: Action SeqMem
impCodeGenAction =
  Action :: forall lore.
String -> String -> (Prog lore -> FutharkM ()) -> Action lore
Action { actionName :: String
actionName = String
"Compile imperative"
         , actionDescription :: String
actionDescription = String
"Translate program into imperative IL and write it on standard output."
         , actionProcedure :: Prog SeqMem -> FutharkM ()
actionProcedure = IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ())
-> (Program -> IO ()) -> Program -> FutharkM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn (String -> IO ()) -> (Program -> String) -> Program -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> String
forall a. Pretty a => a -> String
pretty (Program -> FutharkM ())
-> (Prog SeqMem -> FutharkM Program) -> Prog SeqMem -> FutharkM ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Prog SeqMem -> FutharkM Program
forall (m :: * -> *). MonadFreshNames m => Prog SeqMem -> m Program
ImpGenSequential.compileProg
         }

-- | Convert the program to GPU ImpCode and print it to stdout.
kernelImpCodeGenAction :: Action KernelsMem
kernelImpCodeGenAction :: Action KernelsMem
kernelImpCodeGenAction =
  Action :: forall lore.
String -> String -> (Prog lore -> FutharkM ()) -> Action lore
Action { actionName :: String
actionName = String
"Compile imperative kernels"
         , actionDescription :: String
actionDescription = String
"Translate program into imperative IL with kernels and write it on standard output."
         , actionProcedure :: Prog KernelsMem -> FutharkM ()
actionProcedure = IO () -> FutharkM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> FutharkM ())
-> (Program -> IO ()) -> Program -> FutharkM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn (String -> IO ()) -> (Program -> String) -> Program -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> String
forall a. Pretty a => a -> String
pretty (Program -> FutharkM ())
-> (Prog KernelsMem -> FutharkM Program)
-> Prog KernelsMem
-> FutharkM ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Prog KernelsMem -> FutharkM Program
forall (m :: * -> *).
MonadFreshNames m =>
Prog KernelsMem -> m Program
ImpGenKernels.compileProgOpenCL
         }