    {-# LANGUAGE TypeFamilies #-}
    {-# OPTIONS_GHC -fno-warn-orphans #-}

    -- | Converting 'MC' programs to 'MCMem'.
    module Futhark.Pass.ExplicitAllocations.MC (explicitAllocations) where

    import Futhark.IR.MC
    import Futhark.IR.MCMem
    import Futhark.Pass.ExplicitAllocations
    import Futhark.Pass.ExplicitAllocations.SegOp

    instance SizeSubst (MCOp rep op)

    handleSegOp :: SegOp () MC -> AllocM MC MCMem (SegOp () MCMem)
    handleSegOp :: SegOp () MC -> AllocM MC MCMem (SegOp () MCMem)
    handleSegOp SegOp () MC
    op = do
      let num_threads :: SubExp
    num_threads = IntType -> Integer -> SubExp
    intConst IntType
    Int64 Integer
    256 -- FIXME
      SegOpMapper () MC MCMem (AllocM MC MCMem)
    -> SegOp () MC -> AllocM MC MCMem (SegOp () MCMem)
    forall (m :: * -> *) lvl frep trep.
    Monad m =>
    SegOpMapper lvl frep trep m -> SegOp lvl frep -> m (SegOp lvl trep)
    mapSegOpM (SubExp -> SegOpMapper () MC MCMem (AllocM MC MCMem)
    mapper SubExp
    num_threads) SegOp () MC
    op
      where
        scope :: Scope MCMem
    scope = SegSpace -> Scope MCMem
    forall rep. SegSpace -> Scope rep
    scopeOfSegSpace (SegSpace -> Scope MCMem) -> SegSpace -> Scope MCMem
    forall a b. (a -> b) -> a -> b
    $ SegOp () MC -> SegSpace
    forall lvl rep. SegOp lvl rep -> SegSpace
    segSpace SegOp () MC
    op
        mapper :: SubExp -> SegOpMapper () MC MCMem (AllocM MC MCMem)
    mapper SubExp
    num_threads =
          SegOpMapper () Any Any (AllocM MC MCMem)
    forall (m :: * -> *) lvl rep. Monad m => SegOpMapper lvl rep rep m
    identitySegOpMapper
            { mapOnSegOpBody =
                localScope scope . allocInKernelBody,
              mapOnSegOpLambda =
                allocInBinOpLambda num_threads (segSpace op)
            }

    handleMCOp :: Op MC -> AllocM MC MCMem (Op MCMem)
    handleMCOp :: Op MC -> AllocM MC MCMem (Op MCMem)
    handleMCOp (ParOp Maybe (SegOp () MC)
    par_op SegOp () MC
    op) =
      MCOp NoOp MCMem -> MemOp (MCOp NoOp) MCMem
    forall (inner :: * -> *) rep. inner rep -> MemOp inner rep
    Inner (MCOp NoOp MCMem -> MemOp (MCOp NoOp) MCMem)
    -> AllocM MC MCMem (MCOp NoOp MCMem)
    -> AllocM MC MCMem (MemOp (MCOp NoOp) MCMem)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Maybe (SegOp () MCMem) -> SegOp () MCMem -> MCOp NoOp MCMem
    forall (op :: * -> *) rep.
    Maybe (SegOp () rep) -> SegOp () rep -> MCOp op rep
    ParOp (Maybe (SegOp () MCMem) -> SegOp () MCMem -> MCOp NoOp MCMem)
    -> AllocM MC MCMem (Maybe (SegOp () MCMem))
    -> AllocM MC MCMem (SegOp () MCMem -> MCOp NoOp MCMem)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (SegOp () MC -> AllocM MC MCMem (SegOp () MCMem))
    -> Maybe (SegOp () MC) -> AllocM MC MCMem (Maybe (SegOp () MCMem))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Maybe a -> f (Maybe b)
    traverse SegOp () MC -> AllocM MC MCMem (SegOp () MCMem)
    handleSegOp Maybe (SegOp () MC)
    par_op AllocM MC MCMem (SegOp () MCMem -> MCOp NoOp MCMem)
    -> AllocM MC MCMem (SegOp () MCMem)
    -> AllocM MC MCMem (MCOp NoOp MCMem)
    forall a b.
    AllocM MC MCMem (a -> b) -> AllocM MC MCMem a -> AllocM MC MCMem b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SegOp () MC -> AllocM MC MCMem (SegOp () MCMem)
    handleSegOp SegOp () MC
    op)
    handleMCOp (OtherOp SOAC MC
    soac) =
      [Char] -> AllocM MC MCMem (Op MCMem)
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> AllocM MC MCMem (Op MCMem))
    -> [Char] -> AllocM MC MCMem (Op MCMem)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Cannot allocate memory in SOAC: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SOAC MC -> [Char]
    forall a. Pretty a => a -> [Char]
    prettyString SOAC MC
    soac

    -- | The pass from 'MC' to 'MCMem'.
    explicitAllocations :: Pass MC MCMem
    explicitAllocations :: Pass MC MCMem
    explicitAllocations = Space
    -> (Op MC -> AllocM MC MCMem (Op MCMem))
    -> (Exp MCMem -> AllocM MC MCMem [ExpHint])
    -> Pass MC MCMem
    forall fromrep torep (inner :: * -> *).
    Allocable fromrep torep inner =>
    Space
    -> (Op fromrep -> AllocM fromrep torep (Op torep))
    -> (Exp torep -> AllocM fromrep torep [ExpHint])
    -> Pass fromrep torep
    explicitAllocationsGeneric Space
    DefaultSpace Op MC -> AllocM MC MCMem (Op MCMem)
    handleMCOp Exp MCMem -> AllocM MC MCMem [ExpHint]
    forall rep (m :: * -> *).
    (ASTRep rep, HasScope rep m) =>
    Exp rep -> m [ExpHint]
    defaultExpHints