{-# LANGUAGE CPP                 #-}
{-# LANGUAGE EmptyCase           #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE TypeOperators       #-}
{-# OPTIONS_HADDOCK hide #-}
-- |
-- Module      : Data.Array.Accelerate.LLVM.Compile
-- Copyright   : [2014..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--

module Data.Array.Accelerate.LLVM.Compile (

  Compile(..),
  compileAcc, compileAfun,

  CompiledOpenAcc(..), CompiledOpenAfun,
  CompiledAcc, CompiledAfun,

) where

import Data.Array.Accelerate.AST
import Data.Array.Accelerate.AST.Environment
import Data.Array.Accelerate.AST.Idx
import Data.Array.Accelerate.AST.LeftHandSide
import Data.Array.Accelerate.AST.Var
import Data.Array.Accelerate.Analysis.Match
import Data.Array.Accelerate.Error
import Data.Array.Accelerate.Representation.Array
import Data.Array.Accelerate.Representation.Shape
import Data.Array.Accelerate.Representation.Stencil
import Data.Array.Accelerate.Representation.Tag
import Data.Array.Accelerate.Representation.Type
import Data.Array.Accelerate.Trafo.Delayed
import Data.Array.Accelerate.Trafo.Substitution
import Data.Array.Accelerate.Type
import qualified Data.Array.Accelerate.Sugar.Foreign                as A

import Data.Array.Accelerate.LLVM.CodeGen.Environment
import Data.Array.Accelerate.LLVM.Foreign
import Data.Array.Accelerate.LLVM.State
import qualified Data.Array.Accelerate.LLVM.AST                     as AST

import Data.IntMap                                                  ( IntMap )
import Control.Applicative                                          hiding ( Const )
import Prelude                                                      hiding ( map, unzip, zipWith, scanl, scanl1, scanr, scanr1, exp )
import qualified Data.IntMap                                        as IntMap


class Foreign arch => Compile arch where
  data ObjectR arch

  -- | Compile an accelerate computation into some backend-specific code that
  -- will be used to execute the given array expression. The code is not yet
  -- linked into the running executable.
  --
  compileForTarget
      :: PreOpenAcc DelayedOpenAcc aenv a
      -> Gamma aenv
      -> LLVM arch (ObjectR arch)


data CompiledOpenAcc arch aenv a where
  BuildAcc  :: ArraysR a
            -> Gamma aenv
            -> ObjectR arch
            -> AST.PreOpenAccSkeleton CompiledOpenAcc arch aenv a
            -> CompiledOpenAcc arch aenv a

  PlainAcc  :: ArraysR a
            -> AST.PreOpenAccCommand  CompiledOpenAcc arch aenv a
            -> CompiledOpenAcc arch aenv a


-- An annotated AST with embedded build products
--
type CompiledOpenAfun arch  = PreOpenAfun (CompiledOpenAcc arch)

type CompiledAcc arch a     = CompiledOpenAcc arch () a
type CompiledAfun arch a    = CompiledOpenAfun arch () a


-- | Generate and compile code for an array expression. The returned expression
-- is annotated with the compilation products required to executed each
-- operation on the given target, together with the list of array variables
-- referenced from the embedded scalar expressions.
--
{-# INLINEABLE compileAcc #-}
compileAcc
    :: (HasCallStack, Compile arch)
    => DelayedAcc a
    -> LLVM arch (CompiledAcc arch a)
compileAcc :: DelayedAcc a -> LLVM arch (CompiledAcc arch a)
compileAcc = DelayedAcc a -> LLVM arch (CompiledAcc arch a)
forall arch _aenv _a.
(HasCallStack, Compile arch) =>
DelayedOpenAcc _aenv _a
-> LLVM arch (CompiledOpenAcc arch _aenv _a)
compileOpenAcc

{-# INLINEABLE compileAfun #-}
compileAfun
    :: (HasCallStack, Compile arch)
    => DelayedAfun f
    -> LLVM arch (CompiledAfun arch f)
compileAfun :: DelayedAfun f -> LLVM arch (CompiledAfun arch f)
compileAfun = DelayedAfun f -> LLVM arch (CompiledAfun arch f)
forall arch aenv f.
(HasCallStack, Compile arch) =>
DelayedOpenAfun aenv f -> LLVM arch (CompiledOpenAfun arch aenv f)
compileOpenAfun


{-# INLINEABLE compileOpenAfun #-}
compileOpenAfun
    :: (HasCallStack, Compile arch)
    => DelayedOpenAfun aenv f
    -> LLVM arch (CompiledOpenAfun arch aenv f)
compileOpenAfun :: DelayedOpenAfun aenv f -> LLVM arch (CompiledOpenAfun arch aenv f)
compileOpenAfun (Alam ALeftHandSide a aenv aenv'
lhs PreOpenAfun DelayedOpenAcc aenv' t1
l) = ALeftHandSide a aenv aenv'
-> PreOpenAfun (CompiledOpenAcc arch) aenv' t1
-> PreOpenAfun (CompiledOpenAcc arch) aenv (a -> t1)
forall a aenv aenv' (acc :: * -> * -> *) t1.
ALeftHandSide a aenv aenv'
-> PreOpenAfun acc aenv' t1 -> PreOpenAfun acc aenv (a -> t1)
Alam ALeftHandSide a aenv aenv'
lhs (PreOpenAfun (CompiledOpenAcc arch) aenv' t1
 -> PreOpenAfun (CompiledOpenAcc arch) aenv (a -> t1))
-> LLVM arch (PreOpenAfun (CompiledOpenAcc arch) aenv' t1)
-> LLVM arch (PreOpenAfun (CompiledOpenAcc arch) aenv (a -> t1))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PreOpenAfun DelayedOpenAcc aenv' t1
-> LLVM arch (PreOpenAfun (CompiledOpenAcc arch) aenv' t1)
forall arch aenv f.
(HasCallStack, Compile arch) =>
DelayedOpenAfun aenv f -> LLVM arch (CompiledOpenAfun arch aenv f)
compileOpenAfun PreOpenAfun DelayedOpenAcc aenv' t1
l
compileOpenAfun (Abody DelayedOpenAcc aenv f
b)    = CompiledOpenAcc arch aenv f -> CompiledOpenAfun arch aenv f
forall (acc :: * -> * -> *) aenv t.
acc aenv t -> PreOpenAfun acc aenv t
Abody    (CompiledOpenAcc arch aenv f -> CompiledOpenAfun arch aenv f)
-> LLVM arch (CompiledOpenAcc arch aenv f)
-> LLVM arch (CompiledOpenAfun arch aenv f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DelayedOpenAcc aenv f -> LLVM arch (CompiledOpenAcc arch aenv f)
forall arch _aenv _a.
(HasCallStack, Compile arch) =>
DelayedOpenAcc _aenv _a
-> LLVM arch (CompiledOpenAcc arch _aenv _a)
compileOpenAcc DelayedOpenAcc aenv f
b


{-# INLINEABLE compileOpenAcc #-}
compileOpenAcc
    :: forall arch _aenv _a. (HasCallStack, Compile arch)
    => DelayedOpenAcc _aenv _a
    -> LLVM arch (CompiledOpenAcc arch _aenv _a)
compileOpenAcc :: DelayedOpenAcc _aenv _a
-> LLVM arch (CompiledOpenAcc arch _aenv _a)
compileOpenAcc = DelayedOpenAcc _aenv _a
-> LLVM arch (CompiledOpenAcc arch _aenv _a)
forall aenv arrs.
HasCallStack =>
DelayedOpenAcc aenv arrs
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
traverseAcc
  where
    -- Traverse an open array expression in depth-first order. The top-level
    -- function 'traverseAcc' is intended for manifest arrays that we will
    -- generate LLVM code for. Array valued sub-terms, which might be manifest
    -- or delayed, are handled separately.
    --
    -- As the AST is traversed, we also collect a set of the indices of free
    -- array variables that were referred to within scalar sub-expressions.
    -- These will be required during code generation and execution.
    --
    traverseAcc
        :: forall aenv arrs. HasCallStack
        => DelayedOpenAcc aenv arrs
        -> LLVM arch (CompiledOpenAcc arch aenv arrs)
    traverseAcc :: DelayedOpenAcc aenv arrs
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
traverseAcc Delayed{}       = String -> LLVM arch (CompiledOpenAcc arch aenv arrs)
forall a. HasCallStack => String -> a
internalError String
"unexpected delayed array"
    traverseAcc (Manifest PreOpenAcc DelayedOpenAcc aenv arrs
pacc) =
      case PreOpenAcc DelayedOpenAcc aenv arrs
pacc of
        -- Environment and control flow
        Avar ArrayVar aenv (Array sh e)
ix                     -> (IntMap (Idx' aenv),
 PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e))
-> LLVM arch (CompiledOpenAcc arch aenv (Array sh e))
forall aenv' arrs'.
(IntMap (Idx' aenv'),
 PreOpenAccCommand CompiledOpenAcc arch aenv' arrs')
-> LLVM arch (CompiledOpenAcc arch aenv' arrs')
plain ((IntMap (Idx' aenv),
  PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e))
 -> LLVM arch (CompiledOpenAcc arch aenv (Array sh e)))
-> (IntMap (Idx' aenv),
    PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e))
-> LLVM arch (CompiledOpenAcc arch aenv (Array sh e))
forall a b. (a -> b) -> a -> b
$ PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e)
-> (IntMap (Idx' aenv),
    PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ArrayVar aenv (Array sh e)
-> PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e)
forall aenv arrs (acc :: * -> * -> * -> *) arch.
ArrayVar aenv arrs -> PreOpenAccCommand acc arch aenv arrs
AST.Avar ArrayVar aenv (Array sh e)
ix)
        Alet ALeftHandSide bndArrs aenv aenv'
lhs DelayedOpenAcc aenv bndArrs
a DelayedOpenAcc aenv' arrs
b                -> (IntMap (Idx' aenv),
 PreOpenAccCommand CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
forall aenv' arrs'.
(IntMap (Idx' aenv'),
 PreOpenAccCommand CompiledOpenAcc arch aenv' arrs')
-> LLVM arch (CompiledOpenAcc arch aenv' arrs')
plain ((IntMap (Idx' aenv),
  PreOpenAccCommand CompiledOpenAcc arch aenv arrs)
 -> LLVM arch (CompiledOpenAcc arch aenv arrs))
-> (PreOpenAccCommand CompiledOpenAcc arch aenv arrs
    -> (IntMap (Idx' aenv),
        PreOpenAccCommand CompiledOpenAcc arch aenv arrs))
-> PreOpenAccCommand CompiledOpenAcc arch aenv arrs
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PreOpenAccCommand CompiledOpenAcc arch aenv arrs
-> (IntMap (Idx' aenv),
    PreOpenAccCommand CompiledOpenAcc arch aenv arrs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PreOpenAccCommand CompiledOpenAcc arch aenv arrs
 -> LLVM arch (CompiledOpenAcc arch aenv arrs))
-> LLVM arch (PreOpenAccCommand CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ALeftHandSide bndArrs aenv aenv'
-> CompiledOpenAcc arch aenv bndArrs
-> CompiledOpenAcc arch aenv' arrs
-> PreOpenAccCommand CompiledOpenAcc arch aenv arrs
forall bnd aenv aenv' (acc :: * -> * -> * -> *) arch body.
ALeftHandSide bnd aenv aenv'
-> acc arch aenv bnd
-> acc arch aenv' body
-> PreOpenAccCommand acc arch aenv body
AST.Alet ALeftHandSide bndArrs aenv aenv'
lhs  (CompiledOpenAcc arch aenv bndArrs
 -> CompiledOpenAcc arch aenv' arrs
 -> PreOpenAccCommand CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv bndArrs)
-> LLVM
     arch
     (CompiledOpenAcc arch aenv' arrs
      -> PreOpenAccCommand CompiledOpenAcc arch aenv arrs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DelayedOpenAcc aenv bndArrs
-> LLVM arch (CompiledOpenAcc arch aenv bndArrs)
forall aenv arrs.
HasCallStack =>
DelayedOpenAcc aenv arrs
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
traverseAcc DelayedOpenAcc aenv bndArrs
a LLVM
  arch
  (CompiledOpenAcc arch aenv' arrs
   -> PreOpenAccCommand CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv' arrs)
-> LLVM arch (PreOpenAccCommand CompiledOpenAcc arch aenv arrs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DelayedOpenAcc aenv' arrs
-> LLVM arch (CompiledOpenAcc arch aenv' arrs)
forall aenv arrs.
HasCallStack =>
DelayedOpenAcc aenv arrs
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
traverseAcc DelayedOpenAcc aenv' arrs
b
        Apply ArraysR arrs
r PreOpenAfun DelayedOpenAcc aenv (arrs1 -> arrs)
f DelayedOpenAcc aenv arrs1
a                 -> (IntMap (Idx' aenv),
 PreOpenAccCommand CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
forall aenv' arrs'.
(IntMap (Idx' aenv'),
 PreOpenAccCommand CompiledOpenAcc arch aenv' arrs')
-> LLVM arch (CompiledOpenAcc arch aenv' arrs')
plain ((IntMap (Idx' aenv),
  PreOpenAccCommand CompiledOpenAcc arch aenv arrs)
 -> LLVM arch (CompiledOpenAcc arch aenv arrs))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccCommand CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (PreOpenAfun (CompiledOpenAcc arch) aenv (arrs1 -> arrs)
 -> CompiledOpenAcc arch aenv arrs1
 -> PreOpenAccCommand CompiledOpenAcc arch aenv arrs)
-> (IntMap (Idx' aenv),
    PreOpenAfun (CompiledOpenAcc arch) aenv (arrs1 -> arrs))
-> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv arrs1)
-> (IntMap (Idx' aenv),
    PreOpenAccCommand CompiledOpenAcc arch aenv arrs)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (ArraysR arrs
-> PreOpenAfun (CompiledOpenAcc arch) aenv (arrs1 -> arrs)
-> CompiledOpenAcc arch aenv arrs1
-> PreOpenAccCommand CompiledOpenAcc arch aenv arrs
forall bs (acc :: * -> * -> * -> *) arch aenv as.
ArraysR bs
-> PreOpenAfun (acc arch) aenv (as -> bs)
-> acc arch aenv as
-> PreOpenAccCommand acc arch aenv bs
AST.Apply ArraysR arrs
r) ((IntMap (Idx' aenv),
  PreOpenAfun (CompiledOpenAcc arch) aenv (arrs1 -> arrs))
 -> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv arrs1)
 -> (IntMap (Idx' aenv),
     PreOpenAccCommand CompiledOpenAcc arch aenv arrs))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAfun (CompiledOpenAcc arch) aenv (arrs1 -> arrs))
-> LLVM
     arch
     ((IntMap (Idx' aenv), CompiledOpenAcc arch aenv arrs1)
      -> (IntMap (Idx' aenv),
          PreOpenAccCommand CompiledOpenAcc arch aenv arrs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PreOpenAfun DelayedOpenAcc aenv (arrs1 -> arrs)
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAfun (CompiledOpenAcc arch) aenv (arrs1 -> arrs))
forall f.
HasCallStack =>
DelayedOpenAfun aenv f
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAfun arch aenv f)
travAF PreOpenAfun DelayedOpenAcc aenv (arrs1 -> arrs)
f LLVM
  arch
  ((IntMap (Idx' aenv), CompiledOpenAcc arch aenv arrs1)
   -> (IntMap (Idx' aenv),
       PreOpenAccCommand CompiledOpenAcc arch aenv arrs))
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv arrs1)
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccCommand CompiledOpenAcc arch aenv arrs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DelayedOpenAcc aenv arrs1
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv arrs1)
forall a.
HasCallStack =>
DelayedOpenAcc aenv a
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv a)
travA DelayedOpenAcc aenv arrs1
a
        Awhile PreOpenAfun DelayedOpenAcc aenv (arrs -> Scalar PrimBool)
p PreOpenAfun DelayedOpenAcc aenv (arrs -> arrs)
f DelayedOpenAcc aenv arrs
a                -> (IntMap (Idx' aenv),
 PreOpenAccCommand CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
forall aenv' arrs'.
(IntMap (Idx' aenv'),
 PreOpenAccCommand CompiledOpenAcc arch aenv' arrs')
-> LLVM arch (CompiledOpenAcc arch aenv' arrs')
plain ((IntMap (Idx' aenv),
  PreOpenAccCommand CompiledOpenAcc arch aenv arrs)
 -> LLVM arch (CompiledOpenAcc arch aenv arrs))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccCommand CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (PreOpenAfun (CompiledOpenAcc arch) aenv (arrs -> Scalar PrimBool)
 -> PreOpenAfun (CompiledOpenAcc arch) aenv (arrs -> arrs)
 -> CompiledOpenAcc arch aenv arrs
 -> PreOpenAccCommand CompiledOpenAcc arch aenv arrs)
-> (IntMap (Idx' aenv),
    PreOpenAfun (CompiledOpenAcc arch) aenv (arrs -> Scalar PrimBool))
-> (IntMap (Idx' aenv),
    PreOpenAfun (CompiledOpenAcc arch) aenv (arrs -> arrs))
-> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv arrs)
-> (IntMap (Idx' aenv),
    PreOpenAccCommand CompiledOpenAcc arch aenv arrs)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 PreOpenAfun (CompiledOpenAcc arch) aenv (arrs -> Scalar PrimBool)
-> PreOpenAfun (CompiledOpenAcc arch) aenv (arrs -> arrs)
-> CompiledOpenAcc arch aenv arrs
-> PreOpenAccCommand CompiledOpenAcc arch aenv arrs
forall (acc :: * -> * -> * -> *) arch aenv arrs.
PreOpenAfun (acc arch) aenv (arrs -> Scalar PrimBool)
-> PreOpenAfun (acc arch) aenv (arrs -> arrs)
-> acc arch aenv arrs
-> PreOpenAccCommand acc arch aenv arrs
AST.Awhile    ((IntMap (Idx' aenv),
  PreOpenAfun (CompiledOpenAcc arch) aenv (arrs -> Scalar PrimBool))
 -> (IntMap (Idx' aenv),
     PreOpenAfun (CompiledOpenAcc arch) aenv (arrs -> arrs))
 -> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv arrs)
 -> (IntMap (Idx' aenv),
     PreOpenAccCommand CompiledOpenAcc arch aenv arrs))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAfun (CompiledOpenAcc arch) aenv (arrs -> Scalar PrimBool))
-> LLVM
     arch
     ((IntMap (Idx' aenv),
       PreOpenAfun (CompiledOpenAcc arch) aenv (arrs -> arrs))
      -> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv arrs)
      -> (IntMap (Idx' aenv),
          PreOpenAccCommand CompiledOpenAcc arch aenv arrs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PreOpenAfun DelayedOpenAcc aenv (arrs -> Scalar PrimBool)
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAfun (CompiledOpenAcc arch) aenv (arrs -> Scalar PrimBool))
forall f.
HasCallStack =>
DelayedOpenAfun aenv f
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAfun arch aenv f)
travAF PreOpenAfun DelayedOpenAcc aenv (arrs -> Scalar PrimBool)
p LLVM
  arch
  ((IntMap (Idx' aenv),
    PreOpenAfun (CompiledOpenAcc arch) aenv (arrs -> arrs))
   -> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv arrs)
   -> (IntMap (Idx' aenv),
       PreOpenAccCommand CompiledOpenAcc arch aenv arrs))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAfun (CompiledOpenAcc arch) aenv (arrs -> arrs))
-> LLVM
     arch
     ((IntMap (Idx' aenv), CompiledOpenAcc arch aenv arrs)
      -> (IntMap (Idx' aenv),
          PreOpenAccCommand CompiledOpenAcc arch aenv arrs))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PreOpenAfun DelayedOpenAcc aenv (arrs -> arrs)
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAfun (CompiledOpenAcc arch) aenv (arrs -> arrs))
forall f.
HasCallStack =>
DelayedOpenAfun aenv f
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAfun arch aenv f)
travAF PreOpenAfun DelayedOpenAcc aenv (arrs -> arrs)
f LLVM
  arch
  ((IntMap (Idx' aenv), CompiledOpenAcc arch aenv arrs)
   -> (IntMap (Idx' aenv),
       PreOpenAccCommand CompiledOpenAcc arch aenv arrs))
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv arrs)
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccCommand CompiledOpenAcc arch aenv arrs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DelayedOpenAcc aenv arrs
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv arrs)
forall a.
HasCallStack =>
DelayedOpenAcc aenv a
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv a)
travA DelayedOpenAcc aenv arrs
a
        Acond Exp aenv PrimBool
p DelayedOpenAcc aenv arrs
t DelayedOpenAcc aenv arrs
e                 -> (IntMap (Idx' aenv),
 PreOpenAccCommand CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
forall aenv' arrs'.
(IntMap (Idx' aenv'),
 PreOpenAccCommand CompiledOpenAcc arch aenv' arrs')
-> LLVM arch (CompiledOpenAcc arch aenv' arrs')
plain ((IntMap (Idx' aenv),
  PreOpenAccCommand CompiledOpenAcc arch aenv arrs)
 -> LLVM arch (CompiledOpenAcc arch aenv arrs))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccCommand CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Exp aenv PrimBool
 -> CompiledOpenAcc arch aenv arrs
 -> CompiledOpenAcc arch aenv arrs
 -> PreOpenAccCommand CompiledOpenAcc arch aenv arrs)
-> (IntMap (Idx' aenv), Exp aenv PrimBool)
-> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv arrs)
-> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv arrs)
-> (IntMap (Idx' aenv),
    PreOpenAccCommand CompiledOpenAcc arch aenv arrs)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Exp aenv PrimBool
-> CompiledOpenAcc arch aenv arrs
-> CompiledOpenAcc arch aenv arrs
-> PreOpenAccCommand CompiledOpenAcc arch aenv arrs
forall aenv (acc :: * -> * -> * -> *) arch arrs.
Exp aenv PrimBool
-> acc arch aenv arrs
-> acc arch aenv arrs
-> PreOpenAccCommand acc arch aenv arrs
AST.Acond     ((IntMap (Idx' aenv), Exp aenv PrimBool)
 -> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv arrs)
 -> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv arrs)
 -> (IntMap (Idx' aenv),
     PreOpenAccCommand CompiledOpenAcc arch aenv arrs))
-> LLVM arch (IntMap (Idx' aenv), Exp aenv PrimBool)
-> LLVM
     arch
     ((IntMap (Idx' aenv), CompiledOpenAcc arch aenv arrs)
      -> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv arrs)
      -> (IntMap (Idx' aenv),
          PreOpenAccCommand CompiledOpenAcc arch aenv arrs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp aenv PrimBool
-> LLVM arch (IntMap (Idx' aenv), Exp aenv PrimBool)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE  Exp aenv PrimBool
p LLVM
  arch
  ((IntMap (Idx' aenv), CompiledOpenAcc arch aenv arrs)
   -> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv arrs)
   -> (IntMap (Idx' aenv),
       PreOpenAccCommand CompiledOpenAcc arch aenv arrs))
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv arrs)
-> LLVM
     arch
     ((IntMap (Idx' aenv), CompiledOpenAcc arch aenv arrs)
      -> (IntMap (Idx' aenv),
          PreOpenAccCommand CompiledOpenAcc arch aenv arrs))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DelayedOpenAcc aenv arrs
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv arrs)
forall a.
HasCallStack =>
DelayedOpenAcc aenv a
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv a)
travA  DelayedOpenAcc aenv arrs
t LLVM
  arch
  ((IntMap (Idx' aenv), CompiledOpenAcc arch aenv arrs)
   -> (IntMap (Idx' aenv),
       PreOpenAccCommand CompiledOpenAcc arch aenv arrs))
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv arrs)
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccCommand CompiledOpenAcc arch aenv arrs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DelayedOpenAcc aenv arrs
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv arrs)
forall a.
HasCallStack =>
DelayedOpenAcc aenv a
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv a)
travA DelayedOpenAcc aenv arrs
e
        Apair DelayedOpenAcc aenv as
a1 DelayedOpenAcc aenv bs
a2                 -> (IntMap (Idx' aenv),
 PreOpenAccCommand CompiledOpenAcc arch aenv (as, bs))
-> LLVM arch (CompiledOpenAcc arch aenv (as, bs))
forall aenv' arrs'.
(IntMap (Idx' aenv'),
 PreOpenAccCommand CompiledOpenAcc arch aenv' arrs')
-> LLVM arch (CompiledOpenAcc arch aenv' arrs')
plain ((IntMap (Idx' aenv),
  PreOpenAccCommand CompiledOpenAcc arch aenv (as, bs))
 -> LLVM arch (CompiledOpenAcc arch aenv (as, bs)))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccCommand CompiledOpenAcc arch aenv (as, bs))
-> LLVM arch (CompiledOpenAcc arch aenv (as, bs))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (CompiledOpenAcc arch aenv as
 -> CompiledOpenAcc arch aenv bs
 -> PreOpenAccCommand CompiledOpenAcc arch aenv (as, bs))
-> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv as)
-> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv bs)
-> (IntMap (Idx' aenv),
    PreOpenAccCommand CompiledOpenAcc arch aenv (as, bs))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 CompiledOpenAcc arch aenv as
-> CompiledOpenAcc arch aenv bs
-> PreOpenAccCommand CompiledOpenAcc arch aenv (as, bs)
forall (acc :: * -> * -> * -> *) arch aenv arrs1 arrs2.
acc arch aenv arrs1
-> acc arch aenv arrs2
-> PreOpenAccCommand acc arch aenv (arrs1, arrs2)
AST.Apair     ((IntMap (Idx' aenv), CompiledOpenAcc arch aenv as)
 -> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv bs)
 -> (IntMap (Idx' aenv),
     PreOpenAccCommand CompiledOpenAcc arch aenv (as, bs)))
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv as)
-> LLVM
     arch
     ((IntMap (Idx' aenv), CompiledOpenAcc arch aenv bs)
      -> (IntMap (Idx' aenv),
          PreOpenAccCommand CompiledOpenAcc arch aenv (as, bs)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DelayedOpenAcc aenv as
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv as)
forall a.
HasCallStack =>
DelayedOpenAcc aenv a
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv a)
travA DelayedOpenAcc aenv as
a1 LLVM
  arch
  ((IntMap (Idx' aenv), CompiledOpenAcc arch aenv bs)
   -> (IntMap (Idx' aenv),
       PreOpenAccCommand CompiledOpenAcc arch aenv (as, bs)))
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv bs)
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccCommand CompiledOpenAcc arch aenv (as, bs))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DelayedOpenAcc aenv bs
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv bs)
forall a.
HasCallStack =>
DelayedOpenAcc aenv a
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv a)
travA DelayedOpenAcc aenv bs
a2
        PreOpenAcc DelayedOpenAcc aenv arrs
Anil                        -> (IntMap (Idx' aenv),
 PreOpenAccCommand CompiledOpenAcc arch aenv ())
-> LLVM arch (CompiledOpenAcc arch aenv ())
forall aenv' arrs'.
(IntMap (Idx' aenv'),
 PreOpenAccCommand CompiledOpenAcc arch aenv' arrs')
-> LLVM arch (CompiledOpenAcc arch aenv' arrs')
plain ((IntMap (Idx' aenv),
  PreOpenAccCommand CompiledOpenAcc arch aenv ())
 -> LLVM arch (CompiledOpenAcc arch aenv ()))
-> (IntMap (Idx' aenv),
    PreOpenAccCommand CompiledOpenAcc arch aenv ())
-> LLVM arch (CompiledOpenAcc arch aenv ())
forall a b. (a -> b) -> a -> b
$ PreOpenAccCommand CompiledOpenAcc arch aenv ()
-> (IntMap (Idx' aenv),
    PreOpenAccCommand CompiledOpenAcc arch aenv ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure PreOpenAccCommand CompiledOpenAcc arch aenv ()
forall (acc :: * -> * -> * -> *) arch aenv.
PreOpenAccCommand acc arch aenv ()
AST.Anil

        -- Foreign arrays operations
        Aforeign ArraysR arrs
repr asm (as -> arrs)
ff PreAfun DelayedOpenAcc (as -> arrs)
afun DelayedOpenAcc aenv as
a     -> ArraysR arrs
-> asm (as -> arrs)
-> PreAfun DelayedOpenAcc (as -> arrs)
-> DelayedOpenAcc aenv as
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
forall (asm :: * -> *) b a.
(HasCallStack, Foreign asm) =>
ArraysR b
-> asm (a -> b)
-> DelayedAfun (a -> b)
-> DelayedOpenAcc aenv a
-> LLVM arch (CompiledOpenAcc arch aenv b)
foreignA ArraysR arrs
repr asm (as -> arrs)
ff PreAfun DelayedOpenAcc (as -> arrs)
afun DelayedOpenAcc aenv as
a

        -- Uninitialised array allocation
        Generate ArrayR (Array sh e)
r Exp aenv sh
sh Fun aenv (sh -> e)
f
          | Fun aenv (sh -> e) -> Bool
forall sh e. Fun aenv (sh -> e) -> Bool
alloc Fun aenv (sh -> e)
f                 -> (IntMap (Idx' aenv),
 PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e))
-> LLVM arch (CompiledOpenAcc arch aenv (Array sh e))
forall aenv' arrs'.
(IntMap (Idx' aenv'),
 PreOpenAccCommand CompiledOpenAcc arch aenv' arrs')
-> LLVM arch (CompiledOpenAcc arch aenv' arrs')
plain ((IntMap (Idx' aenv),
  PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e))
 -> LLVM arch (CompiledOpenAcc arch aenv (Array sh e)))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e))
-> LLVM arch (CompiledOpenAcc arch aenv (Array sh e))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Exp aenv sh
 -> PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e))
-> (IntMap (Idx' aenv), Exp aenv sh)
-> (IntMap (Idx' aenv),
    PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e))
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA (ArrayR (Array sh e)
-> Exp aenv sh
-> PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e)
forall sh e aenv (acc :: * -> * -> * -> *) arch.
ArrayR (Array sh e)
-> Exp aenv sh -> PreOpenAccCommand acc arch aenv (Array sh e)
AST.Alloc ArrayR (Array sh e)
r)  ((IntMap (Idx' aenv), Exp aenv sh)
 -> (IntMap (Idx' aenv),
     PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e)))
-> LLVM arch (IntMap (Idx' aenv), Exp aenv sh)
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp aenv sh -> LLVM arch (IntMap (Idx' aenv), Exp aenv sh)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE Exp aenv sh
sh

        -- Array injection & manipulation
        Reshape ShapeR sh
shr Exp aenv sh
sh DelayedOpenAcc aenv (Array sh' e)
a            -> (IntMap (Idx' aenv),
 PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e))
-> LLVM arch (CompiledOpenAcc arch aenv (Array sh e))
forall aenv' arrs'.
(IntMap (Idx' aenv'),
 PreOpenAccCommand CompiledOpenAcc arch aenv' arrs')
-> LLVM arch (CompiledOpenAcc arch aenv' arrs')
plain ((IntMap (Idx' aenv),
  PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e))
 -> LLVM arch (CompiledOpenAcc arch aenv (Array sh e)))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e))
-> LLVM arch (CompiledOpenAcc arch aenv (Array sh e))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Exp aenv sh
 -> ArrayVar aenv (Array sh' e)
 -> PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e))
-> (IntMap (Idx' aenv), Exp aenv sh)
-> (IntMap (Idx' aenv), ArrayVar aenv (Array sh' e))
-> (IntMap (Idx' aenv),
    PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (ShapeR sh
-> Exp aenv sh
-> ArrayVar aenv (Array sh' e)
-> PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e)
forall sh aenv sh' e (acc :: * -> * -> * -> *) arch.
ShapeR sh
-> Exp aenv sh
-> ArrayVar aenv (Array sh' e)
-> PreOpenAccCommand acc arch aenv (Array sh e)
AST.Reshape ShapeR sh
shr) ((IntMap (Idx' aenv), Exp aenv sh)
 -> (IntMap (Idx' aenv), ArrayVar aenv (Array sh' e))
 -> (IntMap (Idx' aenv),
     PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e)))
-> LLVM arch (IntMap (Idx' aenv), Exp aenv sh)
-> LLVM
     arch
     ((IntMap (Idx' aenv), ArrayVar aenv (Array sh' e))
      -> (IntMap (Idx' aenv),
          PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp aenv sh -> LLVM arch (IntMap (Idx' aenv), Exp aenv sh)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE Exp aenv sh
sh LLVM
  arch
  ((IntMap (Idx' aenv), ArrayVar aenv (Array sh' e))
   -> (IntMap (Idx' aenv),
       PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e)))
-> LLVM arch (IntMap (Idx' aenv), ArrayVar aenv (Array sh' e))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DelayedOpenAcc aenv (Array sh' e)
-> LLVM arch (IntMap (Idx' aenv), ArrayVar aenv (Array sh' e))
forall sh e.
HasCallStack =>
DelayedOpenAcc aenv (Array sh e)
-> LLVM arch (IntMap (Idx' aenv), ArrayVar aenv (Array sh e))
travM DelayedOpenAcc aenv (Array sh' e)
a
        Unit TypeR e
tp Exp aenv e
e                   -> (IntMap (Idx' aenv),
 PreOpenAccCommand CompiledOpenAcc arch aenv (Scalar e))
-> LLVM arch (CompiledOpenAcc arch aenv (Scalar e))
forall aenv' arrs'.
(IntMap (Idx' aenv'),
 PreOpenAccCommand CompiledOpenAcc arch aenv' arrs')
-> LLVM arch (CompiledOpenAcc arch aenv' arrs')
plain ((IntMap (Idx' aenv),
  PreOpenAccCommand CompiledOpenAcc arch aenv (Scalar e))
 -> LLVM arch (CompiledOpenAcc arch aenv (Scalar e)))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccCommand CompiledOpenAcc arch aenv (Scalar e))
-> LLVM arch (CompiledOpenAcc arch aenv (Scalar e))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Exp aenv e
 -> PreOpenAccCommand CompiledOpenAcc arch aenv (Scalar e))
-> (IntMap (Idx' aenv), Exp aenv e)
-> (IntMap (Idx' aenv),
    PreOpenAccCommand CompiledOpenAcc arch aenv (Scalar e))
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA (TypeR e
-> Exp aenv e
-> PreOpenAccCommand CompiledOpenAcc arch aenv (Scalar e)
forall e aenv (acc :: * -> * -> * -> *) arch.
TypeR e -> Exp aenv e -> PreOpenAccCommand acc arch aenv (Scalar e)
AST.Unit TypeR e
tp)  ((IntMap (Idx' aenv), Exp aenv e)
 -> (IntMap (Idx' aenv),
     PreOpenAccCommand CompiledOpenAcc arch aenv (Scalar e)))
-> LLVM arch (IntMap (Idx' aenv), Exp aenv e)
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccCommand CompiledOpenAcc arch aenv (Scalar e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp aenv e -> LLVM arch (IntMap (Idx' aenv), Exp aenv e)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE Exp aenv e
e
        Use ArrayR (Array sh e)
repr Array sh e
arrs               -> (IntMap (Idx' aenv),
 PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e))
-> LLVM arch (CompiledOpenAcc arch aenv (Array sh e))
forall aenv' arrs'.
(IntMap (Idx' aenv'),
 PreOpenAccCommand CompiledOpenAcc arch aenv' arrs')
-> LLVM arch (CompiledOpenAcc arch aenv' arrs')
plain ((IntMap (Idx' aenv),
  PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e))
 -> LLVM arch (CompiledOpenAcc arch aenv (Array sh e)))
-> (IntMap (Idx' aenv),
    PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e))
-> LLVM arch (CompiledOpenAcc arch aenv (Array sh e))
forall a b. (a -> b) -> a -> b
$ PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e)
-> (IntMap (Idx' aenv),
    PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ArrayR (Array sh e)
-> Array sh e
-> PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e)
forall sh e (acc :: * -> * -> * -> *) arch aenv.
ArrayR (Array sh e)
-> Array sh e -> PreOpenAccCommand acc arch aenv (Array sh e)
AST.Use ArrayR (Array sh e)
repr Array sh e
arrs)
        Map TypeR e'
_ Fun aenv (e -> e')
f DelayedOpenAcc aenv (Array sh e)
a
          | Just (UnzipIdx e e'
t,ArrayVar aenv (Array sh e)
x) <- Fun aenv (e -> e')
-> DelayedOpenAcc aenv (Array sh e)
-> Maybe (UnzipIdx e e', ArrayVar aenv (Array sh e))
forall sh a b.
Fun aenv (a -> b)
-> DelayedOpenAcc aenv (Array sh a)
-> Maybe (UnzipIdx a b, ArrayVar aenv (Array sh a))
unzip Fun aenv (e -> e')
f DelayedOpenAcc aenv (Array sh e)
a -> (IntMap (Idx' aenv),
 PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e'))
-> LLVM arch (CompiledOpenAcc arch aenv (Array sh e'))
forall aenv' arrs'.
(IntMap (Idx' aenv'),
 PreOpenAccCommand CompiledOpenAcc arch aenv' arrs')
-> LLVM arch (CompiledOpenAcc arch aenv' arrs')
plain ((IntMap (Idx' aenv),
  PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e'))
 -> LLVM arch (CompiledOpenAcc arch aenv (Array sh e')))
-> (IntMap (Idx' aenv),
    PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e'))
-> LLVM arch (CompiledOpenAcc arch aenv (Array sh e'))
forall a b. (a -> b) -> a -> b
$ PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e')
-> (IntMap (Idx' aenv),
    PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e'))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UnzipIdx e e'
-> ArrayVar aenv (Array sh e)
-> PreOpenAccCommand CompiledOpenAcc arch aenv (Array sh e')
forall tup e aenv sh (acc :: * -> * -> * -> *) arch.
UnzipIdx tup e
-> ArrayVar aenv (Array sh tup)
-> PreOpenAccCommand acc arch aenv (Array sh e)
AST.Unzip UnzipIdx e e'
t ArrayVar aenv (Array sh e)
x)

        -- Skeleton operations resulting in compiled code
        -- Producers
        Map TypeR e'
tp Fun aenv (e -> e')
f DelayedOpenAcc aenv (Array sh e)
a                  -> (IntMap (Idx' aenv),
 PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
build ((IntMap (Idx' aenv),
  PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
 -> LLVM arch (CompiledOpenAcc arch aenv arrs))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Fun aenv (e -> e')
 -> CompiledOpenAcc arch aenv (Array sh e)
 -> PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e'))
-> (IntMap (Idx' aenv), Fun aenv (e -> e'))
-> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh e))
-> (IntMap (Idx' aenv),
    PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e'))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (TypeR e'
-> Fun aenv (e -> e')
-> CompiledOpenAcc arch aenv (Array sh e)
-> PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e')
forall b p (acc :: * -> * -> * -> *) arch aenv sh a.
TypeR b
-> p
-> acc arch aenv (Array sh a)
-> PreOpenAccSkeleton acc arch aenv (Array sh b)
map TypeR e'
tp)      ((IntMap (Idx' aenv), Fun aenv (e -> e'))
 -> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh e))
 -> (IntMap (Idx' aenv),
     PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e')))
-> LLVM arch (IntMap (Idx' aenv), Fun aenv (e -> e'))
-> LLVM
     arch
     ((IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh e))
      -> (IntMap (Idx' aenv),
          PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e')))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fun aenv (e -> e')
-> LLVM arch (IntMap (Idx' aenv), Fun aenv (e -> e'))
forall env t.
HasCallStack =>
OpenFun env aenv t
-> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv t)
travF Fun aenv (e -> e')
f  LLVM
  arch
  ((IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh e))
   -> (IntMap (Idx' aenv),
       PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e')))
-> LLVM
     arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh e))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e'))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DelayedOpenAcc aenv (Array sh e)
-> LLVM
     arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh e))
forall a.
HasCallStack =>
DelayedOpenAcc aenv a
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv a)
travA DelayedOpenAcc aenv (Array sh e)
a
        Generate ArrayR (Array sh e)
r Exp aenv sh
sh Fun aenv (sh -> e)
f             -> (IntMap (Idx' aenv),
 PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
build ((IntMap (Idx' aenv),
  PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
 -> LLVM arch (CompiledOpenAcc arch aenv arrs))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Exp aenv sh
 -> Fun aenv (sh -> e)
 -> PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e))
-> (IntMap (Idx' aenv), Exp aenv sh)
-> (IntMap (Idx' aenv), Fun aenv (sh -> e))
-> (IntMap (Idx' aenv),
    PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (ArrayR (Array sh e)
-> Exp aenv sh
-> Fun aenv (sh -> e)
-> PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e)
forall sh e aenv p (acc :: * -> * -> * -> *) arch.
ArrayR (Array sh e)
-> Exp aenv sh
-> p
-> PreOpenAccSkeleton acc arch aenv (Array sh e)
generate ArrayR (Array sh e)
r)  ((IntMap (Idx' aenv), Exp aenv sh)
 -> (IntMap (Idx' aenv), Fun aenv (sh -> e))
 -> (IntMap (Idx' aenv),
     PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e)))
-> LLVM arch (IntMap (Idx' aenv), Exp aenv sh)
-> LLVM
     arch
     ((IntMap (Idx' aenv), Fun aenv (sh -> e))
      -> (IntMap (Idx' aenv),
          PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp aenv sh -> LLVM arch (IntMap (Idx' aenv), Exp aenv sh)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE Exp aenv sh
sh LLVM
  arch
  ((IntMap (Idx' aenv), Fun aenv (sh -> e))
   -> (IntMap (Idx' aenv),
       PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e)))
-> LLVM arch (IntMap (Idx' aenv), Fun aenv (sh -> e))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Fun aenv (sh -> e)
-> LLVM arch (IntMap (Idx' aenv), Fun aenv (sh -> e))
forall env t.
HasCallStack =>
OpenFun env aenv t
-> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv t)
travF Fun aenv (sh -> e)
f
        Transform ArrayR (Array sh' b)
r Exp aenv sh'
sh Fun aenv (sh' -> sh)
p Fun aenv (a1 -> b)
f DelayedOpenAcc aenv (Array sh a1)
a        -> (IntMap (Idx' aenv),
 PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
build ((IntMap (Idx' aenv),
  PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
 -> LLVM arch (CompiledOpenAcc arch aenv arrs))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Exp aenv sh'
 -> Fun aenv (sh' -> sh)
 -> Fun aenv (a1 -> b)
 -> CompiledOpenAcc arch aenv (Array sh a1)
 -> PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' b))
-> (IntMap (Idx' aenv), Exp aenv sh')
-> (IntMap (Idx' aenv), Fun aenv (sh' -> sh))
-> (IntMap (Idx' aenv), Fun aenv (a1 -> b))
-> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh a1))
-> (IntMap (Idx' aenv),
    PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' b))
forall (f :: * -> *) a b c d e.
Applicative f =>
(a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e
liftA4 (ArrayR (Array sh' b)
-> Exp aenv sh'
-> Fun aenv (sh' -> sh)
-> Fun aenv (a1 -> b)
-> CompiledOpenAcc arch aenv (Array sh a1)
-> PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' b)
forall sh' b aenv p p (acc :: * -> * -> * -> *) arch sh a.
ArrayR (Array sh' b)
-> Exp aenv sh'
-> p
-> p
-> acc arch aenv (Array sh a)
-> PreOpenAccSkeleton acc arch aenv (Array sh' b)
transform ArrayR (Array sh' b)
r) ((IntMap (Idx' aenv), Exp aenv sh')
 -> (IntMap (Idx' aenv), Fun aenv (sh' -> sh))
 -> (IntMap (Idx' aenv), Fun aenv (a1 -> b))
 -> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh a1))
 -> (IntMap (Idx' aenv),
     PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' b)))
-> LLVM arch (IntMap (Idx' aenv), Exp aenv sh')
-> LLVM
     arch
     ((IntMap (Idx' aenv), Fun aenv (sh' -> sh))
      -> (IntMap (Idx' aenv), Fun aenv (a1 -> b))
      -> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh a1))
      -> (IntMap (Idx' aenv),
          PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp aenv sh' -> LLVM arch (IntMap (Idx' aenv), Exp aenv sh')
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE Exp aenv sh'
sh LLVM
  arch
  ((IntMap (Idx' aenv), Fun aenv (sh' -> sh))
   -> (IntMap (Idx' aenv), Fun aenv (a1 -> b))
   -> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh a1))
   -> (IntMap (Idx' aenv),
       PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' b)))
-> LLVM arch (IntMap (Idx' aenv), Fun aenv (sh' -> sh))
-> LLVM
     arch
     ((IntMap (Idx' aenv), Fun aenv (a1 -> b))
      -> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh a1))
      -> (IntMap (Idx' aenv),
          PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' b)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Fun aenv (sh' -> sh)
-> LLVM arch (IntMap (Idx' aenv), Fun aenv (sh' -> sh))
forall env t.
HasCallStack =>
OpenFun env aenv t
-> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv t)
travF Fun aenv (sh' -> sh)
p LLVM
  arch
  ((IntMap (Idx' aenv), Fun aenv (a1 -> b))
   -> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh a1))
   -> (IntMap (Idx' aenv),
       PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' b)))
-> LLVM arch (IntMap (Idx' aenv), Fun aenv (a1 -> b))
-> LLVM
     arch
     ((IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh a1))
      -> (IntMap (Idx' aenv),
          PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' b)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Fun aenv (a1 -> b)
-> LLVM arch (IntMap (Idx' aenv), Fun aenv (a1 -> b))
forall env t.
HasCallStack =>
OpenFun env aenv t
-> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv t)
travF Fun aenv (a1 -> b)
f LLVM
  arch
  ((IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh a1))
   -> (IntMap (Idx' aenv),
       PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' b)))
-> LLVM
     arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh a1))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DelayedOpenAcc aenv (Array sh a1)
-> LLVM
     arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh a1))
forall a.
HasCallStack =>
DelayedOpenAcc aenv a
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv a)
travA DelayedOpenAcc aenv (Array sh a1)
a
        Backpermute ShapeR sh'
shr Exp aenv sh'
sh Fun aenv (sh' -> sh)
f DelayedOpenAcc aenv (Array sh e)
a      -> (IntMap (Idx' aenv),
 PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
build ((IntMap (Idx' aenv),
  PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
 -> LLVM arch (CompiledOpenAcc arch aenv arrs))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Exp aenv sh'
 -> Fun aenv (sh' -> sh)
 -> CompiledOpenAcc arch aenv (Array sh e)
 -> PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' e))
-> (IntMap (Idx' aenv), Exp aenv sh')
-> (IntMap (Idx' aenv), Fun aenv (sh' -> sh))
-> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh e))
-> (IntMap (Idx' aenv),
    PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' e))
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (ShapeR sh'
-> Exp aenv sh'
-> Fun aenv (sh' -> sh)
-> CompiledOpenAcc arch aenv (Array sh e)
-> PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' e)
forall sh' aenv p (acc :: * -> * -> * -> *) arch sh e.
ShapeR sh'
-> Exp aenv sh'
-> p
-> acc arch aenv (Array sh e)
-> PreOpenAccSkeleton acc arch aenv (Array sh' e)
backpermute ShapeR sh'
shr) ((IntMap (Idx' aenv), Exp aenv sh')
 -> (IntMap (Idx' aenv), Fun aenv (sh' -> sh))
 -> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh e))
 -> (IntMap (Idx' aenv),
     PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' e)))
-> LLVM arch (IntMap (Idx' aenv), Exp aenv sh')
-> LLVM
     arch
     ((IntMap (Idx' aenv), Fun aenv (sh' -> sh))
      -> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh e))
      -> (IntMap (Idx' aenv),
          PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' e)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp aenv sh' -> LLVM arch (IntMap (Idx' aenv), Exp aenv sh')
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE Exp aenv sh'
sh LLVM
  arch
  ((IntMap (Idx' aenv), Fun aenv (sh' -> sh))
   -> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh e))
   -> (IntMap (Idx' aenv),
       PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' e)))
-> LLVM arch (IntMap (Idx' aenv), Fun aenv (sh' -> sh))
-> LLVM
     arch
     ((IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh e))
      -> (IntMap (Idx' aenv),
          PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' e)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Fun aenv (sh' -> sh)
-> LLVM arch (IntMap (Idx' aenv), Fun aenv (sh' -> sh))
forall env t.
HasCallStack =>
OpenFun env aenv t
-> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv t)
travF Fun aenv (sh' -> sh)
f LLVM
  arch
  ((IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh e))
   -> (IntMap (Idx' aenv),
       PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' e)))
-> LLVM
     arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh e))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DelayedOpenAcc aenv (Array sh e)
-> LLVM
     arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh e))
forall a.
HasCallStack =>
DelayedOpenAcc aenv a
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv a)
travA DelayedOpenAcc aenv (Array sh e)
a

        -- Consumers
        Fold Fun aenv (e -> e -> e)
f Maybe (Exp aenv e)
z DelayedOpenAcc aenv (Array (sh, Int) e)
a                  -> (IntMap (Idx' aenv),
 PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
build ((IntMap (Idx' aenv),
  PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
 -> LLVM arch (CompiledOpenAcc arch aenv arrs))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Fun aenv (e -> e -> e)
 -> Bool
 -> DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e)
 -> PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e))
-> (IntMap (Idx' aenv), Fun aenv (e -> e -> e))
-> (IntMap (Idx' aenv), Bool)
-> (IntMap (Idx' aenv),
    DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
-> (IntMap (Idx' aenv),
    PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e))
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Fun aenv (e -> e -> e)
-> Bool
-> DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e)
-> PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e)
forall p (acc :: * -> * -> * -> *) arch aenv sh e.
p
-> Bool
-> DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
-> PreOpenAccSkeleton acc arch aenv (Array sh e)
fold          ((IntMap (Idx' aenv), Fun aenv (e -> e -> e))
 -> (IntMap (Idx' aenv), Bool)
 -> (IntMap (Idx' aenv),
     DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
 -> (IntMap (Idx' aenv),
     PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e)))
-> LLVM arch (IntMap (Idx' aenv), Fun aenv (e -> e -> e))
-> LLVM
     arch
     ((IntMap (Idx' aenv), Bool)
      -> (IntMap (Idx' aenv),
          DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
      -> (IntMap (Idx' aenv),
          PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fun aenv (e -> e -> e)
-> LLVM arch (IntMap (Idx' aenv), Fun aenv (e -> e -> e))
forall env t.
HasCallStack =>
OpenFun env aenv t
-> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv t)
travF Fun aenv (e -> e -> e)
f LLVM
  arch
  ((IntMap (Idx' aenv), Bool)
   -> (IntMap (Idx' aenv),
       DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
   -> (IntMap (Idx' aenv),
       PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e)))
-> LLVM arch (IntMap (Idx' aenv), Bool)
-> LLVM
     arch
     ((IntMap (Idx' aenv),
       DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
      -> (IntMap (Idx' aenv),
          PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Exp aenv e) -> LLVM arch (IntMap (Idx' aenv), Bool)
forall env e.
Maybe (OpenExp env aenv e) -> LLVM arch (IntMap (Idx' aenv), Bool)
travME Maybe (Exp aenv e)
z LLVM
  arch
  ((IntMap (Idx' aenv),
    DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
   -> (IntMap (Idx' aenv),
       PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e)))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DelayedOpenAcc aenv (Array (sh, Int) e)
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
forall sh e.
HasCallStack =>
DelayedOpenAcc aenv (Array sh e)
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
travD DelayedOpenAcc aenv (Array (sh, Int) e)
a
        FoldSeg IntegralType i
i Fun aenv (e -> e -> e)
f Maybe (Exp aenv e)
z DelayedOpenAcc aenv (Array (sh, Int) e)
a DelayedOpenAcc aenv (Segments i)
s           -> (IntMap (Idx' aenv),
 PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
build ((IntMap (Idx' aenv),
  PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
 -> LLVM arch (CompiledOpenAcc arch aenv arrs))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Fun aenv (e -> e -> e)
 -> Bool
 -> DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e)
 -> DelayedOpenAcc CompiledOpenAcc arch aenv (Segments i)
 -> PreOpenAccSkeleton
      CompiledOpenAcc arch aenv (Array (sh, Int) e))
-> (IntMap (Idx' aenv), Fun aenv (e -> e -> e))
-> (IntMap (Idx' aenv), Bool)
-> (IntMap (Idx' aenv),
    DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
-> (IntMap (Idx' aenv),
    DelayedOpenAcc CompiledOpenAcc arch aenv (Segments i))
-> (IntMap (Idx' aenv),
    PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array (sh, Int) e))
forall (f :: * -> *) a b c d e.
Applicative f =>
(a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e
liftA4 (IntegralType i
-> Fun aenv (e -> e -> e)
-> Bool
-> DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e)
-> DelayedOpenAcc CompiledOpenAcc arch aenv (Segments i)
-> PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array (sh, Int) e)
forall i p (acc :: * -> * -> * -> *) arch aenv sh e.
IntegralType i
-> p
-> Bool
-> DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
-> DelayedOpenAcc acc arch aenv (Segments i)
-> PreOpenAccSkeleton acc arch aenv (Array (sh, Int) e)
foldSeg IntegralType i
i)   ((IntMap (Idx' aenv), Fun aenv (e -> e -> e))
 -> (IntMap (Idx' aenv), Bool)
 -> (IntMap (Idx' aenv),
     DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
 -> (IntMap (Idx' aenv),
     DelayedOpenAcc CompiledOpenAcc arch aenv (Segments i))
 -> (IntMap (Idx' aenv),
     PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array (sh, Int) e)))
-> LLVM arch (IntMap (Idx' aenv), Fun aenv (e -> e -> e))
-> LLVM
     arch
     ((IntMap (Idx' aenv), Bool)
      -> (IntMap (Idx' aenv),
          DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
      -> (IntMap (Idx' aenv),
          DelayedOpenAcc CompiledOpenAcc arch aenv (Segments i))
      -> (IntMap (Idx' aenv),
          PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array (sh, Int) e)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fun aenv (e -> e -> e)
-> LLVM arch (IntMap (Idx' aenv), Fun aenv (e -> e -> e))
forall env t.
HasCallStack =>
OpenFun env aenv t
-> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv t)
travF Fun aenv (e -> e -> e)
f LLVM
  arch
  ((IntMap (Idx' aenv), Bool)
   -> (IntMap (Idx' aenv),
       DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
   -> (IntMap (Idx' aenv),
       DelayedOpenAcc CompiledOpenAcc arch aenv (Segments i))
   -> (IntMap (Idx' aenv),
       PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array (sh, Int) e)))
-> LLVM arch (IntMap (Idx' aenv), Bool)
-> LLVM
     arch
     ((IntMap (Idx' aenv),
       DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
      -> (IntMap (Idx' aenv),
          DelayedOpenAcc CompiledOpenAcc arch aenv (Segments i))
      -> (IntMap (Idx' aenv),
          PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array (sh, Int) e)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Exp aenv e) -> LLVM arch (IntMap (Idx' aenv), Bool)
forall env e.
Maybe (OpenExp env aenv e) -> LLVM arch (IntMap (Idx' aenv), Bool)
travME Maybe (Exp aenv e)
z LLVM
  arch
  ((IntMap (Idx' aenv),
    DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
   -> (IntMap (Idx' aenv),
       DelayedOpenAcc CompiledOpenAcc arch aenv (Segments i))
   -> (IntMap (Idx' aenv),
       PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array (sh, Int) e)))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
-> LLVM
     arch
     ((IntMap (Idx' aenv),
       DelayedOpenAcc CompiledOpenAcc arch aenv (Segments i))
      -> (IntMap (Idx' aenv),
          PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array (sh, Int) e)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DelayedOpenAcc aenv (Array (sh, Int) e)
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
forall sh e.
HasCallStack =>
DelayedOpenAcc aenv (Array sh e)
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
travD DelayedOpenAcc aenv (Array (sh, Int) e)
a LLVM
  arch
  ((IntMap (Idx' aenv),
    DelayedOpenAcc CompiledOpenAcc arch aenv (Segments i))
   -> (IntMap (Idx' aenv),
       PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array (sh, Int) e)))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Segments i))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array (sh, Int) e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DelayedOpenAcc aenv (Segments i)
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Segments i))
forall sh e.
HasCallStack =>
DelayedOpenAcc aenv (Array sh e)
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
travD DelayedOpenAcc aenv (Segments i)
s
        Scan  Direction
d Fun aenv (e -> e -> e)
f Maybe (Exp aenv e)
z DelayedOpenAcc aenv (Array (sh, Int) e)
a               -> (IntMap (Idx' aenv),
 PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
build ((IntMap (Idx' aenv),
  PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
 -> LLVM arch (CompiledOpenAcc arch aenv arrs))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Fun aenv (e -> e -> e)
 -> Bool
 -> DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e)
 -> PreOpenAccSkeleton
      CompiledOpenAcc arch aenv (Array (sh, Int) e))
-> (IntMap (Idx' aenv), Fun aenv (e -> e -> e))
-> (IntMap (Idx' aenv), Bool)
-> (IntMap (Idx' aenv),
    DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
-> (IntMap (Idx' aenv),
    PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array (sh, Int) e))
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (Direction
-> Fun aenv (e -> e -> e)
-> Bool
-> DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e)
-> PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array (sh, Int) e)
forall p (acc :: * -> * -> * -> *) arch aenv sh e.
Direction
-> p
-> Bool
-> DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
-> PreOpenAccSkeleton acc arch aenv (Array (sh, Int) e)
scan  Direction
d)     ((IntMap (Idx' aenv), Fun aenv (e -> e -> e))
 -> (IntMap (Idx' aenv), Bool)
 -> (IntMap (Idx' aenv),
     DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
 -> (IntMap (Idx' aenv),
     PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array (sh, Int) e)))
-> LLVM arch (IntMap (Idx' aenv), Fun aenv (e -> e -> e))
-> LLVM
     arch
     ((IntMap (Idx' aenv), Bool)
      -> (IntMap (Idx' aenv),
          DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
      -> (IntMap (Idx' aenv),
          PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array (sh, Int) e)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fun aenv (e -> e -> e)
-> LLVM arch (IntMap (Idx' aenv), Fun aenv (e -> e -> e))
forall env t.
HasCallStack =>
OpenFun env aenv t
-> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv t)
travF Fun aenv (e -> e -> e)
f LLVM
  arch
  ((IntMap (Idx' aenv), Bool)
   -> (IntMap (Idx' aenv),
       DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
   -> (IntMap (Idx' aenv),
       PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array (sh, Int) e)))
-> LLVM arch (IntMap (Idx' aenv), Bool)
-> LLVM
     arch
     ((IntMap (Idx' aenv),
       DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
      -> (IntMap (Idx' aenv),
          PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array (sh, Int) e)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Exp aenv e) -> LLVM arch (IntMap (Idx' aenv), Bool)
forall env e.
Maybe (OpenExp env aenv e) -> LLVM arch (IntMap (Idx' aenv), Bool)
travME Maybe (Exp aenv e)
z LLVM
  arch
  ((IntMap (Idx' aenv),
    DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
   -> (IntMap (Idx' aenv),
       PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array (sh, Int) e)))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array (sh, Int) e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DelayedOpenAcc aenv (Array (sh, Int) e)
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
forall sh e.
HasCallStack =>
DelayedOpenAcc aenv (Array sh e)
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
travD DelayedOpenAcc aenv (Array (sh, Int) e)
a
        Scan' Direction
d Fun aenv (e -> e -> e)
f Exp aenv e
z DelayedOpenAcc aenv (Array (sh, Int) e)
a               -> (IntMap (Idx' aenv),
 PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
build ((IntMap (Idx' aenv),
  PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
 -> LLVM arch (CompiledOpenAcc arch aenv arrs))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Fun aenv (e -> e -> e)
 -> Exp aenv e
 -> DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e)
 -> PreOpenAccSkeleton
      CompiledOpenAcc arch aenv (Array (sh, Int) e, Array sh e))
-> (IntMap (Idx' aenv), Fun aenv (e -> e -> e))
-> (IntMap (Idx' aenv), Exp aenv e)
-> (IntMap (Idx' aenv),
    DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
-> (IntMap (Idx' aenv),
    PreOpenAccSkeleton
      CompiledOpenAcc arch aenv (Array (sh, Int) e, Array sh e))
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (Direction
-> Fun aenv (e -> e -> e)
-> Exp aenv e
-> DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e)
-> PreOpenAccSkeleton
     CompiledOpenAcc arch aenv (Array (sh, Int) e, Array sh e)
forall p p (acc :: * -> * -> * -> *) arch aenv sh e.
Direction
-> p
-> p
-> DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
-> PreOpenAccSkeleton acc arch aenv (Array (sh, Int) e, Array sh e)
scan' Direction
d)     ((IntMap (Idx' aenv), Fun aenv (e -> e -> e))
 -> (IntMap (Idx' aenv), Exp aenv e)
 -> (IntMap (Idx' aenv),
     DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
 -> (IntMap (Idx' aenv),
     PreOpenAccSkeleton
       CompiledOpenAcc arch aenv (Array (sh, Int) e, Array sh e)))
-> LLVM arch (IntMap (Idx' aenv), Fun aenv (e -> e -> e))
-> LLVM
     arch
     ((IntMap (Idx' aenv), Exp aenv e)
      -> (IntMap (Idx' aenv),
          DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
      -> (IntMap (Idx' aenv),
          PreOpenAccSkeleton
            CompiledOpenAcc arch aenv (Array (sh, Int) e, Array sh e)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fun aenv (e -> e -> e)
-> LLVM arch (IntMap (Idx' aenv), Fun aenv (e -> e -> e))
forall env t.
HasCallStack =>
OpenFun env aenv t
-> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv t)
travF Fun aenv (e -> e -> e)
f LLVM
  arch
  ((IntMap (Idx' aenv), Exp aenv e)
   -> (IntMap (Idx' aenv),
       DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
   -> (IntMap (Idx' aenv),
       PreOpenAccSkeleton
         CompiledOpenAcc arch aenv (Array (sh, Int) e, Array sh e)))
-> LLVM arch (IntMap (Idx' aenv), Exp aenv e)
-> LLVM
     arch
     ((IntMap (Idx' aenv),
       DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
      -> (IntMap (Idx' aenv),
          PreOpenAccSkeleton
            CompiledOpenAcc arch aenv (Array (sh, Int) e, Array sh e)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Exp aenv e -> LLVM arch (IntMap (Idx' aenv), Exp aenv e)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE Exp aenv e
z LLVM
  arch
  ((IntMap (Idx' aenv),
    DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
   -> (IntMap (Idx' aenv),
       PreOpenAccSkeleton
         CompiledOpenAcc arch aenv (Array (sh, Int) e, Array sh e)))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccSkeleton
        CompiledOpenAcc arch aenv (Array (sh, Int) e, Array sh e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DelayedOpenAcc aenv (Array (sh, Int) e)
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Array (sh, Int) e))
forall sh e.
HasCallStack =>
DelayedOpenAcc aenv (Array sh e)
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
travD DelayedOpenAcc aenv (Array (sh, Int) e)
a
        Permute Fun aenv (e -> e -> e)
f DelayedOpenAcc aenv (Array sh' e)
d Fun aenv (sh -> PrimMaybe sh')
g DelayedOpenAcc aenv (Array sh e)
a             -> (IntMap (Idx' aenv),
 PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
build ((IntMap (Idx' aenv),
  PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
 -> LLVM arch (CompiledOpenAcc arch aenv arrs))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Fun aenv (e -> e -> e)
 -> CompiledOpenAcc arch aenv (Array sh' e)
 -> Fun aenv (sh -> PrimMaybe sh')
 -> DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e)
 -> PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' e))
-> (IntMap (Idx' aenv), Fun aenv (e -> e -> e))
-> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh' e))
-> (IntMap (Idx' aenv), Fun aenv (sh -> PrimMaybe sh'))
-> (IntMap (Idx' aenv),
    DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
-> (IntMap (Idx' aenv),
    PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' e))
forall (f :: * -> *) a b c d e.
Applicative f =>
(a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e
liftA4 Fun aenv (e -> e -> e)
-> CompiledOpenAcc arch aenv (Array sh' e)
-> Fun aenv (sh -> PrimMaybe sh')
-> DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e)
-> PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' e)
forall p (acc :: * -> * -> * -> *) arch aenv sh' e p sh.
p
-> acc arch aenv (Array sh' e)
-> p
-> DelayedOpenAcc acc arch aenv (Array sh e)
-> PreOpenAccSkeleton acc arch aenv (Array sh' e)
permute       ((IntMap (Idx' aenv), Fun aenv (e -> e -> e))
 -> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh' e))
 -> (IntMap (Idx' aenv), Fun aenv (sh -> PrimMaybe sh'))
 -> (IntMap (Idx' aenv),
     DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
 -> (IntMap (Idx' aenv),
     PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' e)))
-> LLVM arch (IntMap (Idx' aenv), Fun aenv (e -> e -> e))
-> LLVM
     arch
     ((IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh' e))
      -> (IntMap (Idx' aenv), Fun aenv (sh -> PrimMaybe sh'))
      -> (IntMap (Idx' aenv),
          DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
      -> (IntMap (Idx' aenv),
          PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' e)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fun aenv (e -> e -> e)
-> LLVM arch (IntMap (Idx' aenv), Fun aenv (e -> e -> e))
forall env t.
HasCallStack =>
OpenFun env aenv t
-> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv t)
travF Fun aenv (e -> e -> e)
f LLVM
  arch
  ((IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh' e))
   -> (IntMap (Idx' aenv), Fun aenv (sh -> PrimMaybe sh'))
   -> (IntMap (Idx' aenv),
       DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
   -> (IntMap (Idx' aenv),
       PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' e)))
-> LLVM
     arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh' e))
-> LLVM
     arch
     ((IntMap (Idx' aenv), Fun aenv (sh -> PrimMaybe sh'))
      -> (IntMap (Idx' aenv),
          DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
      -> (IntMap (Idx' aenv),
          PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' e)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DelayedOpenAcc aenv (Array sh' e)
-> LLVM
     arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh' e))
forall a.
HasCallStack =>
DelayedOpenAcc aenv a
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv a)
travA DelayedOpenAcc aenv (Array sh' e)
d LLVM
  arch
  ((IntMap (Idx' aenv), Fun aenv (sh -> PrimMaybe sh'))
   -> (IntMap (Idx' aenv),
       DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
   -> (IntMap (Idx' aenv),
       PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' e)))
-> LLVM arch (IntMap (Idx' aenv), Fun aenv (sh -> PrimMaybe sh'))
-> LLVM
     arch
     ((IntMap (Idx' aenv),
       DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
      -> (IntMap (Idx' aenv),
          PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' e)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Fun aenv (sh -> PrimMaybe sh')
-> LLVM arch (IntMap (Idx' aenv), Fun aenv (sh -> PrimMaybe sh'))
forall env t.
HasCallStack =>
OpenFun env aenv t
-> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv t)
travF Fun aenv (sh -> PrimMaybe sh')
g LLVM
  arch
  ((IntMap (Idx' aenv),
    DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
   -> (IntMap (Idx' aenv),
       PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' e)))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh' e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DelayedOpenAcc aenv (Array sh e)
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
forall sh e.
HasCallStack =>
DelayedOpenAcc aenv (Array sh e)
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
travD DelayedOpenAcc aenv (Array sh e)
a
        Stencil StencilR sh e stencil
s TypeR e'
tp Fun aenv (stencil -> e')
f Boundary aenv (Array sh e)
x DelayedOpenAcc aenv (Array sh e)
a          -> (IntMap (Idx' aenv),
 PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
build ((IntMap (Idx' aenv),
  PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
 -> LLVM arch (CompiledOpenAcc arch aenv arrs))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Fun aenv (stencil -> e')
 -> Boundary aenv (Array sh e)
 -> DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e)
 -> PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e'))
-> (IntMap (Idx' aenv), Fun aenv (stencil -> e'))
-> (IntMap (Idx' aenv), Boundary aenv (Array sh e))
-> (IntMap (Idx' aenv),
    DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
-> (IntMap (Idx' aenv),
    PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e'))
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (StencilR sh e stencil
-> TypeR e'
-> Fun aenv (stencil -> e')
-> Boundary aenv (Array sh e)
-> DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e)
-> PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e')
forall sh a stencil b.
StencilR sh a stencil
-> TypeR b
-> Fun aenv (stencil -> b)
-> Boundary aenv (Array sh a)
-> DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh a)
-> PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh b)
stencil1 StencilR sh e stencil
s TypeR e'
tp) ((IntMap (Idx' aenv), Fun aenv (stencil -> e'))
 -> (IntMap (Idx' aenv), Boundary aenv (Array sh e))
 -> (IntMap (Idx' aenv),
     DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
 -> (IntMap (Idx' aenv),
     PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e')))
-> LLVM arch (IntMap (Idx' aenv), Fun aenv (stencil -> e'))
-> LLVM
     arch
     ((IntMap (Idx' aenv), Boundary aenv (Array sh e))
      -> (IntMap (Idx' aenv),
          DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
      -> (IntMap (Idx' aenv),
          PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e')))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fun aenv (stencil -> e')
-> LLVM arch (IntMap (Idx' aenv), Fun aenv (stencil -> e'))
forall env t.
HasCallStack =>
OpenFun env aenv t
-> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv t)
travF Fun aenv (stencil -> e')
f LLVM
  arch
  ((IntMap (Idx' aenv), Boundary aenv (Array sh e))
   -> (IntMap (Idx' aenv),
       DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
   -> (IntMap (Idx' aenv),
       PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e')))
-> LLVM arch (IntMap (Idx' aenv), Boundary aenv (Array sh e))
-> LLVM
     arch
     ((IntMap (Idx' aenv),
       DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
      -> (IntMap (Idx' aenv),
          PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e')))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Boundary aenv (Array sh e)
-> LLVM arch (IntMap (Idx' aenv), Boundary aenv (Array sh e))
forall t.
HasCallStack =>
Boundary aenv t -> LLVM arch (IntMap (Idx' aenv), Boundary aenv t)
travB Boundary aenv (Array sh e)
x LLVM
  arch
  ((IntMap (Idx' aenv),
    DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
   -> (IntMap (Idx' aenv),
       PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e')))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh e'))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DelayedOpenAcc aenv (Array sh e)
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
forall sh e.
HasCallStack =>
DelayedOpenAcc aenv (Array sh e)
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
travD DelayedOpenAcc aenv (Array sh e)
a
        Stencil2 StencilR sh a1 stencil1
s1 StencilR sh b stencil2
s2 TypeR c
tp Fun aenv (stencil1 -> stencil2 -> c)
f Boundary aenv (Array sh a1)
x DelayedOpenAcc aenv (Array sh a1)
a Boundary aenv (Array sh b)
y DelayedOpenAcc aenv (Array sh b)
b -> (IntMap (Idx' aenv),
 PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
build ((IntMap (Idx' aenv),
  PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
 -> LLVM arch (CompiledOpenAcc arch aenv arrs))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Fun aenv (stencil1 -> stencil2 -> c)
 -> Boundary aenv (Array sh a1)
 -> DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh a1)
 -> Boundary aenv (Array sh b)
 -> DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh b)
 -> PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh c))
-> (IntMap (Idx' aenv), Fun aenv (stencil1 -> stencil2 -> c))
-> (IntMap (Idx' aenv), Boundary aenv (Array sh a1))
-> (IntMap (Idx' aenv),
    DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh a1))
-> (IntMap (Idx' aenv), Boundary aenv (Array sh b))
-> (IntMap (Idx' aenv),
    DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh b))
-> (IntMap (Idx' aenv),
    PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh c))
forall (f :: * -> *) a b c d e g.
Applicative f =>
(a -> b -> c -> d -> e -> g)
-> f a -> f b -> f c -> f d -> f e -> f g
liftA5 (StencilR sh a1 stencil1
-> StencilR sh b stencil2
-> TypeR c
-> Fun aenv (stencil1 -> stencil2 -> c)
-> Boundary aenv (Array sh a1)
-> DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh a1)
-> Boundary aenv (Array sh b)
-> DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh b)
-> PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh c)
forall sh a stencil1 b stencil2 c.
StencilR sh a stencil1
-> StencilR sh b stencil2
-> TypeR c
-> Fun aenv (stencil1 -> stencil2 -> c)
-> Boundary aenv (Array sh a)
-> DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh a)
-> Boundary aenv (Array sh b)
-> DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh b)
-> PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh c)
stencil2 StencilR sh a1 stencil1
s1 StencilR sh b stencil2
s2 TypeR c
tp) ((IntMap (Idx' aenv), Fun aenv (stencil1 -> stencil2 -> c))
 -> (IntMap (Idx' aenv), Boundary aenv (Array sh a1))
 -> (IntMap (Idx' aenv),
     DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh a1))
 -> (IntMap (Idx' aenv), Boundary aenv (Array sh b))
 -> (IntMap (Idx' aenv),
     DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh b))
 -> (IntMap (Idx' aenv),
     PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh c)))
-> LLVM
     arch (IntMap (Idx' aenv), Fun aenv (stencil1 -> stencil2 -> c))
-> LLVM
     arch
     ((IntMap (Idx' aenv), Boundary aenv (Array sh a1))
      -> (IntMap (Idx' aenv),
          DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh a1))
      -> (IntMap (Idx' aenv), Boundary aenv (Array sh b))
      -> (IntMap (Idx' aenv),
          DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh b))
      -> (IntMap (Idx' aenv),
          PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh c)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fun aenv (stencil1 -> stencil2 -> c)
-> LLVM
     arch (IntMap (Idx' aenv), Fun aenv (stencil1 -> stencil2 -> c))
forall env t.
HasCallStack =>
OpenFun env aenv t
-> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv t)
travF Fun aenv (stencil1 -> stencil2 -> c)
f LLVM
  arch
  ((IntMap (Idx' aenv), Boundary aenv (Array sh a1))
   -> (IntMap (Idx' aenv),
       DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh a1))
   -> (IntMap (Idx' aenv), Boundary aenv (Array sh b))
   -> (IntMap (Idx' aenv),
       DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh b))
   -> (IntMap (Idx' aenv),
       PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh c)))
-> LLVM arch (IntMap (Idx' aenv), Boundary aenv (Array sh a1))
-> LLVM
     arch
     ((IntMap (Idx' aenv),
       DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh a1))
      -> (IntMap (Idx' aenv), Boundary aenv (Array sh b))
      -> (IntMap (Idx' aenv),
          DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh b))
      -> (IntMap (Idx' aenv),
          PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh c)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Boundary aenv (Array sh a1)
-> LLVM arch (IntMap (Idx' aenv), Boundary aenv (Array sh a1))
forall t.
HasCallStack =>
Boundary aenv t -> LLVM arch (IntMap (Idx' aenv), Boundary aenv t)
travB Boundary aenv (Array sh a1)
x LLVM
  arch
  ((IntMap (Idx' aenv),
    DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh a1))
   -> (IntMap (Idx' aenv), Boundary aenv (Array sh b))
   -> (IntMap (Idx' aenv),
       DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh b))
   -> (IntMap (Idx' aenv),
       PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh c)))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh a1))
-> LLVM
     arch
     ((IntMap (Idx' aenv), Boundary aenv (Array sh b))
      -> (IntMap (Idx' aenv),
          DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh b))
      -> (IntMap (Idx' aenv),
          PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh c)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DelayedOpenAcc aenv (Array sh a1)
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh a1))
forall sh e.
HasCallStack =>
DelayedOpenAcc aenv (Array sh e)
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
travD DelayedOpenAcc aenv (Array sh a1)
a LLVM
  arch
  ((IntMap (Idx' aenv), Boundary aenv (Array sh b))
   -> (IntMap (Idx' aenv),
       DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh b))
   -> (IntMap (Idx' aenv),
       PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh c)))
-> LLVM arch (IntMap (Idx' aenv), Boundary aenv (Array sh b))
-> LLVM
     arch
     ((IntMap (Idx' aenv),
       DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh b))
      -> (IntMap (Idx' aenv),
          PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh c)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Boundary aenv (Array sh b)
-> LLVM arch (IntMap (Idx' aenv), Boundary aenv (Array sh b))
forall t.
HasCallStack =>
Boundary aenv t -> LLVM arch (IntMap (Idx' aenv), Boundary aenv t)
travB Boundary aenv (Array sh b)
y LLVM
  arch
  ((IntMap (Idx' aenv),
    DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh b))
   -> (IntMap (Idx' aenv),
       PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh c)))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh b))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DelayedOpenAcc aenv (Array sh b)
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh b))
forall sh e.
HasCallStack =>
DelayedOpenAcc aenv (Array sh e)
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
travD DelayedOpenAcc aenv (Array sh b)
b

        -- Removed by fusion
        Replicate{}                 -> LLVM arch (CompiledOpenAcc arch aenv arrs)
forall error. error
fusionError
        Slice{}                     -> LLVM arch (CompiledOpenAcc arch aenv arrs)
forall error. error
fusionError
        ZipWith{}                   -> LLVM arch (CompiledOpenAcc arch aenv arrs)
forall error. error
fusionError

      where
        map :: TypeR b
-> p
-> acc arch aenv (Array sh a)
-> PreOpenAccSkeleton acc arch aenv (Array sh b)
map TypeR b
tp p
_ acc arch aenv (Array sh a)
a             = TypeR b
-> acc arch aenv (Array sh a)
-> PreOpenAccSkeleton acc arch aenv (Array sh b)
forall b (acc :: * -> * -> * -> *) arch aenv sh a.
TypeR b
-> acc arch aenv (Array sh a)
-> PreOpenAccSkeleton acc arch aenv (Array sh b)
AST.Map TypeR b
tp acc arch aenv (Array sh a)
a
        generate :: ArrayR (Array sh e)
-> Exp aenv sh
-> p
-> PreOpenAccSkeleton acc arch aenv (Array sh e)
generate ArrayR (Array sh e)
r Exp aenv sh
sh p
_        = ArrayR (Array sh e)
-> Exp aenv sh -> PreOpenAccSkeleton acc arch aenv (Array sh e)
forall sh e aenv (acc :: * -> * -> * -> *) arch.
ArrayR (Array sh e)
-> Exp aenv sh -> PreOpenAccSkeleton acc arch aenv (Array sh e)
AST.Generate ArrayR (Array sh e)
r Exp aenv sh
sh
        transform :: ArrayR (Array sh' b)
-> Exp aenv sh'
-> p
-> p
-> acc arch aenv (Array sh a)
-> PreOpenAccSkeleton acc arch aenv (Array sh' b)
transform ArrayR (Array sh' b)
r Exp aenv sh'
sh p
_ p
_ acc arch aenv (Array sh a)
a   = ArrayR (Array sh' b)
-> Exp aenv sh'
-> acc arch aenv (Array sh a)
-> PreOpenAccSkeleton acc arch aenv (Array sh' b)
forall sh' b aenv (acc :: * -> * -> * -> *) arch sh' a.
ArrayR (Array sh' b)
-> Exp aenv sh'
-> acc arch aenv (Array sh' a)
-> PreOpenAccSkeleton acc arch aenv (Array sh' b)
AST.Transform ArrayR (Array sh' b)
r Exp aenv sh'
sh acc arch aenv (Array sh a)
a
        backpermute :: ShapeR sh'
-> Exp aenv sh'
-> p
-> acc arch aenv (Array sh e)
-> PreOpenAccSkeleton acc arch aenv (Array sh' e)
backpermute ShapeR sh'
shr Exp aenv sh'
sh p
_ acc arch aenv (Array sh e)
a = ShapeR sh'
-> Exp aenv sh'
-> acc arch aenv (Array sh e)
-> PreOpenAccSkeleton acc arch aenv (Array sh' e)
forall sh' aenv (acc :: * -> * -> * -> *) arch sh e.
ShapeR sh'
-> Exp aenv sh'
-> acc arch aenv (Array sh e)
-> PreOpenAccSkeleton acc arch aenv (Array sh' e)
AST.Backpermute ShapeR sh'
shr Exp aenv sh'
sh acc arch aenv (Array sh e)
a
        fold :: p
-> Bool
-> DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
-> PreOpenAccSkeleton acc arch aenv (Array sh e)
fold p
_ Bool
z DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
a             = Bool
-> DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
-> PreOpenAccSkeleton acc arch aenv (Array sh e)
forall (acc :: * -> * -> * -> *) arch aenv sh i.
Bool
-> DelayedOpenAcc acc arch aenv (Array (sh, Int) i)
-> PreOpenAccSkeleton acc arch aenv (Array sh i)
AST.Fold Bool
z DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
a
        foldSeg :: IntegralType i
-> p
-> Bool
-> DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
-> DelayedOpenAcc acc arch aenv (Segments i)
-> PreOpenAccSkeleton acc arch aenv (Array (sh, Int) e)
foldSeg IntegralType i
i p
_ Bool
z DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
a DelayedOpenAcc acc arch aenv (Segments i)
s      = IntegralType i
-> Bool
-> DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
-> DelayedOpenAcc acc arch aenv (Segments i)
-> PreOpenAccSkeleton acc arch aenv (Array (sh, Int) e)
forall i (acc :: * -> * -> * -> *) arch aenv sh e.
IntegralType i
-> Bool
-> DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
-> DelayedOpenAcc acc arch aenv (Segments i)
-> PreOpenAccSkeleton acc arch aenv (Array (sh, Int) e)
AST.FoldSeg IntegralType i
i Bool
z DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
a DelayedOpenAcc acc arch aenv (Segments i)
s
        scan :: Direction
-> p
-> Bool
-> DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
-> PreOpenAccSkeleton acc arch aenv (Array (sh, Int) e)
scan Direction
d p
_ Bool
z DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
a           = Direction
-> Bool
-> DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
-> PreOpenAccSkeleton acc arch aenv (Array (sh, Int) e)
forall (acc :: * -> * -> * -> *) arch aenv sh e.
Direction
-> Bool
-> DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
-> PreOpenAccSkeleton acc arch aenv (Array (sh, Int) e)
AST.Scan Direction
d Bool
z DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
a
        scan' :: Direction
-> p
-> p
-> DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
-> PreOpenAccSkeleton acc arch aenv (Array (sh, Int) e, Array sh e)
scan' Direction
d p
_ p
_ DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
a          = Direction
-> DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
-> PreOpenAccSkeleton acc arch aenv (Array (sh, Int) e, Array sh e)
forall (acc :: * -> * -> * -> *) arch aenv sh e.
Direction
-> DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
-> PreOpenAccSkeleton acc arch aenv (Array (sh, Int) e, Array sh e)
AST.Scan' Direction
d DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
a
        permute :: p
-> acc arch aenv (Array sh' e)
-> p
-> DelayedOpenAcc acc arch aenv (Array sh e)
-> PreOpenAccSkeleton acc arch aenv (Array sh' e)
permute p
_ acc arch aenv (Array sh' e)
d p
_ DelayedOpenAcc acc arch aenv (Array sh e)
a        = acc arch aenv (Array sh' e)
-> DelayedOpenAcc acc arch aenv (Array sh e)
-> PreOpenAccSkeleton acc arch aenv (Array sh' e)
forall (acc :: * -> * -> * -> *) arch aenv sh' e sh.
acc arch aenv (Array sh' e)
-> DelayedOpenAcc acc arch aenv (Array sh e)
-> PreOpenAccSkeleton acc arch aenv (Array sh' e)
AST.Permute acc arch aenv (Array sh' e)
d DelayedOpenAcc acc arch aenv (Array sh e)
a

        stencil1 :: StencilR sh a stencil
                 -> TypeR b
                 -> Fun      aenv (stencil -> b)
                 -> Boundary aenv (Array sh a)
                 -> AST.DelayedOpenAcc     CompiledOpenAcc arch aenv (Array sh a)
                 -> AST.PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh b)
        stencil1 :: StencilR sh a stencil
-> TypeR b
-> Fun aenv (stencil -> b)
-> Boundary aenv (Array sh a)
-> DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh a)
-> PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh b)
stencil1 StencilR sh a stencil
s TypeR b
tp Fun aenv (stencil -> b)
_ Boundary aenv (Array sh a)
_ DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh a)
a = TypeR b
-> sh
-> DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh a)
-> PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh b)
forall b sh (acc :: * -> * -> * -> *) arch aenv a.
TypeR b
-> sh
-> DelayedOpenAcc acc arch aenv (Array sh a)
-> PreOpenAccSkeleton acc arch aenv (Array sh b)
AST.Stencil1 TypeR b
tp ((ShapeR sh, sh) -> sh
forall a b. (a, b) -> b
snd ((ShapeR sh, sh) -> sh) -> (ShapeR sh, sh) -> sh
forall a b. (a -> b) -> a -> b
$ StencilR sh a stencil -> (ShapeR sh, sh)
forall sh e stencil. StencilR sh e stencil -> (ShapeR sh, sh)
stencilHalo StencilR sh a stencil
s) DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh a)
a

        stencil2 :: StencilR sh a stencil1
                 -> StencilR sh b stencil2
                 -> TypeR c
                 -> Fun                                          aenv (stencil1 -> stencil2 -> c)
                 -> Boundary                                     aenv (Array sh a)
                 -> AST.DelayedOpenAcc     CompiledOpenAcc arch  aenv (Array sh a)
                 -> Boundary                                     aenv (Array sh b)
                 -> AST.DelayedOpenAcc     CompiledOpenAcc arch  aenv (Array sh b)
                 -> AST.PreOpenAccSkeleton CompiledOpenAcc arch  aenv (Array sh c)
        stencil2 :: StencilR sh a stencil1
-> StencilR sh b stencil2
-> TypeR c
-> Fun aenv (stencil1 -> stencil2 -> c)
-> Boundary aenv (Array sh a)
-> DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh a)
-> Boundary aenv (Array sh b)
-> DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh b)
-> PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh c)
stencil2 StencilR sh a stencil1
s1 StencilR sh b stencil2
s2 TypeR c
tp Fun aenv (stencil1 -> stencil2 -> c)
_ Boundary aenv (Array sh a)
_ DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh a)
a Boundary aenv (Array sh b)
_ DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh b)
b = TypeR c
-> sh
-> DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh a)
-> DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh b)
-> PreOpenAccSkeleton CompiledOpenAcc arch aenv (Array sh c)
forall c sh (acc :: * -> * -> * -> *) arch aenv a b.
TypeR c
-> sh
-> DelayedOpenAcc acc arch aenv (Array sh a)
-> DelayedOpenAcc acc arch aenv (Array sh b)
-> PreOpenAccSkeleton acc arch aenv (Array sh c)
AST.Stencil2 TypeR c
tp (ShapeR sh -> sh -> sh -> sh
forall sh. ShapeR sh -> sh -> sh -> sh
union ShapeR sh
shr sh
h1 sh
h2) DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh a)
a DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh b)
b
          where
            (ShapeR sh
shr, sh
h1) = StencilR sh a stencil1 -> (ShapeR sh, sh)
forall sh e stencil. StencilR sh e stencil -> (ShapeR sh, sh)
stencilHalo StencilR sh a stencil1
s1
            (ShapeR sh
_,   sh
h2) = StencilR sh b stencil2 -> (ShapeR sh, sh)
forall sh e stencil. StencilR sh e stencil -> (ShapeR sh, sh)
stencilHalo StencilR sh b stencil2
s2

        fusionError :: error
        fusionError :: error
fusionError = String -> error
forall a. HasCallStack => String -> a
internalError (String -> error) -> String -> error
forall a b. (a -> b) -> a -> b
$ String
"unexpected fusible material: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PreOpenAcc DelayedOpenAcc aenv arrs -> String
forall (acc :: * -> * -> *) aenv arrs.
PreOpenAcc acc aenv arrs -> String
showPreAccOp PreOpenAcc DelayedOpenAcc aenv arrs
pacc

        travA :: HasCallStack
              => DelayedOpenAcc aenv a
              -> LLVM arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv a)
        travA :: DelayedOpenAcc aenv a
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv a)
travA DelayedOpenAcc aenv a
acc = CompiledOpenAcc arch aenv a
-> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CompiledOpenAcc arch aenv a
 -> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv a))
-> LLVM arch (CompiledOpenAcc arch aenv a)
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DelayedOpenAcc aenv a -> LLVM arch (CompiledOpenAcc arch aenv a)
forall aenv arrs.
HasCallStack =>
DelayedOpenAcc aenv arrs
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
traverseAcc DelayedOpenAcc aenv a
acc

        travD :: HasCallStack
              => DelayedOpenAcc aenv (Array sh e)
              -> LLVM arch ( IntMap (Idx' aenv)
                           , AST.DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
        travD :: DelayedOpenAcc aenv (Array sh e)
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
travD DelayedOpenAcc aenv (Array sh e)
acc =
          case DelayedOpenAcc aenv (Array sh e)
acc of
            Delayed{Fun aenv (sh -> e)
Fun aenv (Int -> e)
Exp aenv sh
ArrayR (Array sh e)
linearIndexD :: forall aenv sh e.
DelayedOpenAcc aenv (Array sh e) -> Fun aenv (Int -> e)
indexD :: forall aenv sh e.
DelayedOpenAcc aenv (Array sh e) -> Fun aenv (sh -> e)
extentD :: forall aenv sh e. DelayedOpenAcc aenv (Array sh e) -> Exp aenv sh
reprD :: forall aenv sh e.
DelayedOpenAcc aenv (Array sh e) -> ArrayR (Array sh e)
linearIndexD :: Fun aenv (Int -> e)
indexD :: Fun aenv (sh -> e)
extentD :: Exp aenv sh
reprD :: ArrayR (Array sh e)
..} -> (Exp aenv sh
 -> Fun aenv (sh -> e)
 -> DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
-> (IntMap (Idx' aenv), Exp aenv sh)
-> (IntMap (Idx' aenv), Fun aenv (sh -> e))
-> (IntMap (Idx' aenv),
    DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e)
-> Fun aenv (sh -> e)
-> DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e)
forall a b. a -> b -> a
const (DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e)
 -> Fun aenv (sh -> e)
 -> DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
-> (Exp aenv sh
    -> DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
-> Exp aenv sh
-> Fun aenv (sh -> e)
-> DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ArrayR (Array sh e)
-> Exp aenv sh
-> DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e)
forall sh e aenv (acc :: * -> * -> * -> *) arch.
ArrayR (Array sh e)
-> Exp aenv sh -> DelayedOpenAcc acc arch aenv (Array sh e)
AST.Delayed ArrayR (Array sh e)
reprD)) ((IntMap (Idx' aenv), Exp aenv sh)
 -> (IntMap (Idx' aenv), Fun aenv (sh -> e))
 -> (IntMap (Idx' aenv),
     DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e)))
-> LLVM arch (IntMap (Idx' aenv), Exp aenv sh)
-> LLVM
     arch
     ((IntMap (Idx' aenv), Fun aenv (sh -> e))
      -> (IntMap (Idx' aenv),
          DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp aenv sh -> LLVM arch (IntMap (Idx' aenv), Exp aenv sh)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE Exp aenv sh
extentD LLVM
  arch
  ((IntMap (Idx' aenv), Fun aenv (sh -> e))
   -> (IntMap (Idx' aenv),
       DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e)))
-> LLVM arch (IntMap (Idx' aenv), Fun aenv (sh -> e))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Fun aenv (sh -> e)
-> LLVM arch (IntMap (Idx' aenv), Fun aenv (sh -> e))
forall env t.
HasCallStack =>
OpenFun env aenv t
-> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv t)
travF Fun aenv (sh -> e)
indexD
            DelayedOpenAcc aenv (Array sh e)
_           -> (CompiledOpenAcc arch aenv (Array sh e)
 -> DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
-> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh e))
-> (IntMap (Idx' aenv),
    DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA  (ArraysR (Array sh e)
-> CompiledOpenAcc arch aenv (Array sh e)
-> DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e)
forall sh e (acc :: * -> * -> * -> *) arch aenv.
ArraysR (Array sh e)
-> acc arch aenv (Array sh e)
-> DelayedOpenAcc acc arch aenv (Array sh e)
AST.Manifest (ArraysR (Array sh e)
 -> CompiledOpenAcc arch aenv (Array sh e)
 -> DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
-> ArraysR (Array sh e)
-> CompiledOpenAcc arch aenv (Array sh e)
-> DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e)
forall a b. (a -> b) -> a -> b
$ DelayedOpenAcc aenv (Array sh e) -> ArraysR (Array sh e)
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR DelayedOpenAcc aenv (Array sh e)
acc)  ((IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh e))
 -> (IntMap (Idx' aenv),
     DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e)))
-> LLVM
     arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh e))
-> LLVM
     arch
     (IntMap (Idx' aenv),
      DelayedOpenAcc CompiledOpenAcc arch aenv (Array sh e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DelayedOpenAcc aenv (Array sh e)
-> LLVM
     arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv (Array sh e))
forall a.
HasCallStack =>
DelayedOpenAcc aenv a
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv a)
travA DelayedOpenAcc aenv (Array sh e)
acc

        travM :: HasCallStack
              => DelayedOpenAcc aenv (Array sh e)
              -> LLVM arch (IntMap (Idx' aenv), ArrayVar aenv (Array sh e))
        travM :: DelayedOpenAcc aenv (Array sh e)
-> LLVM arch (IntMap (Idx' aenv), ArrayVar aenv (Array sh e))
travM (Manifest (Avar ArrayVar aenv (Array sh e)
v)) = (IntMap (Idx' aenv), ArrayVar aenv (Array sh e))
-> LLVM arch (IntMap (Idx' aenv), ArrayVar aenv (Array sh e))
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrayVar aenv (Array sh e) -> IntMap (Idx' aenv)
forall aenv a. ArrayVar aenv a -> IntMap (Idx' aenv)
freevar ArrayVar aenv (Array sh e)
v, ArrayVar aenv (Array sh e)
v)
        travM DelayedOpenAcc aenv (Array sh e)
_                   = String
-> LLVM arch (IntMap (Idx' aenv), ArrayVar aenv (Array sh e))
forall a. HasCallStack => String -> a
internalError String
"expected array variable"

        travME :: Maybe (OpenExp env aenv e) -> LLVM arch (IntMap (Idx' aenv), Bool)
        travME :: Maybe (OpenExp env aenv e) -> LLVM arch (IntMap (Idx' aenv), Bool)
travME Maybe (OpenExp env aenv e)
Nothing  = (IntMap (Idx' aenv), Bool) -> LLVM arch (IntMap (Idx' aenv), Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (IntMap (Idx' aenv)
forall a. IntMap a
IntMap.empty, Bool
False)
        travME (Just OpenExp env aenv e
e) = (Bool
True Bool
-> (IntMap (Idx' aenv), OpenExp env aenv e)
-> (IntMap (Idx' aenv), Bool)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) ((IntMap (Idx' aenv), OpenExp env aenv e)
 -> (IntMap (Idx' aenv), Bool))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
-> LLVM arch (IntMap (Idx' aenv), Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv e
e

        travAF :: HasCallStack
               => DelayedOpenAfun aenv f
               -> LLVM arch (IntMap (Idx' aenv), CompiledOpenAfun arch aenv f)
        travAF :: DelayedOpenAfun aenv f
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAfun arch aenv f)
travAF DelayedOpenAfun aenv f
afun = CompiledOpenAfun arch aenv f
-> (IntMap (Idx' aenv), CompiledOpenAfun arch aenv f)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CompiledOpenAfun arch aenv f
 -> (IntMap (Idx' aenv), CompiledOpenAfun arch aenv f))
-> LLVM arch (CompiledOpenAfun arch aenv f)
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAfun arch aenv f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DelayedOpenAfun aenv f -> LLVM arch (CompiledOpenAfun arch aenv f)
forall arch aenv f.
(HasCallStack, Compile arch) =>
DelayedOpenAfun aenv f -> LLVM arch (CompiledOpenAfun arch aenv f)
compileOpenAfun DelayedOpenAfun aenv f
afun

        travF :: HasCallStack
              => OpenFun env aenv t
              -> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv t)
        travF :: OpenFun env aenv t
-> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv t)
travF (Body OpenExp env aenv t
b)    = (OpenExp env aenv t -> OpenFun env aenv t)
-> (IntMap (Idx' aenv), OpenExp env aenv t)
-> (IntMap (Idx' aenv), OpenFun env aenv t)
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA OpenExp env aenv t -> OpenFun env aenv t
forall env aenv t. OpenExp env aenv t -> OpenFun env aenv t
Body ((IntMap (Idx' aenv), OpenExp env aenv t)
 -> (IntMap (Idx' aenv), OpenFun env aenv t))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv t)
-> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpenExp env aenv t
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv t)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv t
b
        travF (Lam ELeftHandSide a env env'
lhs OpenFun env' aenv t1
f) = (OpenFun env' aenv t1 -> OpenFun env aenv (a -> t1))
-> (IntMap (Idx' aenv), OpenFun env' aenv t1)
-> (IntMap (Idx' aenv), OpenFun env aenv (a -> t1))
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA (ELeftHandSide a env env'
-> OpenFun env' aenv t1 -> OpenFun env aenv (a -> t1)
forall a env env' aenv t1.
ELeftHandSide a env env'
-> OpenFun env' aenv t1 -> OpenFun env aenv (a -> t1)
Lam ELeftHandSide a env env'
lhs) ((IntMap (Idx' aenv), OpenFun env' aenv t1)
 -> (IntMap (Idx' aenv), OpenFun env aenv (a -> t1)))
-> LLVM arch (IntMap (Idx' aenv), OpenFun env' aenv t1)
-> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv (a -> t1))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpenFun env' aenv t1
-> LLVM arch (IntMap (Idx' aenv), OpenFun env' aenv t1)
forall env t.
HasCallStack =>
OpenFun env aenv t
-> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv t)
travF OpenFun env' aenv t1
f

        travB :: HasCallStack
              => Boundary aenv t
              -> LLVM arch (IntMap (Idx' aenv), Boundary aenv t)
        travB :: Boundary aenv t -> LLVM arch (IntMap (Idx' aenv), Boundary aenv t)
travB Boundary aenv t
Clamp        = (IntMap (Idx' aenv), Boundary aenv t)
-> LLVM arch (IntMap (Idx' aenv), Boundary aenv t)
forall (m :: * -> *) a. Monad m => a -> m a
return ((IntMap (Idx' aenv), Boundary aenv t)
 -> LLVM arch (IntMap (Idx' aenv), Boundary aenv t))
-> (IntMap (Idx' aenv), Boundary aenv t)
-> LLVM arch (IntMap (Idx' aenv), Boundary aenv t)
forall a b. (a -> b) -> a -> b
$ Boundary aenv t -> (IntMap (Idx' aenv), Boundary aenv t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Boundary aenv t
forall aenv t. Boundary aenv t
Clamp
        travB Boundary aenv t
Mirror       = (IntMap (Idx' aenv), Boundary aenv t)
-> LLVM arch (IntMap (Idx' aenv), Boundary aenv t)
forall (m :: * -> *) a. Monad m => a -> m a
return ((IntMap (Idx' aenv), Boundary aenv t)
 -> LLVM arch (IntMap (Idx' aenv), Boundary aenv t))
-> (IntMap (Idx' aenv), Boundary aenv t)
-> LLVM arch (IntMap (Idx' aenv), Boundary aenv t)
forall a b. (a -> b) -> a -> b
$ Boundary aenv t -> (IntMap (Idx' aenv), Boundary aenv t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Boundary aenv t
forall aenv t. Boundary aenv t
Mirror
        travB Boundary aenv t
Wrap         = (IntMap (Idx' aenv), Boundary aenv t)
-> LLVM arch (IntMap (Idx' aenv), Boundary aenv t)
forall (m :: * -> *) a. Monad m => a -> m a
return ((IntMap (Idx' aenv), Boundary aenv t)
 -> LLVM arch (IntMap (Idx' aenv), Boundary aenv t))
-> (IntMap (Idx' aenv), Boundary aenv t)
-> LLVM arch (IntMap (Idx' aenv), Boundary aenv t)
forall a b. (a -> b) -> a -> b
$ Boundary aenv t -> (IntMap (Idx' aenv), Boundary aenv t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Boundary aenv t
forall aenv t. Boundary aenv t
Wrap
        travB (Constant e
c) = (IntMap (Idx' aenv), Boundary aenv (Array sh e))
-> LLVM arch (IntMap (Idx' aenv), Boundary aenv (Array sh e))
forall (m :: * -> *) a. Monad m => a -> m a
return ((IntMap (Idx' aenv), Boundary aenv (Array sh e))
 -> LLVM arch (IntMap (Idx' aenv), Boundary aenv (Array sh e)))
-> (IntMap (Idx' aenv), Boundary aenv (Array sh e))
-> LLVM arch (IntMap (Idx' aenv), Boundary aenv (Array sh e))
forall a b. (a -> b) -> a -> b
$ Boundary aenv (Array sh e)
-> (IntMap (Idx' aenv), Boundary aenv (Array sh e))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (e -> Boundary aenv (Array sh e)
forall e aenv sh. e -> Boundary aenv (Array sh e)
Constant e
c)
        travB (Function Fun aenv (sh -> e)
f) = (Fun aenv (sh -> e) -> Boundary aenv (Array sh e))
-> (IntMap (Idx' aenv), Fun aenv (sh -> e))
-> (IntMap (Idx' aenv), Boundary aenv (Array sh e))
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA Fun aenv (sh -> e) -> Boundary aenv (Array sh e)
forall aenv sh e. Fun aenv (sh -> e) -> Boundary aenv (Array sh e)
Function ((IntMap (Idx' aenv), Fun aenv (sh -> e))
 -> (IntMap (Idx' aenv), Boundary aenv (Array sh e)))
-> LLVM arch (IntMap (Idx' aenv), Fun aenv (sh -> e))
-> LLVM arch (IntMap (Idx' aenv), Boundary aenv (Array sh e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fun aenv (sh -> e)
-> LLVM arch (IntMap (Idx' aenv), Fun aenv (sh -> e))
forall env t.
HasCallStack =>
OpenFun env aenv t
-> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv t)
travF Fun aenv (sh -> e)
f

        build :: (IntMap (Idx' aenv), AST.PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
              -> LLVM arch (CompiledOpenAcc arch aenv arrs)
        build :: (IntMap (Idx' aenv),
 PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs)
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
build (IntMap (Idx' aenv)
aenv, PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs
eacc) = do
          let aval :: Gamma aenv
aval = IntMap (Idx' aenv) -> Gamma aenv
forall aenv. IntMap (Idx' aenv) -> Gamma aenv
makeGamma IntMap (Idx' aenv)
aenv
          ObjectR arch
kernel <- PreOpenAcc DelayedOpenAcc aenv arrs
-> Gamma aenv -> LLVM arch (ObjectR arch)
forall arch aenv a.
Compile arch =>
PreOpenAcc DelayedOpenAcc aenv a
-> Gamma aenv -> LLVM arch (ObjectR arch)
compileForTarget PreOpenAcc DelayedOpenAcc aenv arrs
pacc Gamma aenv
aval
          CompiledOpenAcc arch aenv arrs
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
forall (m :: * -> *) a. Monad m => a -> m a
return (CompiledOpenAcc arch aenv arrs
 -> LLVM arch (CompiledOpenAcc arch aenv arrs))
-> CompiledOpenAcc arch aenv arrs
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
forall a b. (a -> b) -> a -> b
$! ArraysR arrs
-> Gamma aenv
-> ObjectR arch
-> PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs
-> CompiledOpenAcc arch aenv arrs
forall a aenv arch.
ArraysR a
-> Gamma aenv
-> ObjectR arch
-> PreOpenAccSkeleton CompiledOpenAcc arch aenv a
-> CompiledOpenAcc arch aenv a
BuildAcc (PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs -> ArraysR arrs
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs
eacc) Gamma aenv
aval ObjectR arch
kernel PreOpenAccSkeleton CompiledOpenAcc arch aenv arrs
eacc

        plain :: (IntMap (Idx' aenv'), AST.PreOpenAccCommand CompiledOpenAcc arch aenv' arrs')
              -> LLVM arch (CompiledOpenAcc arch aenv' arrs')
        plain :: (IntMap (Idx' aenv'),
 PreOpenAccCommand CompiledOpenAcc arch aenv' arrs')
-> LLVM arch (CompiledOpenAcc arch aenv' arrs')
plain (IntMap (Idx' aenv')
_, PreOpenAccCommand CompiledOpenAcc arch aenv' arrs'
eacc) = CompiledOpenAcc arch aenv' arrs'
-> LLVM arch (CompiledOpenAcc arch aenv' arrs')
forall (m :: * -> *) a. Monad m => a -> m a
return (ArraysR arrs'
-> PreOpenAccCommand CompiledOpenAcc arch aenv' arrs'
-> CompiledOpenAcc arch aenv' arrs'
forall a arch aenv.
ArraysR a
-> PreOpenAccCommand CompiledOpenAcc arch aenv a
-> CompiledOpenAcc arch aenv a
PlainAcc (PreOpenAccCommand CompiledOpenAcc arch aenv' arrs' -> ArraysR arrs'
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR PreOpenAccCommand CompiledOpenAcc arch aenv' arrs'
eacc) PreOpenAccCommand CompiledOpenAcc arch aenv' arrs'
eacc)

        -- Filling an array with undefined values is equivalent to allocating an
        -- uninitialised array. We look for this specific pattern because we
        -- expect it to appear only in certain places, e.g. as the default array
        -- in a 'permute' where the default values are never used. Note however
        -- that the simplifier does not take into account 'undef' values. For
        -- example, the following transformation is valid:
        --
        --   x + undef  ~~>  undef
        --
        -- so it is still possible to generate empty functions which we will
        -- execute, even though they do nothing (except incur scheduler
        -- overhead).
        --
        alloc :: Fun aenv (sh -> e)
              -> Bool
        alloc :: Fun aenv (sh -> e) -> Bool
alloc Fun aenv (sh -> e)
f
          | Lam ELeftHandSide a () env'
_ (Body (Undef ScalarType t1
_)) <- Fun aenv (sh -> e)
f = Bool
True
          | Bool
otherwise                   = Bool
False

        -- Unzips of manifest array data can be done in constant time without
        -- executing any array programs. We split them out here into a separate
        -- case so that the execution phase does not have to continually perform
        -- the below check.
        --
        unzip :: forall sh a b.
                 Fun aenv (a -> b)
              -> DelayedOpenAcc aenv (Array sh a)
              -> Maybe (AST.UnzipIdx a b, ArrayVar aenv (Array sh a))
        unzip :: Fun aenv (a -> b)
-> DelayedOpenAcc aenv (Array sh a)
-> Maybe (UnzipIdx a b, ArrayVar aenv (Array sh a))
unzip Fun aenv (a -> b)
f DelayedOpenAcc aenv (Array sh a)
a
          | Lam ELeftHandSide a () env'
lhs (Body OpenExp env' aenv t1
b) <- Fun aenv (a -> b)
f
          , Just ExpVars env' t1
vars <- OpenExp env' aenv t1 -> Maybe (ExpVars env' t1)
forall env aenv a. OpenExp env aenv a -> Maybe (ExpVars env a)
extractExpVars OpenExp env' aenv t1
b
          , Delayed ArrayR (Array sh e)
_ Exp aenv sh
sh Fun aenv (sh -> e)
index Fun aenv (Int -> e)
_                <- DelayedOpenAcc aenv (Array sh a)
a
          , Shape ArrayVar aenv (Array sh e)
u                             <- Exp aenv sh
sh
          , Just ArrayVar aenv (Array sh e)
v                              <- Fun aenv (sh -> e) -> Maybe (ArrayVar aenv (Array sh e))
forall env aenv a b.
OpenFun env aenv (a -> b) -> Maybe (ArrayVar aenv (Array a b))
isIdentityIndexing Fun aenv (sh -> e)
index
          , Just Array sh e :~: Array sh e
Refl                           <- ArrayVar aenv (Array sh e)
-> ArrayVar aenv (Array sh e) -> Maybe (Array sh e :~: Array sh e)
forall (s :: * -> *) env t1 t2.
Var s env t1 -> Var s env t2 -> Maybe (t1 :~: t2)
matchVar ArrayVar aenv (Array sh e)
u ArrayVar aenv (Array sh e)
v
          = (UnzipIdx a t1, ArrayVar aenv (Array sh e))
-> Maybe (UnzipIdx a t1, ArrayVar aenv (Array sh e))
forall a. a -> Maybe a
Just (ELeftHandSide a () env' -> ExpVars env' t1 -> UnzipIdx a t1
forall env a b.
ELeftHandSide a () env -> Vars ScalarType env b -> UnzipIdx a b
unzipIdx ELeftHandSide a () env'
lhs ExpVars env' t1
vars, ArrayVar aenv (Array sh e)
u)
        unzip Fun aenv (a -> b)
_ DelayedOpenAcc aenv (Array sh a)
_
          = Maybe (UnzipIdx a b, ArrayVar aenv (Array sh a))
forall a. Maybe a
Nothing

        unzipIdx :: forall env a b. ELeftHandSide a () env -> Vars ScalarType env b -> AST.UnzipIdx a b
        unzipIdx :: ELeftHandSide a () env -> Vars ScalarType env b -> UnzipIdx a b
unzipIdx ELeftHandSide a () env
lhs = Vars ScalarType env b -> UnzipIdx a b
forall y. Vars ScalarType env y -> UnzipIdx a y
go
          where
            go :: Vars ScalarType env y -> AST.UnzipIdx a y
            go :: Vars ScalarType env y -> UnzipIdx a y
go Vars ScalarType env y
TupRunit                = UnzipIdx a y
forall a. UnzipIdx a ()
AST.UnzipUnit
            go (TupRpair TupR (Var ScalarType env) a1
v1 TupR (Var ScalarType env) b
v2)        = UnzipIdx a a1 -> UnzipIdx a b -> UnzipIdx a (a1, b)
forall a b1 b2.
UnzipIdx a b1 -> UnzipIdx a b2 -> UnzipIdx a (b1, b2)
AST.UnzipPair (TupR (Var ScalarType env) a1 -> UnzipIdx a a1
forall y. Vars ScalarType env y -> UnzipIdx a y
go TupR (Var ScalarType env) a1
v1) (TupR (Var ScalarType env) b -> UnzipIdx a b
forall y. Vars ScalarType env y -> UnzipIdx a y
go TupR (Var ScalarType env) b
v2)
            go (TupRsingle (Var ScalarType y
_ Idx env y
ix)) = case ELeftHandSide a () env
-> Idx env y -> Either (Idx () y) (UnzipIdx a y)
forall x env1 env2 y.
ELeftHandSide x env1 env2
-> Idx env2 y -> Either (Idx env1 y) (UnzipIdx x y)
lookupVar ELeftHandSide a () env
lhs Idx env y
ix of
              Right UnzipIdx a y
u -> UnzipIdx a y
u
              Left Idx () y
ix' -> case Idx () y
ix' of {}
              -- Left branch is unreachable, as `Idx () y` is an empty type

            lookupVar :: ELeftHandSide x env1 env2 -> Idx env2 y -> Either (Idx env1 y) (AST.UnzipIdx x y)
            lookupVar :: ELeftHandSide x env1 env2
-> Idx env2 y -> Either (Idx env1 y) (UnzipIdx x y)
lookupVar (LeftHandSideWildcard TupR ScalarType x
_) Idx env2 y
ix = Idx env2 y -> Either (Idx env2 y) (UnzipIdx x y)
forall a b. a -> Either a b
Left Idx env2 y
ix
            lookupVar (LeftHandSideSingle ScalarType x
_)   Idx env2 y
ix = case Idx env2 y
ix of
              Idx env2 y
ZeroIdx     -> UnzipIdx x x -> Either (Idx env1 y) (UnzipIdx x x)
forall a b. b -> Either a b
Right UnzipIdx x x
forall a. UnzipIdx a a
AST.UnzipId
              SuccIdx Idx env1 y
ix' -> Idx env1 y -> Either (Idx env1 y) (UnzipIdx x y)
forall a b. a -> Either a b
Left Idx env1 y
ix'
            lookupVar (LeftHandSidePair LeftHandSide ScalarType v1 env1 env'1
l1 LeftHandSide ScalarType v2 env'1 env2
l2) Idx env2 y
ix = case LeftHandSide ScalarType v2 env'1 env2
-> Idx env2 y -> Either (Idx env'1 y) (UnzipIdx v2 y)
forall x env1 env2 y.
ELeftHandSide x env1 env2
-> Idx env2 y -> Either (Idx env1 y) (UnzipIdx x y)
lookupVar LeftHandSide ScalarType v2 env'1 env2
l2 Idx env2 y
ix of
              Right UnzipIdx v2 y
u -> UnzipIdx (v1, v2) y -> Either (Idx env1 y) (UnzipIdx (v1, v2) y)
forall a b. b -> Either a b
Right (UnzipIdx (v1, v2) y -> Either (Idx env1 y) (UnzipIdx (v1, v2) y))
-> UnzipIdx (v1, v2) y -> Either (Idx env1 y) (UnzipIdx (v1, v2) y)
forall a b. (a -> b) -> a -> b
$ PairIdx (v1, v2) v2 -> UnzipIdx v2 y -> UnzipIdx (v1, v2) y
forall a b c. PairIdx a b -> UnzipIdx b c -> UnzipIdx a c
AST.UnzipPrj PairIdx (v1, v2) v2
forall a1 a. PairIdx (a1, a) a
PairIdxRight UnzipIdx v2 y
u
              Left Idx env'1 y
ix' -> case LeftHandSide ScalarType v1 env1 env'1
-> Idx env'1 y -> Either (Idx env1 y) (UnzipIdx v1 y)
forall x env1 env2 y.
ELeftHandSide x env1 env2
-> Idx env2 y -> Either (Idx env1 y) (UnzipIdx x y)
lookupVar LeftHandSide ScalarType v1 env1 env'1
l1 Idx env'1 y
ix' of
                Right UnzipIdx v1 y
u -> UnzipIdx (v1, v2) y -> Either (Idx env1 y) (UnzipIdx (v1, v2) y)
forall a b. b -> Either a b
Right (UnzipIdx (v1, v2) y -> Either (Idx env1 y) (UnzipIdx (v1, v2) y))
-> UnzipIdx (v1, v2) y -> Either (Idx env1 y) (UnzipIdx (v1, v2) y)
forall a b. (a -> b) -> a -> b
$ PairIdx (v1, v2) v1 -> UnzipIdx v1 y -> UnzipIdx (v1, v2) y
forall a b c. PairIdx a b -> UnzipIdx b c -> UnzipIdx a c
AST.UnzipPrj PairIdx (v1, v2) v1
forall a b. PairIdx (a, b) a
PairIdxLeft UnzipIdx v1 y
u
                Left Idx env1 y
ix'' -> Idx env1 y -> Either (Idx env1 y) (UnzipIdx x y)
forall a b. a -> Either a b
Left Idx env1 y
ix''

        -- Is there a foreign version available for this backend? If so, take
        -- the foreign function and drop the remaining terms. Otherwise, drop
        -- this term and continue walking down the list of alternate
        -- implementations.
        --
        foreignA :: (HasCallStack, A.Foreign asm)
                 => ArraysR b
                 -> asm         (a -> b)
                 -> DelayedAfun (a -> b)
                 -> DelayedOpenAcc aenv a
                 -> LLVM arch (CompiledOpenAcc arch aenv b)
        foreignA :: ArraysR b
-> asm (a -> b)
-> DelayedAfun (a -> b)
-> DelayedOpenAcc aenv a
-> LLVM arch (CompiledOpenAcc arch aenv b)
foreignA ArraysR b
repr asm (a -> b)
ff DelayedAfun (a -> b)
f DelayedOpenAcc aenv a
a =
          case asm (a -> b) -> Maybe (a -> Par arch (FutureR arch b))
forall arch (asm :: * -> *) a b.
(Foreign arch, Foreign asm) =>
asm (a -> b) -> Maybe (a -> Par arch (FutureR arch b))
foreignAcc asm (a -> b)
ff of
            Just a -> Par arch (FutureR arch b)
asm -> (IntMap (Idx' aenv), PreOpenAccCommand CompiledOpenAcc arch aenv b)
-> LLVM arch (CompiledOpenAcc arch aenv b)
forall aenv' arrs'.
(IntMap (Idx' aenv'),
 PreOpenAccCommand CompiledOpenAcc arch aenv' arrs')
-> LLVM arch (CompiledOpenAcc arch aenv' arrs')
plain ((IntMap (Idx' aenv),
  PreOpenAccCommand CompiledOpenAcc arch aenv b)
 -> LLVM arch (CompiledOpenAcc arch aenv b))
-> LLVM
     arch
     (IntMap (Idx' aenv), PreOpenAccCommand CompiledOpenAcc arch aenv b)
-> LLVM arch (CompiledOpenAcc arch aenv b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (CompiledOpenAcc arch aenv a
 -> PreOpenAccCommand CompiledOpenAcc arch aenv b)
-> (IntMap (Idx' aenv), CompiledOpenAcc arch aenv a)
-> (IntMap (Idx' aenv),
    PreOpenAccCommand CompiledOpenAcc arch aenv b)
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA (ArraysR b
-> String
-> (a -> Par arch (FutureR arch b))
-> CompiledOpenAcc arch aenv a
-> PreOpenAccCommand CompiledOpenAcc arch aenv b
forall bs as arch (acc :: * -> * -> * -> *) aenv.
ArraysR bs
-> String
-> (as -> Par arch (FutureR arch bs))
-> acc arch aenv as
-> PreOpenAccCommand acc arch aenv bs
AST.Aforeign ArraysR b
repr (asm (a -> b) -> String
forall (asm :: * -> *) args. Foreign asm => asm args -> String
A.strForeign asm (a -> b)
ff) a -> Par arch (FutureR arch b)
asm) ((IntMap (Idx' aenv), CompiledOpenAcc arch aenv a)
 -> (IntMap (Idx' aenv),
     PreOpenAccCommand CompiledOpenAcc arch aenv b))
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv a)
-> LLVM
     arch
     (IntMap (Idx' aenv), PreOpenAccCommand CompiledOpenAcc arch aenv b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DelayedOpenAcc aenv a
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv a)
forall a.
HasCallStack =>
DelayedOpenAcc aenv a
-> LLVM arch (IntMap (Idx' aenv), CompiledOpenAcc arch aenv a)
travA DelayedOpenAcc aenv a
a
            Maybe (a -> Par arch (FutureR arch b))
Nothing  -> DelayedOpenAcc aenv b -> LLVM arch (CompiledOpenAcc arch aenv b)
forall aenv arrs.
HasCallStack =>
DelayedOpenAcc aenv arrs
-> LLVM arch (CompiledOpenAcc arch aenv arrs)
traverseAcc (DelayedOpenAcc aenv b -> LLVM arch (CompiledOpenAcc arch aenv b))
-> DelayedOpenAcc aenv b -> LLVM arch (CompiledOpenAcc arch aenv b)
forall a b. (a -> b) -> a -> b
$ PreOpenAcc DelayedOpenAcc aenv b -> DelayedOpenAcc aenv b
forall aenv a.
PreOpenAcc DelayedOpenAcc aenv a -> DelayedOpenAcc aenv a
Manifest (ArraysR b
-> PreOpenAfun DelayedOpenAcc aenv (a -> b)
-> DelayedOpenAcc aenv a
-> PreOpenAcc DelayedOpenAcc aenv b
forall a (acc :: * -> * -> *) aenv arrs1.
ArraysR a
-> PreOpenAfun acc aenv (arrs1 -> a)
-> acc aenv arrs1
-> PreOpenAcc acc aenv a
Apply ArraysR b
repr ((() :> aenv)
-> DelayedAfun (a -> b) -> PreOpenAfun DelayedOpenAcc aenv (a -> b)
forall (f :: * -> * -> *) env env' t.
Sink f =>
(env :> env') -> f env t -> f env' t
weaken () :> aenv
forall env'. () :> env'
weakenEmpty DelayedAfun (a -> b)
f) DelayedOpenAcc aenv a
a)

    -- Traverse a scalar expression
    --
    travE :: HasCallStack
          => OpenExp env aenv e
          -> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
    travE :: OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv e
exp =
      case OpenExp env aenv e
exp of
        Evar ExpVar env e
v                  -> (IntMap (Idx' aenv), OpenExp env aenv e)
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
forall (m :: * -> *) a. Monad m => a -> m a
return ((IntMap (Idx' aenv), OpenExp env aenv e)
 -> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e))
-> (IntMap (Idx' aenv), OpenExp env aenv e)
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
forall a b. (a -> b) -> a -> b
$ OpenExp env aenv e -> (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OpenExp env aenv e -> (IntMap (Idx' aenv), OpenExp env aenv e))
-> OpenExp env aenv e -> (IntMap (Idx' aenv), OpenExp env aenv e)
forall a b. (a -> b) -> a -> b
$ ExpVar env e -> OpenExp env aenv e
forall env t aenv. ExpVar env t -> OpenExp env aenv t
Evar ExpVar env e
v
        Const ScalarType e
tp e
c              -> (IntMap (Idx' aenv), OpenExp env aenv e)
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
forall (m :: * -> *) a. Monad m => a -> m a
return ((IntMap (Idx' aenv), OpenExp env aenv e)
 -> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e))
-> (IntMap (Idx' aenv), OpenExp env aenv e)
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
forall a b. (a -> b) -> a -> b
$ OpenExp env aenv e -> (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OpenExp env aenv e -> (IntMap (Idx' aenv), OpenExp env aenv e))
-> OpenExp env aenv e -> (IntMap (Idx' aenv), OpenExp env aenv e)
forall a b. (a -> b) -> a -> b
$ ScalarType e -> e -> OpenExp env aenv e
forall t env aenv. ScalarType t -> t -> OpenExp env aenv t
Const ScalarType e
tp e
c
        PrimConst PrimConst e
c             -> (IntMap (Idx' aenv), OpenExp env aenv e)
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
forall (m :: * -> *) a. Monad m => a -> m a
return ((IntMap (Idx' aenv), OpenExp env aenv e)
 -> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e))
-> (IntMap (Idx' aenv), OpenExp env aenv e)
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
forall a b. (a -> b) -> a -> b
$ OpenExp env aenv e -> (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OpenExp env aenv e -> (IntMap (Idx' aenv), OpenExp env aenv e))
-> OpenExp env aenv e -> (IntMap (Idx' aenv), OpenExp env aenv e)
forall a b. (a -> b) -> a -> b
$ PrimConst e -> OpenExp env aenv e
forall t env aenv. PrimConst t -> OpenExp env aenv t
PrimConst PrimConst e
c
        Undef ScalarType e
tp                -> (IntMap (Idx' aenv), OpenExp env aenv e)
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
forall (m :: * -> *) a. Monad m => a -> m a
return ((IntMap (Idx' aenv), OpenExp env aenv e)
 -> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e))
-> (IntMap (Idx' aenv), OpenExp env aenv e)
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
forall a b. (a -> b) -> a -> b
$ OpenExp env aenv e -> (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OpenExp env aenv e -> (IntMap (Idx' aenv), OpenExp env aenv e))
-> OpenExp env aenv e -> (IntMap (Idx' aenv), OpenExp env aenv e)
forall a b. (a -> b) -> a -> b
$ ScalarType e -> OpenExp env aenv e
forall t env aenv. ScalarType t -> OpenExp env aenv t
Undef ScalarType e
tp
        Foreign TypeR e
tp asm (x -> e)
ff Fun () (x -> e)
f OpenExp env aenv x
x       -> TypeR e
-> asm (x -> e)
-> Fun () (x -> e)
-> OpenExp env aenv x
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
forall (asm :: * -> *) b a env aenv.
(HasCallStack, Foreign asm) =>
TypeR b
-> asm (a -> b)
-> Fun () (a -> b)
-> OpenExp env aenv a
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv b)
foreignE TypeR e
tp asm (x -> e)
ff Fun () (x -> e)
f OpenExp env aenv x
x
        --
        Let ELeftHandSide bnd_t env env'
lhs OpenExp env aenv bnd_t
a OpenExp env' aenv e
b             -> (OpenExp env aenv bnd_t
 -> OpenExp env' aenv e -> OpenExp env aenv e)
-> (IntMap (Idx' aenv), OpenExp env aenv bnd_t)
-> (IntMap (Idx' aenv), OpenExp env' aenv e)
-> (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (ELeftHandSide bnd_t env env'
-> OpenExp env aenv bnd_t
-> OpenExp env' aenv e
-> OpenExp env aenv e
forall bnd_t env env' aenv t.
ELeftHandSide bnd_t env env'
-> OpenExp env aenv bnd_t
-> OpenExp env' aenv t
-> OpenExp env aenv t
Let ELeftHandSide bnd_t env env'
lhs)         ((IntMap (Idx' aenv), OpenExp env aenv bnd_t)
 -> (IntMap (Idx' aenv), OpenExp env' aenv e)
 -> (IntMap (Idx' aenv), OpenExp env aenv e))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv bnd_t)
-> LLVM
     arch
     ((IntMap (Idx' aenv), OpenExp env' aenv e)
      -> (IntMap (Idx' aenv), OpenExp env aenv e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpenExp env aenv bnd_t
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv bnd_t)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv bnd_t
a LLVM
  arch
  ((IntMap (Idx' aenv), OpenExp env' aenv e)
   -> (IntMap (Idx' aenv), OpenExp env aenv e))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env' aenv e)
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OpenExp env' aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env' aenv e)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env' aenv e
b
        IndexSlice SliceIndex slix e co sh
slix OpenExp env aenv slix
x OpenExp env aenv sh
s     -> (OpenExp env aenv slix
 -> OpenExp env aenv sh -> OpenExp env aenv e)
-> (IntMap (Idx' aenv), OpenExp env aenv slix)
-> (IntMap (Idx' aenv), OpenExp env aenv sh)
-> (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (SliceIndex slix e co sh
-> OpenExp env aenv slix
-> OpenExp env aenv sh
-> OpenExp env aenv e
forall slix t co sh env aenv.
SliceIndex slix t co sh
-> OpenExp env aenv slix
-> OpenExp env aenv sh
-> OpenExp env aenv t
IndexSlice SliceIndex slix e co sh
slix) ((IntMap (Idx' aenv), OpenExp env aenv slix)
 -> (IntMap (Idx' aenv), OpenExp env aenv sh)
 -> (IntMap (Idx' aenv), OpenExp env aenv e))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv slix)
-> LLVM
     arch
     ((IntMap (Idx' aenv), OpenExp env aenv sh)
      -> (IntMap (Idx' aenv), OpenExp env aenv e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpenExp env aenv slix
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv slix)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv slix
x LLVM
  arch
  ((IntMap (Idx' aenv), OpenExp env aenv sh)
   -> (IntMap (Idx' aenv), OpenExp env aenv e))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv sh)
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OpenExp env aenv sh
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv sh)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv sh
s
        IndexFull SliceIndex slix sl co e
slix OpenExp env aenv slix
x OpenExp env aenv sl
s      -> (OpenExp env aenv slix
 -> OpenExp env aenv sl -> OpenExp env aenv e)
-> (IntMap (Idx' aenv), OpenExp env aenv slix)
-> (IntMap (Idx' aenv), OpenExp env aenv sl)
-> (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (SliceIndex slix sl co e
-> OpenExp env aenv slix
-> OpenExp env aenv sl
-> OpenExp env aenv e
forall slix sl co t env aenv.
SliceIndex slix sl co t
-> OpenExp env aenv slix
-> OpenExp env aenv sl
-> OpenExp env aenv t
IndexFull SliceIndex slix sl co e
slix)  ((IntMap (Idx' aenv), OpenExp env aenv slix)
 -> (IntMap (Idx' aenv), OpenExp env aenv sl)
 -> (IntMap (Idx' aenv), OpenExp env aenv e))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv slix)
-> LLVM
     arch
     ((IntMap (Idx' aenv), OpenExp env aenv sl)
      -> (IntMap (Idx' aenv), OpenExp env aenv e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpenExp env aenv slix
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv slix)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv slix
x LLVM
  arch
  ((IntMap (Idx' aenv), OpenExp env aenv sl)
   -> (IntMap (Idx' aenv), OpenExp env aenv e))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv sl)
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OpenExp env aenv sl
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv sl)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv sl
s
        ToIndex ShapeR sh
shr OpenExp env aenv sh
s OpenExp env aenv sh
i         -> (OpenExp env aenv sh
 -> OpenExp env aenv sh -> OpenExp env aenv Int)
-> (IntMap (Idx' aenv), OpenExp env aenv sh)
-> (IntMap (Idx' aenv), OpenExp env aenv sh)
-> (IntMap (Idx' aenv), OpenExp env aenv Int)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (ShapeR sh
-> OpenExp env aenv sh
-> OpenExp env aenv sh
-> OpenExp env aenv Int
forall sh env aenv.
ShapeR sh
-> OpenExp env aenv sh
-> OpenExp env aenv sh
-> OpenExp env aenv Int
ToIndex   ShapeR sh
shr)   ((IntMap (Idx' aenv), OpenExp env aenv sh)
 -> (IntMap (Idx' aenv), OpenExp env aenv sh)
 -> (IntMap (Idx' aenv), OpenExp env aenv Int))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv sh)
-> LLVM
     arch
     ((IntMap (Idx' aenv), OpenExp env aenv sh)
      -> (IntMap (Idx' aenv), OpenExp env aenv Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpenExp env aenv sh
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv sh)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv sh
s LLVM
  arch
  ((IntMap (Idx' aenv), OpenExp env aenv sh)
   -> (IntMap (Idx' aenv), OpenExp env aenv Int))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv sh)
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv Int)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OpenExp env aenv sh
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv sh)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv sh
i
        FromIndex ShapeR e
shr OpenExp env aenv e
s OpenExp env aenv Int
i       -> (OpenExp env aenv e -> OpenExp env aenv Int -> OpenExp env aenv e)
-> (IntMap (Idx' aenv), OpenExp env aenv e)
-> (IntMap (Idx' aenv), OpenExp env aenv Int)
-> (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (ShapeR e
-> OpenExp env aenv e -> OpenExp env aenv Int -> OpenExp env aenv e
forall t env aenv.
ShapeR t
-> OpenExp env aenv t -> OpenExp env aenv Int -> OpenExp env aenv t
FromIndex ShapeR e
shr)   ((IntMap (Idx' aenv), OpenExp env aenv e)
 -> (IntMap (Idx' aenv), OpenExp env aenv Int)
 -> (IntMap (Idx' aenv), OpenExp env aenv e))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
-> LLVM
     arch
     ((IntMap (Idx' aenv), OpenExp env aenv Int)
      -> (IntMap (Idx' aenv), OpenExp env aenv e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv e
s LLVM
  arch
  ((IntMap (Idx' aenv), OpenExp env aenv Int)
   -> (IntMap (Idx' aenv), OpenExp env aenv e))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv Int)
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OpenExp env aenv Int
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv Int)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv Int
i
        OpenExp env aenv e
Nil                     -> (IntMap (Idx' aenv), OpenExp env aenv ())
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((IntMap (Idx' aenv), OpenExp env aenv ())
 -> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv ()))
-> (IntMap (Idx' aenv), OpenExp env aenv ())
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv ())
forall a b. (a -> b) -> a -> b
$ OpenExp env aenv () -> (IntMap (Idx' aenv), OpenExp env aenv ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure OpenExp env aenv ()
forall env aenv. OpenExp env aenv ()
Nil
        Pair OpenExp env aenv t1
e1 OpenExp env aenv t2
e2              -> (OpenExp env aenv t1
 -> OpenExp env aenv t2 -> OpenExp env aenv (t1, t2))
-> (IntMap (Idx' aenv), OpenExp env aenv t1)
-> (IntMap (Idx' aenv), OpenExp env aenv t2)
-> (IntMap (Idx' aenv), OpenExp env aenv (t1, t2))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 OpenExp env aenv t1
-> OpenExp env aenv t2 -> OpenExp env aenv (t1, t2)
forall env aenv t1 t2.
OpenExp env aenv t1
-> OpenExp env aenv t2 -> OpenExp env aenv (t1, t2)
Pair              ((IntMap (Idx' aenv), OpenExp env aenv t1)
 -> (IntMap (Idx' aenv), OpenExp env aenv t2)
 -> (IntMap (Idx' aenv), OpenExp env aenv (t1, t2)))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv t1)
-> LLVM
     arch
     ((IntMap (Idx' aenv), OpenExp env aenv t2)
      -> (IntMap (Idx' aenv), OpenExp env aenv (t1, t2)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpenExp env aenv t1
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv t1)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv t1
e1 LLVM
  arch
  ((IntMap (Idx' aenv), OpenExp env aenv t2)
   -> (IntMap (Idx' aenv), OpenExp env aenv (t1, t2)))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv t2)
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv (t1, t2))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OpenExp env aenv t2
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv t2)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv t2
e2
        VecPack   VecR n s tup
vecr OpenExp env aenv tup
e        -> (OpenExp env aenv tup -> OpenExp env aenv (Vec n s))
-> (IntMap (Idx' aenv), OpenExp env aenv tup)
-> (IntMap (Idx' aenv), OpenExp env aenv (Vec n s))
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA  (VecR n s tup -> OpenExp env aenv tup -> OpenExp env aenv (Vec n s)
forall (n :: Nat) s tup env aenv.
KnownNat n =>
VecR n s tup -> OpenExp env aenv tup -> OpenExp env aenv (Vec n s)
VecPack   VecR n s tup
vecr)  ((IntMap (Idx' aenv), OpenExp env aenv tup)
 -> (IntMap (Idx' aenv), OpenExp env aenv (Vec n s)))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv tup)
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv (Vec n s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpenExp env aenv tup
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv tup)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv tup
e
        VecUnpack VecR n s e
vecr OpenExp env aenv (Vec n s)
e        -> (OpenExp env aenv (Vec n s) -> OpenExp env aenv e)
-> (IntMap (Idx' aenv), OpenExp env aenv (Vec n s))
-> (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA  (VecR n s e -> OpenExp env aenv (Vec n s) -> OpenExp env aenv e
forall (n :: Nat) s t env aenv.
KnownNat n =>
VecR n s t -> OpenExp env aenv (Vec n s) -> OpenExp env aenv t
VecUnpack VecR n s e
vecr)  ((IntMap (Idx' aenv), OpenExp env aenv (Vec n s))
 -> (IntMap (Idx' aenv), OpenExp env aenv e))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv (Vec n s))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpenExp env aenv (Vec n s)
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv (Vec n s))
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv (Vec n s)
e
        Case OpenExp env aenv PrimBool
t [(PrimBool, OpenExp env aenv e)]
xs Maybe (OpenExp env aenv e)
x             -> (OpenExp env aenv PrimBool
 -> [(PrimBool, OpenExp env aenv e)]
 -> Maybe (OpenExp env aenv e)
 -> OpenExp env aenv e)
-> (IntMap (Idx' aenv), OpenExp env aenv PrimBool)
-> (IntMap (Idx' aenv), [(PrimBool, OpenExp env aenv e)])
-> (IntMap (Idx' aenv), Maybe (OpenExp env aenv e))
-> (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 OpenExp env aenv PrimBool
-> [(PrimBool, OpenExp env aenv e)]
-> Maybe (OpenExp env aenv e)
-> OpenExp env aenv e
forall env aenv t.
OpenExp env aenv PrimBool
-> [(PrimBool, OpenExp env aenv t)]
-> Maybe (OpenExp env aenv t)
-> OpenExp env aenv t
Case              ((IntMap (Idx' aenv), OpenExp env aenv PrimBool)
 -> (IntMap (Idx' aenv), [(PrimBool, OpenExp env aenv e)])
 -> (IntMap (Idx' aenv), Maybe (OpenExp env aenv e))
 -> (IntMap (Idx' aenv), OpenExp env aenv e))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv PrimBool)
-> LLVM
     arch
     ((IntMap (Idx' aenv), [(PrimBool, OpenExp env aenv e)])
      -> (IntMap (Idx' aenv), Maybe (OpenExp env aenv e))
      -> (IntMap (Idx' aenv), OpenExp env aenv e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpenExp env aenv PrimBool
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv PrimBool)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv PrimBool
t LLVM
  arch
  ((IntMap (Idx' aenv), [(PrimBool, OpenExp env aenv e)])
   -> (IntMap (Idx' aenv), Maybe (OpenExp env aenv e))
   -> (IntMap (Idx' aenv), OpenExp env aenv e))
-> LLVM arch (IntMap (Idx' aenv), [(PrimBool, OpenExp env aenv e)])
-> LLVM
     arch
     ((IntMap (Idx' aenv), Maybe (OpenExp env aenv e))
      -> (IntMap (Idx' aenv), OpenExp env aenv e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [(PrimBool, OpenExp env aenv e)]
-> LLVM arch (IntMap (Idx' aenv), [(PrimBool, OpenExp env aenv e)])
forall env aenv t.
HasCallStack =>
[(PrimBool, OpenExp env aenv t)]
-> LLVM arch (IntMap (Idx' aenv), [(PrimBool, OpenExp env aenv t)])
travLE [(PrimBool, OpenExp env aenv e)]
xs LLVM
  arch
  ((IntMap (Idx' aenv), Maybe (OpenExp env aenv e))
   -> (IntMap (Idx' aenv), OpenExp env aenv e))
-> LLVM arch (IntMap (Idx' aenv), Maybe (OpenExp env aenv e))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (OpenExp env aenv e)
-> LLVM arch (IntMap (Idx' aenv), Maybe (OpenExp env aenv e))
forall env aenv t.
HasCallStack =>
Maybe (OpenExp env aenv t)
-> LLVM arch (IntMap (Idx' aenv), Maybe (OpenExp env aenv t))
travME Maybe (OpenExp env aenv e)
x
        Cond OpenExp env aenv PrimBool
p OpenExp env aenv e
t OpenExp env aenv e
e              -> (OpenExp env aenv PrimBool
 -> OpenExp env aenv e -> OpenExp env aenv e -> OpenExp env aenv e)
-> (IntMap (Idx' aenv), OpenExp env aenv PrimBool)
-> (IntMap (Idx' aenv), OpenExp env aenv e)
-> (IntMap (Idx' aenv), OpenExp env aenv e)
-> (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 OpenExp env aenv PrimBool
-> OpenExp env aenv e -> OpenExp env aenv e -> OpenExp env aenv e
forall env aenv t.
OpenExp env aenv PrimBool
-> OpenExp env aenv t -> OpenExp env aenv t -> OpenExp env aenv t
Cond              ((IntMap (Idx' aenv), OpenExp env aenv PrimBool)
 -> (IntMap (Idx' aenv), OpenExp env aenv e)
 -> (IntMap (Idx' aenv), OpenExp env aenv e)
 -> (IntMap (Idx' aenv), OpenExp env aenv e))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv PrimBool)
-> LLVM
     arch
     ((IntMap (Idx' aenv), OpenExp env aenv e)
      -> (IntMap (Idx' aenv), OpenExp env aenv e)
      -> (IntMap (Idx' aenv), OpenExp env aenv e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpenExp env aenv PrimBool
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv PrimBool)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv PrimBool
p LLVM
  arch
  ((IntMap (Idx' aenv), OpenExp env aenv e)
   -> (IntMap (Idx' aenv), OpenExp env aenv e)
   -> (IntMap (Idx' aenv), OpenExp env aenv e))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
-> LLVM
     arch
     ((IntMap (Idx' aenv), OpenExp env aenv e)
      -> (IntMap (Idx' aenv), OpenExp env aenv e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv e
t LLVM
  arch
  ((IntMap (Idx' aenv), OpenExp env aenv e)
   -> (IntMap (Idx' aenv), OpenExp env aenv e))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv e
e
        While OpenFun env aenv (e -> PrimBool)
p OpenFun env aenv (e -> e)
f OpenExp env aenv e
x             -> (OpenFun env aenv (e -> PrimBool)
 -> OpenFun env aenv (e -> e)
 -> OpenExp env aenv e
 -> OpenExp env aenv e)
-> (IntMap (Idx' aenv), OpenFun env aenv (e -> PrimBool))
-> (IntMap (Idx' aenv), OpenFun env aenv (e -> e))
-> (IntMap (Idx' aenv), OpenExp env aenv e)
-> (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 OpenFun env aenv (e -> PrimBool)
-> OpenFun env aenv (e -> e)
-> OpenExp env aenv e
-> OpenExp env aenv e
forall env aenv t.
OpenFun env aenv (t -> PrimBool)
-> OpenFun env aenv (t -> t)
-> OpenExp env aenv t
-> OpenExp env aenv t
While             ((IntMap (Idx' aenv), OpenFun env aenv (e -> PrimBool))
 -> (IntMap (Idx' aenv), OpenFun env aenv (e -> e))
 -> (IntMap (Idx' aenv), OpenExp env aenv e)
 -> (IntMap (Idx' aenv), OpenExp env aenv e))
-> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv (e -> PrimBool))
-> LLVM
     arch
     ((IntMap (Idx' aenv), OpenFun env aenv (e -> e))
      -> (IntMap (Idx' aenv), OpenExp env aenv e)
      -> (IntMap (Idx' aenv), OpenExp env aenv e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpenFun env aenv (e -> PrimBool)
-> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv (e -> PrimBool))
forall env aenv t.
HasCallStack =>
OpenFun env aenv t
-> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv t)
travF OpenFun env aenv (e -> PrimBool)
p LLVM
  arch
  ((IntMap (Idx' aenv), OpenFun env aenv (e -> e))
   -> (IntMap (Idx' aenv), OpenExp env aenv e)
   -> (IntMap (Idx' aenv), OpenExp env aenv e))
-> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv (e -> e))
-> LLVM
     arch
     ((IntMap (Idx' aenv), OpenExp env aenv e)
      -> (IntMap (Idx' aenv), OpenExp env aenv e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OpenFun env aenv (e -> e)
-> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv (e -> e))
forall env aenv t.
HasCallStack =>
OpenFun env aenv t
-> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv t)
travF OpenFun env aenv (e -> e)
f LLVM
  arch
  ((IntMap (Idx' aenv), OpenExp env aenv e)
   -> (IntMap (Idx' aenv), OpenExp env aenv e))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv e
x
        PrimApp PrimFun (a -> e)
f OpenExp env aenv a
e             -> (OpenExp env aenv a -> OpenExp env aenv e)
-> (IntMap (Idx' aenv), OpenExp env aenv a)
-> (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA  (PrimFun (a -> e) -> OpenExp env aenv a -> OpenExp env aenv e
forall a t env aenv.
PrimFun (a -> t) -> OpenExp env aenv a -> OpenExp env aenv t
PrimApp PrimFun (a -> e)
f)       ((IntMap (Idx' aenv), OpenExp env aenv a)
 -> (IntMap (Idx' aenv), OpenExp env aenv e))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv a)
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpenExp env aenv a
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv a)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv a
e
        Index ArrayVar aenv (Array dim e)
a OpenExp env aenv dim
e               -> (ArrayVar aenv (Array dim e)
 -> OpenExp env aenv dim -> OpenExp env aenv e)
-> (IntMap (Idx' aenv), ArrayVar aenv (Array dim e))
-> (IntMap (Idx' aenv), OpenExp env aenv dim)
-> (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ArrayVar aenv (Array dim e)
-> OpenExp env aenv dim -> OpenExp env aenv e
forall aenv dim t env.
ArrayVar aenv (Array dim t)
-> OpenExp env aenv dim -> OpenExp env aenv t
Index             ((IntMap (Idx' aenv), ArrayVar aenv (Array dim e))
 -> (IntMap (Idx' aenv), OpenExp env aenv dim)
 -> (IntMap (Idx' aenv), OpenExp env aenv e))
-> LLVM arch (IntMap (Idx' aenv), ArrayVar aenv (Array dim e))
-> LLVM
     arch
     ((IntMap (Idx' aenv), OpenExp env aenv dim)
      -> (IntMap (Idx' aenv), OpenExp env aenv e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ArrayVar aenv (Array dim e)
-> LLVM arch (IntMap (Idx' aenv), ArrayVar aenv (Array dim e))
forall aenv sh e.
ArrayVar aenv (Array sh e)
-> LLVM arch (IntMap (Idx' aenv), ArrayVar aenv (Array sh e))
travA ArrayVar aenv (Array dim e)
a LLVM
  arch
  ((IntMap (Idx' aenv), OpenExp env aenv dim)
   -> (IntMap (Idx' aenv), OpenExp env aenv e))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv dim)
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OpenExp env aenv dim
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv dim)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv dim
e
        LinearIndex ArrayVar aenv (Array dim e)
a OpenExp env aenv Int
e         -> (ArrayVar aenv (Array dim e)
 -> OpenExp env aenv Int -> OpenExp env aenv e)
-> (IntMap (Idx' aenv), ArrayVar aenv (Array dim e))
-> (IntMap (Idx' aenv), OpenExp env aenv Int)
-> (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ArrayVar aenv (Array dim e)
-> OpenExp env aenv Int -> OpenExp env aenv e
forall aenv dim t env.
ArrayVar aenv (Array dim t)
-> OpenExp env aenv Int -> OpenExp env aenv t
LinearIndex       ((IntMap (Idx' aenv), ArrayVar aenv (Array dim e))
 -> (IntMap (Idx' aenv), OpenExp env aenv Int)
 -> (IntMap (Idx' aenv), OpenExp env aenv e))
-> LLVM arch (IntMap (Idx' aenv), ArrayVar aenv (Array dim e))
-> LLVM
     arch
     ((IntMap (Idx' aenv), OpenExp env aenv Int)
      -> (IntMap (Idx' aenv), OpenExp env aenv e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ArrayVar aenv (Array dim e)
-> LLVM arch (IntMap (Idx' aenv), ArrayVar aenv (Array dim e))
forall aenv sh e.
ArrayVar aenv (Array sh e)
-> LLVM arch (IntMap (Idx' aenv), ArrayVar aenv (Array sh e))
travA ArrayVar aenv (Array dim e)
a LLVM
  arch
  ((IntMap (Idx' aenv), OpenExp env aenv Int)
   -> (IntMap (Idx' aenv), OpenExp env aenv e))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv Int)
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OpenExp env aenv Int
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv Int)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv Int
e
        Shape ArrayVar aenv (Array e e)
a                 -> (ArrayVar aenv (Array e e) -> OpenExp env aenv e)
-> (IntMap (Idx' aenv), ArrayVar aenv (Array e e))
-> (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA  ArrayVar aenv (Array e e) -> OpenExp env aenv e
forall aenv t e env.
ArrayVar aenv (Array t e) -> OpenExp env aenv t
Shape             ((IntMap (Idx' aenv), ArrayVar aenv (Array e e))
 -> (IntMap (Idx' aenv), OpenExp env aenv e))
-> LLVM arch (IntMap (Idx' aenv), ArrayVar aenv (Array e e))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ArrayVar aenv (Array e e)
-> LLVM arch (IntMap (Idx' aenv), ArrayVar aenv (Array e e))
forall aenv sh e.
ArrayVar aenv (Array sh e)
-> LLVM arch (IntMap (Idx' aenv), ArrayVar aenv (Array sh e))
travA ArrayVar aenv (Array e e)
a
        ShapeSize ShapeR dim
shr OpenExp env aenv dim
e         -> (OpenExp env aenv dim -> OpenExp env aenv Int)
-> (IntMap (Idx' aenv), OpenExp env aenv dim)
-> (IntMap (Idx' aenv), OpenExp env aenv Int)
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA  (ShapeR dim -> OpenExp env aenv dim -> OpenExp env aenv Int
forall dim env aenv.
ShapeR dim -> OpenExp env aenv dim -> OpenExp env aenv Int
ShapeSize ShapeR dim
shr)   ((IntMap (Idx' aenv), OpenExp env aenv dim)
 -> (IntMap (Idx' aenv), OpenExp env aenv Int))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv dim)
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpenExp env aenv dim
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv dim)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv dim
e
        Coerce ScalarType a
t1 ScalarType e
t2 OpenExp env aenv a
x          -> (OpenExp env aenv a -> OpenExp env aenv e)
-> (IntMap (Idx' aenv), OpenExp env aenv a)
-> (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA  (ScalarType a
-> ScalarType e -> OpenExp env aenv a -> OpenExp env aenv e
forall a t env aenv.
BitSizeEq a t =>
ScalarType a
-> ScalarType t -> OpenExp env aenv a -> OpenExp env aenv t
Coerce ScalarType a
t1 ScalarType e
t2)    ((IntMap (Idx' aenv), OpenExp env aenv a)
 -> (IntMap (Idx' aenv), OpenExp env aenv e))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv a)
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpenExp env aenv a
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv a)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv a
x

      where
        travA :: ArrayVar aenv (Array sh e)
              -> LLVM arch (IntMap (Idx' aenv), ArrayVar aenv (Array sh e))
        travA :: ArrayVar aenv (Array sh e)
-> LLVM arch (IntMap (Idx' aenv), ArrayVar aenv (Array sh e))
travA ArrayVar aenv (Array sh e)
var = (IntMap (Idx' aenv), ArrayVar aenv (Array sh e))
-> LLVM arch (IntMap (Idx' aenv), ArrayVar aenv (Array sh e))
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrayVar aenv (Array sh e) -> IntMap (Idx' aenv)
forall aenv a. ArrayVar aenv a -> IntMap (Idx' aenv)
freevar ArrayVar aenv (Array sh e)
var, ArrayVar aenv (Array sh e)
var)

        travF :: HasCallStack
              => OpenFun env aenv t
              -> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv t)
        travF :: OpenFun env aenv t
-> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv t)
travF (Body OpenExp env aenv t
b)    = (OpenExp env aenv t -> OpenFun env aenv t)
-> (IntMap (Idx' aenv), OpenExp env aenv t)
-> (IntMap (Idx' aenv), OpenFun env aenv t)
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA OpenExp env aenv t -> OpenFun env aenv t
forall env aenv t. OpenExp env aenv t -> OpenFun env aenv t
Body      ((IntMap (Idx' aenv), OpenExp env aenv t)
 -> (IntMap (Idx' aenv), OpenFun env aenv t))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv t)
-> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpenExp env aenv t
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv t)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv t
b
        travF (Lam ELeftHandSide a env env'
lhs OpenFun env' aenv t1
f) = (OpenFun env' aenv t1 -> OpenFun env aenv (a -> t1))
-> (IntMap (Idx' aenv), OpenFun env' aenv t1)
-> (IntMap (Idx' aenv), OpenFun env aenv (a -> t1))
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA (ELeftHandSide a env env'
-> OpenFun env' aenv t1 -> OpenFun env aenv (a -> t1)
forall a env env' aenv t1.
ELeftHandSide a env env'
-> OpenFun env' aenv t1 -> OpenFun env aenv (a -> t1)
Lam ELeftHandSide a env env'
lhs) ((IntMap (Idx' aenv), OpenFun env' aenv t1)
 -> (IntMap (Idx' aenv), OpenFun env aenv (a -> t1)))
-> LLVM arch (IntMap (Idx' aenv), OpenFun env' aenv t1)
-> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv (a -> t1))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpenFun env' aenv t1
-> LLVM arch (IntMap (Idx' aenv), OpenFun env' aenv t1)
forall env aenv t.
HasCallStack =>
OpenFun env aenv t
-> LLVM arch (IntMap (Idx' aenv), OpenFun env aenv t)
travF OpenFun env' aenv t1
f

        travLE :: HasCallStack
               => [(TAG, OpenExp env aenv t)]
               -> LLVM arch (IntMap (Idx' aenv), [(TAG, OpenExp env aenv t)])
        travLE :: [(PrimBool, OpenExp env aenv t)]
-> LLVM arch (IntMap (Idx' aenv), [(PrimBool, OpenExp env aenv t)])
travLE []     = (IntMap (Idx' aenv), [(PrimBool, OpenExp env aenv t)])
-> LLVM arch (IntMap (Idx' aenv), [(PrimBool, OpenExp env aenv t)])
forall (m :: * -> *) a. Monad m => a -> m a
return ((IntMap (Idx' aenv), [(PrimBool, OpenExp env aenv t)])
 -> LLVM
      arch (IntMap (Idx' aenv), [(PrimBool, OpenExp env aenv t)]))
-> (IntMap (Idx' aenv), [(PrimBool, OpenExp env aenv t)])
-> LLVM arch (IntMap (Idx' aenv), [(PrimBool, OpenExp env aenv t)])
forall a b. (a -> b) -> a -> b
$ [(PrimBool, OpenExp env aenv t)]
-> (IntMap (Idx' aenv), [(PrimBool, OpenExp env aenv t)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        travLE ((PrimBool
t,OpenExp env aenv t
x):[(PrimBool, OpenExp env aenv t)]
xs) = do
          (IntMap (Idx' aenv)
v,  OpenExp env aenv t
y)  <- OpenExp env aenv t
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv t)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv t
x
          (IntMap (Idx' aenv)
vs, [(PrimBool, OpenExp env aenv t)]
ys) <- [(PrimBool, OpenExp env aenv t)]
-> LLVM arch (IntMap (Idx' aenv), [(PrimBool, OpenExp env aenv t)])
forall env aenv t.
HasCallStack =>
[(PrimBool, OpenExp env aenv t)]
-> LLVM arch (IntMap (Idx' aenv), [(PrimBool, OpenExp env aenv t)])
travLE [(PrimBool, OpenExp env aenv t)]
xs
          (IntMap (Idx' aenv), [(PrimBool, OpenExp env aenv t)])
-> LLVM arch (IntMap (Idx' aenv), [(PrimBool, OpenExp env aenv t)])
forall (m :: * -> *) a. Monad m => a -> m a
return (IntMap (Idx' aenv) -> IntMap (Idx' aenv) -> IntMap (Idx' aenv)
forall a. IntMap a -> IntMap a -> IntMap a
IntMap.union IntMap (Idx' aenv)
v IntMap (Idx' aenv)
vs, (PrimBool
t,OpenExp env aenv t
y)(PrimBool, OpenExp env aenv t)
-> [(PrimBool, OpenExp env aenv t)]
-> [(PrimBool, OpenExp env aenv t)]
forall a. a -> [a] -> [a]
:[(PrimBool, OpenExp env aenv t)]
ys)

        travME :: HasCallStack
               => Maybe (OpenExp env aenv t)
               -> LLVM arch (IntMap (Idx' aenv), Maybe (OpenExp env aenv t))
        travME :: Maybe (OpenExp env aenv t)
-> LLVM arch (IntMap (Idx' aenv), Maybe (OpenExp env aenv t))
travME Maybe (OpenExp env aenv t)
Nothing  = (IntMap (Idx' aenv), Maybe (OpenExp env aenv t))
-> LLVM arch (IntMap (Idx' aenv), Maybe (OpenExp env aenv t))
forall (m :: * -> *) a. Monad m => a -> m a
return ((IntMap (Idx' aenv), Maybe (OpenExp env aenv t))
 -> LLVM arch (IntMap (Idx' aenv), Maybe (OpenExp env aenv t)))
-> (IntMap (Idx' aenv), Maybe (OpenExp env aenv t))
-> LLVM arch (IntMap (Idx' aenv), Maybe (OpenExp env aenv t))
forall a b. (a -> b) -> a -> b
$ Maybe (OpenExp env aenv t)
-> (IntMap (Idx' aenv), Maybe (OpenExp env aenv t))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (OpenExp env aenv t)
forall a. Maybe a
Nothing
        travME (Just OpenExp env aenv t
e) = (OpenExp env aenv t -> Maybe (OpenExp env aenv t))
-> (IntMap (Idx' aenv), OpenExp env aenv t)
-> (IntMap (Idx' aenv), Maybe (OpenExp env aenv t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OpenExp env aenv t -> Maybe (OpenExp env aenv t)
forall a. a -> Maybe a
Just ((IntMap (Idx' aenv), OpenExp env aenv t)
 -> (IntMap (Idx' aenv), Maybe (OpenExp env aenv t)))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv t)
-> LLVM arch (IntMap (Idx' aenv), Maybe (OpenExp env aenv t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpenExp env aenv t
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv t)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv t
e

        foreignE :: (HasCallStack, A.Foreign asm)
                 => TypeR b
                 -> asm           (a -> b)
                 -> Fun () (a -> b)
                 -> OpenExp env aenv a
                 -> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv b)
        foreignE :: TypeR b
-> asm (a -> b)
-> Fun () (a -> b)
-> OpenExp env aenv a
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv b)
foreignE TypeR b
tp asm (a -> b)
asm Fun () (a -> b)
f OpenExp env aenv a
x =
          case asm (a -> b) -> Maybe (IRFun1 arch () (a -> b))
forall arch (asm :: * -> *) x y.
(Foreign arch, Foreign asm) =>
asm (x -> y) -> Maybe (IRFun1 arch () (x -> y))
foreignExp @arch asm (a -> b)
asm of
            Just{}                            -> (OpenExp env aenv a -> OpenExp env aenv b)
-> (IntMap (Idx' aenv), OpenExp env aenv a)
-> (IntMap (Idx' aenv), OpenExp env aenv b)
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA (TypeR b
-> asm (a -> b)
-> Fun () (a -> b)
-> OpenExp env aenv a
-> OpenExp env aenv b
forall (asm :: * -> *) t x env aenv.
Foreign asm =>
TypeR t
-> asm (x -> t)
-> Fun () (x -> t)
-> OpenExp env aenv x
-> OpenExp env aenv t
Foreign TypeR b
tp asm (a -> b)
asm Fun () (a -> b)
forall a b. Fun () (a -> b)
err) ((IntMap (Idx' aenv), OpenExp env aenv a)
 -> (IntMap (Idx' aenv), OpenExp env aenv b))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv a)
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpenExp env aenv a
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv a)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv a
x
            Maybe (IRFun1 arch () (a -> b))
Nothing
              | Lam ELeftHandSide a () env'
lhs (Body OpenExp env' () t1
b) <- Fun () (a -> b)
f
              , Exists LeftHandSide ScalarType a env a
lhs' <- ELeftHandSide a () env' -> Exists (LeftHandSide ScalarType a env)
forall (s :: * -> *) t aenv1 aenv1' aenv2.
LeftHandSide s t aenv1 aenv1' -> Exists (LeftHandSide s t aenv2)
rebuildLHS ELeftHandSide a () env'
lhs -> (OpenExp env aenv a -> OpenExp a aenv t1 -> OpenExp env aenv t1)
-> (IntMap (Idx' aenv), OpenExp env aenv a)
-> (IntMap (Idx' aenv), OpenExp a aenv t1)
-> (IntMap (Idx' aenv), OpenExp env aenv t1)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (LeftHandSide ScalarType a env a
-> OpenExp env aenv a -> OpenExp a aenv t1 -> OpenExp env aenv t1
forall bnd_t env env' aenv t.
ELeftHandSide bnd_t env env'
-> OpenExp env aenv bnd_t
-> OpenExp env' aenv t
-> OpenExp env aenv t
Let LeftHandSide ScalarType a env a
lhs')       ((IntMap (Idx' aenv), OpenExp env aenv a)
 -> (IntMap (Idx' aenv), OpenExp a aenv t1)
 -> (IntMap (Idx' aenv), OpenExp env aenv t1))
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv a)
-> LLVM
     arch
     ((IntMap (Idx' aenv), OpenExp a aenv t1)
      -> (IntMap (Idx' aenv), OpenExp env aenv t1))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpenExp env aenv a
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv a)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE OpenExp env aenv a
x LLVM
  arch
  ((IntMap (Idx' aenv), OpenExp a aenv t1)
   -> (IntMap (Idx' aenv), OpenExp env aenv t1))
-> LLVM arch (IntMap (Idx' aenv), OpenExp a aenv t1)
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv t1)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OpenExp a aenv t1
-> LLVM arch (IntMap (Idx' aenv), OpenExp a aenv t1)
forall env aenv e.
HasCallStack =>
OpenExp env aenv e
-> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv e)
travE ((() :> aenv) -> OpenExp a () t1 -> OpenExp a aenv t1
forall (f :: * -> * -> *) env env' t.
Sink f =>
(env :> env') -> f env t -> f env' t
weaken () :> aenv
forall env'. () :> env'
weakenEmpty (OpenExp a () t1 -> OpenExp a aenv t1)
-> OpenExp a () t1 -> OpenExp a aenv t1
forall a b. (a -> b) -> a -> b
$ (env' :> a) -> OpenExp env' () t1 -> OpenExp a () t1
forall (f :: * -> * -> * -> *) env env' aenv t.
SinkExp f =>
(env :> env') -> f env aenv t -> f env' aenv t
weakenE (ELeftHandSide a () env'
-> LeftHandSide ScalarType a env a -> (() :> env) -> env' :> a
forall (s :: * -> *) t env1 env1' env2 env2'.
HasCallStack =>
LeftHandSide s t env1 env1'
-> LeftHandSide s t env2 env2' -> (env1 :> env2) -> env1' :> env2'
sinkWithLHS ELeftHandSide a () env'
lhs LeftHandSide ScalarType a env a
lhs' () :> env
forall env'. () :> env'
weakenEmpty) OpenExp env' () t1
b)
            Maybe (IRFun1 arch () (a -> b))
_                                 -> String -> LLVM arch (IntMap (Idx' aenv), OpenExp env aenv b)
forall a. HasCallStack => String -> a
error String
"the slow regard of silent things"
          where
            err :: Fun () (a -> b)
            err :: Fun () (a -> b)
err = String -> Fun () (a -> b)
forall a. HasCallStack => String -> a
internalError String
"attempt to use fallback in foreign expression"


-- Applicative
-- -----------
--
liftA4 :: Applicative f => (a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e
liftA4 :: (a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e
liftA4 a -> b -> c -> d -> e
f f a
a f b
b f c
c f d
d = a -> b -> c -> d -> e
f (a -> b -> c -> d -> e) -> f a -> f (b -> c -> d -> e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
a f (b -> c -> d -> e) -> f b -> f (c -> d -> e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f b
b f (c -> d -> e) -> f c -> f (d -> e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f c
c f (d -> e) -> f d -> f e
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f d
d

liftA5 :: Applicative f => (a -> b -> c -> d -> e -> g) -> f a -> f b -> f c -> f d -> f e -> f g
liftA5 :: (a -> b -> c -> d -> e -> g)
-> f a -> f b -> f c -> f d -> f e -> f g
liftA5 a -> b -> c -> d -> e -> g
f f a
a f b
b f c
c f d
d f e
g = a -> b -> c -> d -> e -> g
f (a -> b -> c -> d -> e -> g) -> f a -> f (b -> c -> d -> e -> g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
a f (b -> c -> d -> e -> g) -> f b -> f (c -> d -> e -> g)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f b
b f (c -> d -> e -> g) -> f c -> f (d -> e -> g)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f c
c f (d -> e -> g) -> f d -> f (e -> g)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f d
d f (e -> g) -> f e -> f g
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f e
g

instance HasArraysR (CompiledOpenAcc arch) where
  {-# INLINEABLE arraysR #-}
  arraysR :: CompiledOpenAcc arch aenv a -> ArraysR a
arraysR (BuildAcc ArraysR a
r Gamma aenv
_ ObjectR arch
_ PreOpenAccSkeleton CompiledOpenAcc arch aenv a
_) = ArraysR a
r
  arraysR (PlainAcc ArraysR a
r     PreOpenAccCommand CompiledOpenAcc arch aenv a
_) = ArraysR a
r