{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE LambdaCase            #-}
{-# 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(..),
  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,

  -- ** Miscellaneous
  showPreAccOp,
  showExpOp,

) 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 Language.Haskell.TH                                          ( Q, TExp )
import Prelude

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))


-- | 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 surface types (not the
-- representation 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


  -- 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 partial function: if it evaluates to the magic value 'ignore'
  --      (i.e. a tuple of -1 values) then those elements of the domain 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
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: 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 :: ExpVars env t -> OpenExp env aenv t
expVars ExpVars env t
TupRunit         = OpenExp env aenv t
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) a
v1 TupR (Var ScalarType env) b
v2) = TupR (Var ScalarType env) a -> OpenExp env aenv a
forall env t aenv. ExpVars env t -> OpenExp env aenv t
expVars TupR (Var ScalarType env) a
v1 OpenExp env aenv a -> OpenExp env aenv b -> OpenExp env aenv (a, b)
forall env aenv t1 t2.
OpenExp env aenv t1
-> OpenExp env aenv t2 -> OpenExp env aenv (t1, t2)
`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 tuples or 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 :: OpenAcc aenv a -> ArraysR a
arraysR (OpenAcc PreOpenAcc OpenAcc aenv a
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 :: 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 (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 :: 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 (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 (Array sh e) -> TupR ArrayR (Array sh e)
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle 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 :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
TupRpair (acc aenv as -> TupR ArrayR as
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR acc aenv as
as) (acc aenv bs -> TupR ArrayR bs
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR acc aenv bs
bs)
  arraysR PreOpenAcc acc aenv a
Anil                        = ArraysR a
forall (s :: * -> *). TupR s ()
TupRunit
  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 (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
_)   = ALeftHandSide a aenv aenv' -> TupR ArrayR a
forall (s :: * -> *) v env env'.
LeftHandSide s v env env' -> TupR s v
lhsToTupR 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 (Array sh e) -> TupR ArrayR (Array sh e)
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle 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
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 (Array sh e) -> TupR ArrayR (Array sh e)
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle 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 (Array sh' b) -> TupR ArrayR (Array sh' b)
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle 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
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
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
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
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
sh) 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 (Array (sh, Int) e) -> ArraysR (Array (sh, Int) e)
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR 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 (Array (sh, Int) e) -> ArraysR (Array (sh, Int) e)
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR 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
sh) 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 :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, 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 (Array sh' e) -> ArraysR (Array sh' e)
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR 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
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
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
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 :: 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 -> TypeR 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 -> TypeR t
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ScalarType t
tR
  Foreign TypeR t
tR asm (x -> t)
_ Fun () (x -> t)
_ OpenExp aenv env x
_             -> TypeR 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 :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, 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                          -> TypeR t
forall (s :: * -> *). TupR s ()
TupRunit
  VecPack   VecR n s tup
vecR OpenExp aenv env tup
_             -> ScalarType (Vec n s) -> TupR ScalarType (Vec n s)
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle (ScalarType (Vec n s) -> TupR ScalarType (Vec n s))
-> ScalarType (Vec n s) -> TupR ScalarType (Vec n s)
forall a b. (a -> b) -> a -> b
$ VectorType (Vec n s) -> ScalarType (Vec n s)
forall (n :: Nat) a. VectorType (Vec n a) -> ScalarType (Vec n a)
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 -> TypeR 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 -> TypeR t
forall sh. ShapeR sh -> TypeR sh
shapeType (ShapeR t -> TypeR t) -> ShapeR t -> TypeR 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 -> TypeR t
forall sh. ShapeR sh -> TypeR sh
shapeType (ShapeR t -> TypeR t) -> ShapeR t -> TypeR 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 Int -> TupR ScalarType Int
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ScalarType Int
scalarTypeInt
  FromIndex ShapeR t
shr OpenExp aenv env t
_ OpenExp aenv env Int
_            -> ShapeR t -> TypeR 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 -> TypeR 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 -> TypeR t
forall aenv env t. HasCallStack => OpenExp aenv env t -> TypeR t
expType OpenExp aenv env t
e
  Case{}                       -> [Char] -> TypeR t
forall a. HasCallStack => [Char] -> a
internalError [Char]
"empty case encountered"
  Cond OpenExp aenv env PrimBool
_ OpenExp aenv env t
e OpenExp aenv env t
_                   -> OpenExp aenv env t -> TypeR 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
_        -> ELeftHandSide a aenv env' -> TupR ScalarType a
forall (s :: * -> *) v env env'.
LeftHandSide s v env env' -> TupR s v
lhsToTupR ELeftHandSide a aenv env'
lhs
  While{}                      -> [Char] -> TypeR 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 -> TypeR t
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ScalarType t
tR
  PrimConst PrimConst t
c                  -> ScalarType t -> TypeR t
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle (ScalarType t -> TypeR t) -> ScalarType t -> TypeR 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, TypeR t) -> TypeR t
forall a b. (a, b) -> b
snd ((TypeR a, TypeR t) -> TypeR t) -> (TypeR a, TypeR t) -> TypeR t
forall a b. (a -> b) -> a -> b
$ PrimFun (a -> t) -> (TypeR a, TypeR 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) -> TypeR 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) -> TypeR 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 -> TypeR t
forall sh. ShapeR sh -> TypeR sh
shapeType (ShapeR t -> TypeR t) -> ShapeR t -> TypeR 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 Int -> TupR ScalarType Int
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ScalarType Int
scalarTypeInt
  Undef ScalarType t
tR                     -> ScalarType t -> TypeR 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 -> TypeR t
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ScalarType t
tR

primConstType :: PrimConst a -> SingleType a
primConstType :: 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 :: 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 :: 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 :: PrimFun (a -> b) -> (TypeR a, TypeR b)
primFunType = \case
  -- Num
  PrimAdd NumType a
t                 -> TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a)
forall (s :: * -> *) b. TupR s b -> (TupR s (b, b), TupR s b)
binary' (TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a))
-> TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a)
forall a b. (a -> b) -> a -> b
$ NumType a -> TupR ScalarType a
forall a. NumType a -> TupR ScalarType a
num NumType a
t
  PrimSub NumType a
t                 -> TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a)
forall (s :: * -> *) b. TupR s b -> (TupR s (b, b), TupR s b)
binary' (TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a))
-> TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a)
forall a b. (a -> b) -> a -> b
$ NumType a -> TupR ScalarType a
forall a. NumType a -> TupR ScalarType a
num NumType a
t
  PrimMul NumType a
t                 -> TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a)
forall (s :: * -> *) b. TupR s b -> (TupR s (b, b), TupR s b)
binary' (TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a))
-> TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a)
forall a b. (a -> b) -> a -> b
$ NumType a -> TupR ScalarType a
forall a. NumType a -> TupR ScalarType a
num NumType a
t
  PrimNeg NumType a
t                 -> TupR ScalarType a -> (TupR ScalarType a, TupR ScalarType a)
forall b. b -> (b, b)
unary'  (TupR ScalarType a -> (TupR ScalarType a, TupR ScalarType a))
-> TupR ScalarType a -> (TupR ScalarType a, TupR ScalarType a)
forall a b. (a -> b) -> a -> b
$ NumType a -> TupR ScalarType a
forall a. NumType a -> TupR ScalarType a
num NumType a
t
  PrimAbs NumType a
t                 -> TupR ScalarType a -> (TupR ScalarType a, TupR ScalarType a)
forall b. b -> (b, b)
unary'  (TupR ScalarType a -> (TupR ScalarType a, TupR ScalarType a))
-> TupR ScalarType a -> (TupR ScalarType a, TupR ScalarType a)
forall a b. (a -> b) -> a -> b
$ NumType a -> TupR ScalarType a
forall a. NumType a -> TupR ScalarType a
num NumType a
t
  PrimSig NumType a
t                 -> TupR ScalarType a -> (TupR ScalarType a, TupR ScalarType a)
forall b. b -> (b, b)
unary'  (TupR ScalarType a -> (TupR ScalarType a, TupR ScalarType a))
-> TupR ScalarType a -> (TupR ScalarType a, TupR ScalarType a)
forall a b. (a -> b) -> a -> b
$ NumType a -> TupR ScalarType a
forall a. NumType a -> TupR ScalarType a
num NumType a
t

  -- Integral
  PrimQuot IntegralType a
t                -> TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a)
forall (s :: * -> *) b. TupR s b -> (TupR s (b, b), TupR s b)
binary' (TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a))
-> TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a)
forall a b. (a -> b) -> a -> b
$ IntegralType a -> TupR ScalarType a
forall a. IntegralType a -> TupR ScalarType a
integral IntegralType a
t
  PrimRem  IntegralType a
t                -> TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a)
forall (s :: * -> *) b. TupR s b -> (TupR s (b, b), TupR s b)
binary' (TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a))
-> TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a)
forall a b. (a -> b) -> a -> b
$ IntegralType a -> TupR ScalarType a
forall a. IntegralType a -> TupR ScalarType a
integral IntegralType a
t
  PrimQuotRem IntegralType a
t             -> TupR ScalarType (a, a)
-> (TupR ScalarType (a, a), TupR ScalarType (a, a))
forall b. b -> (b, b)
unary' (TupR ScalarType (a, a)
 -> (TupR ScalarType (a, a), TupR ScalarType (a, a)))
-> TupR ScalarType (a, a)
-> (TupR ScalarType (a, a), TupR ScalarType (a, 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 :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` IntegralType a -> TupR ScalarType a
forall a. IntegralType a -> TupR ScalarType a
integral IntegralType a
t
  PrimIDiv IntegralType a
