{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# OPTIONS_HADDOCK hide #-}
-- |
-- Module      : Data.Array.Accelerate.AST
-- Copyright   : [2008..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--
-- /Scalar versus collective operations/
--
-- The embedded array processing language is a two-level language.  It
-- combines a language of scalar expressions and functions with a language of
-- collective array operations.  Scalar expressions are used to compute
-- arguments for collective operations and scalar functions are used to
-- parametrise higher-order, collective array operations.  The two-level
-- structure, in particular, ensures that collective operations cannot be
-- parametrised with collective operations; hence, we are following a flat
-- data-parallel model.  The collective operations manipulate
-- multi-dimensional arrays whose shape is explicitly tracked in their types.
-- In fact, collective operations cannot produce any values other than
-- multi-dimensional arrays; when they yield a scalar, this is in the form of
-- a 0-dimensional, singleton array.  Similarly, scalar expression can -as
-- their name indicates- only produce tuples of scalar, but not arrays.
--
-- There are, however, two expression forms that take arrays as arguments.  As
-- a result scalar and array expressions are recursively dependent.  As we
-- cannot and don't want to compute arrays in the middle of scalar
-- computations, array computations will always be hoisted out of scalar
-- expressions.  So that this is always possible, these array expressions may
-- not contain any free scalar variables.  To express that condition in the
-- type structure, we use separate environments for scalar and array variables.
--
-- /Programs/
--
-- Collective array programs comprise closed expressions of array operations.
-- There is no explicit sharing in the initial AST form, but sharing is
-- introduced subsequently by common subexpression elimination and floating
-- of array computations.
--
-- /Functions/
--
-- The array expression language is first-order and only provides limited
-- control structures to ensure that it can be efficiently executed on
-- compute-acceleration hardware, such as GPUs.  To restrict functions to
-- first-order, we separate function abstraction from the main expression
-- type.  Functions are represented using de Bruijn indices.
--
-- /Parametric and ad-hoc polymorphism/
--
-- The array language features paramatric polymophism (e.g., pairing and
-- projections) as well as ad-hoc polymorphism (e.g., arithmetic operations).
-- All ad-hoc polymorphic constructs include reified dictionaries (c.f.,
-- module 'Types').  Reified dictionaries also ensure that constants
-- (constructor 'Const') are representable on compute acceleration hardware.
--
-- The AST contains both reified dictionaries and type class constraints.
-- Type classes are used for array-related functionality that is uniformly
-- available for all supported types.  In contrast, reified dictionaries are
-- used for functionality that is only available for certain types, such as
-- arithmetic operations.
--

module Data.Array.Accelerate.AST (

  -- * Internal AST
  -- ** Array computations
  Afun, PreAfun, OpenAfun, PreOpenAfun(..),
  Acc, OpenAcc(..), PreOpenAcc(..), Direction(..), Message(..),
  ALeftHandSide, ArrayVar, ArrayVars,

  -- ** Scalar expressions
  ELeftHandSide, ExpVar, ExpVars, expVars,
  Fun, OpenFun(..),
  Exp, OpenExp(..),
  Boundary(..),
  PrimConst(..),
  PrimFun(..),
  PrimBool,
  PrimMaybe,

  -- ** Extracting type information
  HasArraysR(..), arrayR,
  expType,
  primConstType,
  primFunType,

  -- ** Normal-form
  NFDataAcc,
  rnfOpenAfun, rnfPreOpenAfun,
  rnfOpenAcc, rnfPreOpenAcc,
  rnfALeftHandSide,
  rnfArrayVar,
  rnfOpenFun,
  rnfOpenExp,
  rnfELeftHandSide,
  rnfExpVar,
  rnfBoundary,
  rnfConst,
  rnfPrimConst,
  rnfPrimFun,

  -- ** Template Haskell
  LiftAcc,
  liftPreOpenAfun,
  liftPreOpenAcc,
  liftALeftHandSide,
  liftArrayVar,
  liftOpenFun,
  liftOpenExp,
  liftELeftHandSide,
  liftExpVar,
  liftBoundary,
  liftPrimConst,
  liftPrimFun,
  liftMessage,

  -- ** Miscellaneous
  formatPreAccOp,
  formatExpOp,

) where

import Data.Array.Accelerate.AST.Idx
import Data.Array.Accelerate.AST.LeftHandSide
import Data.Array.Accelerate.AST.Var
import Data.Array.Accelerate.Error
import Data.Array.Accelerate.Representation.Array
import Data.Array.Accelerate.Representation.Elt
import Data.Array.Accelerate.Representation.Shape
import Data.Array.Accelerate.Representation.Slice
import Data.Array.Accelerate.Representation.Stencil
import Data.Array.Accelerate.Representation.Tag
import Data.Array.Accelerate.Representation.Type
import Data.Array.Accelerate.Representation.Vec
import Data.Array.Accelerate.Sugar.Foreign
import Data.Array.Accelerate.Type
import Data.Primitive.Vec

import Control.DeepSeq
import Data.Kind
import Data.Maybe
import Data.Text                                                    ( Text )
import Data.Text.Lazy.Builder
import Formatting
import Language.Haskell.TH.Extra                                    ( CodeQ )
import qualified Language.Haskell.TH.Extra                          as TH
import qualified Language.Haskell.TH.Syntax                         as TH

import GHC.TypeLits


-- Array expressions
-- -----------------

-- | Function abstraction over parametrised array computations
--
data PreOpenAfun acc aenv t where
  Abody ::                               acc             aenv  t -> PreOpenAfun acc aenv t
  Alam  :: ALeftHandSide a aenv aenv' -> PreOpenAfun acc aenv' t -> PreOpenAfun acc aenv (a -> t)

-- Function abstraction over vanilla open array computations
--
type OpenAfun = PreOpenAfun OpenAcc

-- | Parametrised array-computation function without free array variables
--
type PreAfun acc = PreOpenAfun acc ()

-- | Vanilla array-computation function without free array variables
--
type Afun = OpenAfun ()

-- Vanilla open array computations
--
newtype OpenAcc aenv t = OpenAcc (PreOpenAcc OpenAcc aenv t)

-- | Closed array expression aka an array program
--
type Acc = OpenAcc ()

-- Types for array binders
--
type ALeftHandSide  = LeftHandSide ArrayR
type ArrayVar       = Var ArrayR
type ArrayVars aenv = Vars ArrayR aenv

-- Bool is not a primitive type
type PrimBool    = TAG
type PrimMaybe a = (TAG, ((), a))

-- Trace messages
data Message a where
  Message :: (a -> String)                    -- embedded show
          -> Maybe (CodeQ (a -> String))      -- lifted version of show, for TH
          -> Text
          -> Message a

-- | Collective array computations parametrised over array variables
-- represented with de Bruijn indices.
--
-- * Scalar functions and expressions embedded in well-formed array
--   computations cannot contain free scalar variable indices. The latter
--   cannot be bound in array computations, and hence, cannot appear in any
--   well-formed program.
--
-- * The let-form is used to represent the sharing discovered by common
--   subexpression elimination as well as to control evaluation order. (We
--   need to hoist array expressions out of scalar expressions---they occur
--   in scalar indexing and in determining an arrays shape.)
--
-- The data type is parameterised over the representation types (not the
-- surface type).
--
-- We use a non-recursive variant parametrised over the recursive closure,
-- to facilitate attribute calculation in the backend.
--
data PreOpenAcc (acc :: Type -> Type -> Type) aenv a where

  -- Local non-recursive binding to represent sharing and demand
  -- explicitly. Note this is an eager binding!
  --
  Alet        :: ALeftHandSide bndArrs aenv aenv'
              -> acc            aenv  bndArrs         -- bound expression
              -> acc            aenv' bodyArrs        -- the bound expression scope
              -> PreOpenAcc acc aenv  bodyArrs

  -- Variable bound by a 'Let', represented by a de Bruijn index
  --
  Avar        :: ArrayVar       aenv (Array sh e)
              -> PreOpenAcc acc aenv (Array sh e)

  -- Tuples of arrays
  --
  Apair       :: acc            aenv as
              -> acc            aenv bs
              -> PreOpenAcc acc aenv (as, bs)

  Anil        :: PreOpenAcc acc aenv ()

  -- Array-function application.
  --
  -- The array function is not closed at the core level because we need access
  -- to free variables introduced by 'run1' style evaluators. See Issue#95.
  --
  Apply       :: ArraysR arrs2
              -> PreOpenAfun acc aenv (arrs1 -> arrs2)
              -> acc             aenv arrs1
              -> PreOpenAcc  acc aenv arrs2

  -- Apply a backend-specific foreign function to an array, with a pure
  -- Accelerate version for use with other backends. The functions must be
  -- closed.
  --
  Aforeign    :: Foreign asm
              => ArraysR bs
              -> asm                   (as -> bs) -- The foreign function for a given backend
              -> PreAfun      acc      (as -> bs) -- Fallback implementation(s)
              -> acc              aenv as         -- Arguments to the function
              -> PreOpenAcc   acc aenv bs

  -- If-then-else for array-level computations
  --
  Acond       :: Exp            aenv PrimBool
              -> acc            aenv arrs
              -> acc            aenv arrs
              -> PreOpenAcc acc aenv arrs

  -- Value-recursion for array-level computations
  --
  Awhile      :: PreOpenAfun acc aenv (arrs -> Scalar PrimBool) -- continue iteration while true
              -> PreOpenAfun acc aenv (arrs -> arrs)            -- function to iterate
              -> acc             aenv arrs                      -- initial value
              -> PreOpenAcc  acc aenv arrs

  Atrace      :: Message              arrs1
              -> acc             aenv arrs1
              -> acc             aenv arrs2
              -> PreOpenAcc  acc aenv arrs2

  -- Array inlet. Triggers (possibly) asynchronous host->device transfer if
  -- necessary.
  --
  Use         :: ArrayR (Array sh e)
              -> Array sh e
              -> PreOpenAcc acc aenv (Array sh e)

  -- Capture a scalar (or a tuple of scalars) in a singleton array
  --
  Unit        :: TypeR e
              -> Exp            aenv e
              -> PreOpenAcc acc aenv (Scalar e)

  -- Change the shape of an array without altering its contents.
  -- Precondition (this may not be checked!):
  --
  -- > dim == size dim'
  --
  Reshape     :: ShapeR sh
              -> Exp            aenv sh                         -- new shape
              -> acc            aenv (Array sh' e)              -- array to be reshaped
              -> PreOpenAcc acc aenv (Array sh e)

  -- Construct a new array by applying a function to each index.
  --
  Generate    :: ArrayR (Array sh e)
              -> Exp            aenv sh                         -- output shape
              -> Fun            aenv (sh -> e)                  -- representation function
              -> PreOpenAcc acc aenv (Array sh e)

  -- Hybrid map/backpermute, where we separate the index and value
  -- transformations.
  --
  Transform   :: ArrayR (Array sh' b)
              -> Exp            aenv sh'                        -- dimension of the result
              -> Fun            aenv (sh' -> sh)                -- index permutation function
              -> Fun            aenv (a   -> b)                 -- function to apply at each element
              ->            acc aenv (Array sh  a)              -- source array
              -> PreOpenAcc acc aenv (Array sh' b)

  -- Replicate an array across one or more dimensions as given by the first
  -- argument
  --
  Replicate   :: SliceIndex slix sl co sh                       -- slice type specification
              -> Exp            aenv slix                       -- slice value specification
              -> acc            aenv (Array sl e)               -- data to be replicated
              -> PreOpenAcc acc aenv (Array sh e)

  -- Index a sub-array out of an array; i.e., the dimensions not indexed
  -- are returned whole
  --
  Slice       :: SliceIndex slix sl co sh                       -- slice type specification
              -> acc            aenv (Array sh e)               -- array to be indexed
              -> Exp            aenv slix                       -- slice value specification
              -> PreOpenAcc acc aenv (Array sl e)

  -- Apply the given unary function to all elements of the given array
  --
  Map         :: TypeR e'
              -> Fun            aenv (e -> e')
              -> acc            aenv (Array sh e)
              -> PreOpenAcc acc aenv (Array sh e')

  -- Apply a given binary function pairwise to all elements of the given
  -- arrays. The length of the result is the length of the shorter of the
  -- two argument arrays.
  --
  ZipWith     :: TypeR e3
              -> Fun            aenv (e1 -> e2 -> e3)
              -> acc            aenv (Array sh e1)
              -> acc            aenv (Array sh e2)
              -> PreOpenAcc acc aenv (Array sh e3)

  -- Fold along the innermost dimension of an array with a given
  -- /associative/ function.
  --
  Fold        :: Fun            aenv (e -> e -> e)              -- combination function
              -> Maybe     (Exp aenv e)                         -- default value
              -> acc            aenv (Array (sh, Int) e)        -- folded array
              -> PreOpenAcc acc aenv (Array sh e)

  -- Segmented fold along the innermost dimension of an array with a given
  -- /associative/ function
  --
  FoldSeg     :: IntegralType i
              -> Fun            aenv (e -> e -> e)              -- combination function
              -> Maybe     (Exp aenv e)                         -- default value
              -> acc            aenv (Array (sh, Int) e)        -- folded array
              -> acc            aenv (Segments i)               -- segment descriptor
              -> PreOpenAcc acc aenv (Array (sh, Int) e)

  -- Haskell-style scan of a linear array with a given
  -- /associative/ function and optionally an initial element
  -- (which does not need to be the neutral of the associative operations)
  -- If no initial value is given, this is a scan1
  --
  Scan        :: Direction
              -> Fun            aenv (e -> e -> e)              -- combination function
              -> Maybe     (Exp aenv e)                         -- initial value
              -> acc            aenv (Array (sh, Int) e)
              -> PreOpenAcc acc aenv (Array (sh, Int) e)

  -- Like 'Scan', but produces a rightmost (in case of a left-to-right scan)
  -- fold value and an array with the same length as the input array (the
  -- fold value would be the rightmost element in a Haskell-style scan)
  --
  Scan'       :: Direction
              -> Fun            aenv (e -> e -> e)              -- combination function
              -> Exp            aenv e                          -- initial value
              -> acc            aenv (Array (sh, Int) e)
              -> PreOpenAcc acc aenv (Array (sh, Int) e, Array sh e)

  -- Generalised forward permutation is characterised by a permutation function
  -- that determines for each element of the source array where it should go in
  -- the output. The permutation can be between arrays of varying shape and
  -- dimensionality.
  --
  -- Other characteristics of the permutation function 'f':
  --
  --   1. 'f' is a (morally) partial function: only the elements of the domain
  --      for which the function evaluates to a 'Just' value are mapped in the
  --      result. Other elements are dropped.
  --
  --   2. 'f' is not surjective: positions in the target array need not be
  --      picked up by the permutation function, so the target array must first
  --      be initialised from an array of default values.
  --
  --   3. 'f' is not injective: distinct elements of the domain may map to the
  --      same position in the target array. In this case the combination
  --      function is used to combine elements, which needs to be /associative/
  --      and /commutative/.
  --
  Permute     :: Fun            aenv (e -> e -> e)              -- combination function
              -> acc            aenv (Array sh' e)              -- default values
              -> Fun            aenv (sh -> PrimMaybe sh')      -- permutation function
              -> acc            aenv (Array sh e)               -- source array
              -> PreOpenAcc acc aenv (Array sh' e)

  -- Generalised multi-dimensional backwards permutation; the permutation can
  -- be between arrays of varying shape; the permutation function must be total
  --
  Backpermute :: ShapeR sh'
              -> Exp            aenv sh'                        -- dimensions of the result
              -> Fun            aenv (sh' -> sh)                -- permutation function
              -> acc            aenv (Array sh e)               -- source array
              -> PreOpenAcc acc aenv (Array sh' e)

  -- Map a stencil over an array.  In contrast to 'map', the domain of
  -- a stencil function is an entire /neighbourhood/ of each array element.
  --
  Stencil     :: StencilR sh e stencil
              -> TypeR e'
              -> Fun             aenv (stencil -> e')           -- stencil function
              -> Boundary        aenv (Array sh e)              -- boundary condition
              -> acc             aenv (Array sh e)              -- source array
              -> PreOpenAcc  acc aenv (Array sh e')

  -- Map a binary stencil over an array.
  --
  Stencil2    :: StencilR sh a stencil1
              -> StencilR sh b stencil2
              -> TypeR c
              -> Fun             aenv (stencil1 -> stencil2 -> c) -- stencil function
              -> Boundary        aenv (Array sh a)                -- boundary condition #1
              -> acc             aenv (Array sh a)                -- source array #1
              -> Boundary        aenv (Array sh b)                -- boundary condition #2
              -> acc             aenv (Array sh b)                -- source array #2
              -> PreOpenAcc acc  aenv (Array sh c)


data Direction = LeftToRight | RightToLeft
  deriving Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
/= :: Direction -> Direction -> Bool
Eq


-- | Vanilla boundary condition specification for stencil operations
--
data Boundary aenv t where
  -- Clamp coordinates to the extent of the array
  Clamp     :: Boundary aenv t

  -- Mirror coordinates beyond the array extent
  Mirror    :: Boundary aenv t

  -- Wrap coordinates around on each dimension
  Wrap      :: Boundary aenv t

  -- Use a constant value for outlying coordinates
  Constant  :: e
            -> Boundary aenv (Array sh e)

  -- Apply the given function to outlying coordinates
  Function  :: Fun aenv (sh -> e)
            -> Boundary aenv (Array sh e)


-- Embedded expressions
-- --------------------

-- | Vanilla open function abstraction
--
data OpenFun env aenv t where
  Body ::                             OpenExp env  aenv t -> OpenFun env aenv t
  Lam  :: ELeftHandSide a env env' -> OpenFun env' aenv t -> OpenFun env aenv (a -> t)

-- | Vanilla function without free scalar variables
--
type Fun = OpenFun ()

-- | Vanilla expression without free scalar variables
--
type Exp = OpenExp ()

-- Types for scalar bindings
--
type ELeftHandSide = LeftHandSide ScalarType
type ExpVar        = Var ScalarType
type ExpVars env   = Vars ScalarType env

expVars :: ExpVars env t -> OpenExp env aenv t
expVars :: forall env t aenv. ExpVars env t -> OpenExp env aenv t
expVars TupR (Var ScalarType env) t
TupRunit         = OpenExp env aenv t
OpenExp env aenv ()
forall env aenv. OpenExp env aenv ()
Nil
expVars (TupRsingle Var ScalarType env t
var) = Var ScalarType env t -> OpenExp env aenv t
forall env t aenv. ExpVar env t -> OpenExp env aenv t
Evar Var ScalarType env t
var
expVars (TupRpair TupR (Var ScalarType env) a1
v1 TupR (Var ScalarType env) b
v2) = TupR (Var ScalarType env) a1 -> OpenExp env aenv a1
forall env t aenv. ExpVars env t -> OpenExp env aenv t
expVars TupR (Var ScalarType env) a1
v1 OpenExp env aenv a1
-> OpenExp env aenv b -> OpenExp env aenv (a1, b)
forall env aenv a b.
OpenExp env aenv a -> OpenExp env aenv b -> OpenExp env aenv (a, b)
`Pair` TupR (Var ScalarType env) b -> OpenExp env aenv b
forall env t aenv. ExpVars env t -> OpenExp env aenv t
expVars TupR (Var ScalarType env) b
v2


-- | Vanilla open expressions using de Bruijn indices for variables ranging
-- over tuples of scalars and arrays of tuples. All code, except Cond, is
-- evaluated eagerly. N-tuples are represented as nested pairs.
--
-- The data type is parametrised over the representation type (not the
-- surface types).
--
data OpenExp env aenv t where

  -- Local binding of a scalar expression
  Let           :: ELeftHandSide bnd_t env env'
                -> OpenExp env  aenv bnd_t
                -> OpenExp env' aenv body_t
                -> OpenExp env  aenv body_t

  -- Variable index, ranging _only_ over scalars
  Evar          :: ExpVar env t
                -> OpenExp env aenv t

  -- Apply a backend-specific foreign function
  Foreign       :: Foreign asm
                => TypeR y
                -> asm    (x -> y)    -- foreign function
                -> Fun () (x -> y)    -- alternate implementation (for other backends)
                -> OpenExp env aenv x
                -> OpenExp env aenv y

  -- Tuples
  Pair          :: OpenExp env aenv t1
                -> OpenExp env aenv t2
                -> OpenExp env aenv (t1, t2)

  Nil           :: OpenExp env aenv ()

  -- SIMD vectors
  VecPack       :: KnownNat n
                => VecR n s tup
                -> OpenExp env aenv tup
                -> OpenExp env aenv (Vec n s)

  VecUnpack     :: KnownNat n
                => VecR n s tup
                -> OpenExp env aenv (Vec n s)
                -> OpenExp env aenv tup

  -- Array indices & shapes
  IndexSlice    :: SliceIndex slix sl co sh
                -> OpenExp env aenv slix
                -> OpenExp env aenv sh
                -> OpenExp env aenv sl

  IndexFull     :: SliceIndex slix sl co sh
                -> OpenExp env aenv slix
                -> OpenExp env aenv sl
                -> OpenExp env aenv sh

  -- Shape and index conversion
  ToIndex       :: ShapeR sh
                -> OpenExp env aenv sh           -- shape of the array
                -> OpenExp env aenv sh           -- index into the array
                -> OpenExp env aenv Int

  FromIndex     :: ShapeR sh
                -> OpenExp env aenv sh           -- shape of the array
                -> OpenExp env aenv Int          -- index into linear representation
                -> OpenExp env aenv sh

  -- Case statement
  Case          :: OpenExp env aenv TAG
                -> [(TAG, OpenExp env aenv b)]      -- list of equations
                -> Maybe (OpenExp env aenv b)       -- default case
                -> OpenExp env aenv b

  -- Conditional expression (non-strict in 2nd and 3rd argument)
  Cond          :: OpenExp env aenv PrimBool
                -> OpenExp env aenv t
                -> OpenExp env aenv t
                -> OpenExp env aenv t

  -- Value recursion
  While         :: OpenFun env aenv (a -> PrimBool) -- continue while true
                -> OpenFun env aenv (a -> a)        -- function to iterate
                -> OpenExp env aenv a               -- initial value
                -> OpenExp env aenv a

  -- Constant values
  Const         :: ScalarType t
                -> t
                -> OpenExp env aenv t

  PrimConst     :: PrimConst t
                -> OpenExp env aenv t

  -- Primitive scalar operations
  PrimApp       :: PrimFun (a -> r)
                -> OpenExp env aenv a
                -> OpenExp env aenv r

  -- Project a single scalar from an array.
  -- The array expression can not contain any free scalar variables.
  Index         :: ArrayVar    aenv (Array dim t)
                -> OpenExp env aenv dim
                -> OpenExp env aenv t

  LinearIndex   :: ArrayVar    aenv (Array dim t)
                -> OpenExp env aenv Int
                -> OpenExp env aenv t

  -- Array shape.
  -- The array expression can not contain any free scalar variables.
  Shape         :: ArrayVar    aenv (Array dim e)
                -> OpenExp env aenv dim

  -- Number of elements of an array given its shape
  ShapeSize     :: ShapeR dim
                -> OpenExp env aenv dim
                -> OpenExp env aenv Int

  -- Unsafe operations (may fail or result in undefined behaviour)
  -- An unspecified bit pattern
  Undef         :: ScalarType t
                -> OpenExp env aenv t

  -- Reinterpret the bits of a value as a different type
  Coerce        :: BitSizeEq a b
                => ScalarType a
                -> ScalarType b
                -> OpenExp env aenv a
                -> OpenExp env aenv b

-- |Primitive constant values
--
data PrimConst ty where

  -- constants from Bounded
  PrimMinBound  :: BoundedType a -> PrimConst a
  PrimMaxBound  :: BoundedType a -> PrimConst a

  -- constant from Floating
  PrimPi        :: FloatingType a -> PrimConst a


-- |Primitive scalar operations
--
data PrimFun sig where

  -- operators from Num
  PrimAdd  :: NumType a -> PrimFun ((a, a) -> a)
  PrimSub  :: NumType a -> PrimFun ((a, a) -> a)
  PrimMul  :: NumType a -> PrimFun ((a, a) -> a)
  PrimNeg  :: NumType a -> PrimFun (a      -> a)
  PrimAbs  :: NumType a -> PrimFun (a      -> a)
  PrimSig  :: NumType a -> PrimFun (a      -> a)

  -- operators from Integral
  PrimQuot     :: IntegralType a -> PrimFun ((a, a)   -> a)
  PrimRem      :: IntegralType a -> PrimFun ((a, a)   -> a)
  PrimQuotRem  :: IntegralType a -> PrimFun ((a, a)   -> (a, a))
  PrimIDiv     :: IntegralType a -> PrimFun ((a, a)   -> a)
  PrimMod      :: IntegralType a -> PrimFun ((a, a)   -> a)
  PrimDivMod   :: IntegralType a -> PrimFun ((a, a)   -> (a, a))

  -- operators from Bits & FiniteBits
  PrimBAnd               :: IntegralType a -> PrimFun ((a, a)   -> a)
  PrimBOr                :: IntegralType a -> PrimFun ((a, a)   -> a)
  PrimBXor               :: IntegralType a -> PrimFun ((a, a)   -> a)
  PrimBNot               :: IntegralType a -> PrimFun (a        -> a)
  PrimBShiftL            :: IntegralType a -> PrimFun ((a, Int) -> a)
  PrimBShiftR            :: IntegralType a -> PrimFun ((a, Int) -> a)
  PrimBRotateL           :: IntegralType a -> PrimFun ((a, Int) -> a)
  PrimBRotateR           :: IntegralType a -> PrimFun ((a, Int) -> a)
  PrimPopCount           :: IntegralType a -> PrimFun (a -> Int)
  PrimCountLeadingZeros  :: IntegralType a -> PrimFun (a -> Int)
  PrimCountTrailingZeros :: IntegralType a -> PrimFun (a -> Int)

  -- operators from Fractional and Floating
  PrimFDiv        :: FloatingType a -> PrimFun ((a, a) -> a)
  PrimRecip       :: FloatingType a -> PrimFun (a      -> a)
  PrimSin         :: FloatingType a -> PrimFun (a      -> a)
  PrimCos         :: FloatingType a -> PrimFun (a      -> a)
  PrimTan         :: FloatingType a -> PrimFun (a      -> a)
  PrimAsin        :: FloatingType a -> PrimFun (a      -> a)
  PrimAcos        :: FloatingType a -> PrimFun (a      -> a)
  PrimAtan        :: FloatingType a -> PrimFun (a      -> a)
  PrimSinh        :: FloatingType a -> PrimFun (a      -> a)
  PrimCosh        :: FloatingType a -> PrimFun (a      -> a)
  PrimTanh        :: FloatingType a -> PrimFun (a      -> a)
  PrimAsinh       :: FloatingType a -> PrimFun (a      -> a)
  PrimAcosh       :: FloatingType a -> PrimFun (a      -> a)
  PrimAtanh       :: FloatingType a -> PrimFun (a      -> a)
  PrimExpFloating :: FloatingType a -> PrimFun (a      -> a)
  PrimSqrt        :: FloatingType a -> PrimFun (a      -> a)
  PrimLog         :: FloatingType a -> PrimFun (a      -> a)
  PrimFPow        :: FloatingType a -> PrimFun ((a, a) -> a)
  PrimLogBase     :: FloatingType a -> PrimFun ((a, a) -> a)

  -- FIXME: add missing operations from RealFrac & RealFloat

  -- operators from RealFrac
  PrimTruncate :: FloatingType a -> IntegralType b -> PrimFun (a -> b)
  PrimRound    :: FloatingType a -> IntegralType b -> PrimFun (a -> b)
  PrimFloor    :: FloatingType a -> IntegralType b -> PrimFun (a -> b)
  PrimCeiling  :: FloatingType a -> IntegralType b -> PrimFun (a -> b)
  -- PrimProperFraction :: FloatingType a -> IntegralType b -> PrimFun (a -> (b, a))

  -- operators from RealFloat
  PrimAtan2      :: FloatingType a -> PrimFun ((a, a) -> a)
  PrimIsNaN      :: FloatingType a -> PrimFun (a -> PrimBool)
  PrimIsInfinite :: FloatingType a -> PrimFun (a -> PrimBool)

  -- relational and equality operators
  PrimLt   :: SingleType a -> PrimFun ((a, a) -> PrimBool)
  PrimGt   :: SingleType a -> PrimFun ((a, a) -> PrimBool)
  PrimLtEq :: SingleType a -> PrimFun ((a, a) -> PrimBool)
  PrimGtEq :: SingleType a -> PrimFun ((a, a) -> PrimBool)
  PrimEq   :: SingleType a -> PrimFun ((a, a) -> PrimBool)
  PrimNEq  :: SingleType a -> PrimFun ((a, a) -> PrimBool)
  PrimMax  :: SingleType a -> PrimFun ((a, a) -> a)
  PrimMin  :: SingleType a -> PrimFun ((a, a) -> a)

  -- logical operators
  --
  -- Note that these operators are strict in both arguments. That is, the
  -- second argument of PrimLAnd is always evaluated even when the first
  -- argument is false.
  --
  -- We define (surface level) (&&) and (||) using if-then-else to enable
  -- short-circuiting, while (&&!) and (||!) are strict versions of these
  -- operators, which are defined using PrimLAnd and PrimLOr.
  --
  PrimLAnd :: PrimFun ((PrimBool, PrimBool) -> PrimBool)
  PrimLOr  :: PrimFun ((PrimBool, PrimBool) -> PrimBool)
  PrimLNot :: PrimFun (PrimBool             -> PrimBool)

  -- general conversion between types
  PrimFromIntegral :: IntegralType a -> NumType b -> PrimFun (a -> b)
  PrimToFloating   :: NumType a -> FloatingType b -> PrimFun (a -> b)


-- Type utilities
-- --------------

class HasArraysR f where
  arraysR :: f aenv a -> ArraysR a

instance HasArraysR OpenAcc where
  arraysR :: forall aenv a. OpenAcc aenv a -> ArraysR a
arraysR (OpenAcc PreOpenAcc OpenAcc aenv a
a) = PreOpenAcc OpenAcc aenv a -> ArraysR a
forall aenv a. PreOpenAcc OpenAcc aenv a -> ArraysR a
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR PreOpenAcc OpenAcc aenv a
a

arrayR :: HasArraysR f => f aenv (Array sh e) -> ArrayR (Array sh e)
arrayR :: forall (f :: * -> * -> *) aenv sh e.
HasArraysR f =>
f aenv (Array sh e) -> ArrayR (Array sh e)
arrayR f aenv (Array sh e)
a = case f aenv (Array sh e) -> ArraysR (Array sh e)
forall aenv a. f aenv a -> ArraysR a
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR f aenv (Array sh e)
a of
  TupRsingle ArrayR (Array sh e)
aR -> ArrayR (Array sh e)
aR

instance HasArraysR acc => HasArraysR (PreOpenAcc acc) where
  arraysR :: forall aenv a. PreOpenAcc acc aenv a -> ArraysR a
arraysR (Alet ALeftHandSide bndArrs aenv aenv'
_ acc aenv bndArrs
_ acc aenv' a
body)             = acc aenv' a -> ArraysR a
forall aenv a. acc aenv a -> ArraysR a
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR acc aenv' a
body
  arraysR (Avar (Var ArrayR (Array sh e)
aR Idx aenv (Array sh e)
_))           = ArrayR a -> ArraysR a
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ArrayR a
ArrayR (Array sh e)
aR
  arraysR (Apair acc aenv as
as acc aenv bs
bs)               = TupR ArrayR as -> TupR ArrayR bs -> TupR ArrayR (as, bs)
forall (s :: * -> *) a1 b. TupR s a1 -> TupR s b -> TupR s (a1, b)
TupRpair (acc aenv as -> TupR ArrayR as
forall aenv a. acc aenv a -> ArraysR a
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR acc aenv as
as) (acc aenv bs -> TupR ArrayR bs
forall aenv a. acc aenv a -> ArraysR a
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR acc aenv bs
bs)
  arraysR PreOpenAcc acc aenv a
Anil                        = ArraysR a
TupR ArrayR ()
forall (s :: * -> *). TupR s ()
TupRunit
  arraysR (Atrace Message arrs1
_ acc aenv arrs1
_ acc aenv a
bs)             = acc aenv a -> ArraysR a
forall aenv a. acc aenv a -> ArraysR a
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR acc aenv a
bs
  arraysR (Apply ArraysR a
aR PreOpenAfun acc aenv (arrs1 -> a)
_ acc aenv arrs1
_)              = ArraysR a
aR
  arraysR (Aforeign ArraysR a
r asm (as -> a)
_ PreAfun acc (as -> a)
_ acc aenv as
_)          = ArraysR a
r
  arraysR (Acond Exp aenv PrimBool
_ acc aenv a
a acc aenv a
_)               = acc aenv a -> ArraysR a
forall aenv a. acc aenv a -> ArraysR a
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR acc aenv a
a
  arraysR (Awhile PreOpenAfun acc aenv (a -> Scalar PrimBool)
_ (Alam ALeftHandSide a aenv aenv'
lhs PreOpenAfun acc aenv' t
_) acc aenv a
_)   = LeftHandSide ArrayR a aenv aenv' -> ArraysR a
forall (s :: * -> *) v env env'.
LeftHandSide s v env env' -> TupR s v
lhsToTupR LeftHandSide ArrayR a aenv aenv'
ALeftHandSide a aenv aenv'
lhs
  arraysR Awhile{}                    = [Char] -> ArraysR a
forall a. HasCallStack => [Char] -> a
error [Char]
"I want my, I want my MTV!"
  arraysR (Use ArrayR (Array sh e)
aR Array sh e
_)                  = ArrayR a -> ArraysR a
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ArrayR a
ArrayR (Array sh e)
aR
  arraysR (Unit TypeR e
tR Exp aenv e
_)                 = ShapeR () -> TypeR e -> ArraysR (Array () e)
forall sh e. ShapeR sh -> TypeR e -> ArraysR (Array sh e)
arraysRarray ShapeR ()
ShapeRz TypeR e
tR
  arraysR (Reshape ShapeR sh
sh Exp aenv sh
_ acc aenv (Array sh' e)
a)            = let ArrayR ShapeR sh
_ TypeR e
TypeR e
tR = acc aenv (Array sh' e) -> ArrayR (Array sh' e)
forall (f :: * -> * -> *) aenv sh e.
HasArraysR f =>
f aenv (Array sh e) -> ArrayR (Array sh e)
arrayR acc aenv (Array sh' e)
a
                                         in ShapeR sh -> TypeR e -> ArraysR (Array sh e)
forall sh e. ShapeR sh -> TypeR e -> ArraysR (Array sh e)
arraysRarray ShapeR sh
sh TypeR e
tR
  arraysR (Generate ArrayR (Array sh e)
aR Exp aenv sh
_ Fun aenv (sh -> e)
_)           = ArrayR a -> ArraysR a
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ArrayR a
ArrayR (Array sh e)
aR
  arraysR (Transform ArrayR (Array sh' b)
aR Exp aenv sh'
_ Fun aenv (sh' -> sh)
_ Fun aenv (a -> b)
_ acc aenv (Array sh a)
_)      = ArrayR a -> ArraysR a
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ArrayR a
ArrayR (Array sh' b)
aR
  arraysR (Replicate SliceIndex slix sl co sh
slice Exp aenv slix
_ acc aenv (Array sl e)
a)       = let ArrayR ShapeR sh
_ TypeR e
TypeR e
tR = acc aenv (Array sl e) -> ArrayR (Array sl e)
forall (f :: * -> * -> *) aenv sh e.
HasArraysR f =>
f aenv (Array sh e) -> ArrayR (Array sh e)
arrayR acc aenv (Array sl e)
a
                                         in ShapeR sh -> TypeR e -> ArraysR (Array sh e)
forall sh e. ShapeR sh -> TypeR e -> ArraysR (Array sh e)
arraysRarray (SliceIndex slix sl co sh -> ShapeR sh
forall slix sl co dim. SliceIndex slix sl co dim -> ShapeR dim
sliceDomainR SliceIndex slix sl co sh
slice) TypeR e
tR
  arraysR (Slice SliceIndex slix sl co sh
slice acc aenv (Array sh e)
a Exp aenv slix
_)           = let ArrayR ShapeR sh
_ TypeR e
TypeR e
tR = acc aenv (Array sh e) -> ArrayR (Array sh e)
forall (f :: * -> * -> *) aenv sh e.
HasArraysR f =>
f aenv (Array sh e) -> ArrayR (Array sh e)
arrayR acc aenv (Array sh e)
a
                                         in ShapeR sl -> TypeR e -> ArraysR (Array sl e)
forall sh e. ShapeR sh -> TypeR e -> ArraysR (Array sh e)
arraysRarray (SliceIndex slix sl co sh -> ShapeR sl
forall slix sl co dim. SliceIndex slix sl co dim -> ShapeR sl
sliceShapeR SliceIndex slix sl co sh
slice) TypeR e
tR
  arraysR (Map TypeR e'
tR Fun aenv (e -> e')
_ acc aenv (Array sh e)
a)                = let ArrayR ShapeR sh
ShapeR sh
sh TypeR e
_ = acc aenv (Array sh e) -> ArrayR (Array sh e)
forall (f :: * -> * -> *) aenv sh e.
HasArraysR f =>
f aenv (Array sh e) -> ArrayR (Array sh e)
arrayR acc aenv (Array sh e)
a
                                         in ShapeR sh -> TypeR e' -> ArraysR (Array sh e')
forall sh e. ShapeR sh -> TypeR e -> ArraysR (Array sh e)
arraysRarray ShapeR sh
sh TypeR e'
tR
  arraysR (ZipWith TypeR e3
tR Fun aenv (e1 -> e2 -> e3)
_ acc aenv (Array sh e1)
a acc aenv (Array sh e2)
_)          = let ArrayR ShapeR sh
ShapeR sh
sh TypeR e
_ = acc aenv (Array sh e1) -> ArrayR (Array sh e1)
forall (f :: * -> * -> *) aenv sh e.
HasArraysR f =>
f aenv (Array sh e) -> ArrayR (Array sh e)
arrayR acc aenv (Array sh e1)
a
                                         in ShapeR sh -> TypeR e3 -> ArraysR (Array sh e3)
forall sh e. ShapeR sh -> TypeR e -> ArraysR (Array sh e)
arraysRarray ShapeR sh
sh TypeR e3
tR
  arraysR (Fold Fun aenv (e -> e -> e)
_ Maybe (Exp aenv e)
_ acc aenv (Array (sh, Int) e)
a)                = let ArrayR (ShapeRsnoc ShapeR sh
ShapeR sh1
sh) TypeR e
TypeR e
tR = acc aenv (Array (sh, Int) e) -> ArrayR (Array (sh, Int) e)
forall (f :: * -> * -> *) aenv sh e.
HasArraysR f =>
f aenv (Array sh e) -> ArrayR (Array sh e)
arrayR acc aenv (Array (sh, Int) e)
a
                                         in ShapeR sh -> TypeR e -> ArraysR (Array sh e)
forall sh e. ShapeR sh -> TypeR e -> ArraysR (Array sh e)
arraysRarray ShapeR sh
sh TypeR e
tR
  arraysR (FoldSeg IntegralType i
_ Fun aenv (e -> e -> e)
_ Maybe (Exp aenv e)
_ acc aenv (Array (sh, Int) e)
a acc aenv (Segments i)
_)         = acc aenv a -> ArraysR a
forall aenv a. acc aenv a -> ArraysR a
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR acc aenv a
acc aenv (Array (sh, Int) e)
a
  arraysR (Scan Direction
_ Fun aenv (e -> e -> e)
_ Maybe (Exp aenv e)
_ acc aenv (Array (sh, Int) e)
a)              = acc aenv a -> ArraysR a
forall aenv a. acc aenv a -> ArraysR a
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR acc aenv a
acc aenv (Array (sh, Int) e)
a
  arraysR (Scan' Direction
_ Fun aenv (e -> e -> e)
_ Exp aenv e
_ acc aenv (Array (sh, Int) e)
a)             = let aR :: ArrayR (Array (sh, Int) e)
aR@(ArrayR (ShapeRsnoc ShapeR sh
ShapeR sh1
sh) TypeR e
TypeR e
tR) = acc aenv (Array (sh, Int) e) -> ArrayR (Array (sh, Int) e)
forall (f :: * -> * -> *) aenv sh e.
HasArraysR f =>
f aenv (Array sh e) -> ArrayR (Array sh e)
arrayR acc aenv (Array (sh, Int) e)
a
                                         in ArrayR (Array (sh, Int) e) -> TupR ArrayR (Array (sh, Int) e)
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ArrayR (Array (sh, Int) e)
aR TupR ArrayR (Array (sh, Int) e)
-> TupR ArrayR (Array sh e)
-> TupR ArrayR (Array (sh, Int) e, Array sh e)
forall (s :: * -> *) a1 b. TupR s a1 -> TupR s b -> TupR s (a1, b)
`TupRpair` ArrayR (Array sh e) -> TupR ArrayR (Array sh e)
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle (ShapeR sh -> TypeR e -> ArrayR (Array sh e)
forall sh e. ShapeR sh -> TypeR e -> ArrayR (Array sh e)
ArrayR ShapeR sh
sh TypeR e
tR)
  arraysR (Permute Fun aenv (e -> e -> e)
_ acc aenv (Array sh' e)
a Fun aenv (sh -> PrimMaybe sh')
_ acc aenv (Array sh e)
_)           = acc aenv a -> ArraysR a
forall aenv a. acc aenv a -> ArraysR a
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR acc aenv a
acc aenv (Array sh' e)
a
  arraysR (Backpermute ShapeR sh'
sh Exp aenv sh'
_ Fun aenv (sh' -> sh)
_ acc aenv (Array sh e)
a)      = let ArrayR ShapeR sh
_ TypeR e
TypeR e
tR = acc aenv (Array sh e) -> ArrayR (Array sh e)
forall (f :: * -> * -> *) aenv sh e.
HasArraysR f =>
f aenv (Array sh e) -> ArrayR (Array sh e)
arrayR acc aenv (Array sh e)
a
                                         in ShapeR sh' -> TypeR e -> ArraysR (Array sh' e)
forall sh e. ShapeR sh -> TypeR e -> ArraysR (Array sh e)
arraysRarray ShapeR sh'
sh TypeR e
tR
  arraysR (Stencil StencilR sh e stencil
_ TypeR e'
tR Fun aenv (stencil -> e')
_ Boundary aenv (Array sh e)
_ acc aenv (Array sh e)
a)        = let ArrayR ShapeR sh
ShapeR sh
sh TypeR e
_ = acc aenv (Array sh e) -> ArrayR (Array sh e)
forall (f :: * -> * -> *) aenv sh e.
HasArraysR f =>
f aenv (Array sh e) -> ArrayR (Array sh e)
arrayR acc aenv (Array sh e)
a
                                         in ShapeR sh -> TypeR e' -> ArraysR (Array sh e')
forall sh e. ShapeR sh -> TypeR e -> ArraysR (Array sh e)
arraysRarray ShapeR sh
sh TypeR e'
tR
  arraysR (Stencil2 StencilR sh a stencil1
_ StencilR sh b stencil2
_ TypeR c
tR Fun aenv (stencil1 -> stencil2 -> c)
_ Boundary aenv (Array sh a)
_ acc aenv (Array sh a)
a Boundary aenv (Array sh b)
_ acc aenv (Array sh b)
_) = let ArrayR ShapeR sh
ShapeR sh
sh TypeR e
_ = acc aenv (Array sh a) -> ArrayR (Array sh a)
forall (f :: * -> * -> *) aenv sh e.
HasArraysR f =>
f aenv (Array sh e) -> ArrayR (Array sh e)
arrayR acc aenv (Array sh a)
a
                                         in ShapeR sh -> TypeR c -> ArraysR (Array sh c)
forall sh e. ShapeR sh -> TypeR e -> ArraysR (Array sh e)
arraysRarray ShapeR sh
sh TypeR c
tR

expType :: HasCallStack => OpenExp aenv env t -> TypeR t
expType :: forall aenv env t. HasCallStack => OpenExp aenv env t -> TypeR t
expType = \case
  Let ELeftHandSide bnd_t aenv env'
_ OpenExp aenv env bnd_t
_ OpenExp env' env t
body                 -> OpenExp env' env t -> TupR ScalarType t
forall aenv env t. HasCallStack => OpenExp aenv env t -> TypeR t
expType OpenExp env' env t
body
  Evar (Var ScalarType t
tR Idx aenv t
_)              -> ScalarType t -> TupR ScalarType t
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ScalarType t
tR
  Foreign TupR ScalarType t
tR asm (x -> t)
_ Fun () (x -> t)
_ OpenExp aenv env x
_             -> TupR ScalarType t
tR
  Pair OpenExp aenv env t1
e1 OpenExp aenv env t2
e2                   -> TupR ScalarType t1
-> TupR ScalarType t2 -> TupR ScalarType (t1, t2)
forall (s :: * -> *) a1 b. TupR s a1 -> TupR s b -> TupR s (a1, b)
TupRpair (OpenExp aenv env t1 -> TupR ScalarType t1
forall aenv env t. HasCallStack => OpenExp aenv env t -> TypeR t
expType OpenExp aenv env t1
e1) (OpenExp aenv env t2 -> TupR ScalarType t2
forall aenv env t. HasCallStack => OpenExp aenv env t -> TypeR t
expType OpenExp aenv env t2
e2)
  OpenExp aenv env t
Nil                          -> TupR ScalarType t
TupR ScalarType ()
forall (s :: * -> *). TupR s ()
TupRunit
  VecPack   VecR n s tup
vecR OpenExp aenv env tup
_             -> ScalarType t -> TupR ScalarType t
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle (ScalarType t -> TupR ScalarType t)
-> ScalarType t -> TupR ScalarType t
forall a b. (a -> b) -> a -> b
$ VectorType (Vec n s) -> ScalarType (Vec n s)
forall (n :: Nat) a1.
VectorType (Vec n a1) -> ScalarType (Vec n a1)
VectorScalarType (VectorType (Vec n s) -> ScalarType (Vec n s))
-> VectorType (Vec n s) -> ScalarType (Vec n s)
forall a b. (a -> b) -> a -> b
$ VecR n s tup -> VectorType (Vec n s)
forall (n :: Nat) s tuple.
KnownNat n =>
VecR n s tuple -> VectorType (Vec n s)
vecRvector VecR n s tup
vecR
  VecUnpack VecR n s t
vecR OpenExp aenv env (Vec n s)
_             -> VecR n s t -> TupR ScalarType t
forall (n :: Nat) s tuple. VecR n s tuple -> TypeR tuple
vecRtuple VecR n s t
vecR
  IndexSlice SliceIndex slix t co sh
si OpenExp aenv env slix
_ OpenExp aenv env sh
_            -> ShapeR t -> TupR ScalarType t
forall sh. ShapeR sh -> TypeR sh
shapeType (ShapeR t -> TupR ScalarType t) -> ShapeR t -> TupR ScalarType t
forall a b. (a -> b) -> a -> b
$ SliceIndex slix t co sh -> ShapeR t
forall slix sl co dim. SliceIndex slix sl co dim -> ShapeR sl
sliceShapeR SliceIndex slix t co sh
si
  IndexFull  SliceIndex slix sl co t
si OpenExp aenv env slix
_ OpenExp aenv env sl
_            -> ShapeR t -> TupR ScalarType t
forall sh. ShapeR sh -> TypeR sh
shapeType (ShapeR t -> TupR ScalarType t) -> ShapeR t -> TupR ScalarType t
forall a b. (a -> b) -> a -> b
$ SliceIndex slix sl co t -> ShapeR t
forall slix sl co dim. SliceIndex slix sl co dim -> ShapeR dim
sliceDomainR SliceIndex slix sl co t
si
  ToIndex{}                    -> ScalarType t -> TupR ScalarType t
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ScalarType t
ScalarType Int
scalarTypeInt
  FromIndex ShapeR t
shr OpenExp aenv env t
_ OpenExp aenv env Int
_            -> ShapeR t -> TupR ScalarType t
forall sh. ShapeR sh -> TypeR sh
shapeType ShapeR t
shr
  Case OpenExp aenv env PrimBool
_ ((PrimBool
_,OpenExp aenv env t
e):[(PrimBool, OpenExp aenv env t)]
_) Maybe (OpenExp aenv env t)
_           -> OpenExp aenv env t -> TupR ScalarType t
forall aenv env t. HasCallStack => OpenExp aenv env t -> TypeR t
expType OpenExp aenv env t
e
  Case OpenExp aenv env PrimBool
_ [] (Just OpenExp aenv env t
e)           -> OpenExp aenv env t -> TupR ScalarType t
forall aenv env t. HasCallStack => OpenExp aenv env t -> TypeR t
expType OpenExp aenv env t
e
  Case{}                       -> Format (TupR ScalarType t) (TupR ScalarType t) -> TupR ScalarType t
forall r a. HasCallStack => Format r a -> a
internalError Format (TupR ScalarType t) (TupR ScalarType t)
"empty case encountered"
  Cond OpenExp aenv env PrimBool
_ OpenExp aenv env t
e OpenExp aenv env t
_                   -> OpenExp aenv env t -> TupR ScalarType t
forall aenv env t. HasCallStack => OpenExp aenv env t -> TypeR t
expType OpenExp aenv env t
e
  While OpenFun aenv env (t -> PrimBool)
_ (Lam ELeftHandSide a aenv env'
lhs OpenFun env' env t
_) OpenExp aenv env t
_        -> LeftHandSide ScalarType t aenv env' -> TupR ScalarType t
forall (s :: * -> *) v env env'.
LeftHandSide s v env env' -> TupR s v
lhsToTupR LeftHandSide ScalarType t aenv env'
ELeftHandSide a aenv env'
lhs
  While{}                      -> [Char] -> TupR ScalarType t
forall a. HasCallStack => [Char] -> a
error [Char]
"What's the matter, you're running in the shadows"
  Const ScalarType t
tR t
_                   -> ScalarType t -> TupR ScalarType t
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ScalarType t
tR
  PrimConst PrimConst t
c                  -> ScalarType t -> TupR ScalarType t
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle (ScalarType t -> TupR ScalarType t)
-> ScalarType t -> TupR ScalarType t
forall a b. (a -> b) -> a -> b
$ SingleType t -> ScalarType t
forall a. SingleType a -> ScalarType a
SingleScalarType (SingleType t -> ScalarType t) -> SingleType t -> ScalarType t
forall a b. (a -> b) -> a -> b
$ PrimConst t -> SingleType t
forall a. PrimConst a -> SingleType a
primConstType PrimConst t
c
  PrimApp PrimFun (a -> t)
f OpenExp aenv env a
_                  -> (TypeR a, TupR ScalarType t) -> TupR ScalarType t
forall a b. (a, b) -> b
snd ((TypeR a, TupR ScalarType t) -> TupR ScalarType t)
-> (TypeR a, TupR ScalarType t) -> TupR ScalarType t
forall a b. (a -> b) -> a -> b
$ PrimFun (a -> t) -> (TypeR a, TupR ScalarType t)
forall a b. PrimFun (a -> b) -> (TypeR a, TypeR b)
primFunType PrimFun (a -> t)
f
  Index (Var ArrayR (Array dim t)
repr Idx env (Array dim t)
_) OpenExp aenv env dim
_         -> ArrayR (Array dim t) -> TupR ScalarType t
forall sh e. ArrayR (Array sh e) -> TypeR e
arrayRtype ArrayR (Array dim t)
repr
  LinearIndex (Var ArrayR (Array dim t)
repr Idx env (Array dim t)
_) OpenExp aenv env Int
_   -> ArrayR (Array dim t) -> TupR ScalarType t
forall sh e. ArrayR (Array sh e) -> TypeR e
arrayRtype ArrayR (Array dim t)
repr
  Shape (Var ArrayR (Array t e)
repr Idx env (Array t e)
_)           -> ShapeR t -> TupR ScalarType t
forall sh. ShapeR sh -> TypeR sh
shapeType (ShapeR t -> TupR ScalarType t) -> ShapeR t -> TupR ScalarType t
forall a b. (a -> b) -> a -> b
$ ArrayR (Array t e) -> ShapeR t
forall sh e. ArrayR (Array sh e) -> ShapeR sh
arrayRshape ArrayR (Array t e)
repr
  ShapeSize{}                  -> ScalarType t -> TupR ScalarType t
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ScalarType t
ScalarType Int
scalarTypeInt
  Undef ScalarType t
tR                     -> ScalarType t -> TupR ScalarType t
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ScalarType t
tR
  Coerce ScalarType a
_ ScalarType t
tR OpenExp aenv env a
_                -> ScalarType t -> TupR ScalarType t
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ScalarType t
tR

primConstType :: PrimConst a -> SingleType a
primConstType :: forall a. PrimConst a -> SingleType a
primConstType = \case
  PrimMinBound BoundedType a
t -> BoundedType a -> SingleType a
forall a. BoundedType a -> SingleType a
bounded BoundedType a
t
  PrimMaxBound BoundedType a
t -> BoundedType a -> SingleType a
forall a. BoundedType a -> SingleType a
bounded BoundedType a
t
  PrimPi       FloatingType a
t -> FloatingType a -> SingleType a
forall t. FloatingType t -> SingleType t
floating FloatingType a
t
  where
    bounded :: BoundedType a -> SingleType a
    bounded :: forall a. BoundedType a -> SingleType a
bounded (IntegralBoundedType IntegralType a
t) = NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ IntegralType a -> NumType a
forall a. IntegralType a -> NumType a
IntegralNumType IntegralType a
t

    floating :: FloatingType t -> SingleType t
    floating :: forall t. FloatingType t -> SingleType t
floating = NumType t -> SingleType t
forall a. NumType a -> SingleType a
NumSingleType (NumType t -> SingleType t)
-> (FloatingType t -> NumType t) -> FloatingType t -> SingleType t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatingType t -> NumType t
forall a. FloatingType a -> NumType a
FloatingNumType

primFunType :: PrimFun (a -> b) -> (TypeR a, TypeR b)
primFunType :: forall a b. PrimFun (a -> b) -> (TypeR a, TypeR b)
primFunType = \case
  -- Num
  PrimAdd NumType a
t                 -> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall {s :: * -> *} {b}. TupR s b -> (TupR s (b, b), TupR s b)
binary' (TypeR b -> (TupR ScalarType (b, b), TypeR b))
-> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall a b. (a -> b) -> a -> b
$ NumType b -> TypeR b
forall {a}. NumType a -> TupR ScalarType a
num NumType b
NumType a
t
  PrimSub NumType a
t                 -> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall {s :: * -> *} {b}. TupR s b -> (TupR s (b, b), TupR s b)
binary' (TypeR b -> (TupR ScalarType (b, b), TypeR b))
-> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall a b. (a -> b) -> a -> b
$ NumType b -> TypeR b
forall {a}. NumType a -> TupR ScalarType a
num NumType b
NumType a
t
  PrimMul NumType a
t                 -> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall {s :: * -> *} {b}. TupR s b -> (TupR s (b, b), TupR s b)
binary' (TypeR b -> (TupR ScalarType (b, b), TypeR b))
-> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall a b. (a -> b) -> a -> b
$ NumType b -> TypeR b
forall {a}. NumType a -> TupR ScalarType a
num NumType b
NumType a
t
  PrimNeg NumType a
t                 -> TypeR a -> (TypeR a, TypeR a)
forall {b}. b -> (b, b)
unary'  (TypeR a -> (TypeR a, TypeR a)) -> TypeR a -> (TypeR a, TypeR a)
forall a b. (a -> b) -> a -> b
$ NumType a -> TypeR a
forall {a}. NumType a -> TupR ScalarType a
num NumType a
NumType a
t
  PrimAbs NumType a
t                 -> TypeR a -> (TypeR a, TypeR a)
forall {b}. b -> (b, b)
unary'  (TypeR a -> (TypeR a, TypeR a)) -> TypeR a -> (TypeR a, TypeR a)
forall a b. (a -> b) -> a -> b
$ NumType a -> TypeR a
forall {a}. NumType a -> TupR ScalarType a
num NumType a
NumType a
t
  PrimSig NumType a
t                 -> TypeR a -> (TypeR a, TypeR a)
forall {b}. b -> (b, b)
unary'  (TypeR a -> (TypeR a, TypeR a)) -> TypeR a -> (TypeR a, TypeR a)
forall a b. (a -> b) -> a -> b
$ NumType a -> TypeR a
forall {a}. NumType a -> TupR ScalarType a
num NumType a
NumType a
t

  -- Integral
  PrimQuot IntegralType a
t                -> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall {s :: * -> *} {b}. TupR s b -> (TupR s (b, b), TupR s b)
binary' (TypeR b -> (TupR ScalarType (b, b), TypeR b))
-> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall a b. (a -> b) -> a -> b
$ IntegralType b -> TypeR b
forall {a}. IntegralType a -> TupR ScalarType a
integral IntegralType b
IntegralType a
t
  PrimRem  IntegralType a
t                -> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall {s :: * -> *} {b}. TupR s b -> (TupR s (b, b), TupR s b)
binary' (TypeR b -> (TupR ScalarType (b, b), TypeR b))
-> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall a b. (a -> b) -> a -> b
$ IntegralType b -> TypeR b
forall {a}. IntegralType a -> TupR ScalarType a
integral IntegralType b
IntegralType a
t
  PrimQuotRem IntegralType a
t             -> TypeR a -> (TypeR a, TypeR a)
forall {b}. b -> (b, b)
unary' (TypeR a -> (TypeR a, TypeR a)) -> TypeR a -> (TypeR a, TypeR a)
forall a b. (a -> b) -> a -> b
$ IntegralType a -> TupR ScalarType a
forall {a}. IntegralType a -> TupR ScalarType a
integral IntegralType a
t TupR ScalarType a -> TupR ScalarType a -> TupR ScalarType (a, a)
forall (s :: * -> *) a1 b. TupR s a1 -> TupR s b -> TupR s (a1, b)
`TupRpair` IntegralType a -> TupR ScalarType a
forall {a}. IntegralType a -> TupR ScalarType a
integral IntegralType a
t
  PrimIDiv IntegralType a
t                -> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall {s :: * -> *} {b}. TupR s b -> (TupR s (b, b), TupR s b)
binary' (TypeR b -> (TupR ScalarType (b, b), TypeR b))
-> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall a b. (a -> b) -> a -> b
$ IntegralType b -> TypeR b
forall {a}. IntegralType a -> TupR ScalarType a
integral IntegralType b
IntegralType a
t
  PrimMod  IntegralType a
t                -> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall {s :: * -> *} {b}. TupR s b -> (TupR s (b, b), TupR s b)
binary' (TypeR b -> (TupR ScalarType (b, b), TypeR b))
-> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall a b. (a -> b) -> a -> b
$ IntegralType b -> TypeR b
forall {a}. IntegralType a -> TupR ScalarType a
integral IntegralType b
IntegralType a
t
  PrimDivMod IntegralType a
t              -> TypeR a -> (TypeR a, TypeR a)
forall {b}. b -> (b, b)
unary' (TypeR a -> (TypeR a, TypeR a)) -> TypeR a -> (TypeR a, TypeR a)
forall a b. (a -> b) -> a -> b
$ IntegralType a -> TupR ScalarType a
forall {a}. IntegralType a -> TupR ScalarType a
integral IntegralType a
t TupR ScalarType a -> TupR ScalarType a -> TupR ScalarType (a, a)
forall (s :: * -> *) a1 b. TupR s a1 -> TupR s b -> TupR s (a1, b)
`TupRpair` IntegralType a -> TupR ScalarType a
forall {a}. IntegralType a -> TupR ScalarType a
integral IntegralType a
t

  -- Bits & FiniteBits
  PrimBAnd IntegralType a
t                -> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall {s :: * -> *} {b}. TupR s b -> (TupR s (b, b), TupR s b)
binary' (TypeR b -> (TupR ScalarType (b, b), TypeR b))
-> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall a b. (a -> b) -> a -> b
$ IntegralType b -> TypeR b
forall {a}. IntegralType a -> TupR ScalarType a
integral IntegralType b
IntegralType a
t
  PrimBOr IntegralType a
t                 -> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall {s :: * -> *} {b}. TupR s b -> (TupR s (b, b), TupR s b)
binary' (TypeR b -> (TupR ScalarType (b, b), TypeR b))
-> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall a b. (a -> b) -> a -> b
$ IntegralType b -> TypeR b
forall {a}. IntegralType a -> TupR ScalarType a
integral IntegralType b
IntegralType a
t
  PrimBXor IntegralType a
t                -> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall {s :: * -> *} {b}. TupR s b -> (TupR s (b, b), TupR s b)
binary' (TypeR b -> (TupR ScalarType (b, b), TypeR b))
-> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall a b. (a -> b) -> a -> b
$ IntegralType b -> TypeR b
forall {a}. IntegralType a -> TupR ScalarType a
integral IntegralType b
IntegralType a
t
  PrimBNot IntegralType a
t                -> TypeR a -> (TypeR a, TypeR a)
forall {b}. b -> (b, b)
unary' (TypeR a -> (TypeR a, TypeR a)) -> TypeR a -> (TypeR a, TypeR a)
forall a b. (a -> b) -> a -> b
$ IntegralType a -> TypeR a
forall {a}. IntegralType a -> TupR ScalarType a
integral IntegralType a
IntegralType a
t
  PrimBShiftL IntegralType a
t             -> (IntegralType a -> TupR ScalarType a
forall {a}. IntegralType a -> TupR ScalarType a
integral IntegralType a
t TupR ScalarType a
-> TupR ScalarType Int -> TupR ScalarType (a, Int)
forall (s :: * -> *) a1 b. TupR s a1 -> TupR s b -> TupR s (a1, b)
`TupRpair` TupR ScalarType Int
tint, IntegralType b -> TypeR b
forall {a}. IntegralType a -> TupR ScalarType a
integral IntegralType b
IntegralType a
t)
  PrimBShiftR IntegralType a
t             -> (IntegralType a -> TupR ScalarType a
forall {a}. IntegralType a -> TupR ScalarType a
integral IntegralType a
t TupR ScalarType a
-> TupR ScalarType Int -> TupR ScalarType (a, Int)
forall (s :: * -> *) a1 b. TupR s a1 -> TupR s b -> TupR s (a1, b)
`TupRpair` TupR ScalarType Int
tint, IntegralType b -> TypeR b
forall {a}. IntegralType a -> TupR ScalarType a
integral IntegralType b
IntegralType a
t)
  PrimBRotateL IntegralType a
t            -> (IntegralType a -> TupR ScalarType a
forall {a}. IntegralType a -> TupR ScalarType a
integral IntegralType a
t TupR ScalarType a
-> TupR ScalarType Int -> TupR ScalarType (a, Int)
forall (s :: * -> *) a1 b. TupR s a1 -> TupR s b -> TupR s (a1, b)
`TupRpair` TupR ScalarType Int
tint, IntegralType b -> TypeR b
forall {a}. IntegralType a -> TupR ScalarType a
integral IntegralType b
IntegralType a
t)
  PrimBRotateR IntegralType a
t            -> (IntegralType a -> TupR ScalarType a
forall {a}. IntegralType a -> TupR ScalarType a
integral IntegralType a
t TupR ScalarType a
-> TupR ScalarType Int -> TupR ScalarType (a, Int)
forall (s :: * -> *) a1 b. TupR s a1 -> TupR s b -> TupR s (a1, b)
`TupRpair` TupR ScalarType Int
tint, IntegralType b -> TypeR b
forall {a}. IntegralType a -> TupR ScalarType a
integral IntegralType b
IntegralType a
t)
  PrimPopCount IntegralType a
t            -> TypeR a -> TypeR b -> (TypeR a, TypeR b)
forall {a} {b}. a -> b -> (a, b)
unary (IntegralType a -> TypeR a
forall {a}. IntegralType a -> TupR ScalarType a
integral IntegralType a
IntegralType a
t) TypeR b
TupR ScalarType Int
tint
  PrimCountLeadingZeros IntegralType a
t   -> TypeR a -> TypeR b -> (TypeR a, TypeR b)
forall {a} {b}. a -> b -> (a, b)
unary (IntegralType a -> TypeR a
forall {a}. IntegralType a -> TupR ScalarType a
integral IntegralType a
IntegralType a
t) TypeR b
TupR ScalarType Int
tint
  PrimCountTrailingZeros IntegralType a
t  -> TypeR a -> TypeR b -> (TypeR a, TypeR b)
forall {a} {b}. a -> b -> (a, b)
unary (IntegralType a -> TypeR a
forall {a}. IntegralType a -> TupR ScalarType a
integral IntegralType a
IntegralType a
t) TypeR b
TupR ScalarType Int
tint

  -- Fractional, Floating
  PrimFDiv FloatingType a
t                -> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall {s :: * -> *} {b}. TupR s b -> (TupR s (b, b), TupR s b)
binary' (TypeR b -> (TupR ScalarType (b, b), TypeR b))
-> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall a b. (a -> b) -> a -> b
$ FloatingType b -> TypeR b
forall {a}. FloatingType a -> TupR ScalarType a
floating FloatingType b
FloatingType a
t
  PrimRecip FloatingType a
t               -> TypeR a -> (TypeR a, TypeR a)
forall {b}. b -> (b, b)
unary'  (TypeR a -> (TypeR a, TypeR a)) -> TypeR a -> (TypeR a, TypeR a)
forall a b. (a -> b) -> a -> b
$ FloatingType a -> TypeR a
forall {a}. FloatingType a -> TupR ScalarType a
floating FloatingType a
FloatingType a
t
  PrimSin FloatingType a
t                 -> TypeR a -> (TypeR a, TypeR a)
forall {b}. b -> (b, b)
unary'  (TypeR a -> (TypeR a, TypeR a)) -> TypeR a -> (TypeR a, TypeR a)
forall a b. (a -> b) -> a -> b
$ FloatingType a -> TypeR a
forall {a}. FloatingType a -> TupR ScalarType a
floating FloatingType a
FloatingType a
t
  PrimCos FloatingType a
t                 -> TypeR a -> (TypeR a, TypeR a)
forall {b}. b -> (b, b)
unary'  (TypeR a -> (TypeR a, TypeR a)) -> TypeR a -> (TypeR a, TypeR a)
forall a b. (a -> b) -> a -> b
$ FloatingType a -> TypeR a
forall {a}. FloatingType a -> TupR ScalarType a
floating FloatingType a
FloatingType a
t
  PrimTan FloatingType a
t                 -> TypeR a -> (TypeR a, TypeR a)
forall {b}. b -> (b, b)
unary'  (TypeR a -> (TypeR a, TypeR a)) -> TypeR a -> (TypeR a, TypeR a)
forall a b. (a -> b) -> a -> b
$ FloatingType a -> TypeR a
forall {a}. FloatingType a -> TupR ScalarType a
floating FloatingType a
FloatingType a
t
  PrimAsin FloatingType a
t                -> TypeR a -> (TypeR a, TypeR a)
forall {b}. b -> (b, b)
unary'  (TypeR a -> (TypeR a, TypeR a)) -> TypeR a -> (TypeR a, TypeR a)
forall a b. (a -> b) -> a -> b
$ FloatingType a -> TypeR a
forall {a}. FloatingType a -> TupR ScalarType a
floating FloatingType a
FloatingType a
t
  PrimAcos FloatingType a
t                -> TypeR a -> (TypeR a, TypeR a)
forall {b}. b -> (b, b)
unary'  (TypeR a -> (TypeR a, TypeR a)) -> TypeR a -> (TypeR a, TypeR a)
forall a b. (a -> b) -> a -> b
$ FloatingType a -> TypeR a
forall {a}. FloatingType a -> TupR ScalarType a
floating FloatingType a
FloatingType a
t
  PrimAtan FloatingType a
t                -> TypeR a -> (TypeR a, TypeR a)
forall {b}. b -> (b, b)
unary'  (TypeR a -> (TypeR a, TypeR a)) -> TypeR a -> (TypeR a, TypeR a)
forall a b. (a -> b) -> a -> b
$ FloatingType a -> TypeR a
forall {a}. FloatingType a -> TupR ScalarType a
floating FloatingType a
FloatingType a
t
  PrimSinh FloatingType a
t                -> TypeR a -> (TypeR a, TypeR a)
forall {b}. b -> (b, b)
unary'  (TypeR a -> (TypeR a, TypeR a)) -> TypeR a -> (TypeR a, TypeR a)
forall a b. (a -> b) -> a -> b
$ FloatingType a -> TypeR a
forall {a}. FloatingType a -> TupR ScalarType a
floating FloatingType a
FloatingType a
t
  PrimCosh FloatingType a
t                -> TypeR a -> (TypeR a, TypeR a)
forall {b}. b -> (b, b)
unary'  (TypeR a -> (TypeR a, TypeR a)) -> TypeR a -> (TypeR a, TypeR a)
forall a b. (a -> b) -> a -> b
$ FloatingType a -> TypeR a
forall {a}. FloatingType a -> TupR ScalarType a
floating FloatingType a
FloatingType a
t
  PrimTanh FloatingType a
t                -> TypeR a -> (TypeR a, TypeR a)
forall {b}. b -> (b, b)
unary'  (TypeR a -> (TypeR a, TypeR a)) -> TypeR a -> (TypeR a, TypeR a)
forall a b. (a -> b) -> a -> b
$ FloatingType a -> TypeR a
forall {a}. FloatingType a -> TupR ScalarType a
floating FloatingType a
FloatingType a
t
  PrimAsinh FloatingType a
t               -> TypeR a -> (TypeR a, TypeR a)
forall {b}. b -> (b, b)
unary'  (TypeR a -> (TypeR a, TypeR a)) -> TypeR a -> (TypeR a, TypeR a)
forall a b. (a -> b) -> a -> b
$ FloatingType a -> TypeR a
forall {a}. FloatingType a -> TupR ScalarType a
floating FloatingType a
FloatingType a
t
  PrimAcosh FloatingType a
t               -> TypeR a -> (TypeR a, TypeR a)
forall {b}. b -> (b, b)
unary'  (TypeR a -> (TypeR a, TypeR a)) -> TypeR a -> (TypeR a, TypeR a)
forall a b. (a -> b) -> a -> b
$ FloatingType a -> TypeR a
forall {a}. FloatingType a -> TupR ScalarType a
floating FloatingType a
FloatingType a
t
  PrimAtanh FloatingType a
t               -> TypeR a -> (TypeR a, TypeR a)
forall {b}. b -> (b, b)
unary'  (TypeR a -> (TypeR a, TypeR a)) -> TypeR a -> (TypeR a, TypeR a)
forall a b. (a -> b) -> a -> b
$ FloatingType a -> TypeR a
forall {a}. FloatingType a -> TupR ScalarType a
floating FloatingType a
FloatingType a
t
  PrimExpFloating FloatingType a
t         -> TypeR a -> (TypeR a, TypeR a)
forall {b}. b -> (b, b)
unary'  (TypeR a -> (TypeR a, TypeR a)) -> TypeR a -> (TypeR a, TypeR a)
forall a b. (a -> b) -> a -> b
$ FloatingType a -> TypeR a
forall {a}. FloatingType a -> TupR ScalarType a
floating FloatingType a
FloatingType a
t
  PrimSqrt FloatingType a
t                -> TypeR a -> (TypeR a, TypeR a)
forall {b}. b -> (b, b)
unary'  (TypeR a -> (TypeR a, TypeR a)) -> TypeR a -> (TypeR a, TypeR a)
forall a b. (a -> b) -> a -> b
$ FloatingType a -> TypeR a
forall {a}. FloatingType a -> TupR ScalarType a
floating FloatingType a
FloatingType a
t
  PrimLog FloatingType a
t                 -> TypeR a -> (TypeR a, TypeR a)
forall {b}. b -> (b, b)
unary'  (TypeR a -> (TypeR a, TypeR a)) -> TypeR a -> (TypeR a, TypeR a)
forall a b. (a -> b) -> a -> b
$ FloatingType a -> TypeR a
forall {a}. FloatingType a -> TupR ScalarType a
floating FloatingType a
FloatingType a
t
  PrimFPow FloatingType a
t                -> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall {s :: * -> *} {b}. TupR s b -> (TupR s (b, b), TupR s b)
binary' (TypeR b -> (TupR ScalarType (b, b), TypeR b))
-> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall a b. (a -> b) -> a -> b
$ FloatingType b -> TypeR b
forall {a}. FloatingType a -> TupR ScalarType a
floating FloatingType b
FloatingType a
t
  PrimLogBase FloatingType a
t             -> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall {s :: * -> *} {b}. TupR s b -> (TupR s (b, b), TupR s b)
binary' (TypeR b -> (TupR ScalarType (b, b), TypeR b))
-> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall a b. (a -> b) -> a -> b
$ FloatingType b -> TypeR b
forall {a}. FloatingType a -> TupR ScalarType a
floating FloatingType b
FloatingType a
t

  -- RealFrac
  PrimTruncate FloatingType a
a IntegralType b
b          -> TypeR a -> TypeR b -> (TypeR a, TypeR b)
forall {a} {b}. a -> b -> (a, b)
unary (FloatingType a -> TypeR a
forall {a}. FloatingType a -> TupR ScalarType a
floating FloatingType a
FloatingType a
a) (IntegralType b -> TypeR b
forall {a}. IntegralType a -> TupR ScalarType a
integral IntegralType b
IntegralType b
b)
  PrimRound FloatingType a
a IntegralType b
b             -> TypeR a -> TypeR b -> (TypeR a, TypeR b)
forall {a} {b}. a -> b -> (a, b)
unary (FloatingType a -> TypeR a
forall {a}. FloatingType a -> TupR ScalarType a
floating FloatingType a
FloatingType a
a) (IntegralType b -> TypeR b
forall {a}. IntegralType a -> TupR ScalarType a
integral IntegralType b
IntegralType b
b)
  PrimFloor FloatingType a
a IntegralType b
b             -> TypeR a -> TypeR b -> (TypeR a, TypeR b)
forall {a} {b}. a -> b -> (a, b)
unary (FloatingType a -> TypeR a
forall {a}. FloatingType a -> TupR ScalarType a
floating FloatingType a
FloatingType a
a) (IntegralType b -> TypeR b
forall {a}. IntegralType a -> TupR ScalarType a
integral IntegralType b
IntegralType b
b)
  PrimCeiling FloatingType a
a IntegralType b
b           -> TypeR a -> TypeR b -> (TypeR a, TypeR b)
forall {a} {b}. a -> b -> (a, b)
unary (FloatingType a -> TypeR a
forall {a}. FloatingType a -> TupR ScalarType a
floating FloatingType a
FloatingType a
a) (IntegralType b -> TypeR b
forall {a}. IntegralType a -> TupR ScalarType a
integral IntegralType b
IntegralType b
b)

  -- RealFloat
  PrimAtan2 FloatingType a
t               -> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall {s :: * -> *} {b}. TupR s b -> (TupR s (b, b), TupR s b)
binary' (TypeR b -> (TupR ScalarType (b, b), TypeR b))
-> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall a b. (a -> b) -> a -> b
$ FloatingType b -> TypeR b
forall {a}. FloatingType a -> TupR ScalarType a
floating FloatingType b
FloatingType a
t
  PrimIsNaN FloatingType a
t               -> TypeR a -> TypeR b -> (TypeR a, TypeR b)
forall {a} {b}. a -> b -> (a, b)
unary (FloatingType a -> TypeR a
forall {a}. FloatingType a -> TupR ScalarType a
floating FloatingType a
FloatingType a
t) TypeR b
TupR ScalarType PrimBool
tbool
  PrimIsInfinite FloatingType a
t          -> TypeR a -> TypeR b -> (TypeR a, TypeR b)
forall {a} {b}. a -> b -> (a, b)
unary (FloatingType a -> TypeR a
forall {a}. FloatingType a -> TupR ScalarType a
floating FloatingType a
FloatingType a
t) TypeR b
TupR ScalarType PrimBool
tbool

  -- Relational and equality
  PrimLt SingleType a
t                  -> SingleType a -> (TupR ScalarType (a, a), TupR ScalarType PrimBool)
forall {b}.
SingleType b -> (TupR ScalarType (b, b), TupR ScalarType PrimBool)
compare' SingleType a
t
  PrimGt SingleType a
t                  -> SingleType a -> (TupR ScalarType (a, a), TupR ScalarType PrimBool)
forall {b}.
SingleType b -> (TupR ScalarType (b, b), TupR ScalarType PrimBool)
compare' SingleType a
t
  PrimLtEq SingleType a
t                -> SingleType a -> (TupR ScalarType (a, a), TupR ScalarType PrimBool)
forall {b}.
SingleType b -> (TupR ScalarType (b, b), TupR ScalarType PrimBool)
compare' SingleType a
t
  PrimGtEq SingleType a
t                -> SingleType a -> (TupR ScalarType (a, a), TupR ScalarType PrimBool)
forall {b}.
SingleType b -> (TupR ScalarType (b, b), TupR ScalarType PrimBool)
compare' SingleType a
t
  PrimEq SingleType a
t                  -> SingleType a -> (TupR ScalarType (a, a), TupR ScalarType PrimBool)
forall {b}.
SingleType b -> (TupR ScalarType (b, b), TupR ScalarType PrimBool)
compare' SingleType a
t
  PrimNEq SingleType a
t                 -> SingleType a -> (TupR ScalarType (a, a), TupR ScalarType PrimBool)
forall {b}.
SingleType b -> (TupR ScalarType (b, b), TupR ScalarType PrimBool)
compare' SingleType a
t
  PrimMax SingleType a
t                 -> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall {s :: * -> *} {b}. TupR s b -> (TupR s (b, b), TupR s b)
binary' (TypeR b -> (TupR ScalarType (b, b), TypeR b))
-> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall a b. (a -> b) -> a -> b
$ SingleType b -> TypeR b
forall {a}. SingleType a -> TupR ScalarType a
single SingleType b
SingleType a
t
  PrimMin SingleType a
t                 -> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall {s :: * -> *} {b}. TupR s b -> (TupR s (b, b), TupR s b)
binary' (TypeR b -> (TupR ScalarType (b, b), TypeR b))
-> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall a b. (a -> b) -> a -> b
$ SingleType b -> TypeR b
forall {a}. SingleType a -> TupR ScalarType a
single SingleType b
SingleType a
t

  -- Logical
  PrimFun (a -> b)
PrimLAnd                  -> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall {s :: * -> *} {b}. TupR s b -> (TupR s (b, b), TupR s b)
binary' TypeR b
TupR ScalarType PrimBool
tbool
  PrimFun (a -> b)
PrimLOr                   -> TypeR b -> (TupR ScalarType (b, b), TypeR b)
forall {s :: * -> *} {b}. TupR s b -> (TupR s (b, b), TupR s b)
binary' TypeR b
TupR ScalarType PrimBool
tbool
  PrimFun (a -> b)
PrimLNot                  -> TypeR a -> (TypeR a, TypeR a)
forall {b}. b -> (b, b)
unary' TypeR a
TupR ScalarType PrimBool
tbool

  -- general conversion between types
  PrimFromIntegral IntegralType a
a NumType b
b      -> TypeR a -> TypeR b -> (TypeR a, TypeR b)
forall {a} {b}. a -> b -> (a, b)
unary (IntegralType a -> TypeR a
forall {a}. IntegralType a -> TupR ScalarType a
integral IntegralType a
IntegralType a
a) (NumType b -> TypeR b
forall {a}. NumType a -> TupR ScalarType a
num NumType b
NumType b
b)
  PrimToFloating   NumType a
a FloatingType b
b      -> TypeR a -> TypeR b -> (TypeR a, TypeR b)
forall {a} {b}. a -> b -> (a, b)
unary (NumType a -> TypeR a
forall {a}. NumType a -> TupR ScalarType a
num NumType a
NumType a
a) (FloatingType b -> TypeR b
forall {a}. FloatingType a -> TupR ScalarType a
floating FloatingType b
FloatingType b
b)

  where
    unary :: a -> b -> (a, b)
unary a
a b
b  = (a
a, b
b)
    unary' :: b -> (b, b)
unary' b
a   = b -> b -> (b, b)
forall {a} {b}. a -> b -> (a, b)
unary b
a b
a
    binary :: TupR s b -> b -> (TupR s (b, b), b)
binary TupR s b
a b
b = (TupR s b
a TupR s b -> TupR s b -> TupR s (b, b)
forall (s :: * -> *) a1 b. TupR s a1 -> TupR s b -> TupR s (a1, b)
`TupRpair` TupR s b
a, b
b)
    binary' :: TupR s b -> (TupR s (b, b), TupR s b)
binary' TupR s b
a  = TupR s b -> TupR s b -> (TupR s (b, b), TupR s b)
forall {s :: * -> *} {b} {b}. TupR s b -> b -> (TupR s (b, b), b)
binary TupR s b
a TupR s b
a
    compare' :: SingleType b -> (TupR ScalarType (b, b), TupR ScalarType PrimBool)
compare' SingleType b
a = TupR ScalarType b
-> TupR ScalarType PrimBool
-> (TupR ScalarType (b, b), TupR ScalarType PrimBool)
forall {s :: * -> *} {b} {b}. TupR s b -> b -> (TupR s (b, b), b)
binary (SingleType b -> TupR ScalarType b
forall {a}. SingleType a -> TupR ScalarType a
single SingleType b
a) TupR ScalarType PrimBool
tbool

    single :: SingleType a -> TupR ScalarType a
single   = ScalarType a -> TupR ScalarType a
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle (ScalarType a -> TupR ScalarType a)
-> (SingleType a -> ScalarType a)
-> SingleType a
-> TupR ScalarType a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleType a -> ScalarType a
forall a. SingleType a -> ScalarType a
SingleScalarType
    num :: NumType a -> TupR ScalarType a
num      = ScalarType a -> TupR ScalarType a
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle (ScalarType a -> TupR ScalarType a)
-> (NumType a -> ScalarType a) -> NumType a -> TupR ScalarType a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleType a -> ScalarType a
forall a. SingleType a -> ScalarType a
SingleScalarType (SingleType a -> ScalarType a)
-> (NumType a -> SingleType a) -> NumType a -> ScalarType a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType
    integral :: IntegralType a -> TupR ScalarType a
integral = NumType a -> TupR ScalarType a
forall {a}. NumType a -> TupR ScalarType a
num (NumType a -> TupR ScalarType a)
-> (IntegralType a -> NumType a)
-> IntegralType a
-> TupR ScalarType a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntegralType a -> NumType a
forall a. IntegralType a -> NumType a
IntegralNumType
    floating :: FloatingType a -> TupR ScalarType a
floating = NumType a -> TupR ScalarType a
forall {a}. NumType a -> TupR ScalarType a
num (NumType a -> TupR ScalarType a)
-> (FloatingType a -> NumType a)
-> FloatingType a
-> TupR ScalarType a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatingType a -> NumType a
forall a. FloatingType a -> NumType a
FloatingNumType

    tbool :: TupR ScalarType PrimBool
tbool    = ScalarType PrimBool -> TupR ScalarType PrimBool
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ScalarType PrimBool
scalarTypeWord8
    tint :: TupR ScalarType Int
tint     = ScalarType Int -> TupR ScalarType Int
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ScalarType Int
scalarTypeInt


-- Normal form data
-- ================

instance NFData (OpenAfun aenv f) where
  rnf :: OpenAfun aenv f -> ()
rnf = OpenAfun aenv f -> ()
forall aenv f. OpenAfun aenv f -> ()
rnfOpenAfun

instance NFData (OpenAcc aenv t) where
  rnf :: OpenAcc aenv t -> ()
rnf = OpenAcc aenv t -> ()
forall aenv t. OpenAcc aenv t -> ()
rnfOpenAcc

instance NFData (OpenExp env aenv t) where
  rnf :: OpenExp env aenv t -> ()
rnf = OpenExp env aenv t -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfOpenExp

instance NFData (OpenFun env aenv t) where
  rnf :: OpenFun env aenv t -> ()
rnf = OpenFun env aenv t -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfOpenFun


type NFDataAcc acc = forall aenv t. acc aenv t -> ()

rnfOpenAfun :: OpenAfun aenv t -> ()
rnfOpenAfun :: forall aenv f. OpenAfun aenv f -> ()
rnfOpenAfun = (forall aenv t. OpenAcc aenv t -> ())
-> PreOpenAfun OpenAcc aenv t -> ()
forall (acc :: * -> * -> *) aenv t.
NFDataAcc acc -> PreOpenAfun acc aenv t -> ()
rnfPreOpenAfun OpenAcc aenv t -> ()
forall aenv t. OpenAcc aenv t -> ()
rnfOpenAcc

rnfPreOpenAfun :: NFDataAcc acc -> PreOpenAfun acc aenv t -> ()
rnfPreOpenAfun :: forall (acc :: * -> * -> *) aenv t.
NFDataAcc acc -> PreOpenAfun acc aenv t -> ()
rnfPreOpenAfun NFDataAcc acc
rnfA (Abody acc aenv t
b) = acc aenv t -> ()
NFDataAcc acc
rnfA acc aenv t
b
rnfPreOpenAfun NFDataAcc acc
rnfA (Alam ALeftHandSide a aenv aenv'
lhs PreOpenAfun acc aenv' t
f) = ALeftHandSide a aenv aenv' -> ()
forall arrs aenv aenv'. ALeftHandSide arrs aenv aenv' -> ()
rnfALeftHandSide ALeftHandSide a aenv aenv'
lhs () -> () -> ()
forall a b. a -> b -> b
`seq` NFDataAcc acc -> PreOpenAfun acc aenv' t -> ()
forall (acc :: * -> * -> *) aenv t.
NFDataAcc acc -> PreOpenAfun acc aenv t -> ()
rnfPreOpenAfun acc aenv t -> ()
NFDataAcc acc
rnfA PreOpenAfun acc aenv' t
f

rnfOpenAcc :: OpenAcc aenv t -> ()
rnfOpenAcc :: forall aenv t. OpenAcc aenv t -> ()
rnfOpenAcc (OpenAcc PreOpenAcc OpenAcc aenv t
pacc) = (forall aenv t. OpenAcc aenv t -> ())
-> PreOpenAcc OpenAcc aenv t -> ()
forall (acc :: * -> * -> *) aenv t.
HasArraysR acc =>
NFDataAcc acc -> PreOpenAcc acc aenv t -> ()
rnfPreOpenAcc OpenAcc aenv t -> ()
forall aenv t. OpenAcc aenv t -> ()
rnfOpenAcc PreOpenAcc OpenAcc aenv t
pacc

rnfPreOpenAcc :: forall acc aenv t. HasArraysR acc => NFDataAcc acc -> PreOpenAcc acc aenv t -> ()
rnfPreOpenAcc :: forall (acc :: * -> * -> *) aenv t.
HasArraysR acc =>
NFDataAcc acc -> PreOpenAcc acc aenv t -> ()
rnfPreOpenAcc NFDataAcc acc
rnfA PreOpenAcc acc aenv t
pacc =
  let
      rnfAF :: PreOpenAfun acc aenv' t' -> ()
      rnfAF :: forall aenv' t'. PreOpenAfun acc aenv' t' -> ()
rnfAF = NFDataAcc acc -> PreOpenAfun acc aenv' t' -> ()
forall (acc :: * -> * -> *) aenv t.
NFDataAcc acc -> PreOpenAfun acc aenv t -> ()
rnfPreOpenAfun acc aenv t -> ()
NFDataAcc acc
rnfA

      rnfE :: OpenExp env' aenv' t' -> ()
      rnfE :: forall env aenv t. OpenExp env aenv t -> ()
rnfE = OpenExp env' aenv' t' -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfOpenExp

      rnfF :: OpenFun env' aenv' t' -> ()
      rnfF :: forall env aenv t. OpenFun env aenv t -> ()
rnfF = OpenFun env' aenv' t' -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfOpenFun

      rnfB :: ArrayR (Array sh e) -> Boundary aenv' (Array sh e) -> ()
      rnfB :: forall sh e aenv'.
ArrayR (Array sh e) -> Boundary aenv' (Array sh e) -> ()
rnfB = ArrayR (Array sh e) -> Boundary aenv' (Array sh e) -> ()
forall aenv sh e.
ArrayR (Array sh e) -> Boundary aenv (Array sh e) -> ()
rnfBoundary

      rnfM :: Message a -> ()
      rnfM :: forall a. Message a -> ()
rnfM (Message a -> [Char]
f Maybe (CodeQ (a -> [Char]))
g Text
msg) = a -> [Char]
f (a -> [Char]) -> () -> ()
forall a b. a -> b -> b
`seq` (CodeQ (a -> [Char]) -> ()) -> Maybe (CodeQ (a -> [Char])) -> ()
forall a. (a -> ()) -> Maybe a -> ()
rnfMaybe (\CodeQ (a -> [Char])
x -> CodeQ (a -> [Char])
x CodeQ (a -> [Char]) -> () -> ()
forall a b. a -> b -> b
`seq` ()) Maybe (CodeQ (a -> [Char]))
g () -> () -> ()
forall a b. a -> b -> b
`seq` Text -> ()
forall a. NFData a => a -> ()
rnf Text
msg
  in
  case PreOpenAcc acc aenv t
pacc of
    Alet ALeftHandSide bndArrs aenv aenv'
lhs acc aenv bndArrs
bnd acc aenv' t
body         -> ALeftHandSide bndArrs aenv aenv' -> ()
forall arrs aenv aenv'. ALeftHandSide arrs aenv aenv' -> ()
rnfALeftHandSide ALeftHandSide bndArrs aenv aenv'
lhs () -> () -> ()
forall a b. a -> b -> b
`seq` acc aenv bndArrs -> ()
NFDataAcc acc
rnfA acc aenv bndArrs
bnd () -> () -> ()
forall a b. a -> b -> b
`seq` acc aenv' t -> ()
NFDataAcc acc
rnfA acc aenv' t
body
    Avar ArrayVar aenv (Array sh e)
var                  -> ArrayVar aenv (Array sh e) -> ()
forall aenv a. ArrayVar aenv a -> ()
rnfArrayVar ArrayVar aenv (Array sh e)
var
    Apair acc aenv as
as acc aenv bs
bs               -> acc aenv as -> ()
NFDataAcc acc
rnfA acc aenv as
as () -> () -> ()
forall a b. a -> b -> b
`seq` acc aenv bs -> ()
NFDataAcc acc
rnfA acc aenv bs
bs
    PreOpenAcc acc aenv t
Anil                      -> ()
    Atrace Message arrs1
msg acc aenv arrs1
as acc aenv t
bs          -> Message arrs1 -> ()
forall a. Message a -> ()
rnfM Message arrs1
msg () -> () -> ()
forall a b. a -> b -> b
`seq` acc aenv arrs1 -> ()
NFDataAcc acc
rnfA acc aenv arrs1
as () -> () -> ()
forall a b. a -> b -> b
`seq` acc aenv t -> ()
NFDataAcc acc
rnfA acc aenv t
bs
    Apply ArraysR t
repr PreOpenAfun acc aenv (arrs1 -> t)
afun acc aenv arrs1
acc       -> (forall b. ArrayR b -> ()) -> ArraysR t -> ()
forall (s :: * -> *) a. (forall b. s b -> ()) -> TupR s a -> ()
rnfTupR ArrayR b -> ()
forall b. ArrayR b -> ()
rnfArrayR ArraysR t
repr () -> () -> ()
forall a b. a -> b -> b
`seq` PreOpenAfun acc aenv (arrs1 -> t) -> ()
forall aenv' t'. PreOpenAfun acc aenv' t' -> ()
rnfAF PreOpenAfun acc aenv (arrs1 -> t)
afun () -> () -> ()
forall a b. a -> b -> b
`seq` acc aenv arrs1 -> ()
NFDataAcc acc
rnfA acc aenv arrs1
acc
    Aforeign ArraysR t
repr asm (as -> t)
asm PreAfun acc (as -> t)
afun acc aenv as
a  -> (forall b. ArrayR b -> ()) -> ArraysR t -> ()
forall (s :: * -> *) a. (forall b. s b -> ()) -> TupR s a -> ()
rnfTupR ArrayR b -> ()
forall b. ArrayR b -> ()
rnfArrayR ArraysR t
repr () -> () -> ()
forall a b. a -> b -> b
`seq` [Char] -> ()
forall a. NFData a => a -> ()
rnf (asm (as -> t) -> [Char]
forall args. asm args -> [Char]
forall (asm :: * -> *) args. Foreign asm => asm args -> [Char]
strForeign asm (as -> t)
asm) () -> () -> ()
forall a b. a -> b -> b
`seq` PreAfun acc (as -> t) -> ()
forall aenv' t'. PreOpenAfun acc aenv' t' -> ()
rnfAF PreAfun acc (as -> t)
afun () -> () -> ()
forall a b. a -> b -> b
`seq` acc aenv as -> ()
NFDataAcc acc
rnfA acc aenv as
a
    Acond Exp aenv PrimBool
p acc aenv t
a1 acc aenv t
a2             -> Exp aenv PrimBool -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE Exp aenv PrimBool
p () -> () -> ()
forall a b. a -> b -> b
`seq` acc aenv t -> ()
NFDataAcc acc
rnfA acc aenv t
a1 () -> () -> ()
forall a b. a -> b -> b
`seq` acc aenv t -> ()
NFDataAcc acc
rnfA acc aenv t
a2
    Awhile PreOpenAfun acc aenv (t -> Scalar PrimBool)
p PreOpenAfun acc aenv (t -> t)
f acc aenv t
a              -> PreOpenAfun acc aenv (t -> Scalar PrimBool) -> ()
forall aenv' t'. PreOpenAfun acc aenv' t' -> ()
rnfAF PreOpenAfun acc aenv (t -> Scalar PrimBool)
p () -> () -> ()
forall a b. a -> b -> b
`seq` PreOpenAfun acc aenv (t -> t) -> ()
forall aenv' t'. PreOpenAfun acc aenv' t' -> ()
rnfAF PreOpenAfun acc aenv (t -> t)
f () -> () -> ()
forall a b. a -> b -> b
`seq` acc aenv t -> ()
NFDataAcc acc
rnfA acc aenv t
a
    Use ArrayR (Array sh e)
repr Array sh e
arr              -> ArrayR (Array sh e) -> Array sh e -> ()
forall a. ArrayR a -> a -> ()
rnfArray ArrayR (Array sh e)
repr Array sh e
arr
    Unit TypeR e
tp Exp aenv e
x                 -> TypeR e -> ()
forall t. TypeR t -> ()
rnfTypeR TypeR e
tp () -> () -> ()
forall a b. a -> b -> b
`seq` Exp aenv e -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE Exp aenv e
x
    Reshape ShapeR sh
shr Exp aenv sh
sh acc aenv (Array sh' e)
a          -> ShapeR sh -> ()
forall sh. ShapeR sh -> ()
rnfShapeR ShapeR sh
shr () -> () -> ()
forall a b. a -> b -> b
`seq` Exp aenv sh -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE Exp aenv sh
sh () -> () -> ()
forall a b. a -> b -> b
`seq` acc aenv (Array sh' e) -> ()
NFDataAcc acc
rnfA acc aenv (Array sh' e)
a
    Generate ArrayR (Array sh e)
repr Exp aenv sh
sh Fun aenv (sh -> e)
f        -> ArrayR (Array sh e) -> ()
forall b. ArrayR b -> ()
rnfArrayR ArrayR (Array sh e)
repr () -> () -> ()
forall a b. a -> b -> b
`seq` Exp aenv sh -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE Exp aenv sh
sh () -> () -> ()
forall a b. a -> b -> b
`seq` Fun aenv (sh -> e) -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF Fun aenv (sh -> e)
f
    Transform ArrayR (Array sh' b)
repr Exp aenv sh'
sh Fun aenv (sh' -> sh)
p Fun aenv (a -> b)
f acc aenv (Array sh a)
a   -> ArrayR (Array sh' b) -> ()
forall b. ArrayR b -> ()
rnfArrayR ArrayR (Array sh' b)
repr () -> () -> ()
forall a b. a -> b -> b
`seq` Exp aenv sh' -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE Exp aenv sh'
sh () -> () -> ()
forall a b. a -> b -> b
`seq` Fun aenv (sh' -> sh) -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF Fun aenv (sh' -> sh)
p () -> () -> ()
forall a b. a -> b -> b
`seq` Fun aenv (a -> b) -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF Fun aenv (a -> b)
f () -> () -> ()
forall a b. a -> b -> b
`seq` acc aenv (Array sh a) -> ()
NFDataAcc acc
rnfA acc aenv (Array sh a)
a
    Replicate SliceIndex slix sl co sh
slice Exp aenv slix
sh acc aenv (Array sl e)
a      -> SliceIndex slix sl co sh -> ()
forall ix slice co sh. SliceIndex ix slice co sh -> ()
rnfSliceIndex SliceIndex slix sl co sh
slice () -> () -> ()
forall a b. a -> b -> b
`seq` Exp aenv slix -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE Exp aenv slix
sh () -> () -> ()
forall a b. a -> b -> b
`seq` acc aenv (Array sl e) -> ()
NFDataAcc acc
rnfA acc aenv (Array sl e)
a
    Slice SliceIndex slix sl co sh
slice acc aenv (Array sh e)
a Exp aenv slix
sh          -> SliceIndex slix sl co sh -> ()
forall ix slice co sh. SliceIndex ix slice co sh -> ()
rnfSliceIndex SliceIndex slix sl co sh
slice () -> () -> ()
forall a b. a -> b -> b
`seq` Exp aenv slix -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE Exp aenv slix
sh () -> () -> ()
forall a b. a -> b -> b
`seq` acc aenv (Array sh e) -> ()
NFDataAcc acc
rnfA acc aenv (Array sh e)
a
    Map TypeR e'
tp Fun aenv (e -> e')
f acc aenv (Array sh e)
a                -> TypeR e' -> ()
forall t. TypeR t -> ()
rnfTypeR TypeR e'
tp () -> () -> ()
forall a b. a -> b -> b
`seq` Fun aenv (e -> e') -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF Fun aenv (e -> e')
f () -> () -> ()
forall a b. a -> b -> b
`seq` acc aenv (Array sh e) -> ()
NFDataAcc acc
rnfA acc aenv (Array sh e)
a
    ZipWith TypeR e3
tp Fun aenv (e1 -> e2 -> e3)
f acc aenv (Array sh e1)
a1 acc aenv (Array sh e2)
a2        -> TypeR e3 -> ()
forall t. TypeR t -> ()
rnfTypeR TypeR e3
tp () -> () -> ()
forall a b. a -> b -> b
`seq` Fun aenv (e1 -> e2 -> e3) -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF Fun aenv (e1 -> e2 -> e3)
f () -> () -> ()
forall a b. a -> b -> b
`seq` acc aenv (Array sh e1) -> ()
NFDataAcc acc
rnfA acc aenv (Array sh e1)
a1 () -> () -> ()
forall a b. a -> b -> b
`seq` acc aenv (Array sh e2) -> ()
NFDataAcc acc
rnfA acc aenv (Array sh e2)
a2
    Fold Fun aenv (e -> e -> e)
f Maybe (Exp aenv e)
z acc aenv (Array (sh, Int) e)
a                -> Fun aenv (e -> e -> e) -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF Fun aenv (e -> e -> e)
f () -> () -> ()
forall a b. a -> b -> b
`seq` (Exp aenv e -> ()) -> Maybe (Exp aenv e) -> ()
forall a. (a -> ()) -> Maybe a -> ()
rnfMaybe Exp aenv e -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE Maybe (Exp aenv e)
z () -> () -> ()
forall a b. a -> b -> b
`seq` acc aenv (Array (sh, Int) e) -> ()
NFDataAcc acc
rnfA acc aenv (Array (sh, Int) e)
a
    FoldSeg IntegralType i
i Fun aenv (e -> e -> e)
f Maybe (Exp aenv e)
z acc aenv (Array (sh, Int) e)
a acc aenv (Segments i)
s         -> IntegralType i -> ()
forall t. IntegralType t -> ()
rnfIntegralType IntegralType i
i () -> () -> ()
forall a b. a -> b -> b
`seq` Fun aenv (e -> e -> e) -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF Fun aenv (e -> e -> e)
f () -> () -> ()
forall a b. a -> b -> b
`seq` (Exp aenv e -> ()) -> Maybe (Exp aenv e) -> ()
forall a. (a -> ()) -> Maybe a -> ()
rnfMaybe Exp aenv e -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE Maybe (Exp aenv e)
z () -> () -> ()
forall a b. a -> b -> b
`seq` acc aenv (Array (sh, Int) e) -> ()
NFDataAcc acc
rnfA acc aenv (Array (sh, Int) e)
a () -> () -> ()
forall a b. a -> b -> b
`seq` acc aenv (Segments i) -> ()
NFDataAcc acc
rnfA acc aenv (Segments i)
s
    Scan Direction
d Fun aenv (e -> e -> e)
f Maybe (Exp aenv e)
z acc aenv (Array (sh, Int) e)
a              -> Direction
d Direction -> () -> ()
forall a b. a -> b -> b
`seq` Fun aenv (e -> e -> e) -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF Fun aenv (e -> e -> e)
f () -> () -> ()
forall a b. a -> b -> b
`seq` (Exp aenv e -> ()) -> Maybe (Exp aenv e) -> ()
forall a. (a -> ()) -> Maybe a -> ()
rnfMaybe Exp aenv e -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE Maybe (Exp aenv e)
z () -> () -> ()
forall a b. a -> b -> b
`seq` acc aenv (Array (sh, Int) e) -> ()
NFDataAcc acc
rnfA acc aenv (Array (sh, Int) e)
a
    Scan' Direction
d Fun aenv (e -> e -> e)
f Exp aenv e
z acc aenv (Array (sh, Int) e)
a             -> Direction
d Direction -> () -> ()
forall a b. a -> b -> b
`seq` Fun aenv (e -> e -> e) -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF Fun aenv (e -> e -> e)
f () -> () -> ()
forall a b. a -> b -> b
`seq` Exp aenv e -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE Exp aenv e
z () -> () -> ()
forall a b. a -> b -> b
`seq` acc aenv (Array (sh, Int) e) -> ()
NFDataAcc acc
rnfA acc aenv (Array (sh, Int) e)
a
    Permute Fun aenv (e -> e -> e)
f acc aenv (Array sh' e)
d Fun aenv (sh -> PrimMaybe sh')
p acc aenv (Array sh e)
a           -> Fun aenv (e -> e -> e) -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF Fun aenv (e -> e -> e)
f () -> () -> ()
forall a b. a -> b -> b
`seq` acc aenv (Array sh' e) -> ()
NFDataAcc acc
rnfA acc aenv (Array sh' e)
d () -> () -> ()
forall a b. a -> b -> b
`seq` Fun aenv (sh -> PrimMaybe sh') -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF Fun aenv (sh -> PrimMaybe sh')
p () -> () -> ()
forall a b. a -> b -> b
`seq` acc aenv (Array sh e) -> ()
NFDataAcc acc
rnfA acc aenv (Array sh e)
a
    Backpermute ShapeR sh'
shr Exp aenv sh'
sh Fun aenv (sh' -> sh)
f acc aenv (Array sh e)
a    -> ShapeR sh' -> ()
forall sh. ShapeR sh -> ()
rnfShapeR ShapeR sh'
shr () -> () -> ()
forall a b. a -> b -> b
`seq` Exp aenv sh' -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE Exp aenv sh'
sh () -> () -> ()
forall a b. a -> b -> b
`seq` Fun aenv (sh' -> sh) -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF Fun aenv (sh' -> sh)
f () -> () -> ()
forall a b. a -> b -> b
`seq` acc aenv (Array sh e) -> ()
NFDataAcc acc
rnfA acc aenv (Array sh e)
a
    Stencil StencilR sh e stencil
sr TypeR e'
tp Fun aenv (stencil -> e')
f Boundary aenv (Array sh e)
b acc aenv (Array sh e)
a       ->
      let
        TupRsingle (ArrayR ShapeR sh
ShapeR sh
shr TypeR e
_) = acc aenv (Array sh e) -> TupR ArrayR (Array sh e)
forall aenv a. acc aenv a -> ArraysR a
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR acc aenv (Array sh e)
a
        repr :: ArrayR (Array sh e)
repr                      = ShapeR sh -> TypeR e -> ArrayR (Array sh e)
forall sh e. ShapeR sh -> TypeR e -> ArrayR (Array sh e)
ArrayR ShapeR sh
shr (TypeR e -> ArrayR (Array sh e)) -> TypeR e -> ArrayR (Array sh e)
forall a b. (a -> b) -> a -> b
$ StencilR sh e stencil -> TypeR e
forall sh e pat. StencilR sh e pat -> TypeR e
stencilEltR StencilR sh e stencil
sr
      in StencilR sh e stencil -> ()
forall sh e pat. StencilR sh e pat -> ()
rnfStencilR StencilR sh e stencil
sr () -> () -> ()
forall a b. a -> b -> b
`seq` (forall b. ScalarType b -> ()) -> TypeR e' -> ()
forall (s :: * -> *) a. (forall b. s b -> ()) -> TupR s a -> ()
rnfTupR ScalarType b -> ()
forall b. ScalarType b -> ()
rnfScalarType TypeR e'
tp () -> () -> ()
forall a b. a -> b -> b
`seq` Fun aenv (stencil -> e') -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF Fun aenv (stencil -> e')
f () -> () -> ()
forall a b. a -> b -> b
`seq` ArrayR (Array sh e) -> Boundary aenv (Array sh e) -> ()
forall sh e aenv'.
ArrayR (Array sh e) -> Boundary aenv' (Array sh e) -> ()
rnfB ArrayR (Array sh e)
repr Boundary aenv (Array sh e)
b  () -> () -> ()
forall a b. a -> b -> b
`seq` acc aenv (Array sh e) -> ()
NFDataAcc acc
rnfA acc aenv (Array sh e)
a
    Stencil2 StencilR sh a stencil1
sr1 StencilR sh b stencil2
sr2 TypeR c
tp Fun aenv (stencil1 -> stencil2 -> c)
f Boundary aenv (Array sh a)
b1 acc aenv (Array sh a)
a1 Boundary aenv (Array sh b)
b2 acc aenv (Array sh b)
a2 ->
      let
        TupRsingle (ArrayR ShapeR sh
ShapeR sh
shr TypeR e
_) = acc aenv (Array sh a) -> TupR ArrayR (Array sh a)
forall aenv a. acc aenv a -> ArraysR a
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR acc aenv (Array sh a)
a1
        repr1 :: ArrayR (Array sh a)
repr1 = ShapeR sh -> TypeR a -> ArrayR (Array sh a)
forall sh e. ShapeR sh -> TypeR e -> ArrayR (Array sh e)
ArrayR ShapeR sh
shr (TypeR a -> ArrayR (Array sh a)) -> TypeR a -> ArrayR (Array sh a)
forall a b. (a -> b) -> a -> b
$ StencilR sh a stencil1 -> TypeR a
forall sh e pat. StencilR sh e pat -> TypeR e
stencilEltR StencilR sh a stencil1
sr1
        repr2 :: ArrayR (Array sh b)
repr2 = ShapeR sh -> TypeR b -> ArrayR (Array sh b)
forall sh e. ShapeR sh -> TypeR e -> ArrayR (Array sh e)
ArrayR ShapeR sh
shr (TypeR b -> ArrayR (Array sh b)) -> TypeR b -> ArrayR (Array sh b)
forall a b. (a -> b) -> a -> b
$ StencilR sh b stencil2 -> TypeR b
forall sh e pat. StencilR sh e pat -> TypeR e
stencilEltR StencilR sh b stencil2
sr2
      in StencilR sh a stencil1 -> ()
forall sh e pat. StencilR sh e pat -> ()
rnfStencilR StencilR sh a stencil1
sr1 () -> () -> ()
forall a b. a -> b -> b
`seq` StencilR sh b stencil2 -> ()
forall sh e pat. StencilR sh e pat -> ()
rnfStencilR StencilR sh b stencil2
sr2 () -> () -> ()
forall a b. a -> b -> b
`seq` (forall b. ScalarType b -> ()) -> TypeR c -> ()
forall (s :: * -> *) a. (forall b. s b -> ()) -> TupR s a -> ()
rnfTupR ScalarType b -> ()
forall b. ScalarType b -> ()
rnfScalarType TypeR c
tp () -> () -> ()
forall a b. a -> b -> b
`seq` Fun aenv (stencil1 -> stencil2 -> c) -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF Fun aenv (stencil1 -> stencil2 -> c)
f () -> () -> ()
forall a b. a -> b -> b
`seq` ArrayR (Array sh a) -> Boundary aenv (Array sh a) -> ()
forall sh e aenv'.
ArrayR (Array sh e) -> Boundary aenv' (Array sh e) -> ()
rnfB ArrayR (Array sh a)
repr1 Boundary aenv (Array sh a)
b1 () -> () -> ()
forall a b. a -> b -> b
`seq` ArrayR (Array sh b) -> Boundary aenv (Array sh b) -> ()
forall sh e aenv'.
ArrayR (Array sh e) -> Boundary aenv' (Array sh e) -> ()
rnfB ArrayR (Array sh b)
repr2 Boundary aenv (Array sh b)
b2 () -> () -> ()
forall a b. a -> b -> b
`seq` acc aenv (Array sh a) -> ()
NFDataAcc acc
rnfA acc aenv (Array sh a)
a1 () -> () -> ()
forall a b. a -> b -> b
`seq` acc aenv (Array sh b) -> ()
NFDataAcc acc
rnfA acc aenv (Array sh b)
a2

rnfArrayVar :: ArrayVar aenv a -> ()
rnfArrayVar :: forall aenv a. ArrayVar aenv a -> ()
rnfArrayVar = (forall b. ArrayR b -> ()) -> Var ArrayR aenv a -> ()
forall (s :: * -> *) env t.
(forall b. s b -> ()) -> Var s env t -> ()
rnfVar ArrayR b -> ()
forall b. ArrayR b -> ()
rnfArrayR

rnfALeftHandSide :: ALeftHandSide arrs aenv aenv' -> ()
rnfALeftHandSide :: forall arrs aenv aenv'. ALeftHandSide arrs aenv aenv' -> ()
rnfALeftHandSide = (forall b. ArrayR b -> ())
-> LeftHandSide ArrayR arrs aenv aenv' -> ()
forall (s :: * -> *) v env env'.
(forall b. s b -> ()) -> LeftHandSide s v env env' -> ()
rnfLeftHandSide ArrayR b -> ()
forall b. ArrayR b -> ()
rnfArrayR

rnfBoundary :: forall aenv sh e. ArrayR (Array sh e) -> Boundary aenv (Array sh e) -> ()
rnfBoundary :: forall aenv sh e.
ArrayR (Array sh e) -> Boundary aenv (Array sh e) -> ()
rnfBoundary ArrayR (Array sh e)
_             Boundary aenv (Array sh e)
Clamp        = ()
rnfBoundary ArrayR (Array sh e)
_             Boundary aenv (Array sh e)
Mirror       = ()
rnfBoundary ArrayR (Array sh e)
_             Boundary aenv (Array sh e)
Wrap         = ()
rnfBoundary (ArrayR ShapeR sh
_ TypeR e
tR) (Constant e
c) = TypeR e -> e -> ()
forall t. TypeR t -> t -> ()
rnfConst TypeR e
tR e
e
c
rnfBoundary ArrayR (Array sh e)
_             (Function Fun aenv (sh -> e)
f) = Fun aenv (sh -> e) -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfOpenFun Fun aenv (sh -> e)
f

rnfMaybe :: (a -> ()) -> Maybe a -> ()
rnfMaybe :: forall a. (a -> ()) -> Maybe a -> ()
rnfMaybe a -> ()
_ Maybe a
Nothing  = ()
rnfMaybe a -> ()
f (Just a
x) = a -> ()
f a
x

rnfList :: (a -> ()) -> [a] -> ()
rnfList :: forall a. (a -> ()) -> [a] -> ()
rnfList a -> ()
r = [a] -> ()
go
  where
    go :: [a] -> ()
go []     = ()
    go (a
x:[a]
xs) = a -> ()
r a
x () -> () -> ()
forall a b. a -> b -> b
`seq` [a] -> ()
go [a]
xs

rnfOpenFun :: OpenFun env aenv t -> ()
rnfOpenFun :: forall env aenv t. OpenFun env aenv t -> ()
rnfOpenFun (Body OpenExp env aenv t
b)    = OpenExp env aenv t -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfOpenExp OpenExp env aenv t
b
rnfOpenFun (Lam ELeftHandSide a env env'
lhs OpenFun env' aenv t
f) = ELeftHandSide a env env' -> ()
forall t env env'. ELeftHandSide t env env' -> ()
rnfELeftHandSide ELeftHandSide a env env'
lhs () -> () -> ()
forall a b. a -> b -> b
`seq` OpenFun env' aenv t -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfOpenFun OpenFun env' aenv t
f

rnfOpenExp :: forall env aenv t. OpenExp env aenv t -> ()
rnfOpenExp :: forall env aenv t. OpenExp env aenv t -> ()
rnfOpenExp OpenExp env aenv t
topExp =
  let
      rnfF :: OpenFun env' aenv' t' -> ()
      rnfF :: forall env aenv t. OpenFun env aenv t -> ()
rnfF = OpenFun env' aenv' t' -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfOpenFun

      rnfE :: OpenExp env' aenv' t' -> ()
      rnfE :: forall env aenv t. OpenExp env aenv t -> ()
rnfE = OpenExp env' aenv' t' -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfOpenExp
  in
  case OpenExp env aenv t
topExp of
    Let ELeftHandSide bnd_t env env'
lhs OpenExp env aenv bnd_t
bnd OpenExp env' aenv t
body          -> ELeftHandSide bnd_t env env' -> ()
forall t env env'. ELeftHandSide t env env' -> ()
rnfELeftHandSide ELeftHandSide bnd_t env env'
lhs () -> () -> ()
forall a b. a -> b -> b
`seq` OpenExp env aenv bnd_t -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv bnd_t
bnd () -> () -> ()
forall a b. a -> b -> b
`seq` OpenExp env' aenv t -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env' aenv t
body
    Evar ExpVar env t
v                    -> ExpVar env t -> ()
forall env t. ExpVar env t -> ()
rnfExpVar ExpVar env t
v
    Foreign TypeR t
tp asm (x -> t)
asm Fun () (x -> t)
f OpenExp env aenv x
x        -> TypeR t -> ()
forall t. TypeR t -> ()
rnfTypeR TypeR t
tp () -> () -> ()
forall a b. a -> b -> b
`seq` [Char] -> ()
forall a. NFData a => a -> ()
rnf (asm (x -> t) -> [Char]
forall args. asm args -> [Char]
forall (asm :: * -> *) args. Foreign asm => asm args -> [Char]
strForeign asm (x -> t)
asm) () -> () -> ()
forall a b. a -> b -> b
`seq` Fun () (x -> t) -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF Fun () (x -> t)
f () -> () -> ()
forall a b. a -> b -> b
`seq` OpenExp env aenv x -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv x
x
    Const ScalarType t
tp t
c                -> t
c t -> () -> ()
forall a b. a -> b -> b
`seq` ScalarType t -> ()
forall b. ScalarType b -> ()
rnfScalarType ScalarType t
tp -- scalars should have (nf == whnf)
    Undef ScalarType t
tp                  -> ScalarType t -> ()
forall b. ScalarType b -> ()
rnfScalarType ScalarType t
tp
    Pair OpenExp env aenv t1
a OpenExp env aenv t2
b                  -> OpenExp env aenv t1 -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv t1
a () -> () -> ()
forall a b. a -> b -> b
`seq` OpenExp env aenv t2 -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv t2
b
    OpenExp env aenv t
Nil                       -> ()
    VecPack   VecR n s tup
vecr OpenExp env aenv tup
e          -> VecR n s tup -> ()
forall (n :: Nat) single tuple. VecR n single tuple -> ()
rnfVecR VecR n s tup
vecr () -> () -> ()
forall a b. a -> b -> b
`seq` OpenExp env aenv tup -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv tup
e
    VecUnpack VecR n s t
vecr OpenExp env aenv (Vec n s)
e          -> VecR n s t -> ()
forall (n :: Nat) single tuple. VecR n single tuple -> ()
rnfVecR VecR n s t
vecr () -> () -> ()
forall a b. a -> b -> b
`seq` OpenExp env aenv (Vec n s) -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv (Vec n s)
e
    IndexSlice SliceIndex slix t co sh
slice OpenExp env aenv slix
slix OpenExp env aenv sh
sh  -> SliceIndex slix t co sh -> ()
forall ix slice co sh. SliceIndex ix slice co sh -> ()
rnfSliceIndex SliceIndex slix t co sh
slice () -> () -> ()
forall a b. a -> b -> b
`seq` OpenExp env aenv slix -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv slix
slix () -> () -> ()
forall a b. a -> b -> b
`seq` OpenExp env aenv sh -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv sh
sh
    IndexFull SliceIndex slix sl co t
slice OpenExp env aenv slix
slix OpenExp env aenv sl
sl   -> SliceIndex slix sl co t -> ()
forall ix slice co sh. SliceIndex ix slice co sh -> ()
rnfSliceIndex SliceIndex slix sl co t
slice () -> () -> ()
forall a b. a -> b -> b
`seq` OpenExp env aenv slix -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv slix
slix () -> () -> ()
forall a b. a -> b -> b
`seq` OpenExp env aenv sl -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv sl
sl
    ToIndex ShapeR sh
shr OpenExp env aenv sh
sh OpenExp env aenv sh
ix         -> ShapeR sh -> ()
forall sh. ShapeR sh -> ()
rnfShapeR ShapeR sh
shr () -> () -> ()
forall a b. a -> b -> b
`seq` OpenExp env aenv sh -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv sh
sh () -> () -> ()
forall a b. a -> b -> b
`seq` OpenExp env aenv sh -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv sh
ix
    FromIndex ShapeR t
shr OpenExp env aenv t
sh OpenExp env aenv Int
ix       -> ShapeR t -> ()
forall sh. ShapeR sh -> ()
rnfShapeR ShapeR t
shr () -> () -> ()
forall a b. a -> b -> b
`seq` OpenExp env aenv t -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv t
sh () -> () -> ()
forall a b. a -> b -> b
`seq` OpenExp env aenv Int -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv Int
ix
    Case OpenExp env aenv PrimBool
e [(PrimBool, OpenExp env aenv t)]
rhs Maybe (OpenExp env aenv t)
def            -> OpenExp env aenv PrimBool -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv PrimBool
e () -> () -> ()
forall a b. a -> b -> b
`seq` ((PrimBool, OpenExp env aenv t) -> ())
-> [(PrimBool, OpenExp env aenv t)] -> ()
forall a. (a -> ()) -> [a] -> ()
rnfList (\(PrimBool
t,OpenExp env aenv t
c) -> PrimBool
t PrimBool -> () -> ()
forall a b. a -> b -> b
`seq` OpenExp env aenv t -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv t
c) [(PrimBool, OpenExp env aenv t)]
rhs () -> () -> ()
forall a b. a -> b -> b
`seq` (OpenExp env aenv t -> ()) -> Maybe (OpenExp env aenv t) -> ()
forall a. (a -> ()) -> Maybe a -> ()
rnfMaybe OpenExp env aenv t -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE Maybe (OpenExp env aenv t)
def
    Cond OpenExp env aenv PrimBool
p OpenExp env aenv t
e1 OpenExp env aenv t
e2              -> OpenExp env aenv PrimBool -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv PrimBool
p () -> () -> ()
forall a b. a -> b -> b
`seq` OpenExp env aenv t -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv t
e1 () -> () -> ()
forall a b. a -> b -> b
`seq` OpenExp env aenv t -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv t
e2
    While OpenFun env aenv (t -> PrimBool)
p OpenFun env aenv (t -> t)
f OpenExp env aenv t
x               -> OpenFun env aenv (t -> PrimBool) -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF OpenFun env aenv (t -> PrimBool)
p () -> () -> ()
forall a b. a -> b -> b
`seq` OpenFun env aenv (t -> t) -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF OpenFun env aenv (t -> t)
f () -> () -> ()
forall a b. a -> b -> b
`seq` OpenExp env aenv t -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv t
x
    PrimConst PrimConst t
c               -> PrimConst t -> ()
forall c. PrimConst c -> ()
rnfPrimConst PrimConst t
c
    PrimApp PrimFun (a -> t)
f OpenExp env aenv a
x               -> PrimFun (a -> t) -> ()
forall f. PrimFun f -> ()
rnfPrimFun PrimFun (a -> t)
f () -> () -> ()
forall a b. a -> b -> b
`seq` OpenExp env aenv a -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv a
x
    Index ArrayVar aenv (Array dim t)
a OpenExp env aenv dim
ix                -> ArrayVar aenv (Array dim t) -> ()
forall aenv a. ArrayVar aenv a -> ()
rnfArrayVar ArrayVar aenv (Array dim t)
a () -> () -> ()
forall a b. a -> b -> b
`seq` OpenExp env aenv dim -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv dim
ix
    LinearIndex ArrayVar aenv (Array dim t)
a OpenExp env aenv Int
ix          -> ArrayVar aenv (Array dim t) -> ()
forall aenv a. ArrayVar aenv a -> ()
rnfArrayVar ArrayVar aenv (Array dim t)
a () -> () -> ()
forall a b. a -> b -> b
`seq` OpenExp env aenv Int -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv Int
ix
    Shape ArrayVar aenv (Array t e)
a                   -> ArrayVar aenv (Array t e) -> ()
forall aenv a. ArrayVar aenv a -> ()
rnfArrayVar ArrayVar aenv (Array t e)
a
    ShapeSize ShapeR dim
shr OpenExp env aenv dim
sh          -> ShapeR dim -> ()
forall sh. ShapeR sh -> ()
rnfShapeR ShapeR dim
shr () -> () -> ()
forall a b. a -> b -> b
`seq` OpenExp env aenv dim -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv dim
sh
    Coerce ScalarType a
t1 ScalarType t
t2 OpenExp env aenv a
e            -> ScalarType a -> ()
forall b. ScalarType b -> ()
rnfScalarType ScalarType a
t1 () -> () -> ()
forall a b. a -> b -> b
`seq` ScalarType t -> ()
forall b. ScalarType b -> ()
rnfScalarType ScalarType t
t2 () -> () -> ()
forall a b. a -> b -> b
`seq` OpenExp env aenv a -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv a
e

rnfExpVar :: ExpVar env t -> ()
rnfExpVar :: forall env t. ExpVar env t -> ()
rnfExpVar = (forall b. ScalarType b -> ()) -> Var ScalarType env t -> ()
forall (s :: * -> *) env t.
(forall b. s b -> ()) -> Var s env t -> ()
rnfVar ScalarType b -> ()
forall b. ScalarType b -> ()
rnfScalarType

rnfELeftHandSide :: ELeftHandSide t env env' -> ()
rnfELeftHandSide :: forall t env env'. ELeftHandSide t env env' -> ()
rnfELeftHandSide= (forall b. ScalarType b -> ())
-> LeftHandSide ScalarType t env env' -> ()
forall (s :: * -> *) v env env'.
(forall b. s b -> ()) -> LeftHandSide s v env env' -> ()
rnfLeftHandSide ScalarType b -> ()
forall b. ScalarType b -> ()
rnfScalarType

rnfConst :: TypeR t -> t -> ()
rnfConst :: forall t. TypeR t -> t -> ()
rnfConst TupR ScalarType t
TupRunit          ()    = ()
rnfConst (TupRsingle ScalarType t
t)    !t
_    = ScalarType t -> ()
forall b. ScalarType b -> ()
rnfScalarType ScalarType t
t  -- scalars should have (nf == whnf)
rnfConst (TupRpair TupR ScalarType a1
ta TupR ScalarType b
tb)  (a1
a,b
b) = TupR ScalarType a1 -> a1 -> ()
forall t. TypeR t -> t -> ()
rnfConst TupR ScalarType a1
ta a1
a () -> () -> ()
forall a b. a -> b -> b
`seq` TupR ScalarType b -> b -> ()
forall t. TypeR t -> t -> ()
rnfConst TupR ScalarType b
tb b
b

rnfPrimConst :: PrimConst c -> ()
rnfPrimConst :: forall c. PrimConst c -> ()
rnfPrimConst (PrimMinBound BoundedType c
t) = BoundedType c -> ()
forall t. BoundedType t -> ()
rnfBoundedType BoundedType c
t
rnfPrimConst (PrimMaxBound BoundedType c
t) = BoundedType c -> ()
forall t. BoundedType t -> ()
rnfBoundedType BoundedType c
t
rnfPrimConst (PrimPi FloatingType c
t)       = FloatingType c -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType c
t

rnfPrimFun :: PrimFun f -> ()
rnfPrimFun :: forall f. PrimFun f -> ()
rnfPrimFun (PrimAdd NumType a
t)                = NumType a -> ()
forall t. NumType t -> ()
rnfNumType NumType a
t
rnfPrimFun (PrimSub NumType a
t)                = NumType a -> ()
forall t. NumType t -> ()
rnfNumType NumType a
t
rnfPrimFun (PrimMul NumType a
t)                = NumType a -> ()
forall t. NumType t -> ()
rnfNumType NumType a
t
rnfPrimFun (PrimNeg NumType a
t)                = NumType a -> ()
forall t. NumType t -> ()
rnfNumType NumType a
t
rnfPrimFun (PrimAbs NumType a
t)                = NumType a -> ()
forall t. NumType t -> ()
rnfNumType NumType a
t
rnfPrimFun (PrimSig NumType a
t)                = NumType a -> ()
forall t. NumType t -> ()
rnfNumType NumType a
t
rnfPrimFun (PrimQuot IntegralType a
t)               = IntegralType a -> ()
forall t. IntegralType t -> ()
rnfIntegralType IntegralType a
t
rnfPrimFun (PrimRem IntegralType a
t)                = IntegralType a -> ()
forall t. IntegralType t -> ()
rnfIntegralType IntegralType a
t
rnfPrimFun (PrimQuotRem IntegralType a
t)            = IntegralType a -> ()
forall t. IntegralType t -> ()
rnfIntegralType IntegralType a
t
rnfPrimFun (PrimIDiv IntegralType a
t)               = IntegralType a -> ()
forall t. IntegralType t -> ()
rnfIntegralType IntegralType a
t
rnfPrimFun (PrimMod IntegralType a
t)                = IntegralType a -> ()
forall t. IntegralType t -> ()
rnfIntegralType IntegralType a
t
rnfPrimFun (PrimDivMod IntegralType a
t)             = IntegralType a -> ()
forall t. IntegralType t -> ()
rnfIntegralType IntegralType a
t
rnfPrimFun (PrimBAnd IntegralType a
t)               = IntegralType a -> ()
forall t. IntegralType t -> ()
rnfIntegralType IntegralType a
t
rnfPrimFun (PrimBOr IntegralType a
t)                = IntegralType a -> ()
forall t. IntegralType t -> ()
rnfIntegralType IntegralType a
t
rnfPrimFun (PrimBXor IntegralType a
t)               = IntegralType a -> ()
forall t. IntegralType t -> ()
rnfIntegralType IntegralType a
t
rnfPrimFun (PrimBNot IntegralType a
t)               = IntegralType a -> ()
forall t. IntegralType t -> ()
rnfIntegralType IntegralType a
t
rnfPrimFun (PrimBShiftL IntegralType a
t)            = IntegralType a -> ()
forall t. IntegralType t -> ()
rnfIntegralType IntegralType a
t
rnfPrimFun (PrimBShiftR IntegralType a
t)            = IntegralType a -> ()
forall t. IntegralType t -> ()
rnfIntegralType IntegralType a
t
rnfPrimFun (PrimBRotateL IntegralType a
t)           = IntegralType a -> ()
forall t. IntegralType t -> ()
rnfIntegralType IntegralType a
t
rnfPrimFun (PrimBRotateR IntegralType a
t)           = IntegralType a -> ()
forall t. IntegralType t -> ()
rnfIntegralType IntegralType a
t
rnfPrimFun (PrimPopCount IntegralType a
t)           = IntegralType a -> ()
forall t. IntegralType t -> ()
rnfIntegralType IntegralType a
t
rnfPrimFun (PrimCountLeadingZeros IntegralType a
t)  = IntegralType a -> ()
forall t. IntegralType t -> ()
rnfIntegralType IntegralType a
t
rnfPrimFun (PrimCountTrailingZeros IntegralType a
t) = IntegralType a -> ()
forall t. IntegralType t -> ()
rnfIntegralType IntegralType a
t
rnfPrimFun (PrimFDiv FloatingType a
t)               = FloatingType a -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType a
t
rnfPrimFun (PrimRecip FloatingType a
t)              = FloatingType a -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType a
t
rnfPrimFun (PrimSin FloatingType a
t)                = FloatingType a -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType a
t
rnfPrimFun (PrimCos FloatingType a
t)                = FloatingType a -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType a
t
rnfPrimFun (PrimTan FloatingType a
t)                = FloatingType a -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType a
t
rnfPrimFun (PrimAsin FloatingType a
t)               = FloatingType a -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType a
t
rnfPrimFun (PrimAcos FloatingType a
t)               = FloatingType a -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType a
t
rnfPrimFun (PrimAtan FloatingType a
t)               = FloatingType a -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType a
t
rnfPrimFun (PrimSinh FloatingType a
t)               = FloatingType a -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType a
t
rnfPrimFun (PrimCosh FloatingType a
t)               = FloatingType a -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType a
t
rnfPrimFun (PrimTanh FloatingType a
t)               = FloatingType a -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType a
t
rnfPrimFun (PrimAsinh FloatingType a
t)              = FloatingType a -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType a
t
rnfPrimFun (PrimAcosh FloatingType a
t)              = FloatingType a -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType a
t
rnfPrimFun (PrimAtanh FloatingType a
t)              = FloatingType a -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType a
t
rnfPrimFun (PrimExpFloating FloatingType a
t)        = FloatingType a -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType a
t
rnfPrimFun (PrimSqrt FloatingType a
t)               = FloatingType a -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType a
t
rnfPrimFun (PrimLog FloatingType a
t)                = FloatingType a -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType a
t
rnfPrimFun (PrimFPow FloatingType a
t)               = FloatingType a -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType a
t
rnfPrimFun (PrimLogBase FloatingType a
t)            = FloatingType a -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType a
t
rnfPrimFun (PrimTruncate FloatingType a
f IntegralType b
i)         = FloatingType a -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType a
f () -> () -> ()
forall a b. a -> b -> b
`seq` IntegralType b -> ()
forall t. IntegralType t -> ()
rnfIntegralType IntegralType b
i
rnfPrimFun (PrimRound FloatingType a
f IntegralType b
i)            = FloatingType a -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType a
f () -> () -> ()
forall a b. a -> b -> b
`seq` IntegralType b -> ()
forall t. IntegralType t -> ()
rnfIntegralType IntegralType b
i
rnfPrimFun (PrimFloor FloatingType a
f IntegralType b
i)            = FloatingType a -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType a
f () -> () -> ()
forall a b. a -> b -> b
`seq` IntegralType b -> ()
forall t. IntegralType t -> ()
rnfIntegralType IntegralType b
i
rnfPrimFun (PrimCeiling FloatingType a
f IntegralType b
i)          = FloatingType a -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType a
f () -> () -> ()
forall a b. a -> b -> b
`seq` IntegralType b -> ()
forall t. IntegralType t -> ()
rnfIntegralType IntegralType b
i
rnfPrimFun (PrimIsNaN FloatingType a
t)              = FloatingType a -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType a
t
rnfPrimFun (PrimIsInfinite FloatingType a
t)         = FloatingType a -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType a
t
rnfPrimFun (PrimAtan2 FloatingType a
t)              = FloatingType a -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType a
t
rnfPrimFun (PrimLt SingleType a
t)                 = SingleType a -> ()
forall t. SingleType t -> ()
rnfSingleType SingleType a
t
rnfPrimFun (PrimGt SingleType a
t)                 = SingleType a -> ()
forall t. SingleType t -> ()
rnfSingleType SingleType a
t
rnfPrimFun (PrimLtEq SingleType a
t)               = SingleType a -> ()
forall t. SingleType t -> ()
rnfSingleType SingleType a
t
rnfPrimFun (PrimGtEq SingleType a
t)               = SingleType a -> ()
forall t. SingleType t -> ()
rnfSingleType SingleType a
t
rnfPrimFun (PrimEq SingleType a
t)                 = SingleType a -> ()
forall t. SingleType t -> ()
rnfSingleType SingleType a
t
rnfPrimFun (PrimNEq SingleType a
t)                = SingleType a -> ()
forall t. SingleType t -> ()
rnfSingleType SingleType a
t
rnfPrimFun (PrimMax SingleType a
t)                = SingleType a -> ()
forall t. SingleType t -> ()
rnfSingleType SingleType a
t
rnfPrimFun (PrimMin SingleType a
t)                = SingleType a -> ()
forall t. SingleType t -> ()
rnfSingleType SingleType a
t
rnfPrimFun PrimFun f
PrimLAnd                   = ()
rnfPrimFun PrimFun f
PrimLOr                    = ()
rnfPrimFun PrimFun f
PrimLNot                   = ()
rnfPrimFun (PrimFromIntegral IntegralType a
i NumType b
n)     = IntegralType a -> ()
forall t. IntegralType t -> ()
rnfIntegralType IntegralType a
i () -> () -> ()
forall a b. a -> b -> b
`seq` NumType b -> ()
forall t. NumType t -> ()
rnfNumType NumType b
n
rnfPrimFun (PrimToFloating NumType a
n FloatingType b
f)       = NumType a -> ()
forall t. NumType t -> ()
rnfNumType NumType a
n () -> () -> ()
forall a b. a -> b -> b
`seq` FloatingType b -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType b
f


-- Template Haskell
-- ================

type LiftAcc acc = forall aenv a. acc aenv a -> CodeQ (acc aenv a)

liftPreOpenAfun :: LiftAcc acc -> PreOpenAfun acc aenv t -> CodeQ (PreOpenAfun acc aenv t)
liftPreOpenAfun :: forall (acc :: * -> * -> *) aenv t.
LiftAcc acc
-> PreOpenAfun acc aenv t -> CodeQ (PreOpenAfun acc aenv t)
liftPreOpenAfun LiftAcc acc
liftA (Alam ALeftHandSide a aenv aenv'
lhs PreOpenAfun acc aenv' t
f) = [|| ALeftHandSide a aenv aenv'
-> PreOpenAfun acc aenv' t -> PreOpenAfun acc aenv (a -> t)
forall a aenv b (acc :: * -> * -> *) co.
ALeftHandSide a aenv b
-> PreOpenAfun acc b co -> PreOpenAfun acc aenv (a -> co)
Alam $$(ALeftHandSide a aenv aenv' -> CodeQ (ALeftHandSide a aenv aenv')
forall arrs aenv aenv'.
ALeftHandSide arrs aenv aenv'
-> CodeQ (ALeftHandSide arrs aenv aenv')
liftALeftHandSide ALeftHandSide a aenv aenv'
lhs) $$(LiftAcc acc
-> PreOpenAfun acc aenv' t -> CodeQ (PreOpenAfun acc aenv' t)
forall (acc :: * -> * -> *) aenv t.
LiftAcc acc
-> PreOpenAfun acc aenv t -> CodeQ (PreOpenAfun acc aenv t)
liftPreOpenAfun acc aenv a -> CodeQ (acc aenv a)
LiftAcc acc
liftA PreOpenAfun acc aenv' t
f) ||]
liftPreOpenAfun LiftAcc acc
liftA (Abody acc aenv t
b)    = [|| acc aenv t -> PreOpenAfun acc aenv t
forall (acc :: * -> * -> *) aenv t.
acc aenv t -> PreOpenAfun acc aenv t
Abody $$(acc aenv t -> CodeQ (acc aenv t)
LiftAcc acc
liftA acc aenv t
b) ||]

liftPreOpenAcc
    :: forall acc aenv a.
       HasArraysR acc
    => LiftAcc acc
    -> PreOpenAcc acc aenv a
    -> CodeQ (PreOpenAcc acc aenv a)
liftPreOpenAcc :: forall (acc :: * -> * -> *) aenv a.
HasArraysR acc =>
LiftAcc acc
-> PreOpenAcc acc aenv a -> CodeQ (PreOpenAcc acc aenv a)
liftPreOpenAcc LiftAcc acc
liftA PreOpenAcc acc aenv a
pacc =
  let
      liftE :: OpenExp env aenv t -> CodeQ (OpenExp env aenv t)
      liftE :: forall env t. OpenExp env aenv t -> CodeQ (OpenExp env aenv t)
liftE = OpenExp env aenv t -> CodeQ (OpenExp env aenv t)
forall env aenv t. OpenExp env aenv t -> CodeQ (OpenExp env aenv t)
liftOpenExp

      liftF :: OpenFun env aenv t -> CodeQ (OpenFun env aenv t)
      liftF :: forall env t. OpenFun env aenv t -> CodeQ (OpenFun env aenv t)
liftF = OpenFun env aenv t -> CodeQ (OpenFun env aenv t)
forall env aenv t. OpenFun env aenv t -> CodeQ (OpenFun env aenv t)
liftOpenFun

      liftAF :: PreOpenAfun acc aenv f -> CodeQ (PreOpenAfun acc aenv f)
      liftAF :: forall f. PreOpenAfun acc aenv f -> CodeQ (PreOpenAfun acc aenv f)
liftAF = LiftAcc acc
-> PreOpenAfun acc aenv f -> CodeQ (PreOpenAfun acc aenv f)
forall (acc :: * -> * -> *) aenv t.
LiftAcc acc
-> PreOpenAfun acc aenv t -> CodeQ (PreOpenAfun acc aenv t)
liftPreOpenAfun acc aenv a -> CodeQ (acc aenv a)
LiftAcc acc
liftA

      liftB :: ArrayR (Array sh e) -> Boundary aenv (Array sh e) -> CodeQ (Boundary aenv (Array sh e))
      liftB :: forall sh e.
ArrayR (Array sh e)
-> Boundary aenv (Array sh e) -> CodeQ (Boundary aenv (Array sh e))
liftB = ArrayR (Array sh e)
-> Boundary aenv (Array sh e) -> CodeQ (Boundary aenv (Array sh e))
forall aenv sh e.
ArrayR (Array sh e)
-> Boundary aenv (Array sh e) -> CodeQ (Boundary aenv (Array sh e))
liftBoundary
  in
  case PreOpenAcc acc aenv a
pacc of
    Alet ALeftHandSide bndArrs aenv aenv'
lhs acc aenv bndArrs
bnd acc aenv' a
body         -> [|| ALeftHandSide bndArrs aenv aenv'
-> acc aenv bndArrs
-> acc aenv' bodyArrs
-> PreOpenAcc acc aenv bodyArrs
forall a aenv b (acc :: * -> * -> *) bodyArrs.
ALeftHandSide a aenv b
-> acc aenv a -> acc b bodyArrs -> PreOpenAcc acc aenv bodyArrs
Alet $$(ALeftHandSide bndArrs aenv aenv'
-> CodeQ (ALeftHandSide bndArrs aenv aenv')
forall arrs aenv aenv'.
ALeftHandSide arrs aenv aenv'
-> CodeQ (ALeftHandSide arrs aenv aenv')
liftALeftHandSide ALeftHandSide bndArrs aenv aenv'
lhs) $$(acc aenv bndArrs -> CodeQ (acc aenv bndArrs)
LiftAcc acc
liftA acc aenv bndArrs
bnd) $$(acc aenv' a -> CodeQ (acc aenv' a)
LiftAcc acc
liftA acc aenv' a
body) ||]
    Avar ArrayVar aenv (Array sh e)
var                  -> [|| ArrayVar aenv (Array sh e) -> PreOpenAcc acc aenv (Array sh e)
forall aenv a b (acc :: * -> * -> *).
ArrayVar aenv (Array a b) -> PreOpenAcc acc aenv (Array a b)
Avar $$(ArrayVar aenv (Array sh e) -> CodeQ (ArrayVar aenv (Array sh e))
forall aenv a. ArrayVar aenv a -> CodeQ (ArrayVar aenv a)
liftArrayVar ArrayVar aenv (Array sh e)
var) ||]
    Apair acc aenv as
as acc aenv bs
bs               -> [|| acc aenv as -> acc aenv bs -> PreOpenAcc acc aenv (as, bs)
forall (acc :: * -> * -> *) aenv a b.
acc aenv a -> acc aenv b -> PreOpenAcc acc aenv (a, b)
Apair $$(acc aenv as -> CodeQ (acc aenv as)
LiftAcc acc
liftA acc aenv as
as) $$(acc aenv bs -> CodeQ (acc aenv bs)
LiftAcc acc
liftA acc aenv bs
bs) ||]
    PreOpenAcc acc aenv a
Anil                      -> [|| PreOpenAcc acc aenv ()
forall (acc :: * -> * -> *) aenv. PreOpenAcc acc aenv ()
Anil ||]
    Atrace Message arrs1
msg acc aenv arrs1
as acc aenv a
bs          -> [|| Message arrs1
-> acc aenv arrs1 -> acc aenv arrs2 -> PreOpenAcc acc aenv arrs2
forall a (acc :: * -> * -> *) aenv arrs2.
Message a
-> acc aenv a -> acc aenv arrs2 -> PreOpenAcc acc aenv arrs2
Atrace $$(ArraysR arrs1 -> Message arrs1 -> CodeQ (Message arrs1)
forall a. ArraysR a -> Message a -> CodeQ (Message a)
liftMessage (acc aenv arrs1 -> ArraysR arrs1
forall aenv a. acc aenv a -> ArraysR a
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR acc aenv arrs1
as) Message arrs1
msg) $$(acc aenv arrs1 -> CodeQ (acc aenv arrs1)
LiftAcc acc
liftA acc aenv arrs1
as) $$(acc aenv a -> CodeQ (acc aenv a)
LiftAcc acc
liftA acc aenv a
bs) ||]
    Apply ArraysR a
repr PreOpenAfun acc aenv (arrs1 -> a)
f acc aenv arrs1
a            -> [|| ArraysR arrs2
-> PreOpenAfun acc aenv (arrs1 -> arrs2)
-> acc aenv arrs1
-> PreOpenAcc acc aenv arrs2
forall arrs2 (acc :: * -> * -> *) aenv a.
ArraysR arrs2
-> PreOpenAfun acc aenv (a -> arrs2)
-> acc aenv a
-> PreOpenAcc acc aenv arrs2
Apply $$(ArraysR a -> CodeQ (ArraysR a)
forall arrs. ArraysR arrs -> CodeQ (ArraysR arrs)
liftArraysR ArraysR a
repr) $$(PreOpenAfun acc aenv (arrs1 -> a)
-> CodeQ (PreOpenAfun acc aenv (arrs1 -> a))
forall f. PreOpenAfun acc aenv f -> CodeQ (PreOpenAfun acc aenv f)
liftAF PreOpenAfun acc aenv (arrs1 -> a)
f) $$(acc aenv arrs1 -> CodeQ (acc aenv arrs1)
LiftAcc acc
liftA acc aenv arrs1
a) ||]
    Aforeign ArraysR a
repr asm (as -> a)
asm PreAfun acc (as -> a)
f acc aenv as
a     -> [|| ArraysR bs
-> asm (as -> bs)
-> PreAfun acc (as -> bs)
-> acc aenv as
-> PreOpenAcc acc aenv bs
forall (a :: * -> *) bs b (acc :: * -> * -> *) aenv.
Foreign a =>
ArraysR bs
-> a (b -> bs)
-> PreAfun acc (b -> bs)
-> acc aenv b
-> PreOpenAcc acc aenv bs
Aforeign $$(ArraysR a -> CodeQ (ArraysR a)
forall arrs. ArraysR arrs -> CodeQ (ArraysR arrs)
liftArraysR ArraysR a
repr) $$(asm (as -> a) -> CodeQ (asm (as -> a))
forall args. HasCallStack => asm args -> CodeQ (asm args)
forall (asm :: * -> *) args.
(Foreign asm, HasCallStack) =>
asm args -> CodeQ (asm args)
liftForeign asm (as -> a)
asm) $$(LiftAcc acc
-> PreAfun acc (as -> a) -> CodeQ (PreAfun acc (as -> a))
forall (acc :: * -> * -> *) aenv t.
LiftAcc acc
-> PreOpenAfun acc aenv t -> CodeQ (PreOpenAfun acc aenv t)
liftPreOpenAfun acc aenv a -> CodeQ (acc aenv a)
LiftAcc acc
liftA PreAfun acc (as -> a)
f) $$(acc aenv as -> CodeQ (acc aenv as)
LiftAcc acc
liftA acc aenv as
a) ||]
    Acond Exp aenv PrimBool
p acc aenv a
t acc aenv a
e               -> [|| Exp aenv PrimBool
-> acc aenv arrs -> acc aenv arrs -> PreOpenAcc acc aenv arrs
forall aenv (acc :: * -> * -> *) arrs.
Exp aenv PrimBool
-> acc aenv arrs -> acc aenv arrs -> PreOpenAcc acc aenv arrs
Acond $$(Exp aenv PrimBool -> CodeQ (Exp aenv PrimBool)
forall env t. OpenExp env aenv t -> CodeQ (OpenExp env aenv t)
liftE Exp aenv PrimBool
p) $$(acc aenv a -> CodeQ (acc aenv a)
LiftAcc acc
liftA acc aenv a
t) $$(acc aenv a -> CodeQ (acc aenv a)
LiftAcc acc
liftA acc aenv a
e) ||]
    Awhile PreOpenAfun acc aenv (a -> Scalar PrimBool)
p PreOpenAfun acc aenv (a -> a)
f acc aenv a
a              -> [|| PreOpenAfun acc aenv (arrs -> Scalar PrimBool)
-> PreOpenAfun acc aenv (arrs -> arrs)
-> acc aenv arrs
-> PreOpenAcc acc aenv arrs
forall (acc :: * -> * -> *) aenv arrs.
PreOpenAfun acc aenv (arrs -> Scalar PrimBool)
-> PreOpenAfun acc aenv (arrs -> arrs)
-> acc aenv arrs
-> PreOpenAcc acc aenv arrs
Awhile $$(PreOpenAfun acc aenv (a -> Scalar PrimBool)
-> CodeQ (PreOpenAfun acc aenv (a -> Scalar PrimBool))
forall f. PreOpenAfun acc aenv f -> CodeQ (PreOpenAfun acc aenv f)
liftAF PreOpenAfun acc aenv (a -> Scalar PrimBool)
p) $$(PreOpenAfun acc aenv (a -> a)
-> CodeQ (PreOpenAfun acc aenv (a -> a))
forall f. PreOpenAfun acc aenv f -> CodeQ (PreOpenAfun acc aenv f)
liftAF PreOpenAfun acc aenv (a -> a)
f) $$(acc aenv a -> CodeQ (acc aenv a)
LiftAcc acc
liftA acc aenv a
a) ||]
    Use ArrayR (Array sh e)
repr Array sh e
a                -> [|| ArrayR (Array sh e)
-> Array sh e -> PreOpenAcc acc aenv (Array sh e)
forall a b (acc :: * -> * -> *) aenv.
ArrayR (Array a b) -> Array a b -> PreOpenAcc acc aenv (Array a b)
Use $$(ArrayR (Array sh e) -> CodeQ (ArrayR (Array sh e))
forall a. ArrayR a -> CodeQ (ArrayR a)
liftArrayR ArrayR (Array sh e)
repr) $$(ArrayR (Array sh e) -> Array sh e -> CodeQ (Array sh e)
forall sh e.
ArrayR (Array sh e) -> Array sh e -> CodeQ (Array sh e)
liftArray ArrayR (Array sh e)
repr Array sh e
a) ||]
    Unit TypeR e
tp Exp aenv e
e                 -> [|| TypeR e -> Exp aenv e -> PreOpenAcc acc aenv (Scalar e)
forall a aenv (acc :: * -> * -> *).
TypeR a -> Exp aenv a -> PreOpenAcc acc aenv (Scalar a)
Unit $$(TypeR e -> CodeQ (TypeR e)
forall t. TypeR t -> CodeQ (TypeR t)
liftTypeR TypeR e
tp) $$(Exp aenv e -> CodeQ (Exp aenv e)
forall env t. OpenExp env aenv t -> CodeQ (OpenExp env aenv t)
liftE Exp aenv e
e) ||]
    Reshape ShapeR sh
shr Exp aenv sh
sh acc aenv (Array sh' e)
a          -> [|| ShapeR sh
-> Exp aenv sh
-> acc aenv (Array sh' e)
-> PreOpenAcc acc aenv (Array sh e)
forall a aenv (acc :: * -> * -> *) b co.
ShapeR a
-> Exp aenv a
-> acc aenv (Array b co)
-> PreOpenAcc acc aenv (Array a co)
Reshape $$(ShapeR sh -> CodeQ (ShapeR sh)
forall sh. ShapeR sh -> CodeQ (ShapeR sh)
liftShapeR ShapeR sh
shr) $$(Exp aenv sh -> CodeQ (Exp aenv sh)
forall env t. OpenExp env aenv t -> CodeQ (OpenExp env aenv t)
liftE Exp aenv sh
sh) $$(acc aenv (Array sh' e) -> CodeQ (acc aenv (Array sh' e))
LiftAcc acc
liftA acc aenv (Array sh' e)
a) ||]
    Generate ArrayR (Array sh e)
repr Exp aenv sh
sh Fun aenv (sh -> e)
f        -> [|| ArrayR (Array sh e)
-> Exp aenv sh
-> Fun aenv (sh -> e)
-> PreOpenAcc acc aenv (Array sh e)
forall a b aenv (acc :: * -> * -> *).
ArrayR (Array a b)
-> Exp aenv a
-> Fun aenv (a -> b)
-> PreOpenAcc acc aenv (Array a b)
Generate $$(ArrayR (Array sh e) -> CodeQ (ArrayR (Array sh e))
forall a. ArrayR a -> CodeQ (ArrayR a)
liftArrayR ArrayR (Array sh e)
repr) $$(Exp aenv sh -> CodeQ (Exp aenv sh)
forall env t. OpenExp env aenv t -> CodeQ (OpenExp env aenv t)
liftE Exp aenv sh
sh) $$(Fun aenv (sh -> e) -> CodeQ (Fun aenv (sh -> e))
forall env t. OpenFun env aenv t -> CodeQ (OpenFun env aenv t)
liftF Fun aenv (sh -> e)
f) ||]
    Transform ArrayR (Array sh' b)
repr Exp aenv sh'
sh Fun aenv (sh' -> sh)
p Fun aenv (a -> b)
f acc aenv (Array sh a)
a   -> [|| ArrayR (Array sh' b)
-> Exp aenv sh'
-> Fun aenv (sh' -> sh)
-> Fun aenv (a -> b)
-> acc aenv (Array sh a)
-> PreOpenAcc acc aenv (Array sh' b)
forall a b aenv co b (acc :: * -> * -> *).
ArrayR (Array a b)
-> Exp aenv a
-> Fun aenv (a -> co)
-> Fun aenv (b -> b)
-> acc aenv (Array co b)
-> PreOpenAcc acc aenv (Array a b)
Transform $$(ArrayR (Array sh' b) -> CodeQ (ArrayR (Array sh' b))
forall a. ArrayR a -> CodeQ (ArrayR a)
liftArrayR ArrayR (Array sh' b)
repr) $$(Exp aenv sh' -> CodeQ (Exp aenv sh')
forall env t. OpenExp env aenv t -> CodeQ (OpenExp env aenv t)
liftE Exp aenv sh'
sh) $$(Fun aenv (sh' -> sh) -> CodeQ (Fun aenv (sh' -> sh))
forall env t. OpenFun env aenv t -> CodeQ (OpenFun env aenv t)
liftF Fun aenv (sh' -> sh)
p) $$(Fun aenv (a -> b) -> CodeQ (Fun aenv (a -> b))
forall env t. OpenFun env aenv t -> CodeQ (OpenFun env aenv t)
liftF Fun aenv (a -> b)
f) $$(acc aenv (Array sh a) -> CodeQ (acc aenv (Array sh a))
LiftAcc acc
liftA acc aenv (Array sh a)
a) ||]
    Replicate SliceIndex slix sl co sh
slix Exp aenv slix
sl acc aenv (Array sl e)
a       -> [|| SliceIndex slix sl co sh
-> Exp aenv slix
-> acc aenv (Array sl e)
-> PreOpenAcc acc aenv (Array sh e)
forall a b co b aenv (acc :: * -> * -> *) stencil2.
SliceIndex a b co b
-> Exp aenv a
-> acc aenv (Array b stencil2)
-> PreOpenAcc acc aenv (Array b stencil2)
Replicate $$(SliceIndex slix sl co sh -> CodeQ (SliceIndex slix sl co sh)
forall ix slice co sh.
SliceIndex ix slice co sh -> CodeQ (SliceIndex ix slice co sh)
liftSliceIndex SliceIndex slix sl co sh
slix) $$(Exp aenv slix -> CodeQ (Exp aenv slix)
forall env t. OpenExp env aenv t -> CodeQ (OpenExp env aenv t)
liftE Exp aenv slix
sl) $$(acc aenv (Array sl e) -> CodeQ (acc aenv (Array sl e))
LiftAcc acc
liftA acc aenv (Array sl e)
a) ||]
    Slice SliceIndex slix sl co sh
slix acc aenv (Array sh e)
a Exp aenv slix
sh           -> [|| SliceIndex slix sl co sh
-> acc aenv (Array sh e)
-> Exp aenv slix
-> PreOpenAcc acc aenv (Array sl e)
forall a b co b (acc :: * -> * -> *) aenv stencil2.
SliceIndex a b co b
-> acc aenv (Array b stencil2)
-> Exp aenv a
-> PreOpenAcc acc aenv (Array b stencil2)
Slice $$(SliceIndex slix sl co sh -> CodeQ (SliceIndex slix sl co sh)
forall ix slice co sh.
SliceIndex ix slice co sh -> CodeQ (SliceIndex ix slice co sh)
liftSliceIndex SliceIndex slix sl co sh
slix) $$(acc aenv (Array sh e) -> CodeQ (acc aenv (Array sh e))
LiftAcc acc
liftA acc aenv (Array sh e)
a) $$(Exp aenv slix -> CodeQ (Exp aenv slix)
forall env t. OpenExp env aenv t -> CodeQ (OpenExp env aenv t)
liftE Exp aenv slix
sh) ||]
    Map TypeR e'
tp Fun aenv (e -> e')
f acc aenv (Array sh e)
a                -> [|| TypeR e'
-> Fun aenv (e -> e')
-> acc aenv (Array sh e)
-> PreOpenAcc acc aenv (Array sh e')
forall a aenv b (acc :: * -> * -> *) co.
TypeR a
-> Fun aenv (b -> a)
-> acc aenv (Array co b)
-> PreOpenAcc acc aenv (Array co a)
Map $$(TypeR e' -> CodeQ (TypeR e')
forall t. TypeR t -> CodeQ (TypeR t)
liftTypeR TypeR e'
tp) $$(Fun aenv (e -> e') -> CodeQ (Fun aenv (e -> e'))
forall env t. OpenFun env aenv t -> CodeQ (OpenFun env aenv t)
liftF Fun aenv (e -> e')
f) $$(acc aenv (Array sh e) -> CodeQ (acc aenv (Array sh e))
LiftAcc acc
liftA acc aenv (Array sh e)
a) ||]
    ZipWith TypeR e3
tp Fun aenv (e1 -> e2 -> e3)
f acc aenv (Array sh e1)
a acc aenv (Array sh e2)
b          -> [|| TypeR e3
-> Fun aenv (e1 -> e2 -> e3)
-> acc aenv (Array sh e1)
-> acc aenv (Array sh e2)
-> PreOpenAcc acc aenv (Array sh e3)
forall a aenv b co (acc :: * -> * -> *) b.
TypeR a
-> Fun aenv (b -> co -> a)
-> acc aenv (Array b b)
-> acc aenv (Array b co)
-> PreOpenAcc acc aenv (Array b a)
ZipWith $$(TypeR e3 -> CodeQ (TypeR e3)
forall t. TypeR t -> CodeQ (TypeR t)
liftTypeR TypeR e3
tp) $$(Fun aenv (e1 -> e2 -> e3) -> CodeQ (Fun aenv (e1 -> e2 -> e3))
forall env t. OpenFun env aenv t -> CodeQ (OpenFun env aenv t)
liftF Fun aenv (e1 -> e2 -> e3)
f) $$(acc aenv (Array sh e1) -> CodeQ (acc aenv (Array sh e1))
LiftAcc acc
liftA acc aenv (Array sh e1)
a) $$(acc aenv (Array sh e2) -> CodeQ (acc aenv (Array sh e2))
LiftAcc acc
liftA acc aenv (Array sh e2)
b) ||]
    Fold Fun aenv (e -> e -> e)
f Maybe (Exp aenv e)
z acc aenv (Array (sh, Int) e)
a                -> [|| Fun aenv (e -> e -> e)
-> Maybe (Exp aenv e)
-> acc aenv (Array (sh, Int) e)
-> PreOpenAcc acc aenv (Array sh e)
forall aenv a (acc :: * -> * -> *) b.
Fun aenv (a -> a -> a)
-> Maybe (Exp aenv a)
-> acc aenv (Array (b, Int) a)
-> PreOpenAcc acc aenv (Array b a)
Fold $$(Fun aenv (e -> e -> e) -> CodeQ (Fun aenv (e -> e -> e))
forall env t. OpenFun env aenv t -> CodeQ (OpenFun env aenv t)
liftF Fun aenv (e -> e -> e)
f) $$((Exp aenv e -> CodeQ (Exp aenv e))
-> Maybe (Exp aenv e) -> CodeQ (Maybe (Exp aenv e))
forall a. (a -> CodeQ a) -> Maybe a -> CodeQ (Maybe a)
liftMaybe Exp aenv e -> CodeQ (Exp aenv e)
forall env t. OpenExp env aenv t -> CodeQ (OpenExp env aenv t)
liftE Maybe (Exp aenv e)
z) $$(acc aenv (Array (sh, Int) e)
-> CodeQ (acc aenv (Array (sh, Int) e))
LiftAcc acc
liftA acc aenv (Array (sh, Int) e)
a) ||]
    FoldSeg IntegralType i
i Fun aenv (e -> e -> e)
f Maybe (Exp aenv e)
z acc aenv (Array (sh, Int) e)
a acc aenv (Segments i)
s         -> [|| IntegralType i
-> Fun aenv (e -> e -> e)
-> Maybe (Exp aenv e)
-> acc aenv (Array (sh, Int) e)
-> acc aenv (Segments i)
-> PreOpenAcc acc aenv (Array (sh, Int) e)
forall a aenv b (acc :: * -> * -> *) co.
IntegralType a
-> Fun aenv (b -> b -> b)
-> Maybe (Exp aenv b)
-> acc aenv (Array (co, Int) b)
-> acc aenv (Segments a)
-> PreOpenAcc acc aenv (Array (co, Int) b)
FoldSeg $$(IntegralType i -> CodeQ (IntegralType i)
forall t. IntegralType t -> CodeQ (IntegralType t)
liftIntegralType IntegralType i
i) $$(Fun aenv (e -> e -> e) -> CodeQ (Fun aenv (e -> e -> e))
forall env t. OpenFun env aenv t -> CodeQ (OpenFun env aenv t)
liftF Fun aenv (e -> e -> e)
f) $$((Exp aenv e -> CodeQ (Exp aenv e))
-> Maybe (Exp aenv e) -> CodeQ (Maybe (Exp aenv e))
forall a. (a -> CodeQ a) -> Maybe a -> CodeQ (Maybe a)
liftMaybe Exp aenv e -> CodeQ (Exp aenv e)
forall env t. OpenExp env aenv t -> CodeQ (OpenExp env aenv t)
liftE Maybe (Exp aenv e)
z) $$(acc aenv (Array (sh, Int) e)
-> CodeQ (acc aenv (Array (sh, Int) e))
LiftAcc acc
liftA acc aenv (Array (sh, Int) e)
a) $$(acc aenv (Segments i) -> CodeQ (acc aenv (Segments i))
LiftAcc acc
liftA acc aenv (Segments i)
s) ||]
    Scan Direction
d Fun aenv (e -> e -> e)
f Maybe (Exp aenv e)
z acc aenv (Array (sh, Int) e)
a              -> [|| Direction
-> Fun aenv (e -> e -> e)
-> Maybe (Exp aenv e)
-> acc aenv (Array (sh, Int) e)
-> PreOpenAcc acc aenv (Array (sh, Int) e)
forall aenv a (acc :: * -> * -> *) b.
Direction
-> Fun aenv (a -> a -> a)
-> Maybe (Exp aenv a)
-> acc aenv (Array (b, Int) a)
-> PreOpenAcc acc aenv (Array (b, Int) a)
Scan  $$(Direction -> CodeQ Direction
liftDirection Direction
d) $$(Fun aenv (e -> e -> e) -> CodeQ (Fun aenv (e -> e -> e))
forall env t. OpenFun env aenv t -> CodeQ (OpenFun env aenv t)
liftF Fun aenv (e -> e -> e)
f) $$((Exp aenv e -> CodeQ (Exp aenv e))
-> Maybe (Exp aenv e) -> CodeQ (Maybe (Exp aenv e))
forall a. (a -> CodeQ a) -> Maybe a -> CodeQ (Maybe a)
liftMaybe Exp aenv e -> CodeQ (Exp aenv e)
forall env t. OpenExp env aenv t -> CodeQ (OpenExp env aenv t)
liftE Maybe (Exp aenv e)
z) $$(acc aenv (Array (sh, Int) e)
-> CodeQ (acc aenv (Array (sh, Int) e))
LiftAcc acc
liftA acc aenv (Array (sh, Int) e)
a) ||]
    Scan' Direction
d Fun aenv (e -> e -> e)
f Exp aenv e
z acc aenv (Array (sh, Int) e)
a             -> [|| Direction
-> Fun aenv (e -> e -> e)
-> Exp aenv e
-> acc aenv (Array (sh, Int) e)
-> PreOpenAcc acc aenv (Array (sh, Int) e, Array sh e)
forall aenv a (acc :: * -> * -> *) b.
Direction
-> Fun aenv (a -> a -> a)
-> Exp aenv a
-> acc aenv (Array (b, Int) a)
-> PreOpenAcc acc aenv (Array (b, Int) a, Array b a)
Scan' $$(Direction -> CodeQ Direction
liftDirection Direction
d) $$(Fun aenv (e -> e -> e) -> CodeQ (Fun aenv (e -> e -> e))
forall env t. OpenFun env aenv t -> CodeQ (OpenFun env aenv t)
liftF Fun aenv (e -> e -> e)
f) $$(Exp aenv e -> CodeQ (Exp aenv e)
forall env t. OpenExp env aenv t -> CodeQ (OpenExp env aenv t)
liftE Exp aenv e
z) $$(acc aenv (Array (sh, Int) e)
-> CodeQ (acc aenv (Array (sh, Int) e))
LiftAcc acc
liftA acc aenv (Array (sh, Int) e)
a) ||]
    Permute Fun aenv (e -> e -> e)
f acc aenv (Array sh' e)
d Fun aenv (sh -> PrimMaybe sh')
p acc aenv (Array sh e)
a           -> [|| Fun aenv (e -> e -> e)
-> acc aenv (Array sh' e)
-> Fun aenv (sh -> PrimMaybe sh')
-> acc aenv (Array sh e)
-> PreOpenAcc acc aenv (Array sh' e)
forall aenv a (acc :: * -> * -> *) b co.
Fun aenv (a -> a -> a)
-> acc aenv (Array b a)
-> Fun aenv (co -> PrimMaybe b)
-> acc aenv (Array co a)
-> PreOpenAcc acc aenv (Array b a)
Permute $$(Fun aenv (e -> e -> e) -> CodeQ (Fun aenv (e -> e -> e))
forall env t. OpenFun env aenv t -> CodeQ (OpenFun env aenv t)
liftF Fun aenv (e -> e -> e)
f) $$(acc aenv (Array sh' e) -> CodeQ (acc aenv (Array sh' e))
LiftAcc acc
liftA acc aenv (Array sh' e)
d) $$(Fun aenv (sh -> PrimMaybe sh')
-> CodeQ (Fun aenv (sh -> PrimMaybe sh'))
forall env t. OpenFun env aenv t -> CodeQ (OpenFun env aenv t)
liftF Fun aenv (sh -> PrimMaybe sh')
p) $$(acc aenv (Array sh e) -> CodeQ (acc aenv (Array sh e))
LiftAcc acc
liftA acc aenv (Array sh e)
a) ||]
    Backpermute ShapeR sh'
shr Exp aenv sh'
sh Fun aenv (sh' -> sh)
p acc aenv (Array sh e)
a    -> [|| ShapeR sh'
-> Exp aenv sh'
-> Fun aenv (sh' -> sh)
-> acc aenv (Array sh e)
-> PreOpenAcc acc aenv (Array sh' e)
forall a aenv b (acc :: * -> * -> *) co.
ShapeR a
-> Exp aenv a
-> Fun aenv (a -> b)
-> acc aenv (Array b co)
-> PreOpenAcc acc aenv (Array a co)
Backpermute $$(ShapeR sh' -> CodeQ (ShapeR sh')
forall sh. ShapeR sh -> CodeQ (ShapeR sh)
liftShapeR ShapeR sh'
shr) $$(Exp aenv sh' -> CodeQ (Exp aenv sh')
forall env t. OpenExp env aenv t -> CodeQ (OpenExp env aenv t)
liftE Exp aenv sh'
sh) $$(Fun aenv (sh' -> sh) -> CodeQ (Fun aenv (sh' -> sh))
forall env t. OpenFun env aenv t -> CodeQ (OpenFun env aenv t)
liftF Fun aenv (sh' -> sh)
p) $$(acc aenv (Array sh e) -> CodeQ (acc aenv (Array sh e))
LiftAcc acc
liftA acc aenv (Array sh e)
a) ||]
    Stencil StencilR sh e stencil
sr TypeR e'
tp Fun aenv (stencil -> e')
f Boundary aenv (Array sh e)
b acc aenv (Array sh e)
a       ->
      let TupRsingle (ArrayR ShapeR sh
ShapeR sh
shr TypeR e
_) = acc aenv (Array sh e) -> TupR ArrayR (Array sh e)
forall aenv a. acc aenv a -> ArraysR a
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR acc aenv (Array sh e)
a
          repr :: ArrayR (Array sh e)
repr = ShapeR sh -> TypeR e -> ArrayR (Array sh e)
forall sh e. ShapeR sh -> TypeR e -> ArrayR (Array sh e)
ArrayR ShapeR sh
shr (TypeR e -> ArrayR (Array sh e)) -> TypeR e -> ArrayR (Array sh e)
forall a b. (a -> b) -> a -> b
$ StencilR sh e stencil -> TypeR e
forall sh e pat. StencilR sh e pat -> TypeR e
stencilEltR StencilR sh e stencil
sr
       in [|| StencilR sh e stencil
-> TypeR e'
-> Fun aenv (stencil -> e')
-> Boundary aenv (Array sh e)
-> acc aenv (Array sh e)
-> PreOpenAcc acc aenv (Array sh e')
forall a b co b aenv (acc :: * -> * -> *).
StencilR a b co
-> TypeR b
-> Fun aenv (co -> b)
-> Boundary aenv (Array a b)
-> acc aenv (Array a b)
-> PreOpenAcc acc aenv (Array a b)
Stencil $$(StencilR sh e stencil -> CodeQ (StencilR sh e stencil)
forall sh e pat. StencilR sh e pat -> CodeQ (StencilR sh e pat)
liftStencilR StencilR sh e stencil
sr) $$(TypeR e' -> CodeQ (TypeR e')
forall t. TypeR t -> CodeQ (TypeR t)
liftTypeR TypeR e'
tp) $$(Fun aenv (stencil -> e') -> CodeQ (Fun aenv (stencil -> e'))
forall env t. OpenFun env aenv t -> CodeQ (OpenFun env aenv t)
liftF Fun aenv (stencil -> e')
f) $$(ArrayR (Array sh e)
-> Boundary aenv (Array sh e) -> CodeQ (Boundary aenv (Array sh e))
forall sh e.
ArrayR (Array sh e)
-> Boundary aenv (Array sh e) -> CodeQ (Boundary aenv (Array sh e))
liftB ArrayR (Array sh e)
repr Boundary aenv (Array sh e)
b) $$(acc aenv (Array sh e) -> CodeQ (acc aenv (Array sh e))
LiftAcc acc
liftA acc aenv (Array sh e)
a) ||]
    Stencil2 StencilR sh a stencil1
sr1 StencilR sh b stencil2
sr2 TypeR c
tp Fun aenv (stencil1 -> stencil2 -> c)
f Boundary aenv (Array sh a)
b1 acc aenv (Array sh a)
a1 Boundary aenv (Array sh b)
b2 acc aenv (Array sh b)
a2 ->
      let TupRsingle (ArrayR ShapeR sh
ShapeR sh
shr TypeR e
_) = acc aenv (Array sh a) -> TupR ArrayR (Array sh a)
forall aenv a. acc aenv a -> ArraysR a
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR acc aenv (Array sh a)
a1
          repr1 :: ArrayR (Array sh a)
repr1 = ShapeR sh -> TypeR a -> ArrayR (Array sh a)
forall sh e. ShapeR sh -> TypeR e -> ArrayR (Array sh e)
ArrayR ShapeR sh
shr (TypeR a -> ArrayR (Array sh a)) -> TypeR a -> ArrayR (Array sh a)
forall a b. (a -> b) -> a -> b
$ StencilR sh a stencil1 -> TypeR a
forall sh e pat. StencilR sh e pat -> TypeR e
stencilEltR StencilR sh a stencil1
sr1
          repr2 :: ArrayR (Array sh b)
repr2 = ShapeR sh -> TypeR b -> ArrayR (Array sh b)
forall sh e. ShapeR sh -> TypeR e -> ArrayR (Array sh e)
ArrayR ShapeR sh
shr (TypeR b -> ArrayR (Array sh b)) -> TypeR b -> ArrayR (Array sh b)
forall a b. (a -> b) -> a -> b
$ StencilR sh b stencil2 -> TypeR b
forall sh e pat. StencilR sh e pat -> TypeR e
stencilEltR StencilR sh b stencil2
sr2
       in [|| StencilR sh a stencil1
-> StencilR sh b stencil2
-> TypeR c
-> Fun aenv (stencil1 -> stencil2 -> c)
-> Boundary aenv (Array sh a)
-> acc aenv (Array sh a)
-> Boundary aenv (Array sh b)
-> acc aenv (Array sh b)
-> PreOpenAcc acc aenv (Array sh c)
forall a b co b stencil2 c aenv (acc :: * -> * -> *).
StencilR a b co
-> StencilR a b stencil2
-> TypeR c
-> Fun aenv (co -> stencil2 -> c)
-> Boundary aenv (Array a b)
-> acc aenv (Array a b)
-> Boundary aenv (Array a b)
-> acc aenv (Array a b)
-> PreOpenAcc acc aenv (Array a c)
Stencil2 $$(StencilR sh a stencil1 -> CodeQ (StencilR sh a stencil1)
forall sh e pat. StencilR sh e pat -> CodeQ (StencilR sh e pat)
liftStencilR StencilR sh a stencil1
sr1) $$(StencilR sh b stencil2 -> CodeQ (StencilR sh b stencil2)
forall sh e pat. StencilR sh e pat -> CodeQ (StencilR sh e pat)
liftStencilR StencilR sh b stencil2
sr2) $$(TypeR c -> CodeQ (TypeR c)
forall t. TypeR t -> CodeQ (TypeR t)
liftTypeR TypeR c
tp) $$(Fun aenv (stencil1 -> stencil2 -> c)
-> CodeQ (Fun aenv (stencil1 -> stencil2 -> c))
forall env t. OpenFun env aenv t -> CodeQ (OpenFun env aenv t)
liftF Fun aenv (stencil1 -> stencil2 -> c)
f) $$(ArrayR (Array sh a)
-> Boundary aenv (Array sh a) -> CodeQ (Boundary aenv (Array sh a))
forall sh e.
ArrayR (Array sh e)
-> Boundary aenv (Array sh e) -> CodeQ (Boundary aenv (Array sh e))
liftB ArrayR (Array sh a)
repr1 Boundary aenv (Array sh a)
b1) $$(acc aenv (Array sh a) -> CodeQ (acc aenv (Array sh a))
LiftAcc acc
liftA acc aenv (Array sh a)
a1) $$(ArrayR (Array sh b)
-> Boundary aenv (Array sh b) -> CodeQ (Boundary aenv (Array sh b))
forall sh e.
ArrayR (Array sh e)
-> Boundary aenv (Array sh e) -> CodeQ (Boundary aenv (Array sh e))
liftB ArrayR (Array sh b)
repr2 Boundary aenv (Array sh b)
b2) $$(acc aenv (Array sh b) -> CodeQ (acc aenv (Array sh b))
LiftAcc acc
liftA acc aenv (Array sh b)
a2) ||]


liftALeftHandSide :: ALeftHandSide arrs aenv aenv' -> CodeQ (ALeftHandSide arrs aenv aenv')
liftALeftHandSide :: forall arrs aenv aenv'.
ALeftHandSide arrs aenv aenv'
-> CodeQ (ALeftHandSide arrs aenv aenv')
liftALeftHandSide = (forall a. ArrayR a -> CodeQ (ArrayR a))
-> LeftHandSide ArrayR arrs aenv aenv'
-> CodeQ (LeftHandSide ArrayR arrs aenv aenv')
forall (s :: * -> *) v env env'.
(forall u. s u -> CodeQ (s u))
-> LeftHandSide s v env env' -> CodeQ (LeftHandSide s v env env')
liftLeftHandSide ArrayR u -> CodeQ (ArrayR u)
forall a. ArrayR a -> CodeQ (ArrayR a)
liftArrayR

liftArrayVar :: ArrayVar aenv a -> CodeQ (ArrayVar aenv a)
liftArrayVar :: forall aenv a. ArrayVar aenv a -> CodeQ (ArrayVar aenv a)
liftArrayVar = (forall a. ArrayR a -> CodeQ (ArrayR a))
-> Var ArrayR aenv a -> CodeQ (Var ArrayR aenv a)
forall (s :: * -> *) env t.
(forall b. s b -> CodeQ (s b))
-> Var s env t -> CodeQ (Var s env t)
liftVar ArrayR b -> CodeQ (ArrayR b)
forall a. ArrayR a -> CodeQ (ArrayR a)
liftArrayR

liftDirection :: Direction -> CodeQ Direction
liftDirection :: Direction -> CodeQ Direction
liftDirection Direction
LeftToRight = [|| Direction
LeftToRight ||]
liftDirection Direction
RightToLeft = [|| Direction
RightToLeft ||]

liftMessage :: ArraysR a -> Message a -> CodeQ (Message a)
liftMessage :: forall a. ArraysR a -> Message a -> CodeQ (Message a)
liftMessage ArraysR a
aR (Message a -> [Char]
_ Maybe (CodeQ (a -> [Char]))
fmt Text
msg) =
  let
      -- We (ironically?) can't lift TExp, so nested occurrences must fall
      -- back to displaying in representation format
      fmtR :: ArraysR arrs' -> CodeQ (arrs' -> String)
      fmtR :: forall arrs'. ArraysR arrs' -> CodeQ (arrs' -> [Char])
fmtR TupR ArrayR arrs'
TupRunit                         = [|| \() -> a
"()" ||]
      fmtR (TupRsingle (ArrayR ShapeR sh
ShapeRz TypeR e
eR)) = [|| \p
as -> TypeR e -> e -> [Char]
forall e. TypeR e -> e -> [Char]
showElt $$(TypeR e -> CodeQ (TypeR e)
forall t. TypeR t -> CodeQ (TypeR t)
liftTypeR TypeR e
eR) (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ TypeR e -> Array sh e -> Int -> e
forall e sh. TypeR e -> Array sh e -> Int -> e
linearIndexArray $$(TypeR e -> CodeQ (TypeR e)
forall t. TypeR t -> CodeQ (TypeR t)
liftTypeR TypeR e
eR) p
as Int
0 ||]
      fmtR (TupRsingle (ArrayR ShapeR sh
shR TypeR e
eR))     = [|| \p
as -> (e -> ShowS) -> ArrayR (Array sh e) -> Array sh e -> [Char]
forall e sh.
(e -> ShowS) -> ArrayR (Array sh e) -> Array sh e -> [Char]
showArray (TypeR e -> e -> ShowS
forall e. TypeR e -> e -> ShowS
showsElt $$(TypeR e -> CodeQ (TypeR e)
forall t. TypeR t -> CodeQ (TypeR t)
liftTypeR TypeR e
eR)) (ShapeR sh -> TypeR e -> ArrayR (Array sh e)
forall sh e. ShapeR sh -> TypeR e -> ArrayR (Array sh e)
ArrayR $$(ShapeR sh -> CodeQ (ShapeR sh)
forall sh. ShapeR sh -> CodeQ (ShapeR sh)
liftShapeR ShapeR sh
shR) $$(TypeR e -> CodeQ (TypeR e)
forall t. TypeR t -> CodeQ (TypeR t)
liftTypeR TypeR e
eR)) p
as ||]
      fmtR TupR ArrayR arrs'
aR'                              = [|| \p
as -> ArraysR arrs -> arrs -> [Char]
forall arrs. ArraysR arrs -> arrs -> [Char]
showArrays $$(TupR ArrayR arrs' -> CodeQ (TupR ArrayR arrs')
forall arrs. ArraysR arrs -> CodeQ (ArraysR arrs)
liftArraysR TupR ArrayR arrs'
aR') p
as ||]
  in
  [|| (a -> [Char]) -> Maybe (CodeQ (a -> [Char])) -> Text -> Message a
forall a.
(a -> [Char]) -> Maybe (CodeQ (a -> [Char])) -> Text -> Message a
Message $$(CodeQ (a -> [Char])
-> Maybe (CodeQ (a -> [Char])) -> CodeQ (a -> [Char])
forall a. a -> Maybe a -> a
fromMaybe (ArraysR a -> CodeQ (a -> [Char])
forall arrs'. ArraysR arrs' -> CodeQ (arrs' -> [Char])
fmtR ArraysR a
aR) Maybe (CodeQ (a -> [Char]))
fmt) Maybe a
forall a. Maybe a
Nothing $$(Q Exp -> Code Q Text
forall a (m :: * -> *). Quote m => m Exp -> Code m a
TH.unsafeCodeCoerce (Text -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Text -> m Exp
TH.lift Text
msg)) ||]

liftMaybe :: (a -> CodeQ a) -> Maybe a -> CodeQ (Maybe a)
liftMaybe :: forall a. (a -> CodeQ a) -> Maybe a -> CodeQ (Maybe a)
liftMaybe a -> CodeQ a
_ Maybe a
Nothing  = [|| Maybe a
forall a. Maybe a
Nothing ||]
liftMaybe a -> CodeQ a
f (Just a
x) = [|| a -> Maybe a
forall a. a -> Maybe a
Just $$(a -> CodeQ a
f a
x) ||]

liftList :: (a -> CodeQ a) -> [a] -> CodeQ [a]
liftList :: forall a. (a -> CodeQ a) -> [a] -> CodeQ [a]
liftList a -> CodeQ a
_ []     = [|| [] ||]
liftList a -> CodeQ a
f (a
x:[a]
xs) = [|| $$(a -> CodeQ a
f a
x) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: $$((a -> CodeQ a) -> [a] -> CodeQ [a]
forall a. (a -> CodeQ a) -> [a] -> CodeQ [a]
liftList a -> CodeQ a
f [a]
xs) ||]

liftOpenFun
    :: OpenFun env aenv t
    -> CodeQ (OpenFun env aenv t)
liftOpenFun :: forall env aenv t. OpenFun env aenv t -> CodeQ (OpenFun env aenv t)
liftOpenFun (Lam ELeftHandSide a env env'
lhs OpenFun env' aenv t
f)  = [|| ELeftHandSide a env env'
-> OpenFun env' aenv t -> OpenFun env aenv (a -> t)
forall a env b aenv co.
ELeftHandSide a env b
-> OpenFun b aenv co -> OpenFun env aenv (a -> co)
Lam $$(ELeftHandSide a env env' -> CodeQ (ELeftHandSide a env env')
forall t env env'.
ELeftHandSide t env env' -> CodeQ (ELeftHandSide t env env')
liftELeftHandSide ELeftHandSide a env env'
lhs) $$(OpenFun env' aenv t -> CodeQ (OpenFun env' aenv t)
forall env aenv t. OpenFun env aenv t -> CodeQ (OpenFun env aenv t)
liftOpenFun OpenFun env' aenv t
f) ||]
liftOpenFun (Body OpenExp env aenv t
b)     = [|| OpenExp env aenv t -> OpenFun env aenv t
forall env aenv t. OpenExp env aenv t -> OpenFun env aenv t
Body $$(OpenExp env aenv t -> CodeQ (OpenExp env aenv t)
forall env aenv t. OpenExp env aenv t -> CodeQ (OpenExp env aenv t)
liftOpenExp OpenExp env aenv t
b) ||]

liftOpenExp
    :: forall env aenv t.
       OpenExp env aenv t
    -> CodeQ (OpenExp env aenv t)
liftOpenExp :: forall env aenv t. OpenExp env aenv t -> CodeQ (OpenExp env aenv t)
liftOpenExp OpenExp env aenv t
pexp =
  let
      liftE :: OpenExp env aenv e -> CodeQ (OpenExp env aenv e)
      liftE :: forall e. OpenExp env aenv e -> CodeQ (OpenExp env aenv e)
liftE = OpenExp env aenv e -> CodeQ (OpenExp env aenv e)
forall env aenv t. OpenExp env aenv t -> CodeQ (OpenExp env aenv t)
liftOpenExp

      liftF :: OpenFun env aenv f -> CodeQ (OpenFun env aenv f)
      liftF :: forall f. OpenFun env aenv f -> CodeQ (OpenFun env aenv f)
liftF = OpenFun env aenv f -> CodeQ (OpenFun env aenv f)
forall env aenv t. OpenFun env aenv t -> CodeQ (OpenFun env aenv t)
liftOpenFun
  in
  case OpenExp env aenv t
pexp of
    Let ELeftHandSide bnd_t env env'
lhs OpenExp env aenv bnd_t
bnd OpenExp env' aenv t
body          -> [|| ELeftHandSide bnd_t env env'
-> OpenExp env aenv bnd_t
-> OpenExp env' aenv body_t
-> OpenExp env aenv body_t
forall a env b aenv body_t.
ELeftHandSide a env b
-> OpenExp env aenv a
-> OpenExp b aenv body_t
-> OpenExp env aenv body_t
Let $$(ELeftHandSide bnd_t env env'
-> CodeQ (ELeftHandSide bnd_t env env')
forall t env env'.
ELeftHandSide t env env' -> CodeQ (ELeftHandSide t env env')
liftELeftHandSide ELeftHandSide bnd_t env env'
lhs) $$(OpenExp env aenv bnd_t -> CodeQ (OpenExp env aenv bnd_t)
forall env aenv t. OpenExp env aenv t -> CodeQ (OpenExp env aenv t)
liftOpenExp OpenExp env aenv bnd_t
bnd) $$(OpenExp env' aenv t -> CodeQ (OpenExp env' aenv t)
forall env aenv t. OpenExp env aenv t -> CodeQ (OpenExp env aenv t)
liftOpenExp OpenExp env' aenv t
body) ||]
    Evar ExpVar env t
var                  -> [|| ExpVar env t -> OpenExp env aenv t
forall env t aenv. ExpVar env t -> OpenExp env aenv t
Evar $$(ExpVar env t -> CodeQ (ExpVar env t)
forall env t. ExpVar env t -> CodeQ (ExpVar env t)
liftExpVar ExpVar env t
var) ||]
    Foreign TypeR t
repr asm (x -> t)
asm Fun () (x -> t)
f OpenExp env aenv x
x      -> [|| TypeR y
-> asm (x -> y)
-> Fun () (x -> y)
-> OpenExp env aenv x
-> OpenExp env aenv y
forall (a :: * -> *) y b env aenv.
Foreign a =>
TypeR y
-> a (b -> y)
-> Fun () (b -> y)
-> OpenExp env aenv b
-> OpenExp env aenv y
Foreign $$(TypeR t -> CodeQ (TypeR t)
forall t. TypeR t -> CodeQ (TypeR t)
liftTypeR TypeR t
repr) $$(asm (x -> t) -> CodeQ (asm (x -> t))
forall args. HasCallStack => asm args -> CodeQ (asm args)
forall (asm :: * -> *) args.
(Foreign asm, HasCallStack) =>
asm args -> CodeQ (asm args)
liftForeign asm (x -> t)
asm) $$(Fun () (x -> t) -> CodeQ (Fun () (x -> t))
forall env aenv t. OpenFun env aenv t -> CodeQ (OpenFun env aenv t)
liftOpenFun Fun () (x -> t)
f) $$(OpenExp env aenv x -> CodeQ (OpenExp env aenv x)
forall e. OpenExp env aenv e -> CodeQ (OpenExp env aenv e)
liftE OpenExp env aenv x
x) ||]
    Const ScalarType t
tp t
c                -> [|| ScalarType t -> t -> OpenExp env aenv t
forall t env aenv. ScalarType t -> t -> OpenExp env aenv t
Const $$(ScalarType t -> CodeQ (ScalarType t)
forall t. ScalarType t -> CodeQ (ScalarType t)
liftScalarType ScalarType t
tp) $$(TypeR t -> t -> CodeQ t
forall t. TypeR t -> t -> CodeQ t
liftElt (ScalarType t -> TypeR t
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ScalarType t
tp) t
c) ||]
    Undef ScalarType t
tp                  -> [|| ScalarType t -> OpenExp env aenv t
forall t env aenv. ScalarType t -> OpenExp env aenv t
Undef $$(ScalarType t -> CodeQ (ScalarType t)
forall t. ScalarType t -> CodeQ (ScalarType t)
liftScalarType ScalarType t
tp) ||]
    Pair OpenExp env aenv t1
a OpenExp env aenv t2
b                  -> [|| OpenExp env aenv t1
-> OpenExp env aenv t2 -> OpenExp env aenv (t1, t2)
forall env aenv a b.
OpenExp env aenv a -> OpenExp env aenv b -> OpenExp env aenv (a, b)
Pair $$(OpenExp env aenv t1 -> CodeQ (OpenExp env aenv t1)
forall e. OpenExp env aenv e -> CodeQ (OpenExp env aenv e)
liftE OpenExp env aenv t1
a) $$(OpenExp env aenv t2 -> CodeQ (OpenExp env aenv t2)
forall e. OpenExp env aenv e -> CodeQ (OpenExp env aenv e)
liftE OpenExp env aenv t2
b) ||]
    OpenExp env aenv t
Nil                       -> [|| OpenExp env aenv ()
forall env aenv. OpenExp env aenv ()
Nil ||]
    VecPack   VecR n s tup
vecr OpenExp env aenv tup
e          -> [|| VecR n s tup -> OpenExp env aenv tup -> OpenExp env aenv (Vec n s)
forall (a :: Nat) b co env aenv.
KnownNat a =>
VecR a b co -> OpenExp env aenv co -> OpenExp env aenv (Vec a b)
VecPack   $$(VecR n s tup -> CodeQ (VecR n s tup)
forall (n :: Nat) single tuple.
VecR n single tuple -> CodeQ (VecR n single tuple)
liftVecR VecR n s tup
vecr) $$(OpenExp env aenv tup -> CodeQ (OpenExp env aenv tup)
forall e. OpenExp env aenv e -> CodeQ (OpenExp env aenv e)
liftE OpenExp env aenv tup
e) ||]
    VecUnpack VecR n s t
vecr OpenExp env aenv (Vec n s)
e          -> [|| VecR n s tup -> OpenExp env aenv (Vec n s) -> OpenExp env aenv tup
forall (a :: Nat) b tup env aenv.
KnownNat a =>
VecR a b tup -> OpenExp env aenv (Vec a b) -> OpenExp env aenv tup
VecUnpack $$(VecR n s t -> CodeQ (VecR n s t)
forall (n :: Nat) single tuple.
VecR n single tuple -> CodeQ (VecR n single tuple)
liftVecR VecR n s t
vecr) $$(OpenExp env aenv (Vec n s) -> CodeQ (OpenExp env aenv (Vec n s))
forall e. OpenExp env aenv e -> CodeQ (OpenExp env aenv e)
liftE OpenExp env aenv (Vec n s)
e) ||]
    IndexSlice SliceIndex slix t co sh
slice OpenExp env aenv slix
slix OpenExp env aenv sh
sh  -> [|| SliceIndex slix sl co sh
-> OpenExp env aenv slix
-> OpenExp env aenv sh
-> OpenExp env aenv sl
forall a sl b co env aenv.
SliceIndex a sl b co
-> OpenExp env aenv a -> OpenExp env aenv co -> OpenExp env aenv sl
IndexSlice $$(SliceIndex slix t co sh -> CodeQ (SliceIndex slix t co sh)
forall ix slice co sh.
SliceIndex ix slice co sh -> CodeQ (SliceIndex ix slice co sh)
liftSliceIndex SliceIndex slix t co sh
slice) $$(OpenExp env aenv slix -> CodeQ (OpenExp env aenv slix)
forall e. OpenExp env aenv e -> CodeQ (OpenExp env aenv e)
liftE OpenExp env aenv slix
slix) $$(OpenExp env aenv sh -> CodeQ (OpenExp env aenv sh)
forall e. OpenExp env aenv e -> CodeQ (OpenExp env aenv e)
liftE OpenExp env aenv sh
sh) ||]
    IndexFull SliceIndex slix sl co t
slice OpenExp env aenv slix
slix OpenExp env aenv sl
sl   -> [|| SliceIndex slix sl co sh
-> OpenExp env aenv slix
-> OpenExp env aenv sl
-> OpenExp env aenv sh
forall a b co sh env aenv.
SliceIndex a b co sh
-> OpenExp env aenv a -> OpenExp env aenv b -> OpenExp env aenv sh
IndexFull $$(SliceIndex slix sl co t -> CodeQ (SliceIndex slix sl co t)
forall ix slice co sh.
SliceIndex ix slice co sh -> CodeQ (SliceIndex ix slice co sh)
liftSliceIndex SliceIndex slix sl co t
slice) $$(OpenExp env aenv slix -> CodeQ (OpenExp env aenv slix)
forall e. OpenExp env aenv e -> CodeQ (OpenExp env aenv e)
liftE OpenExp env aenv slix
slix) $$(OpenExp env aenv sl -> CodeQ (OpenExp env aenv sl)
forall e. OpenExp env aenv e -> CodeQ (OpenExp env aenv e)
liftE OpenExp env aenv sl
sl) ||]
    ToIndex ShapeR sh
shr OpenExp env aenv sh
sh OpenExp env aenv sh
ix         -> [|| ShapeR sh
-> OpenExp env aenv sh
-> OpenExp env aenv sh
-> OpenExp env aenv Int
forall a env aenv.
ShapeR a
-> OpenExp env aenv a -> OpenExp env aenv a -> OpenExp env aenv Int
ToIndex $$(ShapeR sh -> CodeQ (ShapeR sh)
forall sh. ShapeR sh -> CodeQ (ShapeR sh)
liftShapeR ShapeR sh
shr) $$(OpenExp env aenv sh -> CodeQ (OpenExp env aenv sh)
forall e. OpenExp env aenv e -> CodeQ (OpenExp env aenv e)
liftE OpenExp env aenv sh
sh) $$(OpenExp env aenv sh -> CodeQ (OpenExp env aenv sh)
forall e. OpenExp env aenv e -> CodeQ (OpenExp env aenv e)
liftE OpenExp env aenv sh
ix) ||]
    FromIndex ShapeR t
shr OpenExp env aenv t
sh OpenExp env aenv Int
ix       -> [|| ShapeR sh
-> OpenExp env aenv sh
-> OpenExp env aenv Int
-> OpenExp env aenv sh
forall sh env aenv.
ShapeR sh
-> OpenExp env aenv sh
-> OpenExp env aenv Int
-> OpenExp env aenv sh
FromIndex $$(ShapeR t -> CodeQ (ShapeR t)
forall sh. ShapeR sh -> CodeQ (ShapeR sh)
liftShapeR ShapeR t
shr) $$(OpenExp env aenv t -> CodeQ (OpenExp env aenv t)
forall e. OpenExp env aenv e -> CodeQ (OpenExp env aenv e)
liftE OpenExp env aenv t
sh) $$(OpenExp env aenv Int -> CodeQ (OpenExp env aenv Int)
forall e. OpenExp env aenv e -> CodeQ (OpenExp env aenv e)
liftE OpenExp env aenv Int
ix) ||]
    Case OpenExp env aenv PrimBool
p [(PrimBool, OpenExp env aenv t)]
rhs Maybe (OpenExp env aenv t)
def            -> [|| OpenExp env aenv PrimBool
-> [(PrimBool, OpenExp env aenv b)]
-> Maybe (OpenExp env aenv b)
-> OpenExp env aenv b
forall env aenv b.
OpenExp env aenv PrimBool
-> [(PrimBool, OpenExp env aenv b)]
-> Maybe (OpenExp env aenv b)
-> OpenExp env aenv b
Case $$(OpenExp env aenv PrimBool -> CodeQ (OpenExp env aenv PrimBool)
forall e. OpenExp env aenv e -> CodeQ (OpenExp env aenv e)
liftE OpenExp env aenv PrimBool
p) $$(((PrimBool, OpenExp env aenv t)
 -> CodeQ (PrimBool, OpenExp env aenv t))
-> [(PrimBool, OpenExp env aenv t)]
-> CodeQ [(PrimBool, OpenExp env aenv t)]
forall a. (a -> CodeQ a) -> [a] -> CodeQ [a]
liftList (\(PrimBool
t,OpenExp env aenv t
c) -> [|| (PrimBool
t, $$(OpenExp env aenv t -> CodeQ (OpenExp env aenv t)
forall e. OpenExp env aenv e -> CodeQ (OpenExp env aenv e)
liftE OpenExp env aenv t
c)) ||]) [(PrimBool, OpenExp env aenv t)]
rhs) $$((OpenExp env aenv t -> CodeQ (OpenExp env aenv t))
-> Maybe (OpenExp env aenv t) -> CodeQ (Maybe (OpenExp env aenv t))
forall a. (a -> CodeQ a) -> Maybe a -> CodeQ (Maybe a)
liftMaybe OpenExp env aenv t -> CodeQ (OpenExp env aenv t)
forall e. OpenExp env aenv e -> CodeQ (OpenExp env aenv e)
liftE Maybe (OpenExp env aenv t)
def) ||]
    Cond OpenExp env aenv PrimBool
p OpenExp env aenv t
t OpenExp env aenv t
e                -> [|| OpenExp env aenv PrimBool
-> OpenExp env aenv t -> OpenExp env aenv t -> OpenExp env aenv t
forall env aenv t.
OpenExp env aenv PrimBool
-> OpenExp env aenv t -> OpenExp env aenv t -> OpenExp env aenv t
Cond $$(OpenExp env aenv PrimBool -> CodeQ (OpenExp env aenv PrimBool)
forall e. OpenExp env aenv e -> CodeQ (OpenExp env aenv e)
liftE OpenExp env aenv PrimBool
p) $$(OpenExp env aenv t -> CodeQ (OpenExp env aenv t)
forall e. OpenExp env aenv e -> CodeQ (OpenExp env aenv e)
liftE OpenExp env aenv t
t) $$(OpenExp env aenv t -> CodeQ (OpenExp env aenv t)
forall e. OpenExp env aenv e -> CodeQ (OpenExp env aenv e)
liftE OpenExp env aenv t
e) ||]
    While OpenFun env aenv (t -> PrimBool)
p OpenFun env aenv (t -> t)
f OpenExp env aenv t
x               -> [|| OpenFun env aenv (a -> PrimBool)
-> OpenFun env aenv (a -> a)
-> OpenExp env aenv a
-> OpenExp env aenv a
forall env aenv a.
OpenFun env aenv (a -> PrimBool)
-> OpenFun env aenv (a -> a)
-> OpenExp env aenv a
-> OpenExp env aenv a
While $$(OpenFun env aenv (t -> PrimBool)
-> CodeQ (OpenFun env aenv (t -> PrimBool))
forall f. OpenFun env aenv f -> CodeQ (OpenFun env aenv f)
liftF OpenFun env aenv (t -> PrimBool)
p) $$(OpenFun env aenv (t -> t) -> CodeQ (OpenFun env aenv (t -> t))
forall f. OpenFun env aenv f -> CodeQ (OpenFun env aenv f)
liftF OpenFun env aenv (t -> t)
f) $$(OpenExp env aenv t -> CodeQ (OpenExp env aenv t)
forall e. OpenExp env aenv e -> CodeQ (OpenExp env aenv e)
liftE OpenExp env aenv t
x) ||]
    PrimConst PrimConst t
t               -> [|| PrimConst t -> OpenExp env aenv t
forall t env aenv. PrimConst t -> OpenExp env aenv t
PrimConst $$(PrimConst t -> CodeQ (PrimConst t)
forall c. PrimConst c -> CodeQ (PrimConst c)
liftPrimConst PrimConst t
t) ||]
    PrimApp PrimFun (a -> t)
f OpenExp env aenv a
x               -> [|| PrimFun (a -> r) -> OpenExp env aenv a -> OpenExp env aenv r
forall a r env aenv.
PrimFun (a -> r) -> OpenExp env aenv a -> OpenExp env aenv r
PrimApp $$(PrimFun (a -> t) -> CodeQ (PrimFun (a -> t))
forall f. PrimFun f -> CodeQ (PrimFun f)
liftPrimFun PrimFun (a -> t)
f) $$(OpenExp env aenv a -> CodeQ (OpenExp env aenv a)
forall e. OpenExp env aenv e -> CodeQ (OpenExp env aenv e)
liftE OpenExp env aenv a
x) ||]
    Index ArrayVar aenv (Array dim t)
a OpenExp env aenv dim
ix                -> [|| ArrayVar aenv (Array dim t)
-> OpenExp env aenv dim -> OpenExp env aenv t
forall aenv a t env.
ArrayVar aenv (Array a t)
-> OpenExp env aenv a -> OpenExp env aenv t
Index $$(ArrayVar aenv (Array dim t) -> CodeQ (ArrayVar aenv (Array dim t))
forall aenv a. ArrayVar aenv a -> CodeQ (ArrayVar aenv a)
liftArrayVar ArrayVar aenv (Array dim t)
a) $$(OpenExp env aenv dim -> CodeQ (OpenExp env aenv dim)
forall e. OpenExp env aenv e -> CodeQ (OpenExp env aenv e)
liftE OpenExp env aenv dim
ix) ||]
    LinearIndex ArrayVar aenv (Array dim t)
a OpenExp env aenv Int
ix          -> [|| ArrayVar aenv (Array dim t)
-> OpenExp env aenv Int -> OpenExp env aenv t
forall aenv a t env.
ArrayVar aenv (Array a t)
-> OpenExp env aenv Int -> OpenExp env aenv t
LinearIndex $$(ArrayVar aenv (Array dim t) -> CodeQ (ArrayVar aenv (Array dim t))
forall aenv a. ArrayVar aenv a -> CodeQ (ArrayVar aenv a)
liftArrayVar ArrayVar aenv (Array dim t)
a) $$(OpenExp env aenv Int -> CodeQ (OpenExp env aenv Int)
forall e. OpenExp env aenv e -> CodeQ (OpenExp env aenv e)
liftE OpenExp env aenv Int
ix) ||]
    Shape ArrayVar aenv (Array t e)
a                   -> [|| ArrayVar aenv (Array dim e) -> OpenExp env aenv dim
forall aenv dim a env.
ArrayVar aenv (Array dim a) -> OpenExp env aenv dim
Shape $$(ArrayVar aenv (Array t e) -> CodeQ (ArrayVar aenv (Array t e))
forall aenv a. ArrayVar aenv a -> CodeQ (ArrayVar aenv a)
liftArrayVar ArrayVar aenv (Array t e)
a) ||]
    ShapeSize ShapeR dim
shr OpenExp env aenv dim
ix          -> [|| ShapeR dim -> OpenExp env aenv dim -> OpenExp env aenv Int
forall a env aenv.
ShapeR a -> OpenExp env aenv a -> OpenExp env aenv Int
ShapeSize $$(ShapeR dim -> CodeQ (ShapeR dim)
forall sh. ShapeR sh -> CodeQ (ShapeR sh)
liftShapeR ShapeR dim
shr) $$(OpenExp env aenv dim -> CodeQ (OpenExp env aenv dim)
forall e. OpenExp env aenv e -> CodeQ (OpenExp env aenv e)
liftE OpenExp env aenv dim
ix) ||]
    Coerce ScalarType a
t1 ScalarType t
t2 OpenExp env aenv a
e            -> [|| ScalarType a
-> ScalarType b -> OpenExp env aenv a -> OpenExp env aenv b
forall a b env aenv.
BitSizeEq a b =>
ScalarType a
-> ScalarType b -> OpenExp env aenv a -> OpenExp env aenv b
Coerce $$(ScalarType a -> CodeQ (ScalarType a)
forall t. ScalarType t -> CodeQ (ScalarType t)
liftScalarType ScalarType a
t1) $$(ScalarType t -> CodeQ (ScalarType t)
forall t. ScalarType t -> CodeQ (ScalarType t)
liftScalarType ScalarType t
t2) $$(OpenExp env aenv a -> CodeQ (OpenExp env aenv a)
forall e. OpenExp env aenv e -> CodeQ (OpenExp env aenv e)
liftE OpenExp env aenv a
e) ||]

liftELeftHandSide :: ELeftHandSide t env env' -> CodeQ (ELeftHandSide t env env')
liftELeftHandSide :: forall t env env'.
ELeftHandSide t env env' -> CodeQ (ELeftHandSide t env env')
liftELeftHandSide = (forall t. ScalarType t -> CodeQ (ScalarType t))
-> LeftHandSide ScalarType t env env'
-> CodeQ (LeftHandSide ScalarType t env env')
forall (s :: * -> *) v env env'.
(forall u. s u -> CodeQ (s u))
-> LeftHandSide s v env env' -> CodeQ (LeftHandSide s v env env')
liftLeftHandSide ScalarType u -> CodeQ (ScalarType u)
forall t. ScalarType t -> CodeQ (ScalarType t)
liftScalarType

liftExpVar :: ExpVar env t -> CodeQ (ExpVar env t)
liftExpVar :: forall env t. ExpVar env t -> CodeQ (ExpVar env t)
liftExpVar = (forall t. ScalarType t -> CodeQ (ScalarType t))
-> Var ScalarType env t -> CodeQ (Var ScalarType env t)
forall (s :: * -> *) env t.
(forall b. s b -> CodeQ (s b))
-> Var s env t -> CodeQ (Var s env t)
liftVar ScalarType b -> CodeQ (ScalarType b)
forall t. ScalarType t -> CodeQ (ScalarType t)
liftScalarType

liftBoundary
    :: forall aenv sh e.
       ArrayR (Array sh e)
    -> Boundary aenv (Array sh e)
    -> CodeQ (Boundary aenv (Array sh e))
liftBoundary :: forall aenv sh e.
ArrayR (Array sh e)
-> Boundary aenv (Array sh e) -> CodeQ (Boundary aenv (Array sh e))
liftBoundary ArrayR (Array sh e)
_             Boundary aenv (Array sh e)
Clamp        = [|| Boundary aenv t
forall aenv t. Boundary aenv t
Clamp ||]
liftBoundary ArrayR (Array sh e)
_             Boundary aenv (Array sh e)
Mirror       = [|| Boundary aenv t
forall aenv t. Boundary aenv t
Mirror ||]
liftBoundary ArrayR (Array sh e)
_             Boundary aenv (Array sh e)
Wrap         = [|| Boundary aenv t
forall aenv t. Boundary aenv t
Wrap ||]
liftBoundary (ArrayR ShapeR sh
_ TypeR e
tp) (Constant e
v) = [|| e -> Boundary aenv (Array sh e)
forall a aenv b. a -> Boundary aenv (Array b a)
Constant $$(TypeR e -> e -> CodeQ e
forall t. TypeR t -> t -> CodeQ t
liftElt TypeR e
tp e
e
v) ||]
liftBoundary ArrayR (Array sh e)
_             (Function Fun aenv (sh -> e)
f) = [|| Fun aenv (sh -> e) -> Boundary aenv (Array sh e)
forall aenv a b. Fun aenv (a -> b) -> Boundary aenv (Array a b)
Function $$(Fun aenv (sh -> e) -> CodeQ (Fun aenv (sh -> e))
forall env aenv t. OpenFun env aenv t -> CodeQ (OpenFun env aenv t)
liftOpenFun Fun aenv (sh -> e)
f) ||]

liftPrimConst :: PrimConst c -> CodeQ (PrimConst c)
liftPrimConst :: forall c. PrimConst c -> CodeQ (PrimConst c)
liftPrimConst (PrimMinBound BoundedType c
t) = [|| BoundedType a -> PrimConst a
forall a. BoundedType a -> PrimConst a
PrimMinBound $$(BoundedType c -> CodeQ (BoundedType c)
forall t. BoundedType t -> CodeQ (BoundedType t)
liftBoundedType BoundedType c
t) ||]
liftPrimConst (PrimMaxBound BoundedType c
t) = [|| BoundedType a -> PrimConst a
forall a. BoundedType a -> PrimConst a
PrimMaxBound $$(BoundedType c -> CodeQ (BoundedType c)
forall t. BoundedType t -> CodeQ (BoundedType t)
liftBoundedType BoundedType c
t) ||]
liftPrimConst (PrimPi FloatingType c
t)       = [|| FloatingType a -> PrimConst a
forall a. FloatingType a -> PrimConst a
PrimPi $$(FloatingType c -> CodeQ (FloatingType c)
forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType c
t) ||]

liftPrimFun :: PrimFun f -> CodeQ (PrimFun f)
liftPrimFun :: forall f. PrimFun f -> CodeQ (PrimFun f)
liftPrimFun (PrimAdd NumType a
t)                = [|| NumType a -> PrimFun ((a, a) -> a)
forall a. NumType a -> PrimFun ((a, a) -> a)
PrimAdd $$(NumType a -> CodeQ (NumType a)
forall t. NumType t -> CodeQ (NumType t)
liftNumType NumType a
t) ||]
liftPrimFun (PrimSub NumType a
t)                = [|| NumType a -> PrimFun ((a, a) -> a)
forall a. NumType a -> PrimFun ((a, a) -> a)
PrimSub $$(NumType a -> CodeQ (NumType a)
forall t. NumType t -> CodeQ (NumType t)
liftNumType NumType a
t) ||]
liftPrimFun (PrimMul NumType a
t)                = [|| NumType a -> PrimFun ((a, a) -> a)
forall a. NumType a -> PrimFun ((a, a) -> a)
PrimMul $$(NumType a -> CodeQ (NumType a)
forall t. NumType t -> CodeQ (NumType t)
liftNumType NumType a
t) ||]
liftPrimFun (PrimNeg NumType a
t)                = [|| NumType a -> PrimFun (a -> a)
forall a. NumType a -> PrimFun (a -> a)
PrimNeg $$(NumType a -> CodeQ (NumType a)
forall t. NumType t -> CodeQ (NumType t)
liftNumType NumType a
t) ||]
liftPrimFun (PrimAbs NumType a
t)                = [|| NumType a -> PrimFun (a -> a)
forall a. NumType a -> PrimFun (a -> a)
PrimAbs $$(NumType a -> CodeQ (NumType a)
forall t. NumType t -> CodeQ (NumType t)
liftNumType NumType a
t) ||]
liftPrimFun (PrimSig NumType a
t)                = [|| NumType a -> PrimFun (a -> a)
forall a. NumType a -> PrimFun (a -> a)
PrimSig $$(NumType a -> CodeQ (NumType a)
forall t. NumType t -> CodeQ (NumType t)
liftNumType NumType a
t) ||]
liftPrimFun (PrimQuot IntegralType a
t)               = [|| IntegralType a -> PrimFun ((a, a) -> a)
forall a. IntegralType a -> PrimFun ((a, a) -> a)
PrimQuot $$(IntegralType a -> CodeQ (IntegralType a)
forall t. IntegralType t -> CodeQ (IntegralType t)
liftIntegralType IntegralType a
t) ||]
liftPrimFun (PrimRem IntegralType a
t)                = [|| IntegralType a -> PrimFun ((a, a) -> a)
forall a. IntegralType a -> PrimFun ((a, a) -> a)
PrimRem $$(IntegralType a -> CodeQ (IntegralType a)
forall t. IntegralType t -> CodeQ (IntegralType t)
liftIntegralType IntegralType a
t) ||]
liftPrimFun (PrimQuotRem IntegralType a
t)            = [|| IntegralType a -> PrimFun ((a, a) -> (a, a))
forall a. IntegralType a -> PrimFun ((a, a) -> (a, a))
PrimQuotRem $$(IntegralType a -> CodeQ (IntegralType a)
forall t. IntegralType t -> CodeQ (IntegralType t)
liftIntegralType IntegralType a
t) ||]
liftPrimFun (PrimIDiv IntegralType a
t)               = [|| IntegralType a -> PrimFun ((a, a) -> a)
forall a. IntegralType a -> PrimFun ((a, a) -> a)
PrimIDiv $$(IntegralType a -> CodeQ (IntegralType a)
forall t. IntegralType t -> CodeQ (IntegralType t)
liftIntegralType IntegralType a
t) ||]
liftPrimFun (PrimMod IntegralType a
t)                = [|| IntegralType a -> PrimFun ((a, a) -> a)
forall a. IntegralType a -> PrimFun ((a, a) -> a)
PrimMod $$(IntegralType a -> CodeQ (IntegralType a)
forall t. IntegralType t -> CodeQ (IntegralType t)
liftIntegralType IntegralType a
t) ||]
liftPrimFun (PrimDivMod IntegralType a
t)             = [|| IntegralType a -> PrimFun ((a, a) -> (a, a))
forall a. IntegralType a -> PrimFun ((a, a) -> (a, a))
PrimDivMod $$(IntegralType a -> CodeQ (IntegralType a)
forall t. IntegralType t -> CodeQ (IntegralType t)
liftIntegralType IntegralType a
t) ||]
liftPrimFun (PrimBAnd IntegralType a
t)               = [|| IntegralType a -> PrimFun ((a, a) -> a)
forall a. IntegralType a -> PrimFun ((a, a) -> a)
PrimBAnd $$(IntegralType a -> CodeQ (IntegralType a)
forall t. IntegralType t -> CodeQ (IntegralType t)
liftIntegralType IntegralType a
t) ||]
liftPrimFun (PrimBOr IntegralType a
t)                = [|| IntegralType a -> PrimFun ((a, a) -> a)
forall a. IntegralType a -> PrimFun ((a, a) -> a)
PrimBOr $$(IntegralType a -> CodeQ (IntegralType a)
forall t. IntegralType t -> CodeQ (IntegralType t)
liftIntegralType IntegralType a
t) ||]
liftPrimFun (PrimBXor IntegralType a
t)               = [|| IntegralType a -> PrimFun ((a, a) -> a)
forall a. IntegralType a -> PrimFun ((a, a) -> a)
PrimBXor $$(IntegralType a -> CodeQ (IntegralType a)
forall t. IntegralType t -> CodeQ (IntegralType t)
liftIntegralType IntegralType a
t) ||]
liftPrimFun (PrimBNot IntegralType a
t)               = [|| IntegralType a -> PrimFun (a -> a)
forall a. IntegralType a -> PrimFun (a -> a)
PrimBNot $$(IntegralType a -> CodeQ (IntegralType a)
forall t. IntegralType t -> CodeQ (IntegralType t)
liftIntegralType IntegralType a
t) ||]
liftPrimFun (PrimBShiftL IntegralType a
t)            = [|| IntegralType a -> PrimFun ((a, Int) -> a)
forall a. IntegralType a -> PrimFun ((a, Int) -> a)
PrimBShiftL $$(IntegralType a -> CodeQ (IntegralType a)
forall t. IntegralType t -> CodeQ (IntegralType t)
liftIntegralType IntegralType a
t) ||]
liftPrimFun (PrimBShiftR IntegralType a
t)            = [|| IntegralType a -> PrimFun ((a, Int) -> a)
forall a. IntegralType a -> PrimFun ((a, Int) -> a)
PrimBShiftR $$(IntegralType a -> CodeQ (IntegralType a)
forall t. IntegralType t -> CodeQ (IntegralType t)
liftIntegralType IntegralType a
t) ||]
liftPrimFun (PrimBRotateL IntegralType a
t)           = [|| IntegralType a -> PrimFun ((a, Int) -> a)
forall a. IntegralType a -> PrimFun ((a, Int) -> a)
PrimBRotateL $$(IntegralType a -> CodeQ (IntegralType a)
forall t. IntegralType t -> CodeQ (IntegralType t)
liftIntegralType IntegralType a
t) ||]
liftPrimFun (PrimBRotateR IntegralType a
t)           = [|| IntegralType a -> PrimFun ((a, Int) -> a)
forall a. IntegralType a -> PrimFun ((a, Int) -> a)
PrimBRotateR $$(IntegralType a -> CodeQ (IntegralType a)
forall t. IntegralType t -> CodeQ (IntegralType t)
liftIntegralType IntegralType a
t) ||]
liftPrimFun (PrimPopCount IntegralType a
t)           = [|| IntegralType a -> PrimFun (a -> Int)
forall a. IntegralType a -> PrimFun (a -> Int)
PrimPopCount $$(IntegralType a -> CodeQ (IntegralType a)
forall t. IntegralType t -> CodeQ (IntegralType t)
liftIntegralType IntegralType a
t) ||]
liftPrimFun (PrimCountLeadingZeros IntegralType a
t)  = [|| IntegralType a -> PrimFun (a -> Int)
forall a. IntegralType a -> PrimFun (a -> Int)
PrimCountLeadingZeros $$(IntegralType a -> CodeQ (IntegralType a)
forall t. IntegralType t -> CodeQ (IntegralType t)
liftIntegralType IntegralType a
t) ||]
liftPrimFun (PrimCountTrailingZeros IntegralType a
t) = [|| IntegralType a -> PrimFun (a -> Int)
forall a. IntegralType a -> PrimFun (a -> Int)
PrimCountTrailingZeros $$(IntegralType a -> CodeQ (IntegralType a)
forall t. IntegralType t -> CodeQ (IntegralType t)
liftIntegralType IntegralType a
t) ||]
liftPrimFun (PrimFDiv FloatingType a
t)               = [|| FloatingType a -> PrimFun ((a, a) -> a)
forall a. FloatingType a -> PrimFun ((a, a) -> a)
PrimFDiv $$(FloatingType a -> CodeQ (FloatingType a)
forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType a
t) ||]
liftPrimFun (PrimRecip FloatingType a
t)              = [|| FloatingType a -> PrimFun (a -> a)
forall a. FloatingType a -> PrimFun (a -> a)
PrimRecip $$(FloatingType a -> CodeQ (FloatingType a)
forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType a
t) ||]
liftPrimFun (PrimSin FloatingType a
t)                = [|| FloatingType a -> PrimFun (a -> a)
forall a. FloatingType a -> PrimFun (a -> a)
PrimSin $$(FloatingType a -> CodeQ (FloatingType a)
forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType a
t) ||]
liftPrimFun (PrimCos FloatingType a
t)                = [|| FloatingType a -> PrimFun (a -> a)
forall a. FloatingType a -> PrimFun (a -> a)
PrimCos $$(FloatingType a -> CodeQ (FloatingType a)
forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType a
t) ||]
liftPrimFun (PrimTan FloatingType a
t)                = [|| FloatingType a -> PrimFun (a -> a)
forall a. FloatingType a -> PrimFun (a -> a)
PrimTan $$(FloatingType a -> CodeQ (FloatingType a)
forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType a
t) ||]
liftPrimFun (PrimAsin FloatingType a
t)               = [|| FloatingType a -> PrimFun (a -> a)
forall a. FloatingType a -> PrimFun (a -> a)
PrimAsin $$(FloatingType a -> CodeQ (FloatingType a)
forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType a
t) ||]
liftPrimFun (PrimAcos FloatingType a
t)               = [|| FloatingType a -> PrimFun (a -> a)
forall a. FloatingType a -> PrimFun (a -> a)
PrimAcos $$(FloatingType a -> CodeQ (FloatingType a)
forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType a
t) ||]
liftPrimFun (PrimAtan FloatingType a
t)               = [|| FloatingType a -> PrimFun (a -> a)
forall a. FloatingType a -> PrimFun (a -> a)
PrimAtan $$(FloatingType a -> CodeQ (FloatingType a)
forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType a
t) ||]
liftPrimFun (PrimSinh FloatingType a
t)               = [|| FloatingType a -> PrimFun (a -> a)
forall a. FloatingType a -> PrimFun (a -> a)
PrimSinh $$(FloatingType a -> CodeQ (FloatingType a)
forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType a
t) ||]
liftPrimFun (PrimCosh FloatingType a
t)               = [|| FloatingType a -> PrimFun (a -> a)
forall a. FloatingType a -> PrimFun (a -> a)
PrimCosh $$(FloatingType a -> CodeQ (FloatingType a)
forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType a
t) ||]
liftPrimFun (PrimTanh FloatingType a
t)               = [|| FloatingType a -> PrimFun (a -> a)
forall a. FloatingType a -> PrimFun (a -> a)
PrimTanh $$(FloatingType a -> CodeQ (FloatingType a)
forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType a
t) ||]
liftPrimFun (PrimAsinh FloatingType a
t)              = [|| FloatingType a -> PrimFun (a -> a)
forall a. FloatingType a -> PrimFun (a -> a)
PrimAsinh $$(FloatingType a -> CodeQ (FloatingType a)
forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType a
t) ||]
liftPrimFun (PrimAcosh FloatingType a
t)              = [|| FloatingType a -> PrimFun (a -> a)
forall a. FloatingType a -> PrimFun (a -> a)
PrimAcosh $$(FloatingType a -> CodeQ (FloatingType a)
forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType a
t) ||]
liftPrimFun (PrimAtanh FloatingType a
t)              = [|| FloatingType a -> PrimFun (a -> a)
forall a. FloatingType a -> PrimFun (a -> a)
PrimAtanh $$(FloatingType a -> CodeQ (FloatingType a)
forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType a
t) ||]
liftPrimFun (PrimExpFloating FloatingType a
t)        = [|| FloatingType a -> PrimFun (a -> a)
forall a. FloatingType a -> PrimFun (a -> a)
PrimExpFloating $$(FloatingType a -> CodeQ (FloatingType a)
forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType a
t) ||]
liftPrimFun (PrimSqrt FloatingType a
t)               = [|| FloatingType a -> PrimFun (a -> a)
forall a. FloatingType a -> PrimFun (a -> a)
PrimSqrt $$(FloatingType a -> CodeQ (FloatingType a)
forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType a
t) ||]
liftPrimFun (PrimLog FloatingType a
t)                = [|| FloatingType a -> PrimFun (a -> a)
forall a. FloatingType a -> PrimFun (a -> a)
PrimLog $$(FloatingType a -> CodeQ (FloatingType a)
forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType a
t) ||]
liftPrimFun (PrimFPow FloatingType a
t)               = [|| FloatingType a -> PrimFun ((a, a) -> a)
forall a. FloatingType a -> PrimFun ((a, a) -> a)
PrimFPow $$(FloatingType a -> CodeQ (FloatingType a)
forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType a
t) ||]
liftPrimFun (PrimLogBase FloatingType a
t)            = [|| FloatingType a -> PrimFun ((a, a) -> a)
forall a. FloatingType a -> PrimFun ((a, a) -> a)
PrimLogBase $$(FloatingType a -> CodeQ (FloatingType a)
forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType a
t) ||]
liftPrimFun (PrimTruncate FloatingType a
ta IntegralType b
tb)       = [|| FloatingType a -> IntegralType b -> PrimFun (a -> b)
forall a b. FloatingType a -> IntegralType b -> PrimFun (a -> b)
PrimTruncate $$(FloatingType a -> CodeQ (FloatingType a)
forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType a
ta) $$(IntegralType b -> CodeQ (IntegralType b)
forall t. IntegralType t -> CodeQ (IntegralType t)
liftIntegralType IntegralType b
tb) ||]
liftPrimFun (PrimRound FloatingType a
ta IntegralType b
tb)          = [|| FloatingType a -> IntegralType b -> PrimFun (a -> b)
forall a b. FloatingType a -> IntegralType b -> PrimFun (a -> b)
PrimRound $$(FloatingType a -> CodeQ (FloatingType a)
forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType a
ta) $$(IntegralType b -> CodeQ (IntegralType b)
forall t. IntegralType t -> CodeQ (IntegralType t)
liftIntegralType IntegralType b
tb) ||]
liftPrimFun (PrimFloor FloatingType a
ta IntegralType b
tb)          = [|| FloatingType a -> IntegralType b -> PrimFun (a -> b)
forall a b. FloatingType a -> IntegralType b -> PrimFun (a -> b)
PrimFloor $$(FloatingType a -> CodeQ (FloatingType a)
forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType a
ta) $$(IntegralType b -> CodeQ (IntegralType b)
forall t. IntegralType t -> CodeQ (IntegralType t)
liftIntegralType IntegralType b
tb) ||]
liftPrimFun (PrimCeiling FloatingType a
ta IntegralType b
tb)        = [|| FloatingType a -> IntegralType b -> PrimFun (a -> b)
forall a b. FloatingType a -> IntegralType b -> PrimFun (a -> b)
PrimCeiling $$(FloatingType a -> CodeQ (FloatingType a)
forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType a
ta) $$(IntegralType b -> CodeQ (IntegralType b)
forall t. IntegralType t -> CodeQ (IntegralType t)
liftIntegralType IntegralType b
tb) ||]
liftPrimFun (PrimIsNaN FloatingType a
t)              = [|| FloatingType a -> PrimFun (a -> PrimBool)
forall a. FloatingType a -> PrimFun (a -> PrimBool)
PrimIsNaN $$(FloatingType a -> CodeQ (FloatingType a)
forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType a
t) ||]
liftPrimFun (PrimIsInfinite FloatingType a
t)         = [|| FloatingType a -> PrimFun (a -> PrimBool)
forall a. FloatingType a -> PrimFun (a -> PrimBool)
PrimIsInfinite $$(FloatingType a -> CodeQ (FloatingType a)
forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType a
t) ||]
liftPrimFun (PrimAtan2 FloatingType a
t)              = [|| FloatingType a -> PrimFun ((a, a) -> a)
forall a. FloatingType a -> PrimFun ((a, a) -> a)
PrimAtan2 $$(FloatingType a -> CodeQ (FloatingType a)
forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType a
t) ||]
liftPrimFun (PrimLt SingleType a
t)                 = [|| SingleType a -> PrimFun ((a, a) -> PrimBool)
forall a. SingleType a -> PrimFun ((a, a) -> PrimBool)
PrimLt $$(SingleType a -> CodeQ (SingleType a)
forall t. SingleType t -> CodeQ (SingleType t)
liftSingleType SingleType a
t) ||]
liftPrimFun (PrimGt SingleType a
t)                 = [|| SingleType a -> PrimFun ((a, a) -> PrimBool)
forall a. SingleType a -> PrimFun ((a, a) -> PrimBool)
PrimGt $$(SingleType a -> CodeQ (SingleType a)
forall t. SingleType t -> CodeQ (SingleType t)
liftSingleType SingleType a
t) ||]
liftPrimFun (PrimLtEq SingleType a
t)               = [|| SingleType a -> PrimFun ((a, a) -> PrimBool)
forall a. SingleType a -> PrimFun ((a, a) -> PrimBool)
PrimLtEq $$(SingleType a -> CodeQ (SingleType a)
forall t. SingleType t -> CodeQ (SingleType t)
liftSingleType SingleType a
t) ||]
liftPrimFun (PrimGtEq SingleType a
t)               = [|| SingleType a -> PrimFun ((a, a) -> PrimBool)
forall a. SingleType a -> PrimFun ((a, a) -> PrimBool)
PrimGtEq $$(SingleType a -> CodeQ (SingleType a)
forall t. SingleType t -> CodeQ (SingleType t)
liftSingleType SingleType a
t) ||]
liftPrimFun (PrimEq SingleType a
t)                 = [|| SingleType a -> PrimFun ((a, a) -> PrimBool)
forall a. SingleType a -> PrimFun ((a, a) -> PrimBool)
PrimEq $$(SingleType a -> CodeQ (SingleType a)
forall t. SingleType t -> CodeQ (SingleType t)
liftSingleType SingleType a
t) ||]
liftPrimFun (PrimNEq SingleType a
t)                = [|| SingleType a -> PrimFun ((a, a) -> PrimBool)
forall a. SingleType a -> PrimFun ((a, a) -> PrimBool)
PrimNEq $$(SingleType a -> CodeQ (SingleType a)
forall t. SingleType t -> CodeQ (SingleType t)
liftSingleType SingleType a
t) ||]
liftPrimFun (PrimMax SingleType a
t)                = [|| SingleType a -> PrimFun ((a, a) -> a)
forall a. SingleType a -> PrimFun ((a, a) -> a)
PrimMax $$(SingleType a -> CodeQ (SingleType a)
forall t. SingleType t -> CodeQ (SingleType t)
liftSingleType SingleType a
t) ||]
liftPrimFun (PrimMin SingleType a
t)                = [|| SingleType a -> PrimFun ((a, a) -> a)
forall a. SingleType a -> PrimFun ((a, a) -> a)
PrimMin $$(SingleType a -> CodeQ (SingleType a)
forall t. SingleType t -> CodeQ (SingleType t)
liftSingleType SingleType a
t) ||]
liftPrimFun PrimFun f
PrimLAnd                   = [|| PrimFun ((PrimBool, PrimBool) -> PrimBool)
PrimLAnd ||]
liftPrimFun PrimFun f
PrimLOr                    = [|| PrimFun ((PrimBool, PrimBool) -> PrimBool)
PrimLOr ||]
liftPrimFun PrimFun f
PrimLNot                   = [|| PrimFun (PrimBool -> PrimBool)
PrimLNot ||]
liftPrimFun (PrimFromIntegral IntegralType a
ta NumType b
tb)   = [|| IntegralType a -> NumType b -> PrimFun (a -> b)
forall a b. IntegralType a -> NumType b -> PrimFun (a -> b)
PrimFromIntegral $$(IntegralType a -> CodeQ (IntegralType a)
forall t. IntegralType t -> CodeQ (IntegralType t)
liftIntegralType IntegralType a
ta) $$(NumType b -> CodeQ (NumType b)
forall t. NumType t -> CodeQ (NumType t)
liftNumType NumType b
tb) ||]
liftPrimFun (PrimToFloating NumType a
ta FloatingType b
tb)     = [|| NumType a -> FloatingType b -> PrimFun (a -> b)
forall a b. NumType a -> FloatingType b -> PrimFun (a -> b)
PrimToFloating $$(NumType a -> CodeQ (NumType a)
forall t. NumType t -> CodeQ (NumType t)
liftNumType NumType a
ta) $$(FloatingType b -> CodeQ (FloatingType b)
forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType b
tb) ||]


formatDirection :: Format r (Direction -> r)
formatDirection :: forall r. Format r (Direction -> r)
formatDirection = (Direction -> Builder) -> Format r (Direction -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
later ((Direction -> Builder) -> Format r (Direction -> r))
-> (Direction -> Builder) -> Format r (Direction -> r)
forall a b. (a -> b) -> a -> b
$ \case
  Direction
LeftToRight -> Char -> Builder
singleton Char
'l'
  Direction
RightToLeft -> Char -> Builder
singleton Char
'r'

formatPreAccOp :: Format r (PreOpenAcc acc aenv arrs -> r)
formatPreAccOp :: forall r (acc :: * -> * -> *) aenv arrs.
Format r (PreOpenAcc acc aenv arrs -> r)
formatPreAccOp = (PreOpenAcc acc aenv arrs -> Builder)
-> Format r (PreOpenAcc acc aenv arrs -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
later ((PreOpenAcc acc aenv arrs -> Builder)
 -> Format r (PreOpenAcc acc aenv arrs -> r))
-> (PreOpenAcc acc aenv arrs -> Builder)
-> Format r (PreOpenAcc acc aenv arrs -> r)
forall a b. (a -> b) -> a -> b
$ \case
  Alet{}            -> Builder
"Alet"
  Avar (Var ArrayR (Array sh e)
_ Idx aenv (Array sh e)
ix)   -> Format Builder (Int -> Builder) -> Int -> Builder
forall a. Format Builder a -> a
bformat (Format (Int -> Builder) (Int -> Builder)
"Avar a" Format (Int -> Builder) (Int -> Builder)
-> Format Builder (Int -> Builder)
-> Format Builder (Int -> Builder)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Builder (Int -> Builder)
forall a r. Integral a => Format r (a -> r)
int) (Idx aenv (Array sh e) -> Int
forall env t. Idx env t -> Int
idxToInt Idx aenv (Array sh e)
ix)
  Use ArrayR (Array sh e)
aR Array sh e
a          -> Format Builder ([Char] -> Builder) -> [Char] -> Builder
forall a. Format Builder a -> a
bformat (Format ([Char] -> Builder) ([Char] -> Builder)
"Use " Format ([Char] -> Builder) ([Char] -> Builder)
-> Format Builder ([Char] -> Builder)
-> Format Builder ([Char] -> Builder)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Builder ([Char] -> Builder)
forall r. Format r ([Char] -> r)
string) (Int -> (e -> ShowS) -> ArrayR (Array sh e) -> Array sh e -> [Char]
forall e sh.
Int -> (e -> ShowS) -> ArrayR (Array sh e) -> Array sh e -> [Char]
showArrayShort Int
5 (TypeR e -> e -> ShowS
forall e. TypeR e -> e -> ShowS
showsElt (ArrayR (Array sh e) -> TypeR e
forall sh e. ArrayR (Array sh e) -> TypeR e
arrayRtype ArrayR (Array sh e)
aR)) ArrayR (Array sh e)
aR Array sh e
a)
  Atrace{}          -> Builder
"Atrace"
  Apply{}           -> Builder
"Apply"
  Aforeign{}        -> Builder
"Aforeign"
  Acond{}           -> Builder
"Acond"
  Awhile{}          -> Builder
"Awhile"
  Apair{}           -> Builder
"Apair"
  PreOpenAcc acc aenv arrs
Anil              -> Builder
"Anil"
  Unit{}            -> Builder
"Unit"
  Generate{}        -> Builder
"Generate"
  Transform{}       -> Builder
"Transform"
  Reshape{}         -> Builder
"Reshape"
  Replicate{}       -> Builder
"Replicate"
  Slice{}           -> Builder
"Slice"
  Map{}             -> Builder
"Map"
  ZipWith{}         -> Builder
"ZipWith"
  Fold Fun aenv (e -> e -> e)
_ Maybe (Exp aenv e)
z acc aenv (Array (sh, Int) e)
_        -> Format Builder (Maybe (Exp aenv e) -> Builder)
-> Maybe (Exp aenv e) -> Builder
forall a. Format Builder a -> a
bformat (Format
  (Maybe (Exp aenv e) -> Builder) (Maybe (Exp aenv e) -> Builder)
"Fold" Format
  (Maybe (Exp aenv e) -> Builder) (Maybe (Exp aenv e) -> Builder)
-> Format Builder (Maybe (Exp aenv e) -> Builder)
-> Format Builder (Maybe (Exp aenv e) -> Builder)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Builder
-> Format Builder (Exp aenv e -> Builder)
-> Format Builder (Maybe (Exp aenv e) -> Builder)
forall a r.
Builder -> Format Builder (a -> Builder) -> Format r (Maybe a -> r)
maybed Builder
"1" (Builder -> Format Builder (Exp aenv e -> Builder)
forall r a. Builder -> Format r (a -> r)
fconst Builder
forall a. Monoid a => a
mempty)) Maybe (Exp aenv e)
z
  FoldSeg IntegralType i
_ Fun aenv (e -> e -> e)
_ Maybe (Exp aenv e)
z acc aenv (Array (sh, Int) e)
_ acc aenv (Segments i)
_ -> Format Builder (Maybe (Exp aenv e) -> Builder)
-> Maybe (Exp aenv e) -> Builder
forall a. Format Builder a -> a
bformat (Format
  (Maybe (Exp aenv e) -> Builder) (Maybe (Exp aenv e) -> Builder)
"Fold" Format
  (Maybe (Exp aenv e) -> Builder) (Maybe (Exp aenv e) -> Builder)
-> Format Builder (Maybe (Exp aenv e) -> Builder)
-> Format Builder (Maybe (Exp aenv e) -> Builder)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Builder
-> Format Builder (Exp aenv e -> Builder)
-> Format Builder (Maybe (Exp aenv e) -> Builder)
forall a r.
Builder -> Format Builder (a -> Builder) -> Format r (Maybe a -> r)
maybed Builder
"1" (Builder -> Format Builder (Exp aenv e -> Builder)
forall r a. Builder -> Format r (a -> r)
fconst Builder
forall a. Monoid a => a
mempty) Format Builder (Maybe (Exp aenv e) -> Builder)
-> Format Builder Builder
-> Format Builder (Maybe (Exp aenv e) -> Builder)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Builder Builder
"Seg") Maybe (Exp aenv e)
z
  Scan Direction
d Fun aenv (e -> e -> e)
_ Maybe (Exp aenv e)
z acc aenv (Array (sh, Int) e)
_      -> Format Builder (Direction -> Maybe (Exp aenv e) -> Builder)
-> Direction -> Maybe (Exp aenv e) -> Builder
forall a. Format Builder a -> a
bformat (Format
  (Direction -> Maybe (Exp aenv e) -> Builder)
  (Direction -> Maybe (Exp aenv e) -> Builder)
"Scan" Format
  (Direction -> Maybe (Exp aenv e) -> Builder)
  (Direction -> Maybe (Exp aenv e) -> Builder)
-> Format Builder (Direction -> Maybe (Exp aenv e) -> Builder)
-> Format Builder (Direction -> Maybe (Exp aenv e) -> Builder)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format
  (Maybe (Exp aenv e) -> Builder)
  (Direction -> Maybe (Exp aenv e) -> Builder)
forall r. Format r (Direction -> r)
formatDirection Format
  (Maybe (Exp aenv e) -> Builder)
  (Direction -> Maybe (Exp aenv e) -> Builder)
-> Format Builder (Maybe (Exp aenv e) -> Builder)
-> Format Builder (Direction -> Maybe (Exp aenv e) -> Builder)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Builder
-> Format Builder (Exp aenv e -> Builder)
-> Format Builder (Maybe (Exp aenv e) -> Builder)
forall a r.
Builder -> Format Builder (a -> Builder) -> Format r (Maybe a -> r)
maybed Builder
"1" (Builder -> Format Builder (Exp aenv e -> Builder)
forall r a. Builder -> Format r (a -> r)
fconst Builder
forall a. Monoid a => a
mempty)) Direction
d Maybe (Exp aenv e)
z
  Scan' Direction
d Fun aenv (e -> e -> e)
_ Exp aenv e
_ acc aenv (Array (sh, Int) e)
_     -> Format Builder (Direction -> Builder) -> Direction -> Builder
forall a. Format Builder a -> a
bformat (Format (Direction -> Builder) (Direction -> Builder)
"Scan" Format (Direction -> Builder) (Direction -> Builder)
-> Format Builder (Direction -> Builder)
-> Format Builder (Direction -> Builder)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Builder (Direction -> Builder)
forall r. Format r (Direction -> r)
formatDirection Format Builder (Direction -> Builder)
-> Format Builder Builder -> Format Builder (Direction -> Builder)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Builder Builder
"\'") Direction
d
  Permute{}         -> Builder
"Permute"
  Backpermute{}     -> Builder
"Backpermute"
  Stencil{}         -> Builder
"Stencil"
  Stencil2{}        -> Builder
"Stencil2"

formatExpOp :: Format r (OpenExp aenv env t -> r)
formatExpOp :: forall r aenv env t. Format r (OpenExp aenv env t -> r)
formatExpOp = (OpenExp aenv env t -> Builder)
-> Format r (OpenExp aenv env t -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
later ((OpenExp aenv env t -> Builder)
 -> Format r (OpenExp aenv env t -> r))
-> (OpenExp aenv env t -> Builder)
-> Format r (OpenExp aenv env t -> r)
forall a b. (a -> b) -> a -> b
$ \case
  Let{}           -> Builder
"Let"
  Evar (Var ScalarType t
_ Idx aenv t
ix) -> Format Builder (Int -> Builder) -> Int -> Builder
forall a. Format Builder a -> a
bformat (Format (Int -> Builder) (Int -> Builder)
"Var x" Format (Int -> Builder) (Int -> Builder)
-> Format Builder (Int -> Builder)
-> Format Builder (Int -> Builder)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Builder (Int -> Builder)
forall a r. Integral a => Format r (a -> r)
int) (Idx aenv t -> Int
forall env t. Idx env t -> Int
idxToInt Idx aenv t
ix)
  Const ScalarType t
tp t
c      -> Format Builder ([Char] -> Builder) -> [Char] -> Builder
forall a. Format Builder a -> a
bformat (Format ([Char] -> Builder) ([Char] -> Builder)
"Const " Format ([Char] -> Builder) ([Char] -> Builder)
-> Format Builder ([Char] -> Builder)
-> Format Builder ([Char] -> Builder)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Builder ([Char] -> Builder)
forall r. Format r ([Char] -> r)
string) (TypeR t -> t -> [Char]
forall e. TypeR e -> e -> [Char]
showElt (ScalarType t -> TypeR t
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ScalarType t
tp) t
c)
  Undef{}         -> Builder
"Undef"
  Foreign{}       -> Builder
"Foreign"
  Pair{}          -> Builder
"Pair"
  Nil{}           -> Builder
"Nil"
  VecPack{}       -> Builder
"VecPack"
  VecUnpack{}     -> Builder
"VecUnpack"
  IndexSlice{}    -> Builder
"IndexSlice"
  IndexFull{}     -> Builder
"IndexFull"
  ToIndex{}       -> Builder
"ToIndex"
  FromIndex{}     -> Builder
"FromIndex"
  Case{}          -> Builder
"Case"
  Cond{}          -> Builder
"Cond"
  While{}         -> Builder
"While"
  PrimConst{}     -> Builder
"PrimConst"
  PrimApp{}       -> Builder
"PrimApp"
  Index{}         -> Builder
"Index"
  LinearIndex{}   -> Builder
"LinearIndex"
  Shape{}         -> Builder
"Shape"
  ShapeSize{}     -> Builder
"ShapeSize"
  Coerce{}        -> Builder
"Coerce"