module Futhark.Internalise (internaliseProg) where
import Data.Text qualified as T
import Futhark.Compiler.Config
import Futhark.IR.SOACS as I hiding (stmPat)
import Futhark.Internalise.ApplyTypeAbbrs as ApplyTypeAbbrs
import Futhark.Internalise.Defunctionalise as Defunctionalise
import Futhark.Internalise.Defunctorise as Defunctorise
import Futhark.Internalise.Entry (visibleTypes)
import Futhark.Internalise.Exps qualified as Exps
import Futhark.Internalise.FullNormalise qualified as FullNormalise
import Futhark.Internalise.LiftLambdas as LiftLambdas
import Futhark.Internalise.Monad as I
import Futhark.Internalise.Monomorphise as Monomorphise
import Futhark.Internalise.ReplaceRecords as ReplaceRecords
import Futhark.Util.Log
import Language.Futhark.Semantic (Imports)
internaliseProg ::
(MonadFreshNames m, MonadLogger m) =>
FutharkConfig ->
Imports ->
m (I.Prog SOACS)
internaliseProg :: forall (m :: * -> *).
(MonadFreshNames m, MonadLogger m) =>
FutharkConfig -> Imports -> m (Prog SOACS)
internaliseProg FutharkConfig
config Imports
prog = do
Text -> m ()
forall {m :: * -> *}. MonadLogger m => Text -> m ()
maybeLog Text
"Defunctorising"
prog_decs0 <- [Dec] -> m [ValBind]
forall (m :: * -> *). Monad m => [Dec] -> m [ValBind]
ApplyTypeAbbrs.transformProg ([Dec] -> m [ValBind]) -> m [Dec] -> m [ValBind]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Imports -> m [Dec]
forall (m :: * -> *). MonadFreshNames m => Imports -> m [Dec]
Defunctorise.transformProg Imports
prog
maybeLog "Full Normalising"
prog_decs1 <- FullNormalise.transformProg prog_decs0
maybeLog "Replacing records"
prog_decs2 <- ReplaceRecords.transformProg prog_decs1
maybeLog "Lifting lambdas"
prog_decs3 <- LiftLambdas.transformProg prog_decs2
maybeLog "Monomorphising"
prog_decs4 <- Monomorphise.transformProg prog_decs3
maybeLog "Defunctionalising"
prog_decs5 <- Defunctionalise.transformProg prog_decs4
maybeLog "Converting to core IR"
Exps.transformProg (futharkSafe config) (visibleTypes prog) prog_decs5
where
verbose :: Bool
verbose = (Verbosity, Maybe String) -> Verbosity
forall a b. (a, b) -> a
fst (FutharkConfig -> (Verbosity, Maybe String)
futharkVerbose FutharkConfig
config) Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
> Verbosity
NotVerbose
maybeLog :: Text -> m ()
maybeLog Text
s
| Bool
verbose = Text -> m ()
forall a. ToLog a => a -> m ()
forall (m :: * -> *) a. (MonadLogger m, ToLog a) => a -> m ()
logMsg (Text
s :: T.Text)
| Bool
otherwise = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()