t                -> TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a)
forall (s :: * -> *) b. TupR s b -> (TupR s (b, b), TupR s b)
binary' (TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a))
-> TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a)
forall a b. (a -> b) -> a -> b
$ IntegralType a -> TupR ScalarType a
forall a. IntegralType a -> TupR ScalarType a
integral IntegralType a
t
  PrimMod  IntegralType a
t                -> TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a)
forall (s :: * -> *) b. TupR s b -> (TupR s (b, b), TupR s b)
binary' (TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a))
-> TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a)
forall a b. (a -> b) -> a -> b
$ IntegralType a -> TupR ScalarType a
forall a. IntegralType a -> TupR ScalarType a
integral IntegralType a
t
  PrimDivMod IntegralType a
t              -> TupR ScalarType (a, a)
-> (TupR ScalarType (a, a), TupR ScalarType (a, a))
forall b. b -> (b, b)
unary' (TupR ScalarType (a, a)
 -> (TupR ScalarType (a, a), TupR ScalarType (a, a)))
-> TupR ScalarType (a, a)
-> (TupR ScalarType (a, a), TupR ScalarType (a, 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 :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` IntegralType a -> TupR ScalarType a
forall a. IntegralType a -> TupR ScalarType a
integral IntegralType a
t

  -- Bits & FiniteBits
  PrimBAnd IntegralType a
t                -> TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a)
forall (s :: * -> *) b. TupR s b -> (TupR s (b, b), TupR s b)
binary' (TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a))
-> TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a)
forall a b. (a -> b) -> a -> b
$ IntegralType a -> TupR ScalarType a
forall a. IntegralType a -> TupR ScalarType a
integral IntegralType a
t
  PrimBOr IntegralType a
t                 -> TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a)
forall (s :: * -> *) b. TupR s b -> (TupR s (b, b), TupR s b)
binary' (TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a))
-> TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a)
forall a b. (a -> b) -> a -> b
$ IntegralType a -> TupR ScalarType a
forall a. IntegralType a -> TupR ScalarType a
integral IntegralType a
t
  PrimBXor IntegralType a
t                -> TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a)
forall (s :: * -> *) b. TupR s b -> (TupR s (b, b), TupR s b)
binary' (TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a))
-> TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a)
forall a b. (a -> b) -> a -> b
$ IntegralType a -> TupR ScalarType a
forall a. IntegralType a -> TupR ScalarType a
integral IntegralType a
t
  PrimBNot IntegralType a
t                -> TupR ScalarType a -> (TupR ScalarType a, TupR ScalarType a)
forall b. b -> (b, b)
unary' (TupR ScalarType a -> (TupR ScalarType a, TupR ScalarType a))
-> TupR ScalarType a -> (TupR ScalarType a, TupR ScalarType a)
forall a b. (a -> b) -> a -> b
$ IntegralType a -> TupR ScalarType a
forall a. IntegralType a -> TupR ScalarType a
integral 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 :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` TupR ScalarType Int
int, IntegralType a -> TupR ScalarType a
forall a. IntegralType a -> TupR ScalarType a
integral 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 :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` TupR ScalarType Int
int, IntegralType a -> TupR ScalarType a
forall a. IntegralType a -> TupR ScalarType a
integral 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 :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` TupR ScalarType Int
int, IntegralType a -> TupR ScalarType a
forall a. IntegralType a -> TupR ScalarType a
integral 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 :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, b)
`TupRpair` TupR ScalarType Int
int, IntegralType a -> TupR ScalarType a
forall a. IntegralType a -> TupR ScalarType a
integral IntegralType a
t)
  PrimPopCount IntegralType a
