{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}

-- | A representation for multicore CPU parallelism.
module Futhark.IR.MC
  ( -- * The Lore definition
    MC,

    -- * Simplification
    simplifyProg,

    -- * Module re-exports
    module Futhark.IR.Prop,
    module Futhark.IR.Traversals,
    module Futhark.IR.Pretty,
    module Futhark.IR.Syntax,
    module Futhark.IR.SegOp,
    module Futhark.IR.SOACS.SOAC,
    module Futhark.IR.MC.Op,
  )
where

import Futhark.Binder
import Futhark.Construct
import Futhark.IR.MC.Op
import Futhark.IR.Pretty
import Futhark.IR.Prop
import Futhark.IR.SOACS.SOAC hiding (HistOp (..))
import qualified Futhark.IR.SOACS.Simplify as SOAC
import Futhark.IR.SegOp
import Futhark.IR.Syntax
import Futhark.IR.Traversals
import qualified Futhark.Optimise.Simplify as Simplify
import qualified Futhark.Optimise.Simplify.Engine as Engine
import Futhark.Optimise.Simplify.Rules
import Futhark.Pass
import qualified Futhark.TypeCheck as TypeCheck

data MC

instance Decorations MC where
  type Op MC = MCOp MC (SOAC MC)

instance ASTLore MC where
  expTypesFromPattern :: Pattern MC -> m [BranchType MC]
