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

-- | A sequential representation.
module Futhark.IR.Seq
  ( -- * The Lore definition
    Seq,

    -- * Simplification
    simplifyProg,

    -- * Module re-exports
    module Futhark.IR.Prop,
    module Futhark.IR.Traversals,
    module Futhark.IR.Pretty,
    module Futhark.IR.Syntax,
  )
where

import Futhark.Binder
import Futhark.Construct
import Futhark.IR.Pretty
import Futhark.IR.Prop
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

-- | The phantom type for the Seq representation.
data Seq

instance Decorations Seq where
  type Op Seq = ()

instance ASTLore Seq where
  expTypesFromPattern :: forall (m :: * -> *).
(HasScope Seq m, Monad m) =>
Pattern Seq -> m [BranchType Seq]
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 Seq where
  checkOp :: OpWithAliases (Op Seq) -> TypeM Seq ()
checkOp = OpWithAliases (Op Seq) -> TypeM Seq ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance TypeCheck.Checkable Seq

instance Bindable Seq where
  mkBody :: Stms Seq -> [SubExp] -> Body Seq
mkBody = BodyDec Seq -> Stms Seq -> [SubExp] -> Body Seq
forall lore. BodyDec lore -> Stms lore -> [SubExp] -> BodyT lore
Body ()
  mkExpPat :: [Ident] -> [Ident] -> Exp Seq -> Pattern Seq
mkExpPat [Ident]
ctx [Ident]
val Exp Seq
_ = [Ident] -> [Ident] -> PatternT Type
basicPattern [Ident]
ctx [Ident]
val
  mkExpDec :: Pattern Seq -> Exp Seq -> ExpDec Seq
mkExpDec Pattern Seq
_ Exp Seq
_ = ()
  mkLetNames :: forall (m :: * -> *).
(MonadFreshNames m, HasScope Seq m) =>
[VName] -> Exp Seq -> m (Stm Seq)
mkLetNames = [VName] -> Exp Seq -> m (Stm Seq)
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 Seq

instance PrettyLore Seq

instance BinderOps (Engine.Wise Seq)

simpleSeq :: Simplify.SimpleOps Seq
simpleSeq :: SimpleOps Seq
simpleSeq = SimplifyOp Seq (Op Seq) -> SimpleOps Seq
forall lore.
(SimplifiableLore lore, Bindable lore) =>
SimplifyOp lore (Op lore) -> SimpleOps lore
Simplify.bindableSimpleOps (SimpleM Seq ((), Stms (Wise Seq))
-> () -> SimpleM Seq ((), Stms (Wise Seq))
forall a b. a -> b -> a
const (SimpleM Seq ((), Stms (Wise Seq))
 -> () -> SimpleM Seq ((), Stms (Wise Seq)))
-> SimpleM Seq ((), Stms (Wise Seq))
-> ()
-> SimpleM Seq ((), Stms (Wise Seq))
forall a b. (a -> b) -> a -> b
$ ((), Stms (Wise Seq)) -> SimpleM Seq ((), Stms (Wise Seq))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((), Stms (Wise Seq)
forall a. Monoid a => a
mempty))

-- | Simplify a sequential program.
simplifyProg :: Prog Seq -> PassM (Prog Seq)
simplifyProg :: Prog Seq -> PassM (Prog Seq)
simplifyProg = SimpleOps Seq
-> RuleBook (Wise Seq)
-> HoistBlockers Seq
-> Prog Seq
-> PassM (Prog Seq)
forall lore.
SimplifiableLore lore =>
SimpleOps lore
-> RuleBook (Wise lore)
-> HoistBlockers lore
-> Prog lore
-> PassM (Prog lore)
Simplify.simplifyProg SimpleOps Seq
simpleSeq RuleBook (Wise Seq)
forall lore. (BinderOps lore, Aliased lore) => RuleBook lore
standardRules HoistBlockers Seq
forall {lore}. HoistBlockers lore
blockers
  where
    blockers :: HoistBlockers lore
blockers = HoistBlockers lore
forall {lore}. HoistBlockers lore
Engine.noExtraHoistBlockers