t            -> TupR ScalarType a
-> TupR ScalarType Int -> (TupR ScalarType a, TupR ScalarType Int)
forall a b. a -> b -> (a, b)
unary (IntegralType a -> TupR ScalarType a
forall a. IntegralType a -> TupR ScalarType a
integral IntegralType a
t) TupR ScalarType Int
int
  PrimCountLeadingZeros IntegralType a
t   -> TupR ScalarType a
-> TupR ScalarType Int -> (TupR ScalarType a, TupR ScalarType Int)
forall a b. a -> b -> (a, b)
unary (IntegralType a -> TupR ScalarType a
forall a. IntegralType a -> TupR ScalarType a
integral IntegralType a
t) TupR ScalarType Int
int
  PrimCountTrailingZeros IntegralType a
t  -> TupR ScalarType a
-> TupR ScalarType Int -> (TupR ScalarType a, TupR ScalarType Int)
forall a b. a -> b -> (a, b)
unary (IntegralType a -> TupR ScalarType a
forall a. IntegralType a -> TupR ScalarType a
integral IntegralType a
t) TupR ScalarType Int
int

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

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

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

  -- 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                 -> TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a)
forall (s :: * -> *) b. TupR s b -> (TupR s (b, b), TupR s b)
binary' (TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a))
-> TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a)
forall a b. (a -> b) -> a -> b
$ SingleType a -> TupR ScalarType a
forall a. SingleType a -> TupR ScalarType a
single SingleType a
t
  PrimMin SingleType a
t                 -> TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a)
forall (s :: * -> *) b. TupR s b -> (TupR s (b, b), TupR s b)
binary' (TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a))
-> TupR ScalarType a -> (TupR ScalarType (a, a), TupR ScalarType a)
forall a b. (a -> b) -> a -> b
$ SingleType a -> TupR ScalarType a
forall a. SingleType a -> TupR ScalarType a
single SingleType a
t

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

  -- general conversion between types
  PrimFromIntegral IntegralType a
a NumType b
b      -> TupR ScalarType a
-> TupR ScalarType b -> (TupR ScalarType a, TupR ScalarType b)
forall a b. a -> b -> (a, b)
unary (IntegralType a -> TupR ScalarType a
forall a. IntegralType a -> TupR ScalarType a
integral IntegralType a
a) (NumType b -> TupR ScalarType b
forall a. NumType a -> TupR ScalarType a
num NumType b
b)
  PrimToFloating   NumType a