expTypesFromPattern = [ExtType] -> m [ExtType]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ExtType] -> m [ExtType])
-> (PatternT Type -> [ExtType]) -> PatternT Type -> m [ExtType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatternT Type -> [ExtType]
forall dec. Typed dec => PatternT dec -> [ExtType]
expExtTypesFromPattern

instance TypeCheck.CheckableOp MC where
  checkOp :: OpWithAliases (Op MC) -> TypeM MC ()
checkOp = (SOAC (Aliases MC) -> TypeM MC ())
-> MCOp (Aliases MC) (SOAC (Aliases MC)) -> TypeM MC ()
forall lore op.
Checkable lore =>
(op -> TypeM lore ()) -> MCOp (Aliases lore) op -> TypeM lore ()
typeCheckMCOp SOAC (Aliases MC) -> TypeM MC ()
forall lore. Checkable lore => SOAC (Aliases lore) -> TypeM lore ()
typeCheckSOAC

instance TypeCheck.Checkable MC

instance Bindable MC where
  mkBody :: Stms MC -> [SubExp] -> Body MC
mkBody = BodyDec MC -> Stms MC -> [SubExp] -> Body MC
forall lore. BodyDec lore -> Stms lore -> [SubExp] -> BodyT lore
Body ()
  mkExpPat :: [Ident] -> [Ident] -> Exp MC -> Pattern MC
mkExpPat [Ident]
ctx [Ident]
val Exp MC
_ = [Ident] -> [Ident] -> PatternT Type
basicPattern [Ident]
ctx [Ident]
val
  mkExpDec :: Pattern MC -> Exp MC -> ExpDec MC
mkExpDec Pattern MC
_ Exp MC
_ = ()
  mkLetNames :: [VName] -> Exp MC -> m (Stm MC)
mkLetNames = [VName] -> Exp MC -> m (Stm MC)
forall lore (m :: * -> *).
(ExpDec lore ~ (), LetDec lore ~ Type, MonadFreshNames m,
 TypedOp (Op lore), HasScope lore m) =>
[VName] -> Exp lore -> m (Stm lore)
simpleMkLetNames

instance BinderOps MC

instance BinderOps (Engine.Wise MC)

instance PrettyLore MC

simpleMC :: Simplify.SimpleOps MC
simpleMC :: SimpleOps MC
simpleMC = SimplifyOp MC (Op MC) -> SimpleOps MC
forall lore.
(SimplifiableLore lore, Bindable lore) =>
SimplifyOp lore (Op lore) -> SimpleOps lore
Simplify.bindableSimpleOps (SimplifyOp MC (Op MC) -> SimpleOps MC)
-> SimplifyOp MC (Op MC) -> SimpleOps MC
forall a b. (a -> b) -> a -> b
$ SimplifyOp MC (SOAC MC)
-> MCOp MC (SOAC MC)
-> SimpleM
     MC (MCOp (Wise MC) (OpWithWisdom (SOAC MC)), Stms (Wise MC))
forall lore op.
(SimplifiableLore lore, BodyDec lore ~ ()) =>
SimplifyOp lore op
-> MCOp lore op
-> SimpleM
     lore (MCOp (Wise lore) (OpWithWisdom op), Stms (Wise lore))
simplifyMCOp SimplifyOp MC (SOAC MC)
forall lore. SimplifiableLore lore => SimplifyOp lore (SOAC lore)
SOAC.simplifySOAC

simplifyProg :: Prog MC -> PassM (Prog MC)
simplifyProg :: Prog MC -> PassM (Prog MC)
simplifyProg = SimpleOps MC
-> RuleBook (Wise MC)
-> HoistBlockers MC
-> Prog MC
-> PassM (Prog MC)
forall lore.
SimplifiableLore lore =>
SimpleOps lore
-> RuleBook (Wise lore)
-> HoistBlockers lore
-> Prog lore
-> PassM (Prog lore)
Simplify.simplifyProg SimpleOps MC
simpleMC RuleBook (Wise MC)
rules HoistBlockers MC
forall lore. HoistBlockers lore
blockers
  where
    blockers :: HoistBlockers lore
blockers = HoistBlockers lore
forall lore. HoistBlockers lore
Engine.noExtraHoistBlockers
    rules :: RuleBook (Wise MC)
rules = RuleBook (Wise MC)
forall lore. (BinderOps lore, Aliased lore) => RuleBook lore
standardRules RuleBook (Wise MC) -> RuleBook (Wise MC) -> RuleBook (Wise MC)
forall a. Semigroup a => a -> a -> a
<> RuleBook (Wise MC)
forall lore.
(HasSegOp lore, BinderOps lore, Bindable lore) =>
RuleBook lore
segOpRules

instance HasSegOp MC where
  type SegOpLevel MC = ()
  asSegOp :: Op MC -> Maybe (SegOp (SegOpLevel MC) MC)
asSegOp = Maybe (SegOp () MC) -> MCOp MC (SOAC MC) -> Maybe (SegOp () MC)
forall a b. a -> b -> a
const Maybe (SegOp () MC)
forall a. Maybe a
Nothing
  segOp :: SegOp (SegOpLevel MC) MC -> Op MC
segOp = Maybe (SegOp () MC) -> SegOp () MC -> MCOp MC (SOAC MC)
forall lore op.
Maybe (SegOp () lore) -> SegOp () lore -> MCOp lore op
ParOp Maybe (SegOp () MC)
forall a. Maybe a
Nothing

instance HasSegOp (Engine.Wise MC) where
  type SegOpLevel (Engine.Wise MC) = ()
  asSegOp :: Op (Wise MC) -> Maybe (SegOp (SegOpLevel (Wise MC)) (Wise MC))
asSegOp = Maybe (SegOp () (Wise MC))
-> MCOp (Wise MC) (SOAC (Wise MC)) -> Maybe (SegOp () (Wise MC))
forall a b. a -> b -> a
const Maybe (SegOp () (Wise MC))
forall a. Maybe a
Nothing
  segOp :: SegOp (SegOpLevel (Wise MC)) (Wise MC) -> Op (Wise MC)
segOp = Maybe (SegOp () (Wise MC))
-> SegOp () (Wise MC) -> MCOp (Wise MC) (SOAC (Wise MC))
forall lore op.
Maybe (SegOp () lore) -> SegOp () lore -> MCOp lore op
ParOp Maybe (SegOp () (Wise MC))
forall a. Maybe a
Nothing