a FloatingType b
b      -> TupR ScalarType a
-> TupR ScalarType b -> (TupR ScalarType a, TupR ScalarType b)
forall a b. a -> b -> (a, b)
unary (NumType a -> TupR ScalarType a
forall a. NumType a -> TupR ScalarType a
num NumType a
a) (FloatingType b -> TupR ScalarType b
forall a. FloatingType a -> TupR ScalarType a
floating 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 :: * -> *) a b. TupR s a -> TupR s b -> TupR s (a, 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
bool

    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

    bool :: TupR ScalarType PrimBool
bool     = ScalarType PrimBool -> TupR ScalarType PrimBool
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ScalarType PrimBool
scalarTypeWord8
    int :: TupR ScalarType Int
int      = 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 :: OpenAfun aenv t -> ()
rnfOpenAfun = (forall aenv t. OpenAcc aenv t -> ()) -> OpenAfun aenv t -> ()
forall (acc :: * -> * -> *) aenv t.
NFDataAcc acc -> PreOpenAfun acc aenv t -> ()
rnfPreOpenAfun forall aenv t. OpenAcc aenv t -> ()
rnfOpenAcc

rnfPreOpenAfun :: NFDataAcc acc -> PreOpenAfun acc aenv t -> ()
rnfPreOpenAfun :: 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 () -> () -> ()
`seq` NFDataAcc acc -> PreOpenAfun acc aenv' t -> ()
forall (acc :: * -> * -> *) aenv t.
NFDataAcc acc -> PreOpenAfun acc aenv t -> ()
rnfPreOpenAfun NFDataAcc acc
rnfA PreOpenAfun acc aenv' t
f

rnfOpenAcc :: OpenAcc aenv t -> ()
rnfOpenAcc :: 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 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 :: NFDataAcc acc -> PreOpenAcc acc aenv t -> ()
rnfPreOpenAcc NFDataAcc acc
rnfA PreOpenAcc acc aenv t
pacc =
  let
      rnfAF :: PreOpenAfun acc aenv' t' -> ()
      rnfAF :: PreOpenAfun acc aenv' t' -> ()
rnfAF = NFDataAcc acc -> PreOpenAfun acc aenv' t' -> ()
forall (acc :: * -> * -> *) aenv t.
NFDataAcc acc -> PreOpenAfun acc aenv t -> ()
rnfPreOpenAfun NFDataAcc acc
rnfA

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

      rnfF :: OpenFun env' aenv' t' -> ()
      rnfF :: 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 :: 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
  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 () -> () -> ()
`seq` acc aenv bndArrs -> ()
NFDataAcc acc
rnfA acc aenv bndArrs
bnd () -> () -> ()
`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 () -> () -> ()
`seq` acc aenv bs -> ()
NFDataAcc acc
rnfA acc aenv bs
bs
    PreOpenAcc acc aenv t
Anil                      -> ()
    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 forall b. ArrayR b -> ()
rnfArrayR ArraysR t
repr () -> () -> ()
`seq` PreOpenAfun acc aenv (arrs1 -> t) -> ()
forall aenv' t'. PreOpenAfun acc aenv' t' -> ()
rnfAF PreOpenAfun acc aenv (arrs1 -> t)
afun () -> () -> ()
`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 forall b. ArrayR b -> ()
rnfArrayR ArraysR t
repr () -> () -> ()
`seq` [Char] -> ()
forall a. NFData a => a -> ()
rnf (asm (as -> t) -> [Char]
forall (asm :: * -> *) args. Foreign asm => asm args -> [Char]
strForeign asm (as -> t)
asm) () -> () -> ()
`seq` PreAfun acc (as -> t) -> ()
forall aenv' t'. PreOpenAfun acc aenv' t' -> ()
rnfAF PreAfun acc (as -> t)
afun () -> () -> ()
`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 () -> () -> ()
`seq` acc aenv t -> ()
NFDataAcc acc
rnfA acc aenv t
a1 () -> () -> ()
`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 () -> () -> ()
`seq` PreOpenAfun acc aenv (t -> t) -> ()
forall aenv' t'. PreOpenAfun acc aenv' t' -> ()
rnfAF PreOpenAfun acc aenv (t -> t)
f () -> () -> ()
`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 () -> () -> ()
`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 () -> () -> ()
`seq` Exp aenv sh -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE Exp aenv sh
sh () -> () -> ()
`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 () -> () -> ()
`seq` Exp aenv sh -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE Exp aenv sh
sh () -> () -> ()
`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 () -> () -> ()
`seq` Exp aenv sh' -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE Exp aenv sh'
sh () -> () -> ()
`seq` Fun aenv (sh' -> sh) -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF Fun aenv (sh' -> sh)
p () -> () -> ()
`seq` Fun aenv (a -> b) -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF Fun aenv (a -> b)
f () -> () -> ()
`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 () -> () -> ()
`seq` Exp aenv slix -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE Exp aenv slix
sh () -> () -> ()
`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 () -> () -> ()
`seq` Exp aenv slix -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE Exp aenv slix
sh () -> () -> ()
`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 () -> () -> ()
`seq` Fun aenv (e -> e') -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF Fun aenv (e -> e')
f () -> () -> ()
`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 () -> () -> ()
`seq` Fun aenv (e1 -> e2 -> e3) -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF Fun aenv (e1 -> e2 -> e3)
f () -> () -> ()
`seq` acc aenv (Array sh e1) -> ()
NFDataAcc acc
rnfA acc aenv (Array sh e1)
a1 () -> () -> ()
`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 () -> () -> ()
`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 () -> () -> ()
`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 () -> () -> ()
`seq` Fun aenv (e -> e -> e) -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF Fun aenv (e -> e -> e)
f () -> () -> ()
`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 () -> () -> ()
`seq` acc aenv (Array (sh, Int) e) -> ()
NFDataAcc acc
rnfA acc aenv (Array (sh, Int) e)
a () -> () -> ()
`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 -> () -> ()
`seq` Fun aenv (e -> e -> e) -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF Fun aenv (e -> e -> e)
f () -> () -> ()
`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 () -> () -> ()
`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 -> () -> ()
`seq` Fun aenv (e -> e -> e) -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF Fun aenv (e -> e -> e)
f () -> () -> ()
`seq` Exp aenv e -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE Exp aenv e
z () -> () -> ()
`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 () -> () -> ()
`seq` acc aenv (Array sh' e) -> ()
NFDataAcc acc
rnfA acc aenv (Array sh' e)
d () -> () -> ()
`seq` Fun aenv (sh -> PrimMaybe sh') -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF Fun aenv (sh -> PrimMaybe sh')
p () -> () -> ()
`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 () -> () -> ()
`seq` Exp aenv sh' -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE Exp aenv sh'
sh () -> () -> ()
`seq` Fun aenv (sh' -> sh) -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF Fun aenv (sh' -> sh)
f () -> () -> ()
`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
shr TypeR e
_) = acc aenv (Array sh e) -> TupR ArrayR (Array sh e)
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 () -> () -> ()
`seq` (forall b. ScalarType b -> ()) -> TypeR e' -> ()
forall (s :: * -> *) a. (forall b. s b -> ()) -> TupR s a -> ()
rnfTupR forall b. ScalarType b -> ()
rnfScalarType TypeR e'
tp () -> () -> ()
`seq` Fun aenv (stencil -> e') -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF Fun aenv (stencil -> e')
f () -> () -> ()
`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  () -> () -> ()
`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
shr TypeR e
_) = acc aenv (Array sh a) -> TupR ArrayR (Array sh 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 () -> () -> ()
`seq` StencilR sh b stencil2 -> ()
forall sh e pat. StencilR sh e pat -> ()
rnfStencilR StencilR sh b stencil2
sr2 () -> () -> ()
`seq` (forall b. ScalarType b -> ()) -> TypeR c -> ()
forall (s :: * -> *) a. (forall b. s b -> ()) -> TupR s a -> ()
rnfTupR forall b. ScalarType b -> ()
rnfScalarType TypeR c
tp () -> () -> ()
`seq` Fun aenv (stencil1 -> stencil2 -> c) -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF Fun aenv (stencil1 -> stencil2 -> c)
f () -> () -> ()
`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 () -> () -> ()
`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 () -> () -> ()
`seq` acc aenv (Array sh a) -> ()
NFDataAcc acc
rnfA acc aenv (Array sh a)
a1 () -> () -> ()
`seq` acc aenv (Array sh b) -> ()
NFDataAcc acc
rnfA acc aenv (Array sh b)
a2

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

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

rnfBoundary :: forall aenv sh e. ArrayR (Array sh e) -> Boundary aenv (Array sh e) -> ()
rnfBoundary :: 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 :: (a -> ()) -> Maybe a -> ()
rnfMaybe a -> ()
_ Maybe a
Nothing  = ()
rnfMaybe a -> ()
f (Just a
x) = a -> ()
f a
x

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

rnfOpenFun :: OpenFun env aenv t -> ()
rnfOpenFun :: 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 () -> () -> ()
`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 :: OpenExp env aenv t -> ()
rnfOpenExp OpenExp env aenv t
topExp =
  let
      rnfF :: OpenFun env' aenv' t' -> ()
      rnfF :: OpenFun env' aenv' t' -> ()
rnfF = OpenFun env' aenv' t' -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfOpenFun

      rnfE :: OpenExp env' aenv' t' -> ()
      rnfE :: 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 () -> () -> ()
`seq` OpenExp env aenv bnd_t -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv bnd_t
bnd () -> () -> ()
`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 () -> () -> ()
`seq` [Char] -> ()
forall a. NFData a => a -> ()
rnf (asm (x -> t) -> [Char]
forall (asm :: * -> *) args. Foreign asm => asm args -> [Char]
strForeign asm (x -> t)
asm) () -> () -> ()
`seq` Fun () (x -> t) -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF Fun () (x -> t)
f () -> () -> ()
`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 -> () -> ()
`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 () -> () -> ()
`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 () -> () -> ()
`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 () -> () -> ()
`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 () -> () -> ()
`seq` OpenExp env aenv slix -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv slix
slix () -> () -> ()
`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 () -> () -> ()
`seq` OpenExp env aenv slix -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv slix
slix () -> () -> ()
`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 () -> () -> ()
`seq` OpenExp env aenv sh -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv sh
sh () -> () -> ()
`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 () -> () -> ()
`seq` OpenExp env aenv t -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv t
sh () -> () -> ()
`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 () -> () -> ()
`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 -> () -> ()
`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 () -> () -> ()
`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 () -> () -> ()
`seq` OpenExp env aenv t -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv t
e1 () -> () -> ()
`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 () -> () -> ()
`seq` OpenFun env aenv (t -> t) -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfF OpenFun env aenv (t -> t)
f () -> () -> ()
`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 () -> () -> ()
`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 () -> () -> ()
`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 () -> () -> ()
`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 () -> () -> ()
`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 () -> () -> ()
`seq` ScalarType t -> ()
forall b. ScalarType b -> ()
rnfScalarType ScalarType t
t2 () -> () -> ()
`seq` OpenExp env aenv a -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfE OpenExp env aenv a
e

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

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

rnfConst :: TypeR t -> t -> ()
rnfConst :: TypeR t -> t -> ()
rnfConst TypeR 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 a
ta TupR ScalarType b
tb)  (a,b) = TupR ScalarType a -> a -> ()
forall t. TypeR t -> t -> ()
rnfConst TupR ScalarType a
ta a
a () -> () -> ()
`seq` TupR ScalarType b -> b -> ()
forall t. TypeR t -> t -> ()
rnfConst TupR ScalarType b
tb b
b

rnfPrimConst :: PrimConst c -> ()
rnfPrimConst :: 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 :: 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 () -> () -> ()
`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 () -> () -> ()
`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 () -> () -> ()
`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 () -> () -> ()
`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 () -> () -> ()
`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 () -> () -> ()
`seq` FloatingType b -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType b
f


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

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

liftPreOpenAfun :: LiftAcc acc -> PreOpenAfun acc aenv t -> Q (TExp (PreOpenAfun acc aenv t))
liftPreOpenAfun :: LiftAcc acc
-> PreOpenAfun acc aenv t -> Q (TExp (PreOpenAfun acc aenv t))
liftPreOpenAfun LiftAcc acc
liftA (Alam ALeftHandSide a aenv aenv'
lhs PreOpenAfun acc aenv' t
f) = [|| Alam $$(liftALeftHandSide lhs) $$(liftPreOpenAfun liftA f) ||]
liftPreOpenAfun LiftAcc acc
liftA (Abody acc aenv t
b)    = [|| Abody $$(liftA b) ||]

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

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

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

      liftB :: ArrayR (Array sh e) -> Boundary aenv (Array sh e) -> Q (TExp (Boundary aenv (Array sh e)))
      liftB :: ArrayR (Array sh e)
-> Boundary aenv (Array sh e)
-> Q (TExp (Boundary aenv (Array sh e)))
liftB = ArrayR (Array sh e)
-> Boundary aenv (Array sh e)
-> Q (TExp (Boundary aenv (Array sh e)))
forall aenv sh e.
ArrayR (Array sh e)
-> Boundary aenv (Array sh e)
-> Q (TExp (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         -> [|| Alet $$(liftALeftHandSide lhs) $$(liftA bnd) $$(liftA body) ||]
    Avar ArrayVar aenv (Array sh e)
var                  -> [|| Avar $$(liftArrayVar var) ||]
    Apair acc aenv as
as acc aenv bs
bs               -> [|| Apair $$(liftA as) $$(liftA bs) ||]
    PreOpenAcc acc aenv a
Anil                      -> [|| Anil ||]
    Apply ArraysR a
repr PreOpenAfun acc aenv (arrs1 -> a)
f acc aenv arrs1
a            -> [|| Apply $$(liftArraysR repr) $$(liftAF f) $$(liftA a) ||]
    Aforeign ArraysR a
repr asm (as -> a)
asm PreAfun acc (as -> a)
f acc aenv as
a     -> [|| Aforeign $$(liftArraysR repr) $$(liftForeign asm) $$(liftPreOpenAfun liftA f) $$(liftA a) ||]
    Acond Exp aenv PrimBool
p acc aenv a
t acc aenv a
e               -> [|| Acond $$(liftE p) $$(liftA t) $$(liftA e) ||]
    Awhile PreOpenAfun acc aenv (a -> Scalar PrimBool)
p PreOpenAfun acc aenv (a -> a)
f acc aenv a
a              -> [|| Awhile $$(liftAF p) $$(liftAF f) $$(liftA a) ||]
    Use ArrayR (Array sh e)
repr Array sh e
a                -> [|| Use $$(liftArrayR repr) $$(liftArray repr a) ||]
    Unit TypeR e
tp Exp aenv e
e                 -> [|| Unit $$(liftTypeR tp) $$(liftE e) ||]
    Reshape ShapeR sh
shr Exp aenv sh
sh acc aenv (Array sh' e)
a          -> [|| Reshape $$(liftShapeR shr) $$(liftE sh) $$(liftA a) ||]
    Generate ArrayR (Array sh e)
repr Exp aenv sh
sh Fun aenv (sh -> e)
f        -> [|| Generate $$(liftArrayR repr) $$(liftE sh) $$(liftF 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   -> [|| Transform $$(liftArrayR repr) $$(liftE sh) $$(liftF p) $$(liftF f) $$(liftA a) ||]
    Replicate SliceIndex slix sl co sh
slix Exp aenv slix
sl acc aenv (Array sl e)
a       -> [|| Replicate $$(liftSliceIndex slix) $$(liftE sl) $$(liftA a) ||]
    Slice SliceIndex slix sl co sh
slix acc aenv (Array sh e)
a Exp aenv slix
sh           -> [|| Slice $$(liftSliceIndex slix) $$(liftA a) $$(liftE sh) ||]
    Map TypeR e'
tp Fun aenv (e -> e')
f acc aenv (Array sh e)
a                -> [|| Map $$(liftTypeR tp) $$(liftF f) $$(liftA a) ||]
    ZipWith TypeR e3
tp Fun aenv (e1 -> e2 -> e3)
f acc aenv (Array sh e1)
a acc aenv (Array sh e2)
b          -> [|| ZipWith $$(liftTypeR tp) $$(liftF f) $$(liftA a) $$(liftA b) ||]
    Fold Fun aenv (e -> e -> e)
f Maybe (Exp aenv e)
z acc aenv (Array (sh, Int) e)
a                -> [|| Fold $$(liftF f) $$(liftMaybe liftE z) $$(liftA 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         -> [|| FoldSeg $$(liftIntegralType i) $$(liftF f) $$(liftMaybe liftE z) $$(liftA a) $$(liftA s) ||]
    Scan Direction
d Fun aenv (e -> e -> e)
f Maybe (Exp aenv e)
z acc aenv (Array (sh, Int) e)
a              -> [|| Scan  $$(liftDirection d) $$(liftF f) $$(liftMaybe liftE z) $$(liftA a) ||]
    Scan' Direction
d Fun aenv (e -> e -> e)
f Exp aenv e
z acc aenv (Array (sh, Int) e)
a             -> [|| Scan' $$(liftDirection d) $$(liftF f) $$(liftE z) $$(liftA 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           -> [|| Permute $$(liftF f) $$(liftA d) $$(liftF p) $$(liftA a) ||]
    Backpermute ShapeR sh'
shr Exp aenv sh'
sh Fun aenv (sh' -> sh)
p acc aenv (Array sh e)
a    -> [|| Backpermute $$(liftShapeR shr) $$(liftE sh) $$(liftF p) $$(liftA 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
shr TypeR e
_) = acc aenv (Array sh e) -> TupR ArrayR (Array sh e)
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 [|| Stencil $$(liftStencilR sr) $$(liftTypeR tp) $$(liftF f) $$(liftB repr b) $$(liftA 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
shr TypeR e
_) = acc aenv (Array sh a) -> TupR ArrayR (Array sh 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 [|| Stencil2 $$(liftStencilR sr1) $$(liftStencilR sr2) $$(liftTypeR tp) $$(liftF f) $$(liftB repr1 b1) $$(liftA a1) $$(liftB repr2 b2) $$(liftA a2) ||]


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

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

liftDirection :: Direction -> Q (TExp Direction)
liftDirection :: Direction -> Q (TExp Direction)
liftDirection Direction
LeftToRight = [|| LeftToRight ||]
liftDirection Direction
RightToLeft = [|| RightToLeft ||]

liftMaybe :: (a -> Q (TExp a)) -> Maybe a -> Q (TExp (Maybe a))
liftMaybe :: (a -> Q (TExp a)) -> Maybe a -> Q (TExp (Maybe a))
liftMaybe a -> Q (TExp a)
_ Maybe a
Nothing  = [|| Nothing ||]
liftMaybe a -> Q (TExp a)
f (Just a
x) = [|| Just $$(f x) ||]

liftList :: (a -> Q (TExp a)) -> [a] -> Q (TExp [a])
liftList :: (a -> Q (TExp a)) -> [a] -> Q (TExp [a])
liftList a -> Q (TExp a)
_ []     = [|| [] ||]
liftList a -> Q (TExp a)
f (a
x:[a]
xs) = [|| $$(f x) : $$(liftList f xs) ||]

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

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

      liftF :: OpenFun env aenv f -> Q (TExp (OpenFun env aenv f))
      liftF :: OpenFun env aenv f -> Q (TExp (OpenFun env aenv f))
liftF = OpenFun env aenv f -> Q (TExp (OpenFun env aenv f))
forall env aenv t.
OpenFun env aenv t -> Q (TExp (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          -> [|| Let $$(liftELeftHandSide lhs) $$(liftOpenExp bnd) $$(liftOpenExp body) ||]
    Evar ExpVar env t
var                  -> [|| Evar $$(liftExpVar var) ||]
    Foreign TypeR t
repr asm (x -> t)
asm Fun () (x -> t)
f OpenExp env aenv x
x      -> [|| Foreign $$(liftTypeR repr) $$(liftForeign asm) $$(liftOpenFun f) $$(liftE x) ||]
    Const ScalarType t
tp t
c                -> [|| Const $$(liftScalarType tp) $$(liftElt (TupRsingle tp) c) ||]
    Undef ScalarType t
tp                  -> [|| Undef $$(liftScalarType tp) ||]
    Pair OpenExp env aenv t1
a OpenExp env aenv t2
b                  -> [|| Pair $$(liftE a) $$(liftE b) ||]
    OpenExp env aenv t
Nil                       -> [|| Nil ||]
    VecPack   VecR n s tup
vecr OpenExp env aenv tup
e          -> [|| VecPack   $$(liftVecR vecr) $$(liftE e) ||]
    VecUnpack VecR n s t
vecr OpenExp env aenv (Vec n s)
e          -> [|| VecUnpack $$(liftVecR vecr) $$(liftE e) ||]
    IndexSlice SliceIndex slix t co sh
slice OpenExp env aenv slix
slix OpenExp env aenv sh
sh  -> [|| IndexSlice $$(liftSliceIndex slice) $$(liftE slix) $$(liftE sh) ||]
    IndexFull SliceIndex slix sl co t
slice OpenExp env aenv slix
slix OpenExp env aenv sl
sl   -> [|| IndexFull $$(liftSliceIndex slice) $$(liftE slix) $$(liftE sl) ||]
    ToIndex ShapeR sh
shr OpenExp env aenv sh
sh OpenExp env aenv sh
ix         -> [|| ToIndex $$(liftShapeR shr) $$(liftE sh) $$(liftE ix) ||]
    FromIndex ShapeR t
shr OpenExp env aenv t
sh OpenExp env aenv Int
ix       -> [|| FromIndex $$(liftShapeR shr) $$(liftE sh) $$(liftE ix) ||]
    Case OpenExp env aenv PrimBool
p [(PrimBool, OpenExp env aenv t)]
rhs Maybe (OpenExp env aenv t)
def            -> [|| Case $$(liftE p) $$(liftList (\(t,c) -> [|| (t, $$(liftE c)) ||]) rhs) $$(liftMaybe liftE def) ||]
    Cond OpenExp env aenv PrimBool
p OpenExp env aenv t
t OpenExp env aenv t
e                -> [|| Cond $$(liftE p) $$(liftE t) $$(liftE e) ||]
    While OpenFun env aenv (t -> PrimBool)
p OpenFun env aenv (t -> t)
f OpenExp env aenv t
x               -> [|| While $$(liftF p) $$(liftF f) $$(liftE x) ||]
    PrimConst PrimConst t
t               -> [|| PrimConst $$(liftPrimConst t) ||]
    PrimApp PrimFun (a -> t)
f OpenExp env aenv a
x               -> [|| PrimApp $$(liftPrimFun f) $$(liftE x) ||]
    Index ArrayVar aenv (Array dim t)
a OpenExp env aenv dim
ix                -> [|| Index $$(liftArrayVar a) $$(liftE ix) ||]
    LinearIndex ArrayVar aenv (Array dim t)
a OpenExp env aenv Int
ix          -> [|| LinearIndex $$(liftArrayVar a) $$(liftE ix) ||]
    Shape ArrayVar aenv (Array t e)
a                   -> [|| Shape $$(liftArrayVar a) ||]
    ShapeSize ShapeR dim
shr OpenExp env aenv dim
ix          -> [|| ShapeSize $$(liftShapeR shr) $$(liftE ix) ||]
    Coerce ScalarType a
t1 ScalarType t
t2 OpenExp env aenv a
e            -> [|| Coerce $$(liftScalarType t1) $$(liftScalarType t2) $$(liftE e) ||]

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

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

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

liftPrimConst :: PrimConst c -> Q (TExp (PrimConst c))
liftPrimConst :: PrimConst c -> Q (TExp (PrimConst c))
liftPrimConst (PrimMinBound BoundedType c
t) = [|| PrimMinBound $$(liftBoundedType t) ||]
liftPrimConst (PrimMaxBound BoundedType c
t) = [|| PrimMaxBound $$(liftBoundedType t) ||]
liftPrimConst (PrimPi FloatingType c
t)       = [|| PrimPi $$(liftFloatingType t) ||]

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


showPreAccOp :: forall acc aenv arrs. PreOpenAcc acc aenv arrs -> String
showPreAccOp :: PreOpenAcc acc aenv arrs -> [Char]
showPreAccOp Alet{}              = [Char]
"Alet"
showPreAccOp (Avar (Var ArrayR (Array sh e)
_ Idx aenv (Array sh e)
ix))   = [Char]
"Avar a" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Idx aenv (Array sh e) -> Int
forall env t. Idx env t -> Int
idxToInt Idx aenv (Array sh e)
ix)
showPreAccOp (Use ArrayR (Array sh e)
aR Array sh e
a)          = [Char]
"Use " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int
-> (e -> [Char] -> [Char])
-> ArrayR (Array sh e)
-> Array sh e
-> [Char]
forall e sh.
Int
-> (e -> [Char] -> [Char])
-> ArrayR (Array sh e)
-> Array sh e
-> [Char]
showArrayShort Int
5 (TypeR e -> e -> [Char] -> [Char]
forall e. TypeR e -> e -> [Char] -> [Char]
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
showPreAccOp Apply{}             = [Char]
"Apply"
showPreAccOp Aforeign{}          = [Char]
"Aforeign"
showPreAccOp Acond{}             = [Char]
"Acond"
showPreAccOp Awhile{}            = [Char]
"Awhile"
showPreAccOp Apair{}             = [Char]
"Apair"
showPreAccOp PreOpenAcc acc aenv arrs
Anil                = [Char]
"Anil"
showPreAccOp Unit{}              = [Char]
"Unit"
showPreAccOp Generate{}          = [Char]
"Generate"
showPreAccOp Transform{}         = [Char]
"Transform"
showPreAccOp Reshape{}           = [Char]
"Reshape"
showPreAccOp Replicate{}         = [Char]
"Replicate"
showPreAccOp Slice{}             = [Char]
"Slice"
showPreAccOp Map{}               = [Char]
"Map"
showPreAccOp ZipWith{}           = [Char]
"ZipWith"
showPreAccOp (Fold Fun aenv (e -> e -> e)
_ Maybe (Exp aenv e)
z acc aenv (Array (sh, Int) e)
_)        = [Char]
"Fold" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> (Exp aenv e -> [Char]) -> Maybe (Exp aenv e) -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"1" ([Char] -> Exp aenv e -> [Char]
forall a b. a -> b -> a
const [Char]
"") Maybe (Exp aenv e)
z
showPreAccOp (FoldSeg IntegralType i
_ Fun aenv (e -> e -> e)
_ Maybe (Exp aenv e)
z acc aenv (Array (sh, Int) e)
_ acc aenv (Segments i)
_) = [Char]
"Fold" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> (Exp aenv e -> [Char]) -> Maybe (Exp aenv e) -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"1" ([Char] -> Exp aenv e -> [Char]
forall a b. a -> b -> a
const [Char]
"") Maybe (Exp aenv e)
z [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Seg"
showPreAccOp (Scan Direction
d Fun aenv (e -> e -> e)
_ Maybe (Exp aenv e)
z acc aenv (Array (sh, Int) e)
_)      = [Char]
"Scan" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Direction -> [Char] -> [Char]
showsDirection Direction
d ([Char] -> (Exp aenv e -> [Char]) -> Maybe (Exp aenv e) -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"1" ([Char] -> Exp aenv e -> [Char]
forall a b. a -> b -> a
const [Char]
"") Maybe (Exp aenv e)
z)
showPreAccOp (Scan' Direction
d Fun aenv (e -> e -> e)
_ Exp aenv e
_ acc aenv (Array (sh, Int) e)
_)     = [Char]
"Scan" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Direction -> [Char] -> [Char]
showsDirection Direction
d [Char]
"'"
showPreAccOp Permute{}           = [Char]
"Permute"
showPreAccOp Backpermute{}       = [Char]
"Backpermute"
showPreAccOp Stencil{}           = [Char]
"Stencil"
showPreAccOp Stencil2{}          = [Char]
"Stencil2"

showsDirection :: Direction -> ShowS
showsDirection :: Direction -> [Char] -> [Char]
showsDirection Direction
LeftToRight = (Char
'l'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:)
showsDirection Direction
RightToLeft = (Char
'r'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:)

showExpOp :: forall aenv env t. OpenExp aenv env t -> String
showExpOp :: OpenExp aenv env t -> [Char]
showExpOp Let{}             = [Char]
"Let"
showExpOp (Evar (Var ScalarType t
_ Idx aenv t
ix)) = [Char]
"Var x" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Idx aenv t -> Int
forall env t. Idx env t -> Int
idxToInt Idx aenv t
ix)
showExpOp (Const ScalarType t
tp t
c)      = [Char]
"Const " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ 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
showExpOp Undef{}           = [Char]
"Undef"
showExpOp Foreign{}         = [Char]
"Foreign"
showExpOp Pair{}            = [Char]
"Pair"
showExpOp Nil{}             = [Char]
"Nil"
showExpOp VecPack{}         = [Char]
"VecPack"
showExpOp VecUnpack{}       = [Char]
"VecUnpack"
showExpOp IndexSlice{}      = [Char]
"IndexSlice"
showExpOp IndexFull{}       = [Char]
"IndexFull"
showExpOp ToIndex{}         = [Char]
"ToIndex"
showExpOp FromIndex{}       = [Char]
"FromIndex"
showExpOp Case{}            = [Char]
"Case"
showExpOp Cond{}            = [Char]
"Cond"
showExpOp While{}           = [Char]
"While"
showExpOp PrimConst{}       = [Char]
"PrimConst"
showExpOp PrimApp{}         = [Char]
"PrimApp"
showExpOp Index{}           = [Char]
"Index"
showExpOp LinearIndex{}     = [Char]
"LinearIndex"
showExpOp Shape{}           = [Char]
"Shape"
showExpOp ShapeSize{}       = [Char]
"ShapeSize"
showExpOp Coerce{}          = [Char]
"Coerce"