packages feed

accelerate 1.0.0.0 → 1.1.0.0

raw patch · 42 files changed

+4917/−2762 lines, 42 filesdep +th-lift-instances

Dependencies added: th-lift-instances

Files

+ CHANGELOG.md view
@@ -0,0 +1,103 @@+# Change Log++Notable changes to the project will be documented in this file.++The format is based on [Keep a Changelog](http://keepachangelog.com/) and the+project adheres to the [Haskell Package Versioning+Policy (PVP)](https://pvp.haskell.org)++## [1.1.0.0] - 2017-09-21+### Added+  * Additional EKG monitoring hooks ([#340])+  * Operations from `RealFloat`++### Changed+  * Changed type of `scanl'`, `scanr'` to return an `Acc` tuple, rather than a+    tuple of `Acc` arrays.+  * Specialised folds `sum`, `product`, `minimum`, `maximum`, `and`, `or`,+    `any`, `all` now reduce along the innermost dimension only, rather than+    reducing all elements. You can recover the old behaviour by first+    `flatten`-ing the input array.+  * Add new stencil boundary condition `function`, to apply the given function+    to out-of-bounds indices.++### Fixed+  * [#390]: Wrong number of arguments in printf++## [1.0.0.0] - 2017-03-31+  * Many API and internal changes+  * Bug fixes and other enhancements++## [0.15.1.0]+  * Fix type of `allocateArray`++## [0.15.0.0]+  * Bug fixes and performance improvements.++## [0.14.0.0]+  * New iteration constructs.+  * Additional Prelude-like functions.+  * Improved code generation and fusion optimisation.+  * Concurrent kernel execution in the CUDA backend.+  * Bug fixes.++## [0.13.0.0]+  * New array fusion optimisation.+  * New foreign function interface for array and scalar expressions.+  * Additional Prelude-like functions.+  * New example programs.+  * Bug fixes and performance improvements.++## [0.12.0.0]+  * Full sharing recovery in scalar expressions and array computations.+  * Two new example applications in package `accelerate-examples` (both including a graphical frontend):+    * A real-time Canny edge detection +    * An interactive fluid flow simulator+  * Bug fixes.++## [0.11.0.0]+  * New Prelude-like functions `zip*`, `unzip*`, `fill`, `enumFrom*`, `tail`,+    `init`, `drop`, `take`, `slit`, `gather*`, `scatter*`, and `shapeSize`.+  * New simplified AST (in package `accelerate-backend-kit`) for backend writers+    who want to avoid the complexities of the type-safe AST.++## [0.10.0.0]+  * Complete sharing recovery for scalar expressions (but currently disabled by default).+  * Also bug fixes in array sharing recovery and a few new convenience functions.++## [0.9.0.0]+  * Streaming computations+  * Precompilation+  * Repa-style array indices+  * Additional collective operations supported by the CUDA backend: `stencil`s,+    more `scan`s, rank-polymorphic `fold`, `generate`.+  * Conversions to other array formats+  * Bug fixes++## 0.8.1.0+  * Bug fixes and some performance tweaks.++## 0.8.0.0+  * More collective operations supported by the CUDA backend: `replicate`,+    `slice` and `foldSeg`. Frontend and interpreter support for `stencil`.+  * Bug fixes.++## [0.7.1.0]+  * Initial release of the CUDA backend+++[1.1.0.0]:          https://github.com/AccelerateHS/accelerate/compare/1.0.0.0...1.1.0.0+[1.0.0.0]:          https://github.com/AccelerateHS/accelerate/compare/0.15.1.0...1.0.0.0+[0.15.1.0]:         https://github.com/AccelerateHS/accelerate/compare/0.15.0.0...0.15.1.0+[0.15.0.0]:         https://github.com/AccelerateHS/accelerate/compare/0.14.0.0...0.15.0.0+[0.14.0.0]:         https://github.com/AccelerateHS/accelerate/compare/0.13.0.0...0.14.0.0+[0.13.0.0]:         https://github.com/AccelerateHS/accelerate/compare/0.12.0.0...0.13.0.0+[0.12.0.0]:         https://github.com/AccelerateHS/accelerate/compare/0.11.0.0...0.12.0.0+[0.11.0.0]:         https://github.com/AccelerateHS/accelerate/compare/0.10.0.0...0.11.0.0+[0.10.0.0]:         https://github.com/AccelerateHS/accelerate/compare/0.9.0.0...0.10.0.0+[0.9.0.0]:          https://github.com/AccelerateHS/accelerate/compare/0_8_1_0...0.9.0.0+[0.7.1.0]:          https://github.com/AccelerateHS/accelerate/compare/0_6_0_0...0_7_1_0++[#340]:             https://github.com/AccelerateHS/accelerate/issues/340+[#390]:             https://github.com/AccelerateHS/accelerate/issues/390+
Data/Array/Accelerate.hs view
@@ -55,10 +55,6 @@ -- * <http://hackage.haskell.org/package/accelerate-llvm-ptx accelerate-llvm-ptx>: --   implementation supporting parallel execution on CUDA-capable NVIDIA GPUs. ----- * <http://hackage.haskell.org/package/accelerate-cuda accelerate-cuda>:---   an older implementation supporting parallel execution on CUDA-capable---   NVIDIA GPUs. /__NOTE:__ This backend is being deprecated in favour of @accelerate-llvm-ptx@./--- -- [/Examples:/] -- -- * The <http://hackage.haskell.org/package/accelerate-examples accelerate-examples>@@ -95,6 +91,9 @@ -- * <https://hackage.haskell.org/package/accelerate-fft accelerate-fft>: Fast -- Fourier transform, with FFI bindings to optimised implementations. --+-- * <https://hackage.haskell.org/package/accelerate-blas accelerate-blas>: BLAS+-- and LAPACK operations, with FFI bindings to optimised implementations.+-- -- * <https://hackage.haskell.org/package/accelerate-bignum accelerate-bignum>: -- Fixed-width large integer arithmetic. --@@ -261,7 +260,8 @@   stencil, stencil2,    -- *** Stencil specification-  Stencil, Boundary(..),+  Stencil, Boundary,+  clamp, mirror, wrap, function,    -- *** Common stencil patterns   Stencil3, Stencil5, Stencil7, Stencil9,
Data/Array/Accelerate/AST.hs view
@@ -5,6 +5,7 @@ {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE GADTs                 #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE QuasiQuotes           #-} {-# LANGUAGE RankNTypes            #-} {-# LANGUAGE ScopedTypeVariables   #-} {-# LANGUAGE StandaloneDeriving    #-}@@ -90,7 +91,7 @@    -- * Accelerated array expressions   PreOpenAfun(..), OpenAfun, PreAfun, Afun, PreOpenAcc(..), OpenAcc(..), Acc,-  Stencil(..), StencilR(..),+  PreBoundary(..), Boundary, Stencil(..), StencilR(..),    -- * Accelerated sequences   -- PreOpenSeq(..), Seq,@@ -104,21 +105,41 @@   NFDataAcc,   rnfPreOpenAfun, rnfPreOpenAcc, rnfPreOpenFun, rnfPreOpenExp, +  -- TemplateHaskell+  LiftAcc,+  liftIdx, liftTupleIdx, liftArrays,+  liftConst, liftSliceIndex, liftPrimConst, liftPrimFun,+  liftPreOpenAfun, liftPreOpenAcc, liftPreOpenFun, liftPreOpenExp,+   -- debugging   showPreAccOp, showPreExpOp,  ) where  --standard library+import Control.DeepSeq import Data.List import Data.Typeable-import Control.DeepSeq+import Foreign.ForeignPtr+import Foreign.Marshal+import Foreign.Ptr+import Foreign.Storable+import GHC.Ptr                                                      ( Ptr(..) )+import System.IO.Unsafe+import Language.Haskell.TH                                          ( Q, TExp )+import qualified Language.Haskell.TH                                as TH+import qualified Language.Haskell.TH.Syntax                         as TH+#if __GLASGOW_HASKELL__ <= 708+import Instances.TH.Lift                                            () -- Int8, Int16...+#endif  -- friends-import Data.Array.Accelerate.Type+import Data.Array.Accelerate.Array.Data+import Data.Array.Accelerate.Array.Representation                   ( SliceIndex(..), size )+import Data.Array.Accelerate.Array.Sugar                            hiding ( size )+import Data.Array.Accelerate.Array.Unique import Data.Array.Accelerate.Product-import Data.Array.Accelerate.Array.Representation       ( SliceIndex(..) )-import Data.Array.Accelerate.Array.Sugar                as Sugar+import Data.Array.Accelerate.Type #if __GLASGOW_HASKELL__ < 800 import Data.Array.Accelerate.Error #endif@@ -175,7 +196,7 @@ -- Projection of a value from a valuation of array elements using a de Bruijn index -- prjElt :: Idx env t -> ValElt env -> t-prjElt ZeroIdx       (PushElt _   v) = Sugar.toElt v+prjElt ZeroIdx       (PushElt _   v) = toElt v prjElt (SuccIdx idx) (PushElt val _) = prjElt idx val #if __GLASGOW_HASKELL__ < 800 prjElt _             _               = $internalError "prjElt" "inconsistent valuation"@@ -470,22 +491,19 @@   -- 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     :: (Elt e, Elt e', Stencil sh e stencil)-              => PreFun     acc aenv (stencil -> e')            -- stencil function-              -> Boundary            (EltRepr e)                -- boundary condition-              -> acc            aenv (Array sh e)               -- source array-              -> PreOpenAcc acc aenv (Array sh e')+              => PreFun      acc aenv (stencil -> e')           -- stencil function+              -> PreBoundary acc 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    :: (Elt e1, Elt e2, Elt e',-                  Stencil sh e1 stencil1,-                  Stencil sh e2 stencil2)-              => PreFun     acc aenv (stencil1 ->-                                      stencil2 -> e')           -- stencil function-              -> Boundary            (EltRepr e1)               -- boundary condition #1-              -> acc            aenv (Array sh e1)              -- source array #1-              -> Boundary            (EltRepr e2)               -- boundary condition #2-              -> acc            aenv (Array sh e2)              -- source array #2-              -> PreOpenAcc acc aenv (Array sh e')+  Stencil2    :: (Elt a, Elt b, Elt c, Stencil sh a stencil1, Stencil sh b stencil2)+              => PreFun      acc aenv (stencil1 -> stencil2 -> c) -- stencil function+              -> PreBoundary acc aenv (Array sh a)                -- boundary condition #1+              -> acc             aenv (Array sh a)                -- source array #1+              -> PreBoundary acc aenv (Array sh b)                -- boundary condition #2+              -> acc             aenv (Array sh b)                -- source array #2+              -> PreOpenAcc acc  aenv (Array sh c)    -- A sequence of operations.   -- Collect     :: Arrays arrs@@ -610,28 +628,52 @@ --}  --- |Operations on stencils.+-- | Vanilla stencil boundary condition --+type Boundary = PreBoundary OpenAcc++-- | Boundary condition specification for stencil operations+--+data PreBoundary (acc :: * -> * -> *) aenv t where+  -- Clamp coordinates to the extent of the array+  Clamp     :: PreBoundary acc aenv t++  -- Mirror coordinates beyond the array extent+  Mirror    :: PreBoundary acc aenv t++  -- Wrap coordinates around on each dimension+  Wrap      :: PreBoundary acc aenv t++  -- Use a constant value for outlying coordinates+  Constant  :: Elt e+            => EltRepr e+            -> PreBoundary acc aenv (Array sh e)++  -- Apply the given function to outlying coordinates+  Function  :: (Shape sh, Elt e)+            => PreFun acc aenv (sh -> e)+            -> PreBoundary acc aenv (Array sh e)+++-- | Operations on stencils+-- class (Shape sh, Elt e, IsTuple stencil, Elt stencil) => Stencil sh e stencil where-  stencil       :: StencilR sh e stencil-  stencilAccess :: (sh -> e) -> sh -> stencil+  stencil :: StencilR sh e stencil --- |GADT reifying the 'Stencil' class.+-- | GADT reifying the 'Stencil' class -- data StencilR sh e pat where-  StencilRunit3 :: (Elt e)-                => StencilR DIM1 e (e,e,e)-  StencilRunit5 :: (Elt e)-                => StencilR DIM1 e (e,e,e,e,e)-  StencilRunit7 :: (Elt e)-                => StencilR DIM1 e (e,e,e,e,e,e,e)-  StencilRunit9 :: (Elt e)-                => StencilR DIM1 e (e,e,e,e,e,e,e,e,e)+  StencilRunit3 :: Elt e => StencilR DIM1 e (e,e,e)+  StencilRunit5 :: Elt e => StencilR DIM1 e (e,e,e,e,e)+  StencilRunit7 :: Elt e => StencilR DIM1 e (e,e,e,e,e,e,e)+  StencilRunit9 :: Elt e => StencilR DIM1 e (e,e,e,e,e,e,e,e,e)+   StencilRtup3  :: (Shape sh, Elt e)                 => StencilR sh e pat1                 -> StencilR sh e pat2                 -> StencilR sh e pat3                 -> StencilR (sh:.Int) e (pat1,pat2,pat3)+   StencilRtup5  :: (Shape sh, Elt e)                 => StencilR sh e pat1                 -> StencilR sh e pat2@@ -639,6 +681,7 @@                 -> StencilR sh e pat4                 -> StencilR sh e pat5                 -> StencilR (sh:.Int) e (pat1,pat2,pat3,pat4,pat5)+   StencilRtup7  :: (Shape sh, Elt e)                 => StencilR sh e pat1                 -> StencilR sh e pat2@@ -648,6 +691,7 @@                 -> StencilR sh e pat6                 -> StencilR sh e pat7                 -> StencilR (sh:.Int) e (pat1,pat2,pat3,pat4,pat5,pat6,pat7)+   StencilRtup9  :: (Shape sh, Elt e)                 => StencilR sh e pat1                 -> StencilR sh e pat2@@ -661,91 +705,40 @@                 -> StencilR (sh:.Int) e (pat1,pat2,pat3,pat4,pat5,pat6,pat7,pat8,pat9)  --- NB: We cannot start with 'DIM0'.  The 'IsTuple stencil' superclass would at 'DIM0' imply that---     the types of individual array elements are in 'IsTuple'.  (That would only possible if we---     could have (degenerate) 1-tuple, but we can't as we can't distinguish between a 1-tuple of a---     pair and a simple pair.)  Hence, we need to start from 'DIM1' and use 'sh:.Int:.Int' in the---     recursive case (to avoid overlapping instances).+-- Note: [Stencil reification class]+--+-- We cannot start with 'DIM0'.  The 'IsTuple stencil' superclass would at+-- 'DIM0' imply that the types of individual array elements are in 'IsTuple'.+-- (That would only possible if we could have (degenerate) 1-tuple, but we can't+-- as we can't distinguish between a 1-tuple of a pair and a simple pair.)+-- Hence, we need to start from 'DIM1' and use 'sh:.Int:.Int' in the recursive+-- case (to avoid overlapping instances).  -- DIM1 instance Elt e => Stencil DIM1 e (e, e, e) where   stencil = StencilRunit3-  stencilAccess rf (Z:.y) = (rf' (y - 1),-                             rf' y      ,-                             rf' (y + 1))-    where-      rf' d = rf (Z:.d)  instance Elt e => Stencil DIM1 e (e, e, e, e, e) where   stencil = StencilRunit5-  stencilAccess rf (Z:.y) = (rf' (y - 2),-                             rf' (y - 1),-                             rf' y      ,-                             rf' (y + 1),-                             rf' (y + 2))-    where-      rf' d = rf (Z:.d)+ instance Elt e => Stencil DIM1 e (e, e, e, e, e, e, e) where   stencil = StencilRunit7-  stencilAccess rf (Z:.y) = (rf' (y - 3),-                             rf' (y - 2),-                             rf' (y - 1),-                             rf' y      ,-                             rf' (y + 1),-                             rf' (y + 2),-                             rf' (y + 3))-    where-      rf' d = rf (Z:.d)+ instance Elt e => Stencil DIM1 e (e, e, e, e, e, e, e, e, e) where   stencil = StencilRunit9-  stencilAccess rf (Z:.y) = (rf' (y - 4),-                             rf' (y - 3),-                             rf' (y - 2),-                             rf' (y - 1),-                             rf' y      ,-                             rf' (y + 1),-                             rf' (y + 2),-                             rf' (y + 3),-                             rf' (y + 4))-    where-      rf' d = rf (Z:.d) --- DIM(n+1), where n>0+-- DIM(n+1), where n>1 instance (Stencil (sh:.Int) a row1,           Stencil (sh:.Int) a row2,           Stencil (sh:.Int) a row3) => Stencil (sh:.Int:.Int) a (row1, row2, row3) where   stencil = StencilRtup3 stencil stencil stencil-  stencilAccess rf xi = (stencilAccess (rf' (i - 1)) ix,-                         stencilAccess (rf'  i     ) ix,-                         stencilAccess (rf' (i + 1)) ix) -    where-      -- Invert then re-invert to ensure each recursive step gets a shape in the-      -- standard scoc (right-recursive) ordering-      ---      ix' :. i  = invertShape xi-      ix        = invertShape ix'--      -- Inject this dimension innermost-      ---      rf' d ds  = rf $ invertShape (invertShape ds :. d)-- instance (Stencil (sh:.Int) a row1,           Stencil (sh:.Int) a row2,           Stencil (sh:.Int) a row3,           Stencil (sh:.Int) a row4,           Stencil (sh:.Int) a row5) => Stencil (sh:.Int:.Int) a (row1, row2, row3, row4, row5) where   stencil = StencilRtup5 stencil stencil stencil stencil stencil-  stencilAccess rf xi = (stencilAccess (rf' (i - 2)) ix,-                         stencilAccess (rf' (i - 1)) ix,-                         stencilAccess (rf'  i     ) ix,-                         stencilAccess (rf' (i + 1)) ix,-                         stencilAccess (rf' (i + 2)) ix)-    where-      ix' :. i  = invertShape xi-      ix        = invertShape ix'-      rf' d ds  = rf $ invertShape (invertShape ds :. d)  instance (Stencil (sh:.Int) a row1,           Stencil (sh:.Int) a row2,@@ -756,17 +749,6 @@           Stencil (sh:.Int) a row7)   => Stencil (sh:.Int:.Int) a (row1, row2, row3, row4, row5, row6, row7) where   stencil = StencilRtup7 stencil stencil stencil stencil stencil stencil stencil-  stencilAccess rf xi = (stencilAccess (rf' (i - 3)) ix,-                         stencilAccess (rf' (i - 2)) ix,-                         stencilAccess (rf' (i - 1)) ix,-                         stencilAccess (rf'  i     ) ix,-                         stencilAccess (rf' (i + 1)) ix,-                         stencilAccess (rf' (i + 2)) ix,-                         stencilAccess (rf' (i + 3)) ix)-    where-      ix' :. i  = invertShape xi-      ix        = invertShape ix'-      rf' d ds  = rf $ invertShape (invertShape ds :. d)  instance (Stencil (sh:.Int) a row1,           Stencil (sh:.Int) a row2,@@ -779,39 +761,8 @@           Stencil (sh:.Int) a row9)   => Stencil (sh:.Int:.Int) a (row1, row2, row3, row4, row5, row6, row7, row8, row9) where   stencil = StencilRtup9 stencil stencil stencil stencil stencil stencil stencil stencil stencil-  stencilAccess rf xi = (stencilAccess (rf' (i - 4)) ix,-                         stencilAccess (rf' (i - 3)) ix,-                         stencilAccess (rf' (i - 2)) ix,-                         stencilAccess (rf' (i - 1)) ix,-                         stencilAccess (rf'  i     ) ix,-                         stencilAccess (rf' (i + 1)) ix,-                         stencilAccess (rf' (i + 2)) ix,-                         stencilAccess (rf' (i + 3)) ix,-                         stencilAccess (rf' (i + 4)) ix)-    where-      ix' :. i  = invertShape xi-      ix        = invertShape ix'-      rf' d ds  = rf $ invertShape (invertShape ds :. d)  --- For stencilAccess to match how the user draws the stencil in code as a series--- of nested tuples, we need to recurse from the left. That is, we desire the--- following 2D stencil to represent elements to the top, bottom, left, and--- right of the focus as follows:------ stencil2D ( (_, t, _)---           , (l, _, r)---           , (_, b, _) ) = ...------ This function is used to reverse all components of a shape so that the--- innermost component, now the head, can be picked off.------ ...but needing to go via lists is unfortunate.----invertShape :: Shape sh => sh -> sh-invertShape =  listToShape . reverse . shapeToList-- -- Embedded expressions -- -------------------- @@ -1064,8 +1015,9 @@   -- PrimProperFraction :: FloatingType a -> IntegralType b -> PrimFun (a -> (b, a))    -- operators from RealFloat-  PrimIsNaN :: FloatingType a -> PrimFun (a -> Bool)-  PrimAtan2 :: FloatingType a -> PrimFun ((a, a) -> a)+  PrimAtan2          :: FloatingType a -> PrimFun ((a, a) -> a)+  PrimIsNaN          :: FloatingType a -> PrimFun (a -> Bool)+  PrimIsInfinite     :: FloatingType a -> PrimFun (a -> Bool)   -- PrimFloatRadix     :: FloatingType a -> PrimFun (a -> Int)         -- Integer?   -- PrimFloatDigits    :: FloatingType a -> PrimFun (a -> Int)   -- PrimFloatRange     :: FloatingType a -> PrimFun (a -> (Int, Int))@@ -1074,7 +1026,6 @@   -- PrimExponent       :: FloatingType a -> PrimFun (a -> Int)   -- PrimSignificand    :: FloatingType a -> PrimFun (a -> a)   -- PrimScaleFloat     :: FloatingType a -> PrimFun ((Int, a) -> a)-  -- PrimIsInfinite     :: FloatingType a -> PrimFun (a -> Bool)   -- PrimIsDenormalized :: FloatingType a -> PrimFun (a -> Bool)   -- PrimIsNegativeZero :: FloatingType a -> PrimFun (a -> Bool)   -- PrimIsIEEE         :: FloatingType a -> PrimFun (a -> Bool)@@ -1175,8 +1126,8 @@       -- rnfS :: PreOpenSeq acc aenv' senv' t' -> ()       -- rnfS = rnfPreOpenSeq rnfA -      rnfB :: forall aenv' sh e. Elt e => acc aenv' (Array sh e) -> Boundary (EltRepr e) -> ()-      rnfB _ = rnfBoundary (eltType (undefined::e))+      rnfB :: PreBoundary acc aenv' (Array sh e) -> ()+      rnfB = rnfBoundary rnfA   in   case pacc of     Alet bnd body             -> rnfA bnd `seq` rnfA body@@ -1208,8 +1159,8 @@     Scanr' f z a              -> rnfF f `seq` rnfE z `seq` rnfA a     Permute f d p a           -> rnfF f `seq` rnfA d `seq` rnfF p `seq` rnfA a     Backpermute sh f a        -> rnfE sh `seq` rnfF f `seq` rnfA a-    Stencil f b a             -> rnfF f `seq` rnfB a b `seq` rnfA a-    Stencil2 f b1 a1 b2 a2    -> rnfF f `seq` rnfB a1 b1 `seq` rnfB a2 b2 `seq` rnfA a1 `seq` rnfA a2+    Stencil f b a             -> rnfF f `seq` rnfB b  `seq` rnfA a+    Stencil2 f b1 a1 b2 a2    -> rnfF f `seq` rnfB b1 `seq` rnfB b2 `seq` rnfA a1 `seq` rnfA a2     -- Collect s                 -> rnfS s  @@ -1222,11 +1173,12 @@ rnfArrays ArraysRarray          arr     = rnf arr rnfArrays (ArraysRpair ar1 ar2) (a1,a2) = rnfArrays ar1 a1 `seq` rnfArrays ar2 a2 -rnfBoundary :: TupleType t -> Boundary t -> ()-rnfBoundary _ Clamp        = ()-rnfBoundary _ Mirror       = ()-rnfBoundary _ Wrap         = ()-rnfBoundary t (Constant c) = rnfConst t c+rnfBoundary :: forall acc aenv sh e. NFDataAcc acc -> PreBoundary acc aenv (Array sh e) -> ()+rnfBoundary _    Clamp        = ()+rnfBoundary _    Mirror       = ()+rnfBoundary _    Wrap         = ()+rnfBoundary _    (Constant c) = rnfConst (eltType (undefined::e)) c+rnfBoundary rnfA (Function f) = rnfPreOpenFun rnfA f   {--@@ -1401,6 +1353,7 @@ rnfPrimFun (PrimFloor f i)            = rnfFloatingType f `seq` rnfIntegralType i rnfPrimFun (PrimCeiling f i)          = rnfFloatingType f `seq` rnfIntegralType i rnfPrimFun (PrimIsNaN t)              = rnfFloatingType t+rnfPrimFun (PrimIsInfinite t)         = rnfFloatingType t rnfPrimFun (PrimAtan2 t)              = rnfFloatingType t rnfPrimFun (PrimLt t)                 = rnfScalarType t rnfPrimFun (PrimGt t)                 = rnfScalarType t@@ -1471,8 +1424,390 @@ rnfFloatingType (TypeCDouble FloatingDict) = ()  +-- Template Haskell+-- ================++type LiftAcc acc = forall aenv a. acc aenv a -> Q (TExp (acc aenv a))++liftIdx :: Idx env t -> Q (TExp (Idx env t))+liftIdx ZeroIdx      = [|| ZeroIdx ||]+liftIdx (SuccIdx ix) = [|| SuccIdx $$(liftIdx ix) ||]++liftTupleIdx :: TupleIdx t e -> Q (TExp (TupleIdx t e))+liftTupleIdx ZeroTupIdx       = [|| ZeroTupIdx ||]+liftTupleIdx (SuccTupIdx tix) = [|| SuccTupIdx $$(liftTupleIdx tix) ||]+++liftPreOpenAfun :: LiftAcc acc -> PreOpenAfun acc aenv t -> Q (TExp (PreOpenAfun acc aenv t))+liftPreOpenAfun liftA (Alam f)  = [|| Alam  $$(liftPreOpenAfun liftA f) ||]+liftPreOpenAfun liftA (Abody b) = [|| Abody $$(liftA b) ||]++liftPreOpenAcc+    :: forall acc aenv a.+       LiftAcc acc+    -> PreOpenAcc acc aenv a+    -> Q (TExp (PreOpenAcc acc aenv a))+liftPreOpenAcc liftA pacc =+  let+      liftE :: PreOpenExp acc env aenv t -> Q (TExp (PreOpenExp acc env aenv t))+      liftE = liftPreOpenExp liftA++      liftF :: PreOpenFun acc env aenv t -> Q (TExp (PreOpenFun acc env aenv t))+      liftF = liftPreOpenFun liftA++      liftAF :: PreOpenAfun acc aenv f -> Q (TExp (PreOpenAfun acc aenv f))+      liftAF = liftPreOpenAfun liftA++      liftB :: PreBoundary acc aenv (Array sh e) -> Q (TExp (PreBoundary acc aenv (Array sh e)))+      liftB = liftBoundary liftA++      liftAtuple :: Atuple (acc aenv) t -> Q (TExp (Atuple (acc aenv) t))+      liftAtuple NilAtup          = [|| NilAtup ||]+      liftAtuple (SnocAtup tup a) = [|| SnocAtup $$(liftAtuple tup) $$(liftA a) ||]+  in+  case pacc of+    Alet bnd body             -> [|| Alet $$(liftA bnd) $$(liftA body) ||]+    Avar ix                   -> [|| Avar $$(liftIdx ix) ||]+    Atuple tup                -> [|| Atuple $$(liftAtuple tup) ||]+    Aprj tix a                -> [|| Aprj $$(liftTupleIdx tix) $$(liftA a) ||]+    Apply f a                 -> [|| Apply $$(liftAF f) $$(liftA a) ||]+    Aforeign asm f a          -> [|| Aforeign $$(liftForeign asm) $$(liftPreOpenAfun liftA f) $$(liftA a) ||]+    Acond p t e               -> [|| Acond $$(liftE p) $$(liftA t) $$(liftA e) ||]+    Awhile p f a              -> [|| Awhile $$(liftAF p) $$(liftAF f) $$(liftA a) ||]+    Use a                     -> [|| Use $$(liftArrays (arrays (undefined::a)) a) ||]+    Unit e                    -> [|| Unit $$(liftE e) ||]+    Reshape sh a              -> [|| Reshape $$(liftE sh) $$(liftA a) ||]+    Generate sh f             -> [|| Generate $$(liftE sh) $$(liftF f) ||]+    Transform sh p f a        -> [|| Transform $$(liftE sh) $$(liftF p) $$(liftF f) $$(liftA a) ||]+    Replicate slix sl a       -> [|| Replicate $$(liftSliceIndex slix) $$(liftE sl) $$(liftA a) ||]+    Slice slix a sh           -> [|| Slice $$(liftSliceIndex slix) $$(liftA a) $$(liftE sh) ||]+    Map f a                   -> [|| Map $$(liftF f) $$(liftA a) ||]+    ZipWith f a b             -> [|| ZipWith $$(liftF f) $$(liftA a) $$(liftA b) ||]+    Fold f z a                -> [|| Fold $$(liftF f) $$(liftE z) $$(liftA a) ||]+    Fold1 f a                 -> [|| Fold1 $$(liftF f) $$(liftA a) ||]+    FoldSeg f z a s           -> [|| FoldSeg $$(liftF f) $$(liftE z) $$(liftA a) $$(liftA s) ||]+    Fold1Seg f a s            -> [|| Fold1Seg $$(liftF f) $$(liftA a) $$(liftA s) ||]+    Scanl f z a               -> [|| Scanl $$(liftF f) $$(liftE z) $$(liftA a) ||]+    Scanl1 f a                -> [|| Scanl1 $$(liftF f) $$(liftA a) ||]+    Scanl' f z a              -> [|| Scanl' $$(liftF f) $$(liftE z) $$(liftA a) ||]+    Scanr f z a               -> [|| Scanr $$(liftF f) $$(liftE z) $$(liftA a) ||]+    Scanr1 f a                -> [|| Scanr1 $$(liftF f) $$(liftA a) ||]+    Scanr' f z a              -> [|| Scanr' $$(liftF f) $$(liftE z) $$(liftA a) ||]+    Permute f d p a           -> [|| Permute $$(liftF f) $$(liftA d) $$(liftF p) $$(liftA a) ||]+    Backpermute sh p a        -> [|| Backpermute $$(liftE sh) $$(liftF p) $$(liftA a) ||]+    Stencil f b a             -> [|| Stencil $$(liftF f) $$(liftB b) $$(liftA a) ||]+    Stencil2 f b1 a1 b2 a2    -> [|| Stencil2 $$(liftF f) $$(liftB b1) $$(liftA a1) $$(liftB b2) $$(liftA a2) ||]+++liftPreOpenFun+    :: LiftAcc acc+    -> PreOpenFun acc env aenv t+    -> Q (TExp (PreOpenFun acc env aenv t))+liftPreOpenFun liftA (Lam f)  = [|| Lam  $$(liftPreOpenFun liftA f) ||]+liftPreOpenFun liftA (Body b) = [|| Body $$(liftPreOpenExp liftA b) ||]++liftPreOpenExp+    :: forall acc env aenv t.+       LiftAcc acc+    -> PreOpenExp acc env aenv t+    -> Q (TExp (PreOpenExp acc env aenv t))+liftPreOpenExp liftA pexp =+  let+      liftE :: PreOpenExp acc env aenv e -> Q (TExp (PreOpenExp acc env aenv e))+      liftE = liftPreOpenExp liftA++      liftF :: PreOpenFun acc env aenv f -> Q (TExp (PreOpenFun acc env aenv f))+      liftF = liftPreOpenFun liftA++      liftT :: Tuple (PreOpenExp acc env aenv) e -> Q (TExp (Tuple (PreOpenExp acc env aenv) e))+      liftT NilTup          = [|| NilTup ||]+      liftT (SnocTup tup e) = [|| SnocTup $$(liftT tup) $$(liftE e) ||]+  in+  case pexp of+    Let bnd body              -> [|| Let $$(liftPreOpenExp liftA bnd) $$(liftPreOpenExp liftA body) ||]+    Var ix                    -> [|| Var $$(liftIdx ix) ||]+    Foreign asm f x           -> [|| Foreign $$(liftForeign asm) $$(liftPreOpenFun liftA f) $$(liftE x) ||]+    Const c                   -> [|| Const $$(liftConst (eltType (undefined::t)) c) ||]+    Tuple tup                 -> [|| Tuple $$(liftT tup) ||]+    Prj tix e                 -> [|| Prj $$(liftTupleIdx tix) $$(liftE e) ||]+    IndexNil                  -> [|| IndexNil ||]+    IndexCons sh sz           -> [|| IndexCons $$(liftE sh) $$(liftE sz) ||]+    IndexHead sh              -> [|| IndexHead $$(liftE sh) ||]+    IndexTail sh              -> [|| IndexTail $$(liftE sh) ||]+    IndexAny                  -> [|| IndexAny ||]+    IndexSlice slice slix sh  -> [|| IndexSlice $$(liftSliceIndex slice) $$(liftE slix) $$(liftE sh) ||]+    IndexFull slice slix sl   -> [|| IndexFull $$(liftSliceIndex slice) $$(liftE slix) $$(liftE sl) ||]+    ToIndex sh ix             -> [|| ToIndex $$(liftE sh) $$(liftE ix) ||]+    FromIndex sh ix           -> [|| FromIndex $$(liftE sh) $$(liftE ix) ||]+    Cond p t e                -> [|| Cond $$(liftE p) $$(liftE t) $$(liftE e) ||]+    While p f x               -> [|| While $$(liftF p) $$(liftF f) $$(liftE x) ||]+    PrimConst t               -> [|| PrimConst $$(liftPrimConst t) ||]+    PrimApp f x               -> [|| PrimApp $$(liftPrimFun f) $$(liftE x) ||]+    Index a ix                -> [|| Index $$(liftA a) $$(liftE ix) ||]+    LinearIndex a ix          -> [|| LinearIndex $$(liftA a) $$(liftE ix) ||]+    Shape a                   -> [|| Shape $$(liftA a) ||]+    ShapeSize ix              -> [|| ShapeSize $$(liftE ix) ||]+    Intersect sh1 sh2         -> [|| Intersect $$(liftE sh1) $$(liftE sh2) ||]+    Union sh1 sh2             -> [|| Union $$(liftE sh1) $$(liftE sh2) ||]+++liftArrays :: ArraysR arr -> arr -> Q (TExp arr)+liftArrays ArraysRunit ()              = [|| () ||]+liftArrays ArraysRarray arr            = [|| $$(liftArray arr) ||]+liftArrays (ArraysRpair r1 r2) (a1,a2) = [|| ($$(liftArrays r1 a1), $$(liftArrays r2 a2)) ||]++liftArray :: forall sh e. Array sh e -> Q (TExp (Array sh e))+liftArray (Array sh adata) =+  [|| Array $$(liftConst (eltType (undefined::sh)) sh) $$(go arrayElt adata) ||] `sigE` typeRepToType (typeOf (undefined::Array sh e))+  where+    sz :: Int+    sz = size sh++    sigE :: Q (TExp t) -> Q TH.Type -> Q (TExp t)+    sigE e t = TH.unsafeTExpCoerce $ TH.sigE (TH.unTypeQ e) t++    typeRepToType :: TypeRep -> Q TH.Type+    typeRepToType trep = do+      let (con, args)     = splitTyConApp trep+          name            = TH.Name (TH.OccName (tyConName con)) (TH.NameG TH.TcClsName (TH.PkgName (tyConPackage con)) (TH.ModName (tyConModule con)))+          --+          appsT x []      = x+          appsT x (y:xs)  = appsT (TH.AppT x y) xs+          --+      resultArgs <- mapM typeRepToType args+      return (appsT (TH.ConT name) resultArgs)++    -- TODO: make sure that the resulting array is 16-byte aligned...+    arr :: forall a. (ArrayElt a, Storable a) => UniqueArray a -> Q (TExp (UniqueArray a))+    arr ua = do+      bytes <- TH.runIO $ peekArray (sizeOf (undefined::a) * sz) (castPtr (unsafeUniqueArrayPtr ua) :: Ptr Word8)+      [|| unsafePerformIO $ do+           fp  <- newForeignPtr_ $$( TH.unsafeTExpCoerce [| Ptr $(TH.litE (TH.StringPrimL bytes)) |] )+           ua' <- newUniqueArray (castForeignPtr fp)+           return ua'+       ||]++    go :: ArrayEltR e' -> ArrayData e' -> Q (TExp (ArrayData e'))+    go ArrayEltRunit         AD_Unit         = [|| AD_Unit ||]+    go ArrayEltRint          (AD_Int ua)     = [|| AD_Int $$(arr ua) ||]+    go ArrayEltRint8         (AD_Int8 ua)    = [|| AD_Int8 $$(arr ua) ||]+    go ArrayEltRint16        (AD_Int16 ua)   = [|| AD_Int16 $$(arr ua) ||]+    go ArrayEltRint32        (AD_Int32 ua)   = [|| AD_Int32 $$(arr ua) ||]+    go ArrayEltRint64        (AD_Int64 ua)   = [|| AD_Int64 $$(arr ua) ||]+    go ArrayEltRword         (AD_Word ua)    = [|| AD_Word $$(arr ua) ||]+    go ArrayEltRword8        (AD_Word8 ua)   = [|| AD_Word8 $$(arr ua) ||]+    go ArrayEltRword16       (AD_Word16 ua)  = [|| AD_Word16 $$(arr ua) ||]+    go ArrayEltRword32       (AD_Word32 ua)  = [|| AD_Word32 $$(arr ua) ||]+    go ArrayEltRword64       (AD_Word64 ua)  = [|| AD_Word64 $$(arr ua) ||]+    go ArrayEltRcshort       (AD_CShort ua)  = [|| AD_CShort $$(arr ua) ||]+    go ArrayEltRcushort      (AD_CUShort ua) = [|| AD_CUShort $$(arr ua) ||]+    go ArrayEltRcint         (AD_CInt ua)    = [|| AD_CInt $$(arr ua) ||]+    go ArrayEltRcuint        (AD_CUInt ua)   = [|| AD_CUInt $$(arr ua) ||]+    go ArrayEltRclong        (AD_CLong ua)   = [|| AD_CLong $$(arr ua) ||]+    go ArrayEltRculong       (AD_CULong ua)  = [|| AD_CULong $$(arr ua) ||]+    go ArrayEltRcllong       (AD_CLLong ua)  = [|| AD_CLLong $$(arr ua) ||]+    go ArrayEltRcullong      (AD_CULLong ua) = [|| AD_CULLong $$(arr ua) ||]+    go ArrayEltRfloat        (AD_Float ua)   = [|| AD_Float $$(arr ua) ||]+    go ArrayEltRdouble       (AD_Double ua)  = [|| AD_Double $$(arr ua) ||]+    go ArrayEltRcfloat       (AD_CFloat ua)  = [|| AD_CFloat $$(arr ua) ||]+    go ArrayEltRcdouble      (AD_CDouble ua) = [|| AD_CDouble $$(arr ua) ||]+    go ArrayEltRbool         (AD_Bool ua)    = [|| AD_Bool $$(arr ua) ||]+    go ArrayEltRchar         (AD_Char ua)    = [|| AD_Char $$(arr ua) ||]+    go ArrayEltRcchar        (AD_CChar ua)   = [|| AD_CChar $$(arr ua) ||]+    go ArrayEltRcschar       (AD_CSChar ua)  = [|| AD_CSChar $$(arr ua) ||]+    go ArrayEltRcuchar       (AD_CUChar ua)  = [|| AD_CUChar $$(arr ua) ||]+    go (ArrayEltRpair r1 r2) (AD_Pair a1 a2) = [|| AD_Pair $$(go r1 a1) $$(go r2 a2) ||]+++liftBoundary+    :: forall acc aenv sh e.+       LiftAcc acc+    -> PreBoundary acc aenv (Array sh e)+    -> Q (TExp (PreBoundary acc aenv (Array sh e)))+liftBoundary _     Clamp        = [|| Clamp ||]+liftBoundary _     Mirror       = [|| Mirror ||]+liftBoundary _     Wrap         = [|| Wrap ||]+liftBoundary _     (Constant v) = [|| Constant $$(liftConst (eltType (undefined::e)) v) ||]+liftBoundary liftA (Function f) = [|| Function $$(liftPreOpenFun liftA f) ||]++liftSliceIndex :: SliceIndex ix slice coSlice sliceDim -> Q (TExp (SliceIndex ix slice coSlice sliceDim))+liftSliceIndex SliceNil          = [|| SliceNil ||]+liftSliceIndex (SliceAll rest)   = [|| SliceAll $$(liftSliceIndex rest) ||]+liftSliceIndex (SliceFixed rest) = [|| SliceFixed $$(liftSliceIndex rest) ||]++liftPrimConst :: PrimConst c -> Q (TExp (PrimConst c))+liftPrimConst (PrimMinBound t) = [|| PrimMinBound $$(liftBoundedType t) ||]+liftPrimConst (PrimMaxBound t) = [|| PrimMaxBound $$(liftBoundedType t) ||]+liftPrimConst (PrimPi t)       = [|| PrimPi $$(liftFloatingType t) ||]++liftPrimFun :: PrimFun f -> Q (TExp (PrimFun f))+liftPrimFun (PrimAdd t)                = [|| PrimAdd $$(liftNumType t) ||]+liftPrimFun (PrimSub t)                = [|| PrimSub $$(liftNumType t) ||]+liftPrimFun (PrimMul t)                = [|| PrimMul $$(liftNumType t) ||]+liftPrimFun (PrimNeg t)                = [|| PrimNeg $$(liftNumType t) ||]+liftPrimFun (PrimAbs t)                = [|| PrimAbs $$(liftNumType t) ||]+liftPrimFun (PrimSig t)                = [|| PrimSig $$(liftNumType t) ||]+liftPrimFun (PrimQuot t)               = [|| PrimQuot $$(liftIntegralType t) ||]+liftPrimFun (PrimRem t)                = [|| PrimRem $$(liftIntegralType t) ||]+liftPrimFun (PrimQuotRem t)            = [|| PrimQuotRem $$(liftIntegralType t) ||]+liftPrimFun (PrimIDiv t)               = [|| PrimIDiv $$(liftIntegralType t) ||]+liftPrimFun (PrimMod t)                = [|| PrimMod $$(liftIntegralType t) ||]+liftPrimFun (PrimDivMod t)             = [|| PrimDivMod $$(liftIntegralType t) ||]+liftPrimFun (PrimBAnd t)               = [|| PrimBAnd $$(liftIntegralType t) ||]+liftPrimFun (PrimBOr t)                = [|| PrimBOr $$(liftIntegralType t) ||]+liftPrimFun (PrimBXor t)               = [|| PrimBXor $$(liftIntegralType t) ||]+liftPrimFun (PrimBNot t)               = [|| PrimBNot $$(liftIntegralType t) ||]+liftPrimFun (PrimBShiftL t)            = [|| PrimBShiftL $$(liftIntegralType t) ||]+liftPrimFun (PrimBShiftR t)            = [|| PrimBShiftR $$(liftIntegralType t) ||]+liftPrimFun (PrimBRotateL t)           = [|| PrimBRotateL $$(liftIntegralType t) ||]+liftPrimFun (PrimBRotateR t)           = [|| PrimBRotateR $$(liftIntegralType t) ||]+liftPrimFun (PrimPopCount t)           = [|| PrimPopCount $$(liftIntegralType t) ||]+liftPrimFun (PrimCountLeadingZeros t)  = [|| PrimCountLeadingZeros $$(liftIntegralType t) ||]+liftPrimFun (PrimCountTrailingZeros t) = [|| PrimCountTrailingZeros $$(liftIntegralType t) ||]+liftPrimFun (PrimFDiv t)               = [|| PrimFDiv $$(liftFloatingType t) ||]+liftPrimFun (PrimRecip t)              = [|| PrimRecip $$(liftFloatingType t) ||]+liftPrimFun (PrimSin t)                = [|| PrimSin $$(liftFloatingType t) ||]+liftPrimFun (PrimCos t)                = [|| PrimCos $$(liftFloatingType t) ||]+liftPrimFun (PrimTan t)                = [|| PrimTan $$(liftFloatingType t) ||]+liftPrimFun (PrimAsin t)               = [|| PrimAsin $$(liftFloatingType t) ||]+liftPrimFun (PrimAcos t)               = [|| PrimAcos $$(liftFloatingType t) ||]+liftPrimFun (PrimAtan t)               = [|| PrimAtan $$(liftFloatingType t) ||]+liftPrimFun (PrimSinh t)               = [|| PrimSinh $$(liftFloatingType t) ||]+liftPrimFun (PrimCosh t)               = [|| PrimCosh $$(liftFloatingType t) ||]+liftPrimFun (PrimTanh t)               = [|| PrimTanh $$(liftFloatingType t) ||]+liftPrimFun (PrimAsinh t)              = [|| PrimAsinh $$(liftFloatingType t) ||]+liftPrimFun (PrimAcosh t)              = [|| PrimAcosh $$(liftFloatingType t) ||]+liftPrimFun (PrimAtanh t)              = [|| PrimAtanh $$(liftFloatingType t) ||]+liftPrimFun (PrimExpFloating t)        = [|| PrimExpFloating $$(liftFloatingType t) ||]+liftPrimFun (PrimSqrt t)               = [|| PrimSqrt $$(liftFloatingType t) ||]+liftPrimFun (PrimLog t)                = [|| PrimLog $$(liftFloatingType t) ||]+liftPrimFun (PrimFPow t)               = [|| PrimFPow $$(liftFloatingType t) ||]+liftPrimFun (PrimLogBase t)            = [|| PrimLogBase $$(liftFloatingType t) ||]+liftPrimFun (PrimTruncate ta tb)       = [|| PrimTruncate $$(liftFloatingType ta) $$(liftIntegralType tb) ||]+liftPrimFun (PrimRound ta tb)          = [|| PrimRound $$(liftFloatingType ta) $$(liftIntegralType tb) ||]+liftPrimFun (PrimFloor ta tb)          = [|| PrimFloor $$(liftFloatingType ta) $$(liftIntegralType tb) ||]+liftPrimFun (PrimCeiling ta tb)        = [|| PrimCeiling $$(liftFloatingType ta) $$(liftIntegralType tb) ||]+liftPrimFun (PrimIsNaN t)              = [|| PrimIsNaN $$(liftFloatingType t) ||]+liftPrimFun (PrimIsInfinite t)         = [|| PrimIsInfinite $$(liftFloatingType t) ||]+liftPrimFun (PrimAtan2 t)              = [|| PrimAtan2 $$(liftFloatingType t) ||]+liftPrimFun (PrimLt t)                 = [|| PrimLt $$(liftScalarType t) ||]+liftPrimFun (PrimGt t)                 = [|| PrimGt $$(liftScalarType t) ||]+liftPrimFun (PrimLtEq t)               = [|| PrimLtEq $$(liftScalarType t) ||]+liftPrimFun (PrimGtEq t)               = [|| PrimGtEq $$(liftScalarType t) ||]+liftPrimFun (PrimEq t)                 = [|| PrimEq $$(liftScalarType t) ||]+liftPrimFun (PrimNEq t)                = [|| PrimNEq $$(liftScalarType t) ||]+liftPrimFun (PrimMax t)                = [|| PrimMax $$(liftScalarType t) ||]+liftPrimFun (PrimMin t)                = [|| PrimMin $$(liftScalarType t) ||]+liftPrimFun PrimLAnd                   = [|| PrimLAnd ||]+liftPrimFun PrimLOr                    = [|| PrimLOr ||]+liftPrimFun PrimLNot                   = [|| PrimLNot ||]+liftPrimFun PrimOrd                    = [|| PrimOrd ||]+liftPrimFun PrimChr                    = [|| PrimChr ||]+liftPrimFun PrimBoolToInt              = [|| PrimBoolToInt ||]+liftPrimFun (PrimFromIntegral ta tb)   = [|| PrimFromIntegral $$(liftIntegralType ta) $$(liftNumType tb) ||]+liftPrimFun (PrimToFloating ta tb)     = [|| PrimToFloating $$(liftNumType ta) $$(liftFloatingType tb) ||]+liftPrimFun (PrimCoerce ta tb)         = [|| PrimCoerce $$(liftScalarType ta) $$(liftScalarType tb) ||]+++liftConst :: TupleType t -> t -> Q (TExp t)+liftConst UnitTuple         ()    = [|| () ||]+liftConst (SingleTuple t)   x     = [|| $$(liftScalar t x) ||]+liftConst (PairTuple ta tb) (a,b) = [|| ($$(liftConst ta a), $$(liftConst tb b)) ||]++liftScalar :: ScalarType t -> t -> Q (TExp t)+liftScalar (NumScalarType t)    x = liftNum t x+liftScalar (NonNumScalarType t) x = liftNonNum t x++liftNum :: NumType t -> t -> Q (TExp t)+liftNum (IntegralNumType t) x = liftIntegral t x+liftNum (FloatingNumType t) x = liftFloating t x++liftNonNum :: NonNumType t -> t -> Q (TExp t)+liftNonNum TypeBool{}   x = [|| x ||]+liftNonNum TypeChar{}   x = [|| x ||]+liftNonNum TypeCChar{}  x = return (TH.TExp (TH.LitE (TH.IntegerL (toInteger x))))+liftNonNum TypeCSChar{} x = return (TH.TExp (TH.LitE (TH.IntegerL (toInteger x))))+liftNonNum TypeCUChar{} x = return (TH.TExp (TH.LitE (TH.IntegerL (toInteger x))))++liftIntegral :: IntegralType t -> t -> Q (TExp t)+liftIntegral TypeInt{}     x = [|| x ||]+liftIntegral TypeInt8{}    x = [|| x ||]+liftIntegral TypeInt16{}   x = [|| x ||]+liftIntegral TypeInt32{}   x = [|| x ||]+liftIntegral TypeInt64{}   x = [|| x ||]+#if __GLASGOW_HASKELL__ >= 710+liftIntegral TypeWord{}    x = [|| x ||]+#else+liftIntegral TypeWord{}    x = return (TH.TExp (TH.LitE (TH.IntegerL (toInteger x))))+#endif+liftIntegral TypeWord8{}   x = [|| x ||]+liftIntegral TypeWord16{}  x = [|| x ||]+liftIntegral TypeWord32{}  x = [|| x ||]+liftIntegral TypeWord64{}  x = [|| x ||]+liftIntegral TypeCShort{}  x = return (TH.TExp (TH.LitE (TH.IntegerL (toInteger x))))+liftIntegral TypeCUShort{} x = return (TH.TExp (TH.LitE (TH.IntegerL (toInteger x))))+liftIntegral TypeCInt{}    x = return (TH.TExp (TH.LitE (TH.IntegerL (toInteger x))))+liftIntegral TypeCUInt{}   x = return (TH.TExp (TH.LitE (TH.IntegerL (toInteger x))))+liftIntegral TypeCLong{}   x = return (TH.TExp (TH.LitE (TH.IntegerL (toInteger x))))+liftIntegral TypeCULong{}  x = return (TH.TExp (TH.LitE (TH.IntegerL (toInteger x))))+liftIntegral TypeCLLong{}  x = return (TH.TExp (TH.LitE (TH.IntegerL (toInteger x))))+liftIntegral TypeCULLong{} x = return (TH.TExp (TH.LitE (TH.IntegerL (toInteger x))))++liftFloating :: FloatingType t -> t -> Q (TExp t)+liftFloating TypeFloat{}   x = [|| x ||]+liftFloating TypeDouble{}  x = [|| x ||]+liftFloating TypeCFloat{}  x = return (TH.TExp (TH.LitE (TH.RationalL (toRational x))))+liftFloating TypeCDouble{} x = return (TH.TExp (TH.LitE (TH.RationalL (toRational x))))+++liftIntegralType :: IntegralType t -> Q (TExp (IntegralType t))+liftIntegralType TypeInt{}     = [|| TypeInt IntegralDict ||]+liftIntegralType TypeInt8{}    = [|| TypeInt8 IntegralDict ||]+liftIntegralType TypeInt16{}   = [|| TypeInt16 IntegralDict ||]+liftIntegralType TypeInt32{}   = [|| TypeInt32 IntegralDict ||]+liftIntegralType TypeInt64{}   = [|| TypeInt64 IntegralDict ||]+liftIntegralType TypeWord{}    = [|| TypeWord IntegralDict ||]+liftIntegralType TypeWord8{}   = [|| TypeWord8 IntegralDict ||]+liftIntegralType TypeWord16{}  = [|| TypeWord16 IntegralDict ||]+liftIntegralType TypeWord32{}  = [|| TypeWord32 IntegralDict ||]+liftIntegralType TypeWord64{}  = [|| TypeWord64 IntegralDict ||]+liftIntegralType TypeCShort{}  = [|| TypeCShort IntegralDict ||]+liftIntegralType TypeCUShort{} = [|| TypeCUShort IntegralDict ||]+liftIntegralType TypeCInt{}    = [|| TypeCInt IntegralDict ||]+liftIntegralType TypeCUInt{}   = [|| TypeCUInt IntegralDict ||]+liftIntegralType TypeCLong{}   = [|| TypeCLong IntegralDict ||]+liftIntegralType TypeCULong{}  = [|| TypeCULong IntegralDict ||]+liftIntegralType TypeCLLong{}  = [|| TypeCLLong IntegralDict ||]+liftIntegralType TypeCULLong{} = [|| TypeCULLong IntegralDict ||]++liftFloatingType :: FloatingType t -> Q (TExp (FloatingType t))+liftFloatingType TypeFloat{}   = [|| TypeFloat FloatingDict ||]+liftFloatingType TypeDouble{}  = [|| TypeDouble FloatingDict ||]+liftFloatingType TypeCFloat{}  = [|| TypeCFloat FloatingDict ||]+liftFloatingType TypeCDouble{} = [|| TypeCDouble FloatingDict ||]++liftNonNumType :: NonNumType t -> Q (TExp (NonNumType t))+liftNonNumType TypeBool{}   = [|| TypeBool NonNumDict ||]+liftNonNumType TypeChar{}   = [|| TypeChar NonNumDict ||]+liftNonNumType TypeCChar{}  = [|| TypeCChar NonNumDict ||]+liftNonNumType TypeCSChar{} = [|| TypeCSChar NonNumDict ||]+liftNonNumType TypeCUChar{} = [|| TypeCUChar NonNumDict ||]++liftNumType :: NumType t -> Q (TExp (NumType t))+liftNumType (IntegralNumType t) = [|| IntegralNumType $$(liftIntegralType t) ||]+liftNumType (FloatingNumType t) = [|| FloatingNumType $$(liftFloatingType t) ||]++liftBoundedType :: BoundedType t -> Q (TExp (BoundedType t))+liftBoundedType (IntegralBoundedType t) = [|| IntegralBoundedType $$(liftIntegralType t) ||]+liftBoundedType (NonNumBoundedType t)   = [|| NonNumBoundedType $$(liftNonNumType t) ||]++liftScalarType :: ScalarType t -> Q (TExp (ScalarType t))+liftScalarType (NumScalarType t)    = [|| NumScalarType $$(liftNumType t) ||]+liftScalarType (NonNumScalarType t) = [|| NonNumScalarType $$(liftNonNumType t) ||]++ -- Debugging--- ---------+-- =========  showPreAccOp :: forall acc aenv arrs. PreOpenAcc acc aenv arrs -> String showPreAccOp Alet{}             = "Alet"@@ -1525,7 +1860,7 @@ showShortendArr arr   = show (take cutoff l) ++ if length l > cutoff then ".." else ""   where-    l      = Sugar.toList arr+    l      = toList arr     cutoff = 5
+ Data/Array/Accelerate/Analysis/Hash.hs view
@@ -0,0 +1,506 @@+{-# LANGUAGE GADTs               #-}+{-# LANGUAGE PatternGuards       #-}+{-# LANGUAGE RankNTypes          #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell     #-}+{-# OPTIONS_HADDOCK hide #-}+-- |+-- Module      : Data.Array.Accelerate.Analysis.Hash+-- Copyright   : [2017] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- License     : BSD3+--+-- Maintainer  : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability   : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.Analysis.Hash (++  -- hashing expressions+  HashAcc,+  hashPreOpenAcc, hashOpenAcc,+  hashPreOpenExp, hashOpenExp,+  hashPreOpenFun,++  -- auxiliary+  hashQ,+  commutes,++) where++import Data.Array.Accelerate.AST+import Data.Array.Accelerate.Analysis.Hash.TH+import Data.Array.Accelerate.Array.Sugar+import Data.Array.Accelerate.Array.Representation                   ( SliceIndex(..) )+import Data.Array.Accelerate.Product+import Data.Array.Accelerate.Type++import Data.Hashable+import Foreign.C.Types+import Data.Maybe                                                   ( fromMaybe )+import System.Mem.StableName                                        ( hashStableName, makeStableName )+import System.IO.Unsafe                                             ( unsafePerformIO )+import Prelude                                                      hiding ( exp )+++-- Array computations+-- ------------------++type HashAcc acc = forall aenv a. acc aenv a -> Int+++hashOpenAcc :: OpenAcc aenv arrs -> Int+hashOpenAcc (OpenAcc pacc) = hashPreOpenAcc hashOpenAcc pacc++hashPreOpenAcc :: forall acc aenv arrs. HashAcc acc -> PreOpenAcc acc aenv arrs -> Int+hashPreOpenAcc hashAcc pacc =+  let+    hashA :: forall aenv' a. Arrays a => Int -> acc aenv' a -> Int+    hashA salt+      = hashWithSalt salt+      . hashWithSalt (hashArraysType (arrays (undefined::a)))+      . hashAcc++    hashE :: Int -> PreOpenExp acc env' aenv' e -> Int+    hashE salt = hashWithSalt salt . hashPreOpenExp hashAcc++    hashF :: Int -> PreOpenFun acc env' aenv' f -> Int+    hashF salt = hashWithSalt salt . hashPreOpenFun hashAcc++    hashB :: Int -> PreBoundary acc aenv' (Array sh e) -> Int+    hashB salt = hashWithSalt salt . hashPreBoundary hashAcc++    -- hashS :: Int -> PreOpenSeq acc aenv senv arrs -> Int+    -- hashS salt = hashWithSalt salt . hashPreOpenSeq hashAcc++    nacl :: Arrays arrs => Int+    nacl = hashArraysType (arrays (undefined::arrs))++  in case pacc of+    Alet bnd body               -> $(hashQ "Alet")        `hashA` bnd `hashA` body+    Avar v                      -> $(hashQ "Avar")        `hashWithSalt` nacl `hashWithSalt` hashIdx v+    Atuple t                    -> $(hashQ "Atuple")      `hashWithSalt` nacl `hashWithSalt` hashAtuple hashAcc t+    Aprj ix a                   -> $(hashQ "Aprj")        `hashWithSalt` nacl `hashWithSalt` hashTupleIdx ix    `hashA` a+    Apply f a                   -> $(hashQ "Apply")       `hashWithSalt` nacl `hashWithSalt` hashAfun hashAcc f `hashA` a+    Aforeign _ f a              -> $(hashQ "Aforeign")    `hashWithSalt` nacl `hashWithSalt` hashAfun hashAcc f `hashA` a+    Use a                       -> $(hashQ "Use")         `hashWithSalt` hashArrays (arrays (undefined::arrs)) a+    Awhile p f a                -> $(hashQ "Awhile")      `hashWithSalt` hashAfun hashAcc f `hashWithSalt` hashAfun hashAcc p `hashA` a+    Unit e                      -> $(hashQ "Unit")        `hashE` e+    Generate e f                -> $(hashQ "Generate")    `hashE` e  `hashF` f+    Acond e a1 a2               -> $(hashQ "Acond")       `hashE` e  `hashA` a1 `hashA` a2+    Reshape sh a                -> $(hashQ "Reshape")     `hashE` sh `hashA` a+    Transform sh f1 f2 a        -> $(hashQ "Transform")   `hashE` sh `hashF` f1 `hashF` f2 `hashA` a+    Replicate spec ix a         -> $(hashQ "Replicate")   `hashE` ix `hashA` a  `hashWithSalt` hashSliceIndex spec+    Slice spec a ix             -> $(hashQ "Slice")       `hashE` ix `hashA` a  `hashWithSalt` hashSliceIndex spec+    Map f a                     -> $(hashQ "Map")         `hashF` f  `hashA` a+    ZipWith f a1 a2             -> $(hashQ "ZipWith")     `hashF` f  `hashA` a1 `hashA` a2+    Fold f e a                  -> $(hashQ "Fold")        `hashF` f  `hashE` e  `hashA` a+    Fold1 f a                   -> $(hashQ "Fold1")       `hashF` f  `hashA` a+    FoldSeg f e a s             -> $(hashQ "FoldSeg")     `hashF` f  `hashE` e  `hashA` a  `hashA` s+    Fold1Seg f a s              -> $(hashQ "Fold1Seg")    `hashF` f  `hashA` a  `hashA` s+    Scanl f e a                 -> $(hashQ "Scanl")       `hashF` f  `hashE` e  `hashA` a+    Scanl' f e a                -> $(hashQ "Scanl'")      `hashF` f  `hashE` e  `hashA` a+    Scanl1 f a                  -> $(hashQ "Scanl1")      `hashF` f  `hashA` a+    Scanr f e a                 -> $(hashQ "Scanr")       `hashF` f  `hashE` e  `hashA` a+    Scanr' f e a                -> $(hashQ "Scanr'")      `hashF` f  `hashE` e  `hashA` a+    Scanr1 f a                  -> $(hashQ "Scanr1")      `hashF` f  `hashA` a+    Backpermute sh f a          -> $(hashQ "Backpermute") `hashF` f  `hashE` sh `hashA` a+    Permute f1 a1 f2 a2         -> $(hashQ "Permute")     `hashF` f1 `hashA` a1 `hashF` f2 `hashA` a2+    Stencil f b a               -> $(hashQ "Stencil")     `hashF` f  `hashB` b  `hashA` a+    Stencil2 f b1 a1 b2 a2      -> $(hashQ "Stencil2")    `hashF` f  `hashB` b1 `hashA` a1 `hashB` b2 `hashA` a2++{--+hashPreOpenSeq :: forall acc aenv senv arrs. HashAcc acc -> PreOpenSeq acc aenv senv arrs -> Int+hashPreOpenSeq hashAcc s =+  let+    hashA :: Int -> acc aenv' a -> Int+    hashA salt = hashWithSalt salt . hashAcc++    hashE :: Int -> PreOpenExp acc env' aenv' e -> Int+    hashE salt = hashWithSalt salt . hashPreOpenExp hashAcc++    hashAF :: Int -> PreOpenAfun acc aenv' f -> Int+    hashAF salt = hashWithSalt salt . hashAfun hashAcc++    hashF :: Int -> PreOpenFun acc env' aenv' f -> Int+    hashF salt = hashWithSalt salt . hashPreOpenFun hashAcc++    hashS :: Int -> PreOpenSeq acc aenv senv' arrs' -> Int+    hashS salt = hashWithSalt salt . hashPreOpenSeq hashAcc++    hashVar :: Int -> Idx senv' a -> Int+    hashVar salt = hashWithSalt salt . idxToInt++    hashP :: Int -> Producer acc aenv senv a -> Int+    hashP salt p =+      case p of+        StreamIn arrs       -> unsafePerformIO $! hashStableName `fmap` makeStableName arrs+        ToSeq spec _ acc    -> hashWithSalt salt "ToSeq"         `hashA`  acc `hashWithSalt` show spec+        MapSeq f x          -> hashWithSalt salt "MapSeq"        `hashAF` f   `hashVar` x+        ChunkedMapSeq f x   -> hashWithSalt salt "ChunkedMapSeq" `hashAF` f   `hashVar` x+        ZipWithSeq f x y    -> hashWithSalt salt "ZipWithSeq"    `hashAF` f   `hashVar` x `hashVar` y+        ScanSeq f e x       -> hashWithSalt salt "ScanSeq"       `hashF`  f   `hashE`   e `hashVar` x++    hashC :: Int -> Consumer acc aenv senv' a -> Int+    hashC salt c =+      case c of+        FoldSeq f e x          -> hashWithSalt salt "FoldSeq"        `hashF`  f `hashE` e   `hashVar` x+        FoldSeqFlatten f acc x -> hashWithSalt salt "FoldSeqFlatten" `hashAF` f `hashA` acc `hashVar` x+        Stuple t               -> hash "Stuple" `hashWithSalt` hashAtuple (hashC salt) t++  in case s of+    Producer   p s' -> hash "Producer"   `hashP` p `hashS` s'+    Consumer   c    -> hash "Consumer"   `hashC` c+    Reify      ix   -> hash "Reify"      `hashVar` ix+--}+++hashIdx :: Idx env t -> Int+hashIdx = hash . idxToInt++hashTupleIdx :: TupleIdx tup e -> Int+hashTupleIdx = hash . tupleIdxToInt+++hashArrays :: ArraysR a -> a -> Int+hashArrays ArraysRunit         ()       = hash ()+hashArrays (ArraysRpair r1 r2) (a1, a2) = hash (hashArrays r1 a1, hashArrays r2 a2)+hashArrays ArraysRarray        ad       = unsafePerformIO $! hashStableName `fmap` makeStableName ad++hashArraysType :: forall a. ArraysR a -> Int+hashArraysType ArraysRunit         = $(hashQ "ArraysRunit")+hashArraysType (ArraysRpair r1 r2) = $(hashQ "ArraysRpair")  `hashWithSalt` hashArraysType r1 `hashWithSalt` hashArraysType r2+hashArraysType ArraysRarray        = $(hashQ "ArraysRarray") `hashWithSalt` hashArrayType (undefined::a)+  where+    hashArrayType :: forall sh e. (Shape sh, Elt e) => Array sh e -> Int+    hashArrayType _ = hashTupleType (eltType (undefined::sh)) `hashWithSalt` hashTupleType (eltType (undefined::e))++hashAtuple :: HashAcc acc -> Atuple (acc aenv) a -> Int+hashAtuple _ NilAtup            = $(hashQ "NilAtup")+hashAtuple h (SnocAtup t a)     = $(hashQ "SnocAtup") `hashWithSalt` hashAtuple h t `hashWithSalt` h a++hashAfun :: forall acc aenv f. HashAcc acc -> PreOpenAfun acc aenv f -> Int+hashAfun hashAcc afun =+  let+    hashA :: forall aenv' a. Arrays a => Int -> acc aenv' a -> Int+    hashA salt+      = hashWithSalt salt+      . hashWithSalt (hashArraysType (arrays (undefined::a)))+      . hashAcc++    hashL :: forall aenv' a b. Arrays a => Int -> PreOpenAfun acc (aenv',a) b -> Int+    hashL salt+       = hashWithSalt salt+       . hashWithSalt (hashArraysType (arrays (undefined::a)))+       . hashAfun hashAcc++  in case afun of+    Abody b -> $(hashQ "Abody") `hashA` b+    Alam  l -> $(hashQ "Alam")  `hashL` l+++hashPreBoundary :: forall acc aenv sh e. HashAcc acc -> PreBoundary acc aenv (Array sh e) -> Int+hashPreBoundary _ Wrap          = $(hashQ "Wrap")+hashPreBoundary _ Clamp         = $(hashQ "Clamp")+hashPreBoundary _ Mirror        = $(hashQ "Mirror")+hashPreBoundary _ (Constant c)  = $(hashQ "Constant") `hashWithSalt` hashConst (eltType (undefined::e)) c+hashPreBoundary h (Function f)  = $(hashQ "Function") `hashWithSalt` hashPreOpenFun h f++hashSliceIndex :: SliceIndex slix sl co sh -> Int+hashSliceIndex SliceNil         = $(hashQ "SliceNil")+hashSliceIndex (SliceAll r)     = $(hashQ "SliceAll")   `hashWithSalt` hashSliceIndex r+hashSliceIndex (SliceFixed r)   = $(hashQ "sliceFixed") `hashWithSalt` hashSliceIndex r+++-- Scalar expressions+-- ------------------++hashOpenExp :: OpenExp env aenv exp -> Int+hashOpenExp = hashPreOpenExp hashOpenAcc++hashPreOpenExp :: forall acc env aenv exp. HashAcc acc -> PreOpenExp acc env aenv exp -> Int+hashPreOpenExp hashAcc exp =+  let+    hashE :: forall env' aenv' e. Elt e => Int -> PreOpenExp acc env' aenv' e -> Int+    hashE salt+      = hashWithSalt salt+      . hashWithSalt (hashTupleType (eltType (undefined::e)))+      . hashPreOpenExp hashAcc++    hashA :: Int -> acc aenv' a -> Int+    hashA salt = hashWithSalt salt . hashAcc++    hashF :: Int -> PreOpenFun acc env' aenv' f -> Int+    hashF salt = hashWithSalt salt . hashPreOpenFun hashAcc++    nacl :: Elt exp => Int+    nacl = hashTupleType (eltType (undefined::exp))++  in case exp of+    Let bnd body                -> $(hashQ "Let")         `hashE` bnd `hashE` body+    Const c                     -> $(hashQ "Const")       `hashWithSalt` hashConst (eltType (undefined::exp)) c+    Var ix                      -> $(hashQ "Var")         `hashWithSalt` nacl `hashWithSalt` hashIdx ix+    Tuple t                     -> $(hashQ "Tuple")       `hashWithSalt` nacl `hashWithSalt` hashTuple hashAcc t+    Prj i e                     -> $(hashQ "Prj")         `hashWithSalt` nacl `hashWithSalt` hashTupleIdx i `hashE` e+    IndexAny                    -> $(hashQ "IndexAny")    `hashWithSalt` nacl+    IndexNil                    -> $(hashQ "IndexNil")+    IndexCons sl a              -> $(hashQ "IndexCons")   `hashE` sl `hashE` a+    IndexHead sl                -> $(hashQ "IndexHead")   `hashE` sl+    IndexTail sl                -> $(hashQ "IndexTail")   `hashE` sl+    IndexSlice spec ix sh       -> $(hashQ "IndexSlice")  `hashE` ix `hashE` sh `hashWithSalt` hashSliceIndex spec+    IndexFull  spec ix sl       -> $(hashQ "IndexFull")   `hashE` ix `hashE` sl `hashWithSalt` hashSliceIndex spec+    ToIndex sh i                -> $(hashQ "ToIndex")     `hashE` sh `hashE` i+    FromIndex sh i              -> $(hashQ "FromIndex")   `hashE` sh `hashE` i+    Cond c t e                  -> $(hashQ "Cond")        `hashE` c  `hashE` t  `hashE` e+    While p f x                 -> $(hashQ "While")       `hashF` p  `hashF` f  `hashE` x+    PrimApp f x                 -> $(hashQ "PrimApp")     `hashWithSalt` hashPrimFun f `hashE` fromMaybe x (commutes hashAcc f x)+    PrimConst c                 -> $(hashQ "PrimConst")   `hashWithSalt` hashPrimConst c+    Index a ix                  -> $(hashQ "Index")       `hashA` a  `hashE` ix+    LinearIndex a ix            -> $(hashQ "LinearIndex") `hashA` a  `hashE` ix+    Shape a                     -> $(hashQ "Shape")       `hashA` a+    ShapeSize sh                -> $(hashQ "ShapeSize")   `hashE` sh+    Intersect sa sb             -> $(hashQ "Intersect")   `hashE` sa `hashE` sb+    Union sa sb                 -> $(hashQ "Union")       `hashE` sa `hashE` sb+    Foreign _ f e               -> $(hashQ "Foreign")     `hashF` f  `hashE` e+++hashPreOpenFun :: forall acc env aenv f. HashAcc acc -> PreOpenFun acc env aenv f -> Int+hashPreOpenFun hashAcc fun =+  let+    hashE :: forall env' aenv' e. Elt e => Int -> PreOpenExp acc env' aenv' e -> Int+    hashE salt+      = hashWithSalt salt+      . hashWithSalt (hashTupleType (eltType (undefined::e)))+      . hashPreOpenExp hashAcc++    hashL :: forall env' aenv' a b. Elt a => Int -> PreOpenFun acc (env',a) aenv' b -> Int+    hashL salt+      = hashWithSalt salt+      . hashWithSalt (hashTupleType (eltType (undefined::a)))+      . hashPreOpenFun hashAcc++  in case fun of+    Body b -> $(hashQ "Body") `hashE` b+    Lam f  -> $(hashQ "Lam")  `hashL` f+++hashTuple :: HashAcc acc -> Tuple (PreOpenExp acc env aenv) e -> Int+hashTuple _ NilTup              = $(hashQ "NilTup")+hashTuple h (SnocTup t e)       = $(hashQ "SnocTup") `hashWithSalt` hashTuple h t `hashWithSalt` hashPreOpenExp h e+++hashConst :: TupleType t -> t -> Int+hashConst UnitTuple         ()    = hash ()+hashConst (PairTuple ta tb) (a,b) = hash (hashConst ta a, hashConst tb b)+hashConst (SingleTuple t)   c     = hashScalarConst t c++hashScalarConst :: ScalarType t -> t -> Int+hashScalarConst (NumScalarType t)    = hashNumConst t+hashScalarConst (NonNumScalarType t) = hashNonNumConst t++hashNonNumConst :: NonNumType t -> t -> Int+hashNonNumConst TypeBool{}   x          = $(hashQ "Bool")   `hashWithSalt` x+hashNonNumConst TypeChar{}   x          = $(hashQ "Char")   `hashWithSalt` x+hashNonNumConst TypeCChar{}  (CChar  x) = $(hashQ "CChar")  `hashWithSalt` x+hashNonNumConst TypeCSChar{} (CSChar x) = $(hashQ "CSChar") `hashWithSalt` x+hashNonNumConst TypeCUChar{} (CUChar x) = $(hashQ "CUChar") `hashWithSalt` x++hashNumConst :: NumType t -> t -> Int+hashNumConst (IntegralNumType t) = hashIntegralConst t+hashNumConst (FloatingNumType t) = hashFloatingConst t++hashIntegralConst :: IntegralType t -> t -> Int+hashIntegralConst TypeInt{}     x           = $(hashQ "Int")     `hashWithSalt` x+hashIntegralConst TypeInt8{}    x           = $(hashQ "Int8")    `hashWithSalt` x+hashIntegralConst TypeInt16{}   x           = $(hashQ "Int16")   `hashWithSalt` x+hashIntegralConst TypeInt32{}   x           = $(hashQ "Int32")   `hashWithSalt` x+hashIntegralConst TypeInt64{}   x           = $(hashQ "Int64")   `hashWithSalt` x+hashIntegralConst TypeWord{}    x           = $(hashQ "Word")    `hashWithSalt` x+hashIntegralConst TypeWord8{}   x           = $(hashQ "Word8")   `hashWithSalt` x+hashIntegralConst TypeWord16{}  x           = $(hashQ "Word16")  `hashWithSalt` x+hashIntegralConst TypeWord32{}  x           = $(hashQ "Word32")  `hashWithSalt` x+hashIntegralConst TypeWord64{}  x           = $(hashQ "Word64")  `hashWithSalt` x+hashIntegralConst TypeCShort{}  (CShort x)  = $(hashQ "CShort")  `hashWithSalt` x+hashIntegralConst TypeCUShort{} (CUShort x) = $(hashQ "CUShort") `hashWithSalt` x+hashIntegralConst TypeCInt{}    (CInt x)    = $(hashQ "CInt")    `hashWithSalt` x+hashIntegralConst TypeCUInt{}   (CUInt x)   = $(hashQ "CUInt")   `hashWithSalt` x+hashIntegralConst TypeCLong{}   (CLong x)   = $(hashQ "CLong")   `hashWithSalt` x+hashIntegralConst TypeCULong{}  (CULong x)  = $(hashQ "CULong")  `hashWithSalt` x+hashIntegralConst TypeCLLong{}  (CLLong x)  = $(hashQ "CLLong")  `hashWithSalt` x+hashIntegralConst TypeCULLong{} (CULLong x) = $(hashQ "CULLong") `hashWithSalt` x++hashFloatingConst :: FloatingType t -> t -> Int+hashFloatingConst TypeFloat{}   x           = $(hashQ "Float")   `hashWithSalt` x+hashFloatingConst TypeDouble{}  x           = $(hashQ "Double")  `hashWithSalt` x+hashFloatingConst TypeCFloat{}  (CFloat x)  = $(hashQ "CFloat")  `hashWithSalt` x+hashFloatingConst TypeCDouble{} (CDouble x) = $(hashQ "CDouble") `hashWithSalt` x++hashPrimConst :: PrimConst c -> Int+hashPrimConst (PrimMinBound t)  = $(hashQ "PrimMinBound") `hashWithSalt` hashBoundedType t+hashPrimConst (PrimMaxBound t)  = $(hashQ "PrimMaxBound") `hashWithSalt` hashBoundedType t+hashPrimConst (PrimPi t)        = $(hashQ "PrimPi")       `hashWithSalt` hashFloatingType t+++hashPrimFun :: PrimFun f -> Int+hashPrimFun (PrimAdd a)                = $(hashQ "PrimAdd")                `hashWithSalt` hashNumType a+hashPrimFun (PrimSub a)                = $(hashQ "PrimSub")                `hashWithSalt` hashNumType a+hashPrimFun (PrimMul a)                = $(hashQ "PrimMul")                `hashWithSalt` hashNumType a+hashPrimFun (PrimNeg a)                = $(hashQ "PrimNeg")                `hashWithSalt` hashNumType a+hashPrimFun (PrimAbs a)                = $(hashQ "PrimAbs")                `hashWithSalt` hashNumType a+hashPrimFun (PrimSig a)                = $(hashQ "PrimSig")                `hashWithSalt` hashNumType a+hashPrimFun (PrimQuot a)               = $(hashQ "PrimQuot")               `hashWithSalt` hashIntegralType a+hashPrimFun (PrimRem a)                = $(hashQ "PrimRem")                `hashWithSalt` hashIntegralType a+hashPrimFun (PrimQuotRem a)            = $(hashQ "PrimQuotRem")            `hashWithSalt` hashIntegralType a+hashPrimFun (PrimIDiv a)               = $(hashQ "PrimIDiv")               `hashWithSalt` hashIntegralType a+hashPrimFun (PrimMod a)                = $(hashQ "PrimMod")                `hashWithSalt` hashIntegralType a+hashPrimFun (PrimDivMod a)             = $(hashQ "PrimDivMod")             `hashWithSalt` hashIntegralType a+hashPrimFun (PrimBAnd a)               = $(hashQ "PrimBAnd")               `hashWithSalt` hashIntegralType a+hashPrimFun (PrimBOr a)                = $(hashQ "PrimBOr")                `hashWithSalt` hashIntegralType a+hashPrimFun (PrimBXor a)               = $(hashQ "PrimBXor")               `hashWithSalt` hashIntegralType a+hashPrimFun (PrimBNot a)               = $(hashQ "PrimBNot")               `hashWithSalt` hashIntegralType a+hashPrimFun (PrimBShiftL a)            = $(hashQ "PrimBShiftL")            `hashWithSalt` hashIntegralType a+hashPrimFun (PrimBShiftR a)            = $(hashQ "PrimBShiftR")            `hashWithSalt` hashIntegralType a+hashPrimFun (PrimBRotateL a)           = $(hashQ "PrimBRotateL")           `hashWithSalt` hashIntegralType a+hashPrimFun (PrimBRotateR a)           = $(hashQ "PrimBRotateR")           `hashWithSalt` hashIntegralType a+hashPrimFun (PrimPopCount a)           = $(hashQ "PrimPopCount")           `hashWithSalt` hashIntegralType a+hashPrimFun (PrimCountLeadingZeros a)  = $(hashQ "PrimCountLeadingZeros")  `hashWithSalt` hashIntegralType a+hashPrimFun (PrimCountTrailingZeros a) = $(hashQ "PrimCountTrailingZeros") `hashWithSalt` hashIntegralType a+hashPrimFun (PrimFDiv a)               = $(hashQ "PrimFDiv")               `hashWithSalt` hashFloatingType a+hashPrimFun (PrimRecip a)              = $(hashQ "PrimRecip")              `hashWithSalt` hashFloatingType a+hashPrimFun (PrimSin a)                = $(hashQ "PrimSin")                `hashWithSalt` hashFloatingType a+hashPrimFun (PrimCos a)                = $(hashQ "PrimCos")                `hashWithSalt` hashFloatingType a+hashPrimFun (PrimTan a)                = $(hashQ "PrimTan")                `hashWithSalt` hashFloatingType a+hashPrimFun (PrimAsin a)               = $(hashQ "PrimAsin")               `hashWithSalt` hashFloatingType a+hashPrimFun (PrimAcos a)               = $(hashQ "PrimAcos")               `hashWithSalt` hashFloatingType a+hashPrimFun (PrimAtan a)               = $(hashQ "PrimAtan")               `hashWithSalt` hashFloatingType a+hashPrimFun (PrimSinh a)               = $(hashQ "PrimSinh")               `hashWithSalt` hashFloatingType a+hashPrimFun (PrimCosh a)               = $(hashQ "PrimCosh")               `hashWithSalt` hashFloatingType a+hashPrimFun (PrimTanh a)               = $(hashQ "PrimTanh")               `hashWithSalt` hashFloatingType a+hashPrimFun (PrimAsinh a)              = $(hashQ "PrimAsinh")              `hashWithSalt` hashFloatingType a+hashPrimFun (PrimAcosh a)              = $(hashQ "PrimAcosh")              `hashWithSalt` hashFloatingType a+hashPrimFun (PrimAtanh a)              = $(hashQ "PrimAtanh")              `hashWithSalt` hashFloatingType a+hashPrimFun (PrimExpFloating a)        = $(hashQ "PrimExpFloating")        `hashWithSalt` hashFloatingType a+hashPrimFun (PrimSqrt a)               = $(hashQ "PrimSqrt")               `hashWithSalt` hashFloatingType a+hashPrimFun (PrimLog a)                = $(hashQ "PrimLog")                `hashWithSalt` hashFloatingType a+hashPrimFun (PrimFPow a)               = $(hashQ "PrimFPow")               `hashWithSalt` hashFloatingType a+hashPrimFun (PrimLogBase a)            = $(hashQ "PrimLogBase")            `hashWithSalt` hashFloatingType a+hashPrimFun (PrimAtan2 a)              = $(hashQ "PrimAtan2")              `hashWithSalt` hashFloatingType a+hashPrimFun (PrimTruncate a b)         = $(hashQ "PrimTruncate")           `hashWithSalt` hashFloatingType a `hashWithSalt` hashIntegralType b+hashPrimFun (PrimRound a b)            = $(hashQ "PrimRound")              `hashWithSalt` hashFloatingType a `hashWithSalt` hashIntegralType b+hashPrimFun (PrimFloor a b)            = $(hashQ "PrimFloor")              `hashWithSalt` hashFloatingType a `hashWithSalt` hashIntegralType b+hashPrimFun (PrimCeiling a b)          = $(hashQ "PrimCeiling")            `hashWithSalt` hashFloatingType a `hashWithSalt` hashIntegralType b+hashPrimFun (PrimIsNaN a)              = $(hashQ "PrimIsNaN")              `hashWithSalt` hashFloatingType a+hashPrimFun (PrimIsInfinite a)         = $(hashQ "PrimIsInfinite")         `hashWithSalt` hashFloatingType a+hashPrimFun (PrimLt a)                 = $(hashQ "PrimLt")                 `hashWithSalt` hashScalarType a+hashPrimFun (PrimGt a)                 = $(hashQ "PrimGt")                 `hashWithSalt` hashScalarType a+hashPrimFun (PrimLtEq a)               = $(hashQ "PrimLtEq")               `hashWithSalt` hashScalarType a+hashPrimFun (PrimGtEq a)               = $(hashQ "PrimGtEq")               `hashWithSalt` hashScalarType a+hashPrimFun (PrimEq a)                 = $(hashQ "PrimEq")                 `hashWithSalt` hashScalarType a+hashPrimFun (PrimNEq a)                = $(hashQ "PrimNEq")                `hashWithSalt` hashScalarType a+hashPrimFun (PrimMax a)                = $(hashQ "PrimMax")                `hashWithSalt` hashScalarType a+hashPrimFun (PrimMin a)                = $(hashQ "PrimMin")                `hashWithSalt` hashScalarType a+hashPrimFun (PrimFromIntegral a b)     = $(hashQ "PrimFromIntegral")       `hashWithSalt` hashIntegralType a `hashWithSalt` hashNumType b+hashPrimFun (PrimToFloating a b)       = $(hashQ "PrimToFloating")         `hashWithSalt` hashNumType a      `hashWithSalt` hashFloatingType b+hashPrimFun (PrimCoerce a b)           = $(hashQ "PrimCoerce")             `hashWithSalt` hashScalarType a   `hashWithSalt` hashScalarType b+hashPrimFun PrimLAnd                   = $(hashQ "PrimLAnd")+hashPrimFun PrimLOr                    = $(hashQ "PrimLOr")+hashPrimFun PrimLNot                   = $(hashQ "PrimLNot")+hashPrimFun PrimOrd                    = $(hashQ "PrimOrd")+hashPrimFun PrimChr                    = $(hashQ "PrimChr")+hashPrimFun PrimBoolToInt              = $(hashQ "PrimBoolToInt")+++-- TLM: We need to include the depth of the branches in the pair case, otherwise+--      we are getting a collision at @hash t == hash (t,(t,t))@.+--+hashTupleType :: TupleType t -> Int+hashTupleType UnitTuple       = $(hashQ "UnitTuple")+hashTupleType (SingleTuple t) = $(hashQ "SingleTuple") `hashWithSalt` hashScalarType t+hashTupleType (PairTuple a b) = $(hashQ "PairTuple")   `hashWithSalt` hashTupleType a `hashWithSalt` depthTupleType a+                                                       `hashWithSalt` hashTupleType b `hashWithSalt` depthTupleType b++depthTupleType :: TupleType t -> Int+depthTupleType UnitTuple       = 0+depthTupleType SingleTuple{}   = 1+depthTupleType (PairTuple a b) = depthTupleType a + depthTupleType b++hashScalarType :: ScalarType t -> Int+hashScalarType (NumScalarType t)    = $(hashQ "NumScalarType")    `hashWithSalt` hashNumType t+hashScalarType (NonNumScalarType t) = $(hashQ "NonNumScalarType") `hashWithSalt` hashNonNumType t++hashBoundedType :: BoundedType t -> Int+hashBoundedType (IntegralBoundedType t) = $(hashQ "IntegralBoundedType") `hashWithSalt` hashIntegralType t+hashBoundedType (NonNumBoundedType t)   = $(hashQ "NonNumBoundedType")   `hashWithSalt` hashNonNumType t++hashNonNumType :: NonNumType t -> Int+hashNonNumType TypeBool{}   = $(hashQ "Bool")+hashNonNumType TypeChar{}   = $(hashQ "Char")+hashNonNumType TypeCChar{}  = $(hashQ "CChar")+hashNonNumType TypeCSChar{} = $(hashQ "CSChar")+hashNonNumType TypeCUChar{} = $(hashQ "CUChar")++hashNumType :: NumType t -> Int+hashNumType (IntegralNumType t) = $(hashQ "IntegralNumType") `hashWithSalt` hashIntegralType t+hashNumType (FloatingNumType t) = $(hashQ "FloatingNumType") `hashWithSalt` hashFloatingType t++hashIntegralType :: IntegralType t -> Int+hashIntegralType TypeInt{}     = $(hashQ "Int")+hashIntegralType TypeInt8{}    = $(hashQ "Int8")+hashIntegralType TypeInt16{}   = $(hashQ "Int16")+hashIntegralType TypeInt32{}   = $(hashQ "Int32")+hashIntegralType TypeInt64{}   = $(hashQ "Int64")+hashIntegralType TypeWord{}    = $(hashQ "Word")+hashIntegralType TypeWord8{}   = $(hashQ "Word8")+hashIntegralType TypeWord16{}  = $(hashQ "Word16")+hashIntegralType TypeWord32{}  = $(hashQ "Word32")+hashIntegralType TypeWord64{}  = $(hashQ "Word64")+hashIntegralType TypeCShort{}  = $(hashQ "CShort")+hashIntegralType TypeCUShort{} = $(hashQ "CUShort")+hashIntegralType TypeCInt{}    = $(hashQ "CInt")+hashIntegralType TypeCUInt{}   = $(hashQ "CUInt")+hashIntegralType TypeCLong{}   = $(hashQ "CLong")+hashIntegralType TypeCULong{}  = $(hashQ "CULong")+hashIntegralType TypeCLLong{}  = $(hashQ "CLLong")+hashIntegralType TypeCULLong{} = $(hashQ "CULLong")++hashFloatingType :: FloatingType t -> Int+hashFloatingType TypeFloat{}   = $(hashQ "Float")+hashFloatingType TypeDouble{}  = $(hashQ "Double")+hashFloatingType TypeCFloat{}  = $(hashQ "CFloat")+hashFloatingType TypeCDouble{} = $(hashQ "CDouble")+++-- Auxiliary+-- ---------++-- Discriminate binary functions that commute, and if so return the operands in+-- a stable ordering such that matching recognises expressions modulo+-- commutativity.+--+commutes+    :: forall acc env aenv a r.+       HashAcc acc+    -> PrimFun (a -> r)+    -> PreOpenExp acc env aenv a+    -> Maybe (PreOpenExp acc env aenv a)+commutes h f x = case f of+  PrimAdd{}     -> Just (swizzle x)+  PrimMul{}     -> Just (swizzle x)+  PrimBAnd{}    -> Just (swizzle x)+  PrimBOr{}     -> Just (swizzle x)+  PrimBXor{}    -> Just (swizzle x)+  PrimEq{}      -> Just (swizzle x)+  PrimNEq{}     -> Just (swizzle x)+  PrimMax{}     -> Just (swizzle x)+  PrimMin{}     -> Just (swizzle x)+  PrimLAnd      -> Just (swizzle x)+  PrimLOr       -> Just (swizzle x)+  _             -> Nothing+  where+    swizzle :: PreOpenExp acc env aenv (a',a') -> PreOpenExp acc env aenv (a',a')+    swizzle exp+      | Tuple (NilTup `SnocTup` a `SnocTup` b)  <- exp+      , hashPreOpenExp h a > hashPreOpenExp h b = Tuple (NilTup `SnocTup` b `SnocTup` a)+      --+      | otherwise                               = exp+
+ Data/Array/Accelerate/Analysis/Hash/TH.hs view
@@ -0,0 +1,30 @@+-- |+-- Module      : Data.Array.Accelerate.Analysis.Hash.TH+-- Copyright   : [2017] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- License     : BSD3+--+-- Maintainer  : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability   : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.Analysis.Hash.TH (++  hashQ,+  hashWithSaltQ,++) where++import Data.Hashable+import Language.Haskell.TH+++hashQ :: Hashable a => a -> ExpQ+hashQ = intE . hash++hashWithSaltQ :: Hashable a => Int -> a -> ExpQ+hashWithSaltQ s x = intE (hashWithSalt s x)++intE :: Int -> ExpQ+intE = litE . integerL . fromIntegral+
Data/Array/Accelerate/Analysis/Match.hs view
@@ -2,7 +2,6 @@ {-# LANGUAGE PatternGuards       #-} {-# LANGUAGE RankNTypes          #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving  #-} {-# LANGUAGE TypeOperators       #-} {-# OPTIONS_HADDOCK hide #-} -- |@@ -30,28 +29,22 @@   matchIdx, matchTupleType,   matchIntegralType, matchFloatingType, matchNumType, matchScalarType, -  -- hashing expressions-  HashAcc,-  hashPreOpenAcc, hashOpenAcc,-  hashPreOpenExp, hashOpenExp,-  hashPreOpenFun,- ) where  -- standard library-import Prelude                                          hiding ( exp ) import Data.Maybe import Data.Typeable-import Data.Hashable-import System.Mem.StableName import System.IO.Unsafe                                 ( unsafePerformIO )+import System.Mem.StableName+import Prelude                                          hiding ( exp )  -- friends import Data.Array.Accelerate.AST-import Data.Array.Accelerate.Type-import Data.Array.Accelerate.Array.Sugar+import Data.Array.Accelerate.Analysis.Hash import Data.Array.Accelerate.Array.Representation       ( SliceIndex(..) )+import Data.Array.Accelerate.Array.Sugar import Data.Array.Accelerate.Product+import Data.Array.Accelerate.Type   -- The type of matching array computations@@ -246,20 +239,18 @@       , Just Refl <- matchAcc a1  a2       = Just Refl -    match (Stencil f1 b1 (a1 :: acc aenv (Array sh1 e1)))-          (Stencil f2 b2 (a2 :: acc aenv (Array sh2 e2)))+    match (Stencil f1 b1 a1) (Stencil f2 b2 a2)       | Just Refl <- matchFun f1 f2       , Just Refl <- matchAcc a1 a2-      , matchBoundary (eltType (undefined::e1)) b1 b2+      , matchBoundary matchAcc hashAcc b1 b2       = Just Refl -    match (Stencil2 f1 b1  (a1  :: acc aenv (Array sh1  e1 )) b2  (a2 :: acc aenv (Array sh2  e2 )))-          (Stencil2 f2 b1' (a1' :: acc aenv (Array sh1' e1')) b2' (a2':: acc aenv (Array sh2' e2')))+    match (Stencil2 f1 b1  a1  b2  a2) (Stencil2 f2 b1' a1' b2' a2')       | Just Refl <- matchFun f1 f2       , Just Refl <- matchAcc a1 a1'       , Just Refl <- matchAcc a2 a2'-      , matchBoundary (eltType (undefined::e1)) b1 b1'-      , matchBoundary (eltType (undefined::e2)) b2 b2'+      , matchBoundary matchAcc hashAcc b1 b1'+      , matchBoundary matchAcc hashAcc b2 b2'       = Just Refl      -- match (Collect s1) (Collect s2)@@ -313,12 +304,22 @@  -- Match stencil boundaries ---matchBoundary :: TupleType e -> Boundary e -> Boundary e -> Bool-matchBoundary ty (Constant s) (Constant t) = matchConst ty s t-matchBoundary _  Wrap         Wrap         = True-matchBoundary _  Clamp        Clamp        = True-matchBoundary _  Mirror       Mirror       = True-matchBoundary _  _            _            = False+matchBoundary+    :: forall acc aenv sh t. Elt t+    => MatchAcc acc+    -> HashAcc acc+    -> PreBoundary acc aenv (Array sh t)+    -> PreBoundary acc aenv (Array sh t)+    -> Bool+matchBoundary _ _ Clamp        Clamp        = True+matchBoundary _ _ Mirror       Mirror       = True+matchBoundary _ _ Wrap         Wrap         = True+matchBoundary _ _ (Constant s) (Constant t) = matchConst (eltType (undefined::t)) s t+matchBoundary m h (Function f) (Function g)+  | Just Refl <- matchPreOpenFun m h f g+  = True+matchBoundary _ _ _ _+  = False   {--@@ -752,6 +753,7 @@ matchPrimFun (PrimFloor _ s)            (PrimFloor _ t)            = matchIntegralType s t matchPrimFun (PrimCeiling _ s)          (PrimCeiling _ t)          = matchIntegralType s t matchPrimFun (PrimIsNaN _)              (PrimIsNaN _)              = Just Refl+matchPrimFun (PrimIsInfinite _)         (PrimIsInfinite _)         = Just Refl matchPrimFun (PrimLt _)                 (PrimLt _)                 = Just Refl matchPrimFun (PrimGt _)                 (PrimGt _)                 = Just Refl matchPrimFun (PrimLtEq _)               (PrimLtEq _)               = Just Refl@@ -823,6 +825,7 @@ matchPrimFun' (PrimFloor s _)            (PrimFloor t _)            = matchFloatingType s t matchPrimFun' (PrimCeiling s _)          (PrimCeiling t _)          = matchFloatingType s t matchPrimFun' (PrimIsNaN s)              (PrimIsNaN t)              = matchFloatingType s t+matchPrimFun' (PrimIsInfinite s)         (PrimIsInfinite t)         = matchFloatingType s t matchPrimFun' (PrimMax _)                (PrimMax _)                = Just Refl matchPrimFun' (PrimMin _)                (PrimMin _)                = Just Refl matchPrimFun' (PrimFromIntegral s _)     (PrimFromIntegral t _)     = matchIntegralType s t@@ -928,296 +931,4 @@ matchNonNumType (TypeCSChar _) (TypeCSChar _) = Just Refl matchNonNumType (TypeCUChar _) (TypeCUChar _) = Just Refl matchNonNumType _              _              = Nothing----- Discriminate binary functions that commute, and if so return the operands in--- a stable ordering such that matching recognises expressions modulo--- commutativity.----commutes-    :: forall acc env aenv a r.-       HashAcc acc-    -> PrimFun (a -> r)-    -> PreOpenExp acc env aenv a-    -> Maybe (PreOpenExp acc env aenv a)-commutes h f x = case f of-  PrimAdd _     -> Just (swizzle x)-  PrimMul _     -> Just (swizzle x)-  PrimBAnd _    -> Just (swizzle x)-  PrimBOr _     -> Just (swizzle x)-  PrimBXor _    -> Just (swizzle x)-  PrimEq _      -> Just (swizzle x)-  PrimNEq _     -> Just (swizzle x)-  PrimMax _     -> Just (swizzle x)-  PrimMin _     -> Just (swizzle x)-  PrimLAnd      -> Just (swizzle x)-  PrimLOr       -> Just (swizzle x)-  _             -> Nothing-  where-    swizzle :: PreOpenExp acc env aenv (a',a') -> PreOpenExp acc env aenv (a',a')-    swizzle exp-      | Tuple (NilTup `SnocTup` a `SnocTup` b)  <- exp-      , hashPreOpenExp h a > hashPreOpenExp h b = Tuple (NilTup `SnocTup` b `SnocTup` a)-      ---      | otherwise                               = exp----- Hashing--- =======--hashIdx :: Idx env t -> Int-hashIdx = hash . idxToInt--hashTupleIdx :: TupleIdx tup e -> Int-hashTupleIdx = hash . tupleIdxToInt----- Array computations--- --------------------type HashAcc acc = forall aenv a. acc aenv a -> Int---hashOpenAcc :: OpenAcc aenv arrs -> Int-hashOpenAcc (OpenAcc pacc) = hashPreOpenAcc hashOpenAcc pacc--{---hashPreOpenSeq :: forall acc aenv senv arrs. HashAcc acc -> PreOpenSeq acc aenv senv arrs -> Int-hashPreOpenSeq hashAcc s =-  let-    hashA :: Int -> acc aenv' a -> Int-    hashA salt = hashWithSalt salt . hashAcc--    hashE :: Int -> PreOpenExp acc env' aenv' e -> Int-    hashE salt = hashWithSalt salt . hashPreOpenExp hashAcc--    hashAF :: Int -> PreOpenAfun acc aenv' f -> Int-    hashAF salt = hashWithSalt salt . hashAfun hashAcc--    hashF :: Int -> PreOpenFun acc env' aenv' f -> Int-    hashF salt = hashWithSalt salt . hashPreOpenFun hashAcc--    hashS :: Int -> PreOpenSeq acc aenv senv' arrs' -> Int-    hashS salt = hashWithSalt salt . hashPreOpenSeq hashAcc--    hashVar :: Int -> Idx senv' a -> Int-    hashVar salt = hashWithSalt salt . idxToInt--    hashP :: Int -> Producer acc aenv senv a -> Int-    hashP salt p =-      case p of-        StreamIn arrs       -> unsafePerformIO $! hashStableName `fmap` makeStableName arrs-        ToSeq spec _ acc    -> hashWithSalt salt "ToSeq"         `hashA`  acc `hashWithSalt` show spec-        MapSeq f x          -> hashWithSalt salt "MapSeq"        `hashAF` f   `hashVar` x-        ChunkedMapSeq f x   -> hashWithSalt salt "ChunkedMapSeq" `hashAF` f   `hashVar` x-        ZipWithSeq f x y    -> hashWithSalt salt "ZipWithSeq"    `hashAF` f   `hashVar` x `hashVar` y-        ScanSeq f e x       -> hashWithSalt salt "ScanSeq"       `hashF`  f   `hashE`   e `hashVar` x--    hashC :: Int -> Consumer acc aenv senv' a -> Int-    hashC salt c =-      case c of-        FoldSeq f e x          -> hashWithSalt salt "FoldSeq"        `hashF`  f `hashE` e   `hashVar` x-        FoldSeqFlatten f acc x -> hashWithSalt salt "FoldSeqFlatten" `hashAF` f `hashA` acc `hashVar` x-        Stuple t               -> hash "Stuple" `hashWithSalt` hashAtuple (hashC salt) t--  in case s of-    Producer   p s' -> hash "Producer"   `hashP` p `hashS` s'-    Consumer   c    -> hash "Consumer"   `hashC` c-    Reify      ix   -> hash "Reify"      `hashVar` ix---}---hashPreOpenAcc :: forall acc aenv arrs. HashAcc acc -> PreOpenAcc acc aenv arrs -> Int-hashPreOpenAcc hashAcc pacc =-  let-    hashA :: Int -> acc aenv' a -> Int-    hashA salt = hashWithSalt salt . hashAcc--    hashE :: Int -> PreOpenExp acc env' aenv' e -> Int-    hashE salt = hashWithSalt salt . hashPreOpenExp hashAcc--    hashF :: Int -> PreOpenFun acc env' aenv' f -> Int-    hashF salt = hashWithSalt salt . hashPreOpenFun hashAcc--    -- hashS :: Int -> PreOpenSeq acc aenv senv arrs -> Int-    -- hashS salt = hashWithSalt salt . hashPreOpenSeq hashAcc--  in case pacc of-    Alet bnd body               -> hash "Alet"          `hashA` bnd `hashA` body-    Avar v                      -> hash "Avar"          `hashWithSalt` hashIdx v-    Atuple t                    -> hash "Atuple"        `hashWithSalt` hashAtuple hashAcc t-    Aprj ix a                   -> hash "Aprj"          `hashWithSalt` hashTupleIdx ix    `hashA` a-    Apply f a                   -> hash "Apply"         `hashWithSalt` hashAfun hashAcc f `hashA` a-    Aforeign _ f a              -> hash "Aforeign"      `hashWithSalt` hashAfun hashAcc f `hashA` a-    Use a                       -> hash "Use"           `hashWithSalt` hashArrays (arrays (undefined::arrs)) a-    Awhile p f a                -> hash "Awhile"        `hashWithSalt` hashAfun hashAcc f `hashWithSalt` hashAfun hashAcc p `hashA` a-    Unit e                      -> hash "Unit"          `hashE` e-    Generate e f                -> hash "Generate"      `hashE` e  `hashF` f-    Acond e a1 a2               -> hash "Acond"         `hashE` e  `hashA` a1 `hashA` a2-    Reshape sh a                -> hash "Reshape"       `hashE` sh `hashA` a-    Transform sh f1 f2 a        -> hash "Transform"     `hashE` sh `hashF` f1 `hashF` f2 `hashA` a-    Replicate spec ix a         -> hash "Replicate"     `hashE` ix `hashA` a  `hashWithSalt` show spec-    Slice spec a ix             -> hash "Slice"         `hashE` ix `hashA` a  `hashWithSalt` show spec-    Map f a                     -> hash "Map"           `hashF` f  `hashA` a-    ZipWith f a1 a2             -> hash "ZipWith"       `hashF` f  `hashA` a1 `hashA` a2-    Fold f e a                  -> hash "Fold"          `hashF` f  `hashE` e  `hashA` a-    Fold1 f a                   -> hash "Fold1"         `hashF` f  `hashA` a-    FoldSeg f e a s             -> hash "FoldSeg"       `hashF` f  `hashE` e  `hashA` a  `hashA` s-    Fold1Seg f a s              -> hash "Fold1Seg"      `hashF` f  `hashA` a  `hashA` s-    Scanl f e a                 -> hash "Scanl"         `hashF` f  `hashE` e  `hashA` a-    Scanl' f e a                -> hash "Scanl'"        `hashF` f  `hashE` e  `hashA` a-    Scanl1 f a                  -> hash "Scanl1"        `hashF` f  `hashA` a-    Scanr f e a                 -> hash "Scanr"         `hashF` f  `hashE` e  `hashA` a-    Scanr' f e a                -> hash "Scanr'"        `hashF` f  `hashE` e  `hashA` a-    Scanr1 f a                  -> hash "Scanr1"        `hashF` f  `hashA` a-    Backpermute sh f a          -> hash "Backpermute"   `hashF` f  `hashE` sh `hashA` a-    Permute f1 a1 f2 a2         -> hash "Permute"       `hashF` f1 `hashA` a1 `hashF` f2 `hashA` a2-    Stencil f b a               -> hash "Stencil"       `hashF` f  `hashA` a             `hashWithSalt` hashBoundary a  b-    Stencil2 f b1 a1 b2 a2      -> hash "Stencil2"      `hashF` f  `hashA` a1 `hashA` a2 `hashWithSalt` hashBoundary a1 b1 `hashWithSalt` hashBoundary a2 b2-    -- Collect s                   -> hash "Seq"           `hashS` s---hashArrays :: ArraysR a -> a -> Int-hashArrays ArraysRunit         ()       = hash ()-hashArrays (ArraysRpair r1 r2) (a1, a2) = hash ( hashArrays r1 a1, hashArrays r2 a2)-hashArrays ArraysRarray        ad       = unsafePerformIO $! hashStableName `fmap` makeStableName ad--hashAtuple :: HashAcc acc -> Atuple (acc aenv) a -> Int-hashAtuple _ NilAtup            = hash "NilAtup"-hashAtuple h (SnocAtup t a)     = hash "SnocAtup"       `hashWithSalt` hashAtuple h t `hashWithSalt` h a--hashAfun :: HashAcc acc -> PreOpenAfun acc aenv f -> Int-hashAfun h (Abody b)            = hash "Abody"          `hashWithSalt` h b-hashAfun h (Alam f)             = hash "Alam"           `hashWithSalt` hashAfun h f--hashBoundary :: forall acc aenv sh e. Elt e => acc aenv (Array sh e) -> Boundary (EltRepr e) -> Int-hashBoundary _ Wrap             = hash "Wrap"-hashBoundary _ Clamp            = hash "Clamp"-hashBoundary _ Mirror           = hash "Mirror"-hashBoundary _ (Constant c)     = hash "Constant"       `hashWithSalt` show (toElt c :: e)----- Scalar expressions--- --------------------hashOpenExp :: OpenExp env aenv exp -> Int-hashOpenExp = hashPreOpenExp hashOpenAcc--hashPreOpenExp :: forall acc env aenv exp. HashAcc acc -> PreOpenExp acc env aenv exp -> Int-hashPreOpenExp hashAcc exp =-  let-    hashA :: Int -> acc aenv' a -> Int-    hashA salt = hashWithSalt salt . hashAcc--    hashE :: Int -> PreOpenExp acc env' aenv' e -> Int-    hashE salt = hashWithSalt salt . hashPreOpenExp hashAcc--  in case exp of-    Let bnd body                -> hash "Let"           `hashE` bnd `hashE` body-    Var ix                      -> hash "Var"           `hashWithSalt` hashIdx ix-    Const c                     -> hash "Const"         `hashWithSalt` show (toElt c :: exp)-    Tuple t                     -> hash "Tuple"         `hashWithSalt` hashTuple hashAcc t-    Prj i e                     -> hash "Prj"           `hashWithSalt` hashTupleIdx i `hashE` e-    IndexAny                    -> hash "IndexAny"-    IndexNil                    -> hash "IndexNil"-    IndexCons sl a              -> hash "IndexCons"     `hashE` sl `hashE` a-    IndexHead sl                -> hash "IndexHead"     `hashE` sl-    IndexTail sl                -> hash "IndexTail"     `hashE` sl-    IndexSlice spec ix sh       -> hash "IndexSlice"    `hashE` ix `hashE` sh `hashWithSalt` show spec-    IndexFull  spec ix sl       -> hash "IndexFull"     `hashE` ix `hashE` sl `hashWithSalt` show spec-    ToIndex sh i                -> hash "ToIndex"       `hashE` sh `hashE` i-    FromIndex sh i              -> hash "FromIndex"     `hashE` sh `hashE` i-    Cond c t e                  -> hash "Cond"          `hashE` c  `hashE` t  `hashE` e-    While p f x                 -> hash "While"         `hashWithSalt` hashPreOpenFun hashAcc p  `hashWithSalt` hashPreOpenFun hashAcc f  `hashE` x-    PrimApp f x                 -> hash "PrimApp"       `hashWithSalt` hashPrimFun f `hashE` fromMaybe x (commutes hashAcc f x)-    PrimConst c                 -> hash "PrimConst"     `hashWithSalt` hashPrimConst c-    Index a ix                  -> hash "Index"         `hashA` a  `hashE` ix-    LinearIndex a ix            -> hash "LinearIndex"   `hashA` a  `hashE` ix-    Shape a                     -> hash "Shape"         `hashA` a-    ShapeSize sh                -> hash "ShapeSize"     `hashE` sh-    Intersect sa sb             -> hash "Intersect"     `hashE` sa `hashE` sb-    Union sa sb                 -> hash "Union"         `hashE` sa `hashE` sb-    Foreign _ f e               -> hash "Foreign"       `hashWithSalt` hashPreOpenFun hashAcc f `hashE` e---hashPreOpenFun :: HashAcc acc -> PreOpenFun acc env aenv f -> Int-hashPreOpenFun h (Body e)       = hash "Body"           `hashWithSalt` hashPreOpenExp h e-hashPreOpenFun h (Lam f)        = hash "Lam"            `hashWithSalt` hashPreOpenFun h f--hashTuple :: HashAcc acc -> Tuple (PreOpenExp acc env aenv) e -> Int-hashTuple _ NilTup              = hash "NilTup"-hashTuple h (SnocTup t e)       = hash "SnocTup"        `hashWithSalt` hashTuple h t `hashWithSalt` hashPreOpenExp h e---hashPrimConst :: PrimConst c -> Int-hashPrimConst PrimMinBound{}    = hash "PrimMinBound"-hashPrimConst PrimMaxBound{}    = hash "PrimMaxBound"-hashPrimConst PrimPi{}          = hash "PrimPi"--hashPrimFun :: PrimFun f -> Int-hashPrimFun PrimAdd{}                = hash "PrimAdd"-hashPrimFun PrimSub{}                = hash "PrimSub"-hashPrimFun PrimMul{}                = hash "PrimMul"-hashPrimFun PrimNeg{}                = hash "PrimNeg"-hashPrimFun PrimAbs{}                = hash "PrimAbs"-hashPrimFun PrimSig{}                = hash "PrimSig"-hashPrimFun PrimQuot{}               = hash "PrimQuot"-hashPrimFun PrimRem{}                = hash "PrimRem"-hashPrimFun PrimQuotRem{}            = hash "PrimQuotRem"-hashPrimFun PrimIDiv{}               = hash "PrimIDiv"-hashPrimFun PrimMod{}                = hash "PrimMod"-hashPrimFun PrimDivMod{}             = hash "PrimDivMod"-hashPrimFun PrimBAnd{}               = hash "PrimBAnd"-hashPrimFun PrimBOr{}                = hash "PrimBOr"-hashPrimFun PrimBXor{}               = hash "PrimBXor"-hashPrimFun PrimBNot{}               = hash "PrimBNot"-hashPrimFun PrimBShiftL{}            = hash "PrimBShiftL"-hashPrimFun PrimBShiftR{}            = hash "PrimBShiftR"-hashPrimFun PrimBRotateL{}           = hash "PrimBRotateL"-hashPrimFun PrimBRotateR{}           = hash "PrimBRotateR"-hashPrimFun PrimPopCount{}           = hash "PrimPopCount"-hashPrimFun PrimCountLeadingZeros{}  = hash "PrimCountLeadingZeros"-hashPrimFun PrimCountTrailingZeros{} = hash "PrimCountTrailingZeros"-hashPrimFun PrimFDiv{}               = hash "PrimFDiv"-hashPrimFun PrimRecip{}              = hash "PrimRecip"-hashPrimFun PrimSin{}                = hash "PrimSin"-hashPrimFun PrimCos{}                = hash "PrimCos"-hashPrimFun PrimTan{}                = hash "PrimTan"-hashPrimFun PrimAsin{}               = hash "PrimAsin"-hashPrimFun PrimAcos{}               = hash "PrimAcos"-hashPrimFun PrimAtan{}               = hash "PrimAtan"-hashPrimFun PrimSinh{}               = hash "PrimSinh"-hashPrimFun PrimCosh{}               = hash "PrimCosh"-hashPrimFun PrimTanh{}               = hash "PrimTanh"-hashPrimFun PrimAsinh{}              = hash "PrimAsinh"-hashPrimFun PrimAcosh{}              = hash "PrimAcosh"-hashPrimFun PrimAtanh{}              = hash "PrimAtanh"-hashPrimFun PrimExpFloating{}        = hash "PrimExpFloating"-hashPrimFun PrimSqrt{}               = hash "PrimSqrt"-hashPrimFun PrimLog{}                = hash "PrimLog"-hashPrimFun PrimFPow{}               = hash "PrimFPow"-hashPrimFun PrimLogBase{}            = hash "PrimLogBase"-hashPrimFun PrimAtan2{}              = hash "PrimAtan2"-hashPrimFun PrimTruncate{}           = hash "PrimTruncate"-hashPrimFun PrimRound{}              = hash "PrimRound"-hashPrimFun PrimFloor{}              = hash "PrimFloor"-hashPrimFun PrimCeiling{}            = hash "PrimCeiling"-hashPrimFun PrimIsNaN{}              = hash "PrimIsNaN"-hashPrimFun PrimLt{}                 = hash "PrimLt"-hashPrimFun PrimGt{}                 = hash "PrimGt"-hashPrimFun PrimLtEq{}               = hash "PrimLtEq"-hashPrimFun PrimGtEq{}               = hash "PrimGtEq"-hashPrimFun PrimEq{}                 = hash "PrimEq"-hashPrimFun PrimNEq{}                = hash "PrimNEq"-hashPrimFun PrimMax{}                = hash "PrimMax"-hashPrimFun PrimMin{}                = hash "PrimMin"-hashPrimFun PrimFromIntegral{}       = hash "PrimFromIntegral"-hashPrimFun PrimToFloating{}         = hash "PrimToFloating"-hashPrimFun PrimCoerce{}             = hash "PrimCoerce"-hashPrimFun PrimLAnd                 = hash "PrimLAnd"-hashPrimFun PrimLOr                  = hash "PrimLOr"-hashPrimFun PrimLNot                 = hash "PrimLNot"-hashPrimFun PrimOrd                  = hash "PrimOrd"-hashPrimFun PrimChr                  = hash "PrimChr"-hashPrimFun PrimBoolToInt            = hash "PrimBoolToInt"
Data/Array/Accelerate/Array/Data.hs view
@@ -46,6 +46,7 @@ import Data.Array.Accelerate.Type  import Data.Array.Accelerate.Debug.Flags+import Data.Array.Accelerate.Debug.Monitoring import Data.Array.Accelerate.Debug.Trace  -- standard libraries@@ -774,6 +775,7 @@       new <- readIORef __mallocForeignPtrBytes       ptr <- new bytes       traceIO dump_gc $ printf "gc: allocated new host array (size=%d, ptr=%s)" bytes (show ptr)+      didAllocateBytesLocal (fromIntegral bytes)       return (castForeignPtr ptr)  -- | Register the given function as the callback to use to allocate new array@@ -800,6 +802,7 @@ -- to add a finaliser to the plain ForeignPtr. For our purposes this is fine, -- since in Accelerate finalisers are handled using Lifetime --+{-# INLINE mallocPlainForeignPtrBytesAligned #-} mallocPlainForeignPtrBytesAligned :: Int -> IO (ForeignPtr a) mallocPlainForeignPtrBytesAligned (I# size) = IO $ \s ->   case newAlignedPinnedByteArray# size 16# s of
Data/Array/Accelerate/Array/Remote/LRU.hs view
@@ -34,25 +34,26 @@  ) where -import Data.Functor-import Data.Maybe                                               ( isNothing )-import Data.Proxy+import Control.Concurrent.MVar                                  ( MVar, newMVar, takeMVar, putMVar, mkWeakMVar ) import Control.Monad                                            ( filterM ) import Control.Monad.Catch import Control.Monad.IO.Class                                   ( MonadIO, liftIO )-import Control.Concurrent.MVar                                  ( MVar, newMVar, takeMVar, putMVar, mkWeakMVar )+import Data.Functor+import Data.Int                                                 ( Int64 )+import Data.Maybe                                               ( isNothing )+import Data.Proxy+import Foreign.Storable                                         ( sizeOf ) import System.CPUTime import System.Mem.Weak                                          ( Weak, deRefWeak, finalize ) import Prelude                                                  hiding ( lookup )- import qualified Data.HashTable.IO                              as HT -import qualified Data.Array.Accelerate.Debug                    as D-import Data.Array.Accelerate.Error                              ( internalError ) import Data.Array.Accelerate.Array.Data                         ( ArrayData, touchArrayData ) import Data.Array.Accelerate.Array.Remote.Class import Data.Array.Accelerate.Array.Remote.Table                 ( StableArray, makeWeakArrayData )+import Data.Array.Accelerate.Error                              ( internalError ) import qualified Data.Array.Accelerate.Array.Remote.Table       as Basic+import qualified Data.Array.Accelerate.Debug                    as D   -- We build cached memory tables on top of a basic memory table.@@ -185,13 +186,13 @@ -- This has similar behaviour to malloc in Data.Array.Accelerate.Array.Memory.Table -- but also will copy remote arrays back to main memory in order to make space. ----- The third argument indicates that the array should be considered frozen.--- That is to say the array arrays contents will never change. In the event that--- the array has to be evicted from the remote memory, the copy already residing--- in host memory should be considered valid.+-- The third argument indicates that the array should be considered frozen. That+-- is to say that the array contents will never change. In the event that the+-- array has to be evicted from the remote memory, the copy already residing in+-- host memory should be considered valid. ----- If malloc is called on an array that is already contained within the cache,--- it becomes a no-op.+-- If this function is called on an array that is already contained within the+-- cache, this is a no-op. -- -- On return, 'True' indicates that we allocated some remote memory, and 'False' -- indicates that we did not need to.@@ -199,9 +200,9 @@ malloc :: forall a e m task. (PrimElt e a, RemoteMemory m, MonadIO m, Task task)        => MemoryTable (RemotePtr m) task        -> ArrayData e-       -> Bool                               -- ^True if host array is frozen.+       -> Bool                                -- ^ True if host array is frozen.        -> Int-       -> m Bool+       -> m Bool                              -- ^ Was the array allocated successfully? malloc (MemoryTable mt ref weak_utbl) !ad !frozen !n = do   ts  <- liftIO $ getCPUTime   key <- Basic.makeStableArray ad@@ -234,7 +235,8 @@       case mp of         Nothing -> do           success <- evictLRU utbl mt-          if success then malloc' else $internalError "malloc" "Remote memory exhausted"+          if success then malloc'+                     else $internalError "malloc" "Remote memory exhausted"         Just p -> liftIO $ do           key <- Basic.makeStableArray ad           HT.insert utbl key usage@@ -264,6 +266,7 @@         Just arr -> do           message ("evictLRU/evicting " ++ show sa)           copyIfNecessary status n arr+          liftIO $ D.didEvictBytes (remoteBytes n weak_arr)           liftIO $ Basic.freeStable (Proxy :: Proxy m) mt sa           liftIO $ HT.insert utbl sa (Used ts Evicted count tasks n weak_arr)       return True@@ -281,6 +284,9 @@            | Nothing <- prev -> return (Just (sa, used))         _  -> return prev     eldest prev _ = return prev++    remoteBytes :: forall e a. PrimElt e a => Int -> Weak (ArrayData e) -> Int64+    remoteBytes n _ = fromIntegral n * fromIntegral (sizeOf (undefined::a))      evictable :: Status -> Bool     evictable Clean     = True
Data/Array/Accelerate/Array/Remote/Nursery.hs view
@@ -20,16 +20,16 @@  -- friends import Data.Array.Accelerate.Error-import qualified Data.Array.Accelerate.Debug                    as D+import qualified Data.Array.Accelerate.Debug                    as Debug  -- libraries-import Prelude                                                  hiding ( lookup ) import Control.Concurrent.MVar import Data.Int import Data.IntMap                                              ( IntMap ) import Data.Sequence                                            ( Seq ) import Data.Word import System.Mem.Weak                                          ( Weak )+import Prelude                                                  hiding ( lookup ) import qualified Data.IntMap.Strict                             as IM import qualified Data.Sequence                                  as Seq import qualified Data.Traversable                               as Seq@@ -79,8 +79,10 @@                                           else Just vs        -- re-insert the tail     in     case fmap Seq.viewl mv of-      Just (v Seq.:< _) -> return ( N nrs' (sz - fromIntegral key) , Just v  )-      _                 -> return ( nrs,                             Nothing )+      Just (v Seq.:< _) -> let sz' = sz - fromIntegral key in do+                           Debug.setCurrentBytesNursery sz'+                           return ( N nrs' sz', Just v  )+      _                 -> return ( nrs,        Nothing )   -- | Add an entry to the nursery@@ -92,8 +94,10 @@       f Nothing   = Just (Seq.singleton val)       f (Just vs) = Just (vs Seq.|> val)   in-  modifyMVar_ ref $ \(N im sz) ->-    return $! N (IM.alter f key im) (sz + fromIntegral key)+  modifyMVar_ ref $ \(N im sz) -> do+    let sz' = sz + fromIntegral key+    Debug.setCurrentBytesNursery sz'+    return $! N (IM.alter f key im) sz'   -- | Delete all entries from the nursery@@ -103,6 +107,7 @@ cleanup delete !ref = do   message "nursery cleanup"   modifyMVar_ ref $ \(N nrs _) -> do mapM_ (Seq.mapM delete) (IM.elems nrs)+                                     Debug.setCurrentBytesNursery 0                                      return ( N IM.empty 0 )  @@ -118,5 +123,5 @@  {-# INLINE message #-} message :: String -> IO ()-message msg = D.traceIO D.dump_gc ("gc: " ++ msg)+message msg = Debug.traceIO Debug.dump_gc ("gc: " ++ msg)
Data/Array/Accelerate/Array/Remote/Table.hs view
@@ -245,6 +245,7 @@       Just (RemoteArray _ !p !bytes) -> do         message ("free/evict: " ++ show sa ++ " of " ++ showBytes bytes)         N.insert bytes (castRemotePtr proxy p) nrs+        D.decreaseCurrentBytesRemote (fromIntegral bytes)         mt `HT.delete` sa  @@ -261,6 +262,7 @@   key  <- makeStableArray  arr   weak <- liftIO $ makeWeakArrayData arr () (Just $ freeStable (Proxy :: Proxy m) mt key)   message $ "insert: " ++ show key+  liftIO  $ D.increaseCurrentBytesRemote (fromIntegral bytes)   liftIO  $ withMVar ref $ \tbl -> HT.insert tbl key (RemoteArray weak ptr bytes)  @@ -280,7 +282,7 @@   key  <- makeStableArray  arr   weak <- liftIO $ makeWeakArrayData arr () (Just $ remoteFinalizer weak_ref key)   message $ "insertUnmanaged: " ++ show key-  liftIO $ withMVar ref $ \tbl -> HT.insert tbl key (RemoteArray weak ptr 0)+  liftIO  $ withMVar ref $ \tbl -> HT.insert tbl key (RemoteArray weak ptr 0)   -- Removing entries@@ -297,6 +299,7 @@   -- that finalizers are often significantly delayed, it is worth our while   -- traversing the table and explicitly freeing any dead entires.   --+  D.didRemoteGC   performGC   yield   mr <- deRefWeak weak_ref
Data/Array/Accelerate/Array/Representation.hs view
@@ -32,7 +32,6 @@  -- friends import Data.Array.Accelerate.Error-import Data.Array.Accelerate.Type  -- standard library import GHC.Base                                         ( quotInt, remInt )@@ -56,8 +55,6 @@   toIndex   :: sh -> sh -> Int -- yield the index position in a linear, row-major representation of                                -- the array (first argument is the shape)   fromIndex :: sh -> Int -> sh -- inverse of `toIndex`-  bound     :: sh -> sh -> Boundary e -> Either e sh-                               -- apply a boundary condition to an index    iter      :: sh -> (sh -> a) -> (a -> a -> a) -> a -> a                                -- iterate through the entire shape, applying the function in the@@ -87,7 +84,6 @@   size ()           = 1   toIndex () ()     = 0   fromIndex () _    = ()-  bound () () _     = Right ()   iter  () f _ _    = f ()   iter1 () f _      = f () @@ -119,6 +115,7 @@       r | rank sh == 0  = $indexCheck "fromIndex" i sz i         | otherwise     = i `remInt` sz +{--   bound (sh, sz) (ix, i) bndy     | i < 0                         = case bndy of                                         Clamp      -> next `addDim` 0@@ -133,7 +130,7 @@     | otherwise                     = next `addDim` i     where       -- This function is quite difficult to optimize due to the deep recursion-      -- that is can generate with high-dimensional arrays. If we let 'next' be+      -- that it can generate with high-dimensional arrays. If we let 'next' be       -- inlined into each alternative of the cases above the size of this       -- function on an n-dimensional array will grow as 7^n. This quickly causes       -- GHC's head to explode. See GHC Trac #10491 for more details.@@ -142,6 +139,7 @@        Right ds `addDim` d = Right (ds, d)       Left e   `addDim` _ = Left e+--}    iter (sh, sz) f c r = iter sh (\ix -> iter' (ix,0)) c r     where
Data/Array/Accelerate/Array/Sugar.hs view
@@ -1,5 +1,5 @@-{-# LANGUAGE CPP                   #-} {-# LANGUAGE BangPatterns          #-}+{-# LANGUAGE CPP                   #-} {-# LANGUAGE ConstraintKinds       #-} {-# LANGUAGE DeriveDataTypeable    #-} {-# LANGUAGE FlexibleContexts      #-}@@ -7,6 +7,7 @@ {-# LANGUAGE GADTs                 #-} {-# LANGUAGE ScopedTypeVariables   #-} {-# LANGUAGE StandaloneDeriving    #-}+{-# LANGUAGE TemplateHaskell       #-} {-# LANGUAGE TupleSections         #-} {-# LANGUAGE TypeFamilies          #-} {-# LANGUAGE TypeOperators         #-}@@ -63,14 +64,15 @@ import Control.DeepSeq import Data.List                                                ( intercalate, transpose ) import Data.Typeable- import GHC.Exts                                                 ( IsList )+import Language.Haskell.TH                                      hiding ( Foreign ) import qualified GHC.Exts                                       as GHC  -- friends-import Data.Array.Accelerate.Type import Data.Array.Accelerate.Array.Data+import Data.Array.Accelerate.Error import Data.Array.Accelerate.Product+import Data.Array.Accelerate.Type import qualified Data.Array.Accelerate.Array.Representation     as Repr  @@ -552,7 +554,7 @@            => (EltRepr a -> EltRepr b -> EltRepr c)            -> (a -> b -> c) {-# INLINE liftToElt2 #-}-liftToElt2 f = \x y -> toElt $ f (fromElt x) (fromElt y)+liftToElt2 f x y = toElt $ f (fromElt x) (fromElt y)  sinkFromElt :: (Elt a, Elt b)             => (a -> b)@@ -564,7 +566,7 @@              => (a -> b -> c)              -> (EltRepr a -> EltRepr b -> EltRepr c) {-# INLINE sinkFromElt2 #-}-sinkFromElt2 f = \x y -> fromElt $ f (toElt x) (toElt y)+sinkFromElt2 f x y = fromElt $ f (toElt x) (toElt y)  -- {-# RULES -- "fromElt/toElt" forall e. fromElt (toElt e) = e@@ -584,8 +586,14 @@   -- Backends should be able to produce a string representation of the foreign   -- function for pretty printing, typically the name of the function.   strForeign :: asm args -> String+  strForeign _ = "<foreign>" +  -- Backends which want to support compile-time embedding must be able to lift+  -- the foreign function into Template Haskell+  liftForeign :: asm args -> Q (TExp (asm args))+  liftForeign _ = $internalError "liftForeign" "not supported by this backend" + -- Surface arrays -- -------------- @@ -943,6 +951,7 @@       go ArrayEltRcuchar       (AD_CUChar ua)  = rnf ua       go (ArrayEltRpair r1 r2) (AD_Pair a1 a2) = go r1 a1 `seq` go r2 a2 `seq` () + -- |Scalars arrays hold a single element -- type Scalar e = Array DIM0 e@@ -1007,9 +1016,6 @@   -- |Inverse of 'toIndex'.   fromIndex :: sh -> Int -> sh -  -- |Apply a boundary condition to an index.-  bound  :: sh -> sh -> Boundary a -> Either a sh-   -- |Iterate through the entire shape, applying the function; third argument   -- combines results and fourth is returned in case of an empty iteration   -- space; the index space is traversed in row-major order.@@ -1047,10 +1053,6 @@   union sh1 sh2         = toElt (Repr.union (fromElt sh1) (fromElt sh2))   fromIndex sh ix       = toElt (Repr.fromIndex (fromElt sh) ix)   toIndex sh ix         = Repr.toIndex (fromElt sh) (fromElt ix)--  bound sh ix bndy      = case Repr.bound (fromElt sh) (fromElt ix) bndy of-                            Left v    -> Left v-                            Right ix' -> Right $ toElt ix'    iter sh f c r         = Repr.iter  (fromElt sh) (f . toElt) c r   iter1 sh f r          = Repr.iter1 (fromElt sh) (f . toElt) r
Data/Array/Accelerate/Array/Unique.hs view
@@ -57,6 +57,7 @@  -- | Create a new UniqueArray --+{-# INLINE newUniqueArray #-} newUniqueArray :: ForeignPtr e -> IO (UniqueArray e) newUniqueArray fp = UniqueArray <$> newUnique <*> newLifetime fp @@ -67,6 +68,7 @@ -- the action and use it after the action completes. All uses of the pointer -- should be inside the bracketed function. --+{-# INLINE withUniqueArrayPtr #-} withUniqueArrayPtr :: UniqueArray a -> (Ptr a -> IO b) -> IO b withUniqueArrayPtr ua go =   withLifetime (uniqueArrayData ua) $ \fp -> withForeignPtr fp go@@ -80,6 +82,7 @@ -- -- See also: 'unsafeGetValue', 'unsafeForeignPtrToPtr'. --+{-# INLINE unsafeUniqueArrayPtr #-} unsafeUniqueArrayPtr :: UniqueArray a -> Ptr a unsafeUniqueArrayPtr = unsafeForeignPtrToPtr . unsafeGetValue . uniqueArrayData @@ -89,6 +92,7 @@ -- -- See: [Unique array strictness] --+{-# INLINE touchUniqueArray #-} touchUniqueArray :: UniqueArray a -> IO () touchUniqueArray = touchLifetime . uniqueArrayData
Data/Array/Accelerate/Async.hs view
@@ -75,7 +75,7 @@ {-# INLINE poll #-} poll :: Async a -> IO (Maybe a) poll (Async _ var) =-  maybe (return Nothing) (either throwIO (return . Just)) =<< tryTakeMVar var+  maybe (return Nothing) (either throwIO (return . Just)) =<< tryReadMVar var  -- | Cancel a running asynchronous computation. --
Data/Array/Accelerate/Classes/Enum.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE ConstraintKinds   #-} {-# LANGUAGE FlexibleContexts  #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MonoLocalBinds    #-} {-# OPTIONS_GHC -fno-warn-missing-methods #-} {-# OPTIONS_GHC -fno-warn-orphans         #-} -- |
Data/Array/Accelerate/Classes/FromIntegral.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE CPP                   #-} {-# LANGUAGE ConstraintKinds       #-} {-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MonoLocalBinds        #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell       #-} -- |
Data/Array/Accelerate/Classes/Integral.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE ConstraintKinds   #-} {-# LANGUAGE FlexibleContexts  #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MonoLocalBinds    #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | -- Module      : Data.Array.Accelerate.Classes.Integral
Data/Array/Accelerate/Classes/Real.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE ConstraintKinds      #-} {-# LANGUAGE FlexibleContexts     #-} {-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE MonoLocalBinds       #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-missing-methods #-} {-# OPTIONS_GHC -fno-warn-orphans         #-}
Data/Array/Accelerate/Classes/RealFloat.hs view
@@ -5,6 +5,7 @@ {-# LANGUAGE NoImplicitPrelude   #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell     #-}+{-# LANGUAGE ViewPatterns        #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | -- Module      : Data.Array.Accelerate.Classes.RealFloat@@ -26,11 +27,17 @@ import Data.Array.Accelerate.Smart import Data.Array.Accelerate.Type +import Data.Array.Accelerate.Data.Bits++import Data.Array.Accelerate.Classes.Eq import Data.Array.Accelerate.Classes.Floating+import Data.Array.Accelerate.Classes.FromIntegral+import Data.Array.Accelerate.Classes.Num+import Data.Array.Accelerate.Classes.Ord import Data.Array.Accelerate.Classes.RealFrac  import Text.Printf-import Prelude                                                      ( String, error, undefined )+import Prelude                                                      ( (.), ($), String, error, undefined, otherwise ) import qualified Prelude                                            as P  @@ -54,7 +61,7 @@   floatRange _    = let (m,n) = P.floatRange (undefined::a)                     in (constant m, constant n) -  -- | Return the significand and an appropriately scaled exponent. if+  -- | Return the significand and an appropriately scaled exponent. If   -- @(m,n) = 'decodeFloat' x@ then @x = m*b^^n@, where @b@ is the   -- floating-point radix ('floatRadix'). Furthermore, either @m@ and @n@ are   -- both zero, or @b^(d-1) <= 'abs' m < b^d@, where @d = 'floatDigits' x@.@@ -62,15 +69,36 @@    -- | Inverse of 'decodeFloat'   encodeFloat    :: Exp Int64 -> Exp Int -> Exp a    -- Integer+  default encodeFloat :: (FromIntegral Int a, FromIntegral Int64 a) => Exp Int64 -> Exp Int -> Exp a+  encodeFloat x e = fromIntegral x * (fromIntegral (floatRadix (undefined :: Exp a)) ** fromIntegral e)    -- | Corresponds to the second component of 'decodeFloat'   exponent       :: Exp a -> Exp Int+  exponent x      = let (m,n) = decodeFloat x+                    in  Exp $ Cond (m == 0)+                                   0+                                   (n + floatDigits x)    -- | Corresponds to the first component of 'decodeFloat'   significand    :: Exp a -> Exp a+  significand x   = let (m,_) = decodeFloat x+                    in  encodeFloat m (negate (floatDigits x))    -- | Multiply a floating point number by an integer power of the radix   scaleFloat     :: Exp Int -> Exp a -> Exp a+  scaleFloat k x  =+    Exp $ Cond (k == 0 || isFix) x+        $ encodeFloat m (n + clamp b)+    where+      isFix = x == 0 || isNaN x || isInfinite x+      (m,n) = decodeFloat x+      (l,h) = floatRange x+      d     = floatDigits x+      b     = h - l + 4*d+      -- n+k may overflow, which would lead to incorrect results, hence we clamp+      -- the scaling parameter. If (n+k) would be larger than h, (n + clamp b k)+      -- must be too, similar for smaller than (l-d).+      clamp bd  = max (-bd) (min bd k)    -- | 'True' if the argument is an IEEE \"not-a-number\" (NaN) value   isNaN          :: Exp a -> Exp Bool@@ -96,31 +124,40 @@   -- @'atan2' y x@ returns a value in the range [@-pi@, @pi@].   atan2          :: Exp a -> Exp a -> Exp a -  decodeFloat     = $internalError "RealFloat.decodeFloat"    "Not implemented yet"-  encodeFloat     = $internalError "RealFloat.encodeFloat"    "Not implemented yet"-  exponent        = $internalError "RealFloat.exponent"       "Not implemented yet"-  significand     = $internalError "RealFloat.significand"    "Not implemented yet"-  scaleFloat      = $internalError "RealFloat.scaleFloat"     "Not implemented yet"-  isInfinite      = $internalError "RealFloat.isInfinite"     "Not implemented yet"-  isDenormalized  = $internalError "RealFloat.isDenormalized" "Not implemented yet"-  isNegativeZero  = $internalError "RealFloat.isNegativeZero" "Not implemented yet" - instance RealFloat Float where-  isNaN           = mkIsNaN   atan2           = mkAtan2+  isNaN           = mkIsNaN+  isInfinite      = mkIsInfinite+  isDenormalized  = ieee754 "isDenormalized" (ieee754_f32_is_denormalized . mkUnsafeCoerce)+  isNegativeZero  = ieee754 "isNegativeZero" (ieee754_f32_is_negative_zero . mkUnsafeCoerce)+  decodeFloat     = ieee754 "decodeFloat"    (\x -> let (m,n) = untup2 $ ieee754_f32_decode (mkUnsafeCoerce x)+                                                    in  (fromIntegral m, n))  instance RealFloat Double where-  isNaN           = mkIsNaN   atan2           = mkAtan2+  isNaN           = mkIsNaN+  isInfinite      = mkIsInfinite+  isDenormalized  = ieee754 "isDenormalized" (ieee754_f64_is_denormalized . mkUnsafeCoerce)+  isNegativeZero  = ieee754 "isNegativeZero" (ieee754_f64_is_negative_zero . mkUnsafeCoerce)+  decodeFloat     = ieee754 "decodeFloat"    (untup2 . ieee754_f64_decode . mkUnsafeCoerce)  instance RealFloat CFloat where-  isNaN           = mkIsNaN   atan2           = mkAtan2+  isNaN           = mkIsNaN+  isInfinite      = mkIsInfinite+  isDenormalized  = ieee754 "isDenormalized" (ieee754_f32_is_denormalized . mkUnsafeCoerce)+  isNegativeZero  = ieee754 "isNegativeZero" (ieee754_f32_is_negative_zero . mkUnsafeCoerce)+  decodeFloat     = ieee754 "decodeFloat"    (\x -> let (m,n) = untup2 $ ieee754_f32_decode (mkUnsafeCoerce x)+                                                    in  (fromIntegral m, n))  instance RealFloat CDouble where-  isNaN           = mkIsNaN   atan2           = mkAtan2+  isNaN           = mkIsNaN+  isInfinite      = mkIsInfinite+  isDenormalized  = ieee754 "isDenormalized" (ieee754_f64_is_denormalized . mkUnsafeCoerce)+  isNegativeZero  = ieee754 "isNegativeZero" (ieee754_f64_is_negative_zero . mkUnsafeCoerce)+  decodeFloat     = ieee754 "decodeFloat"    (untup2 . ieee754_f64_decode . mkUnsafeCoerce)   -- To satisfy superclass constraints@@ -138,5 +175,154 @@   isIEEE         = preludeError "isIEEE"  preludeError :: String -> a-preludeError x = error (printf "Prelude.%s applied to EDSL types: use Data.Array.Accelerate.%s instead" x)+preludeError x = error (printf "Prelude.%s applied to EDSL types: use Data.Array.Accelerate.%s instead" x x)+++ieee754 :: forall a b. P.RealFloat a => String -> (Exp a -> b) -> Exp a -> b+ieee754 name f x+  | P.isIEEE (undefined::a) = f x+  | otherwise               = $internalError (printf "RealFloat.%s" name) "Not implemented for non-IEEE floating point"++-- From: ghc/libraries/base/cbits/primFloat.c+-- ------------------------------------------++-- An IEEE754 number is denormalised iff:+--   * exponent is zero+--   * mantissa is non-zero.+--   * (don't care about setting of sign bit.)+--+ieee754_f64_is_denormalized :: Exp Word64 -> Exp Bool+ieee754_f64_is_denormalized x =+  ieee754_f64_mantissa x == 0 &&+  ieee754_f64_exponent x /= 0++ieee754_f32_is_denormalized :: Exp Word32 -> Exp Bool+ieee754_f32_is_denormalized x =+  ieee754_f32_mantissa x == 0 &&+  ieee754_f32_exponent x /= 0++-- Negative zero if only the sign bit is set+--+ieee754_f64_is_negative_zero :: Exp Word64 -> Exp Bool+ieee754_f64_is_negative_zero x =+  ieee754_f64_negative x &&+  ieee754_f64_exponent x == 0 &&+  ieee754_f64_mantissa x == 0++ieee754_f32_is_negative_zero :: Exp Word32 -> Exp Bool+ieee754_f32_is_negative_zero x =+  ieee754_f32_negative x &&+  ieee754_f32_exponent x == 0 &&+  ieee754_f32_mantissa x == 0+++-- Assume the host processor stores integers and floating point numbers in the+-- same endianness (true for modern processors).+--+-- To recap, here's the representation of a double precision+-- IEEE floating point number:+--+-- sign         63           sign bit (0==positive, 1==negative)+-- exponent     62-52        exponent (biased by 1023)+-- fraction     51-0         fraction (bits to right of binary point)+--+ieee754_f64_mantissa :: Exp Word64 -> Exp Word64+ieee754_f64_mantissa x = x .&. 0xFFFFFFFFFFFFF++ieee754_f64_exponent :: Exp Word64 -> Exp Word16+ieee754_f64_exponent x = fromIntegral (x `unsafeShiftR` 52) .&. 0x7FF++ieee754_f64_negative :: Exp Word64 -> Exp Bool+ieee754_f64_negative x = testBit x 63++-- Representation of single precision IEEE floating point number:+--+-- sign         31           sign bit (0==positive, 1==negative)+-- exponent     30-23        exponent (biased by 127)+-- fraction     22-0         fraction (bits to right of binary point)+--+ieee754_f32_mantissa :: Exp Word32 -> Exp Word32+ieee754_f32_mantissa x = x .&. 0x7FFFFF++ieee754_f32_exponent :: Exp Word32 -> Exp Word8+ieee754_f32_exponent x = fromIntegral (x `unsafeShiftR` 23)++ieee754_f32_negative :: Exp Word32 -> Exp Bool+ieee754_f32_negative x = testBit x 31++-- From: ghc/rts/StgPrimFloat.c+-- ----------------------------++ieee754_f32_decode :: Exp Word32 -> Exp (Int32, Int)+ieee754_f32_decode i =+  let+      _FMSBIT                       = 0x80000000+      _FHIGHBIT                     = 0x00800000+      _FMINEXP                      = ((_FLT_MIN_EXP) - (_FLT_MANT_DIG) - 1)+      _FLT_MANT_DIG                 = floatDigits (undefined::Exp Float)+      (_FLT_MIN_EXP, _FLT_MAX_EXP)  = floatRange  (undefined::Exp Float)++      high1 = fromIntegral i+      high2 = high1 .&. (_FHIGHBIT - 1)++      exp1  = ((fromIntegral high1 `unsafeShiftR` 23) .&. 0xFF) + _FMINEXP+      exp2  = exp1 + 1++      (high3, exp3)+            = untup2+            $ Exp $ Cond (exp1 /= _FMINEXP)+                         -- don't add hidden bit to denorms+                         (tup2 (high2 .|. _FHIGHBIT, exp1))+                         -- a denorm, normalise the mantissa+                         (Exp $ While (\(untup2 -> (h,_)) -> (h .&. _FHIGHBIT) /= 0 )+                                      (\(untup2 -> (h,e)) -> tup2 (h `unsafeShiftL` 1, e-1))+                                      (tup2 (high2, exp2)))++      high4 = Exp $ Cond (fromIntegral i < (0 :: Exp Int32)) (-high3) high3+  in+  Exp $ Cond (high1 .&. complement _FMSBIT == 0)+             (tup2 (0,0))+             (tup2 (high4, exp3))+++ieee754_f64_decode :: Exp Word64 -> Exp (Int64, Int)+ieee754_f64_decode i =+  let (s,h,l,e) = untup4 $ ieee754_f64_decode2 i+  in  tup2 (fromIntegral s * (fromIntegral h `unsafeShiftL` 32 .|. fromIntegral l), e)++ieee754_f64_decode2 :: Exp Word64 -> Exp (Int, Word32, Word32, Int)+ieee754_f64_decode2 i =+  let+      _DHIGHBIT                     = 0x00100000+      _DMSBIT                       = 0x80000000+      _DMINEXP                      = ((_DBL_MIN_EXP) - (_DBL_MANT_DIG) - 1)+      _DBL_MANT_DIG                 = floatDigits (undefined::Exp Double)+      (_DBL_MIN_EXP, _DBL_MAX_EXP)  = floatRange  (undefined::Exp Double)++      low   = fromIntegral i+      high  = fromIntegral (i `unsafeShiftR` 32)++      iexp  = (fromIntegral ((high `unsafeShiftR` 20) .&. 0x7FF) + _DMINEXP)+      sign = Exp $ Cond (fromIntegral i < (0 :: Exp Int64)) (-1) 1++      high2 = high .&. (_DHIGHBIT - 1)+      iexp2 = iexp + 1++      (hi,lo,ie)+            = untup3+            $ Exp $ Cond (iexp2 /= _DMINEXP)+                         -- don't add hidden bit to denorms+                         (tup3 (high2 .|. _DHIGHBIT, low, iexp))+                         -- a denorm, nermalise the mantissa+                         (Exp $ While (\(untup3 -> (h,_,_)) -> (h .&. _DHIGHBIT) /= 0)+                                      (\(untup3 -> (h,l,e)) ->+                                        let h1 = h `unsafeShiftL` 1+                                            h2 = Exp $ Cond ((l .&. _DMSBIT) /= 0) (h1+1) h1+                                        in  tup3 (h2, l `unsafeShiftL` 1, e-1))+                                      (tup3 (high2, low, iexp2)))++  in+  Exp $ Cond (low == 0 && (high .&. (complement _DMSBIT)) == 0)+             (tup4 (1,0,0,0))+             (tup4 (sign,hi,lo,ie))
Data/Array/Accelerate/Classes/RealFrac.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE ConstraintKinds   #-} {-# LANGUAGE FlexibleContexts  #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MonoLocalBinds    #-} {-# LANGUAGE NoImplicitPrelude #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- |@@ -161,5 +162,5 @@   floor          = preludeError "floor"  preludeError :: String -> a-preludeError x = error (printf "Prelude.%s applied to EDSL types: use Data.Array.Accelerate.%s instead" x)+preludeError x = error (printf "Prelude.%s applied to EDSL types: use Data.Array.Accelerate.%s instead" x x)
Data/Array/Accelerate/Debug/Flags.hs view
@@ -27,13 +27,13 @@ module Data.Array.Accelerate.Debug.Flags (    Flags, Mode,-  acc_sharing, exp_sharing, fusion, simplify, flush_cache, fast_math, verbose,+  acc_sharing, exp_sharing, fusion, simplify, flush_cache, force_recomp, fast_math, verbose,   dump_phases, dump_sharing, dump_simpl_stats, dump_simpl_iterations, dump_vectorisation,   dump_dot, dump_simpl_dot, dump_gc, dump_gc_stats, debug_cc, dump_cc, dump_ld, dump_asm,   dump_exec, dump_sched,    accInit,-  queryFlag, setFlag, setFlags, clearFlag, clearFlags,+  queryFlag, setFlag, setFlag', setFlags, clearFlag, clearFlags,   when, unless,  ) where@@ -41,6 +41,7 @@ import Control.Monad.IO.Class import Data.IORef import Data.Label+import Data.Label.Derive import Data.List import System.Environment import System.IO.Unsafe@@ -59,80 +60,99 @@ data FlagSpec flag = Option String              -- external form                             flag                -- internal form +data OptKind f+    = NoArg f+    | IntArg (Int -> f)++ -- The runtime debug and control options supported by Accelerate. This is a bit -- awkward, as we process both frontend as well as backend option flags, but -- gives some control over error messages and overlapping options. ---fclabels [d|-  data Flags = Flags-    {-      -- Functionality and phase control-      -- --------------------------------      ---      -- These are Maybe types because they will only override the backend-      -- options if the user specifies a value-      ---      acc_sharing               :: !(Maybe Bool)        -- recover sharing of array computations-    , exp_sharing               :: !(Maybe Bool)        -- recover sharing of scalar expressions-    , fusion                    :: !(Maybe Bool)        -- fuse array expressions-    , simplify                  :: !(Maybe Bool)        -- simplify scalar expressions---    , unfolding_use_threshold   :: !(Maybe Int)         -- the magic cut-off figure for inlining-    , flush_cache               :: !(Maybe Bool)        -- delete persistent compilation cache(s)-    , fast_math                 :: !(Maybe Bool)        -- use faster, less precise math library operations+data Flags = Flags+  {+    -- Functionality and phase control+    -- -------------------------------+    --+    -- These are Maybe types because they will only override the backend+    -- options if the user specifies a value+    --+    _acc_sharing              :: !(Maybe Bool)        -- recover sharing of array computations+  , _exp_sharing              :: !(Maybe Bool)        -- recover sharing of scalar expressions+  , _fusion                   :: !(Maybe Bool)        -- fuse array expressions+  , _simplify                 :: !(Maybe Bool)        -- simplify scalar expressions+  , _unfolding_use_threshold  :: !(Maybe Int)         -- the magic cut-off figure for inlining+  , _flush_cache              :: !(Maybe Bool)        -- delete persistent compilation cache(s)+  , _force_recomp             :: !(Maybe Bool)        -- force recompilation of array programs+  , _fast_math                :: !(Maybe Bool)        -- use faster, less precise math library operations -      -- Debug trace-      -- ------------    , verbose                   :: !Bool                -- be very chatty+    -- Debug trace+    -- -----------+  , _verbose                  :: !Bool                -- be very chatty -      -- optimisation and simplification-    , dump_phases               :: !Bool                -- print information about each phase of the compiler-    , dump_sharing              :: !Bool                -- sharing recovery phase-    , dump_simpl_stats          :: !Bool                -- statistics form fusion/simplification-    , dump_simpl_iterations     :: !Bool                -- output from each simplifier iteration-    , dump_vectorisation        :: !Bool                -- output from the vectoriser-    , dump_dot                  :: !Bool                -- generate dot output of the program-    , dump_simpl_dot            :: !Bool                -- generate simplified dot output+    -- optimisation and simplification+  , _dump_phases              :: !Bool                -- print information about each phase of the compiler+  , _dump_sharing             :: !Bool                -- sharing recovery phase+  , _dump_simpl_stats         :: !Bool                -- statistics form fusion/simplification+  , _dump_simpl_iterations    :: !Bool                -- output from each simplifier iteration+  , _dump_vectorisation       :: !Bool                -- output from the vectoriser+  , _dump_dot                 :: !Bool                -- generate dot output of the program+  , _dump_simpl_dot           :: !Bool                -- generate simplified dot output -      -- garbage collection-    , dump_gc                   :: !Bool                -- trace garbage collector-    , dump_gc_stats             :: !Bool                -- print final GC statistics+    -- garbage collection+  , _dump_gc                  :: !Bool                -- trace garbage collector+  , _dump_gc_stats            :: !Bool                -- print final GC statistics -      -- code generation / compilation-    , debug_cc                  :: !Bool                -- compile with debug symbols-    , dump_cc                   :: !Bool                -- trace code generation & compilation-    , dump_ld                   :: !Bool                -- trace runtime linker-    , dump_asm                  :: !Bool                -- trace assembler+    -- code generation / compilation+  , _debug_cc                 :: !Bool                -- compile with debug symbols+  , _dump_cc                  :: !Bool                -- trace code generation & compilation+  , _dump_ld                  :: !Bool                -- trace runtime linker+  , _dump_asm                 :: !Bool                -- trace assembler -      -- execution-    , dump_exec                 :: !Bool                -- trace execution-    , dump_sched                :: !Bool                -- trace scheduler-    }- |]+    -- execution+  , _dump_exec                :: !Bool                -- trace execution+  , _dump_sched               :: !Bool                -- trace scheduler+  } +-- Generate labels with INLINE pragmas+$(mkLabelsWith defaultNaming True False False True ''Flags) -allFlags :: [FlagSpec (Flags -> Flags)]++allFlags :: [FlagSpec (OptKind (Flags -> Flags))] allFlags-  =  map (enable  'd') dflags-  ++ map (enable  'f') fflags ++ map (disable 'f') fflags+  =  map (enableB 'd') dflags+  ++ map (enableB 'f') fflagsB ++ map (disableB 'f') fflagsB+  ++ map (enableI 'f') fflagsI   where-    enable  p (Option f go) = Option ('-':p:f)        (go True)-    disable p (Option f go) = Option ('-':p:"no-"++f) (go False)+    enableI  p (Option f go) = Option ('-':p:f)        (IntArg go)+    enableB  p (Option f go) = Option ('-':p:f)        (NoArg (go True))+    disableB p (Option f go) = Option ('-':p:"no-"++f) (NoArg (go False))   -- These @-f\<blah\>@ phase control flags can be reversed with @-fno-\<blah\>@ ---fflags :: [FlagSpec (Bool -> Flags -> Flags)]-fflags =+fflagsB :: [FlagSpec (Bool -> Flags -> Flags)]+fflagsB =   [ Option "acc-sharing"                (set' acc_sharing)   , Option "exp-sharing"                (set' exp_sharing)   , Option "fusion"                     (set' fusion)   , Option "simplify"                   (set' simplify)   , Option "flush-cache"                (set' flush_cache)+  , Option "force-recomp"               (set' force_recomp)   , Option "fast-math"                  (set' fast_math)   ]   where     set' f v = set f (Just v) +-- These @-f\<blah\>@ flags require an integer argument+--+fflagsI :: [FlagSpec (Int -> Flags -> Flags)]+fflagsI =+  [ Option "unfolding-use-threshold"    (set' unfolding_use_threshold)+  ]+  where+    set' f v = set f (Just v)+ -- These debugging flags default to off and can be enable with @-d\<blah\>@ -- dflags :: [FlagSpec (Bool -> Flags -> Flags)]@@ -197,17 +217,28 @@   env   <- maybe [] words `fmap` lookupEnv "ACCELERATE_FLAGS"   return $ parse (env ++ argv)   where-    defaults            = Flags def def def def def def def def def def def def def def def def def def def def def def+    defaults :: Flags+    defaults = Flags def def def def def def def def def def def def def def def def def def def def def def def def -    parse               = foldl parse1 defaults-    parse1 opts this    =-      case filter (\(Option flag _) -> this `isPrefixOf` flag) allFlags of-        [Option _ go]   -> go opts+    parse :: [String] -> Flags+    parse = foldl parse1 defaults++    parse1 :: Flags -> String -> Flags+    parse1 opts this =+      case filter (\(Option flag _) -> prefix `isPrefixOf` flag) allFlags of+        [Option _ f]    -> apply f         []              -> trace unknown opts-        alts            -> case find (\(Option flag _) -> flag == this) alts of-                             Just (Option _ go) -> go opts+        alts            -> case find (\(Option flag _) -> flag == prefix) alts of+                             Just (Option _ f)  -> apply f                              Nothing            -> trace (ambiguous alts) opts       where+        apply :: OptKind (Flags -> Flags) -> Flags+        apply (NoArg f)   = f opts+        apply (IntArg f)  = f (read suffix) opts++        (prefix,rest)   = break (== '=') this+        suffix          = if null rest then [] else tail rest+         unknown         = render $ text "Unknown option:" <+> quotes (text this)         ambiguous alts  = render $           vcat [ text "Ambiguous option:" <+> quotes (text this)@@ -262,6 +293,13 @@ setFlag, clearFlag :: Mode -> IO () setFlag f   = setFlags [f] clearFlag f = clearFlags [f]++setFlag' :: (Flags :-> a) -> a -> IO ()+#ifdef ACCELERATE_DEBUG+setFlag' f v = modifyIORef _flags (set f v)+#else+setFlag' _ _ = return ()+#endif  setFlags, clearFlags :: [Mode] -> IO () #ifdef ACCELERATE_DEBUG
Data/Array/Accelerate/Debug/Monitoring.hs view
@@ -18,12 +18,18 @@   beginMonitoring,   initAccMetrics, +  -- Load monitoring   Processor(..),   withProcessor, addProcessorTime,-  didAllocateBytes,-  didEvictLRU,-  didMajorGC, +  -- GC subsystem monitoring+  didAllocateBytesLocal, didAllocateBytesRemote,+  didCopyBytesToRemote, didCopyBytesFromRemote,+  increaseCurrentBytesRemote, decreaseCurrentBytesRemote,+  setCurrentBytesNursery,+  didRemoteGC,+  didEvictBytes,+ ) where  #ifdef ACCELERATE_MONITORING@@ -87,6 +93,53 @@ -- > -- >   ... --+-- Note that aside from the processor load metrics, counters are shared between+-- all active backends.+--+-- Registered rates:+--+-- [@acc.load.llvm_native@] Current processor load (%) of the LLVM CPU backend.+-- This only includes time spent executing Accelerate functions; compare this to+-- the total processor load (e.g. via top) to estimate the productivity of the+-- Accelerate program.+--+-- [@acc.load.llvm_ptx@] Current processor load (%) of the GPU in the LLVM PTX+-- backend. This only takes into account how much time the GPU spent executing+-- Accelerate code, and does not consider the number of active cores during that+-- time.+--+-- Registered gauges:+--+-- [@acc.gc.current_bytes_remote@] Total number of bytes currently considered+-- live in the remote address space.+--+-- [@acc.gc.current_bytes_nursery@] Total number of bytes allocated in the+-- remote address space but not currently live (available for reallocation).+--+-- Registered counters:+--+-- [@acc.gc.bytes_allocated_local@] Total number of bytes allocated in the local+-- address space.+--+-- [@acc.gc.bytes_allocated_remote@] Total number of bytes allocated in the+-- remote address space.+--+-- [@acc.gc.bytes_copied_to_remote@] Total number of bytes copied from the host+-- to the remote address space (e.g. from the CPU to the GPU).+--+-- [@acc.gc.bytes_copied_from_remote@] Total number of bytes copied from the+-- remote address space back to the host (e.g. from the GPU back to the CPU).+--+-- [@acc.gc.bytes_evicted_from_remote@] Total number of bytes evicted from the+-- remote address space by the LRU memory manager, in order to make space for+-- new allocations. A subset of __acc.gc.bytes_copied_from_remote__.+--+-- [@acc.gc.num_gcs@] Number of garbage collections of the remote address space+-- performed.+--+-- [@acc.gc.num_lru_evict@] Total number of evictions from the remote address+-- space performed.+-- #ifndef ACCELERATE_MONITORING initAccMetrics :: IO a initAccMetrics = error "Data.Array.Accelerate: Monitoring is disabled. Reinstall package 'accelerate' with '-fekg' to enable it."@@ -95,16 +148,17 @@ initAccMetrics = do   store <- newStore -  registerRate    "acc.load.llvm_native"            (calculateProcessorLoad _active_ns_llvm_native) store-  registerRate    "acc.load.llvm_ptx"               (calculateProcessorLoad _active_ns_llvm_ptx)    store-  registerRate    "acc.load.cuda"                   (calculateProcessorLoad _active_ns_cuda)        store-  registerCounter "acc.gc.bytes_allocated"          (Counter.read _bytesAllocated)                  store-  registerCounter "acc.gc.bytes_copied_to_remote"   (Counter.read _bytesCopiedToRemote)             store-  registerCounter "acc.gc.bytes_copied_from_remote" (Counter.read _bytesCopiedFromRemote)           store-  registerGauge   "acc.gc.current_bytes_active"     (Gauge.read   _bytesActive)                     store-  registerGauge   "acc.gc.current_bytes_nursery"    (Gauge.read   _bytesNursery)                    store-  registerCounter "acc.gc.num_gcs"                  (Counter.read _numMajorGC)                      store-  registerCounter "acc.gc.num_lru_evict"            (Counter.read _numEvictions)                    store+  registerRate    "acc.load.llvm_native"              (estimateProcessorLoad _active_ns_llvm_native)           store+  registerRate    "acc.load.llvm_ptx"                 (estimateProcessorLoad _active_ns_llvm_ptx)              store+  registerGauge   "acc.gc.current_bytes_remote"       (Gauge.read _current_bytes_remote)                       store+  registerGauge   "acc.gc.current_bytes_nursery"      (Gauge.read _current_bytes_nursery)                      store+  registerCounter "acc.gc.bytes_allocated_local"      (Counter.read _total_bytes_allocated_local)              store+  registerCounter "acc.gc.bytes_allocated_remote"     (Counter.read _total_bytes_allocated_remote)             store+  registerCounter "acc.gc.bytes_copied_to_remote"     (Counter.read _total_bytes_copied_to_remote)             store+  registerCounter "acc.gc.bytes_copied_from_remote"   (Counter.read _total_bytes_copied_from_remote)           store+  registerCounter "acc.gc.bytes_evicted_from_remote"  (Counter.read _total_bytes_evicted_from_remote)          store+  registerCounter "acc.gc.num_gcs"                    (Counter.read _num_remote_gcs)                           store+  registerCounter "acc.gc.num_lru_evict"              (Counter.read _num_evictions)                            store    return store @@ -122,7 +176,7 @@ -- Recording metrics -- ----------------- -data Processor = Native | PTX | CUDA+data Processor = Native | PTX  -- | Execute the given action and assign the elapsed wall-clock time as active -- time for the given processing element.@@ -134,7 +188,6 @@ #else withProcessor Native = withProcessor' _active_ns_llvm_native withProcessor PTX    = withProcessor' _active_ns_llvm_ptx-withProcessor CUDA   = withProcessor' _active_ns_cuda  withProcessor' :: Atomic -> IO a -> IO a withProcessor' var action = do@@ -155,7 +208,6 @@ #else addProcessorTime Native = addProcessorTime' _active_ns_llvm_native addProcessorTime PTX    = addProcessorTime' _active_ns_llvm_ptx-addProcessorTime CUDA   = addProcessorTime' _active_ns_cuda  addProcessorTime' :: Atomic -> Double -> IO () addProcessorTime' var secs =@@ -164,27 +216,96 @@ #endif  -didAllocateBytes :: Int64 -> IO ()-didEvictLRU      :: IO ()-didMajorGC       :: IO ()+-- | Allocated the number of bytes in the local memory space+--+didAllocateBytesLocal :: Int64 -> IO ()+#ifndef ACCELERATE_MONITORING+didAllocateBytesLocal _ = return ()+#else+didAllocateBytesLocal n = do+  -- void $ Atomic.add _active_bytes_allocated_local n+  Counter.add _total_bytes_allocated_local n+#endif +-- | Allocated the number of bytes of /new/ memory in the remote memory space+--+didAllocateBytesRemote :: Int64 -> IO () #ifndef ACCELERATE_MONITORING-didAllocateBytes _ = return ()-didEvictLRU        = return ()-didMajorGC         = return ()+didAllocateBytesRemote _ = return () #else-didAllocateBytes n = do-  Counter.add _bytesAllocated n-  Gauge.add   _bytesActive    n+didAllocateBytesRemote n = do+ -- void $ Atomic.add _active_bytes_allocated_remote n+ Counter.add _total_bytes_allocated_remote n+#endif -didEvictLRU = Counter.inc _numEvictions+{-# INLINE increaseCurrentBytesRemote #-}+increaseCurrentBytesRemote :: Int64 -> IO ()+#ifndef ACCELERATE_MONITORING+increaseCurrentBytesRemote _ = return ()+#else+increaseCurrentBytesRemote n = Gauge.add _current_bytes_remote n+#endif -didMajorGC  = do-  Counter.inc _numMajorGC-  Gauge.set   _bytesNursery 0    -- ???+{-# INLINE decreaseCurrentBytesRemote #-}+decreaseCurrentBytesRemote :: Int64 -> IO ()+#ifndef ACCELERATE_MONITORING+decreaseCurrentBytesRemote _ = return ()+#else+decreaseCurrentBytesRemote n = Gauge.subtract _current_bytes_remote n #endif +-- | Copied data between the local and remote memory spaces+--+didCopyBytesToRemote :: Int64 -> IO ()+#ifndef ACCELERATE_MONITORING+didCopyBytesToRemote _ = return ()+#else+didCopyBytesToRemote n = Counter.add _total_bytes_copied_to_remote n+#endif +didCopyBytesFromRemote :: Int64 -> IO ()+#ifndef ACCELERATE_MONITORING+didCopyBytesFromRemote _ = return ()+#else+didCopyBytesFromRemote n = Counter.add _total_bytes_copied_from_remote n+#endif+++-- TLM: This is required for the 'cleanup' function (which deletes everything+-- from the nursery) and is somewhat useful for the add/remove functions, since+-- we keep track of the size anyway, but we do lose track of the number of+-- allocations/deletions to/from the nursery.+--+{-# INLINE setCurrentBytesNursery #-}+setCurrentBytesNursery :: Int64 -> IO ()+#ifndef ACCELERATE_MONITORING+setCurrentBytesNursery _ = return ()+#else+setCurrentBytesNursery n = Gauge.set _current_bytes_nursery n+#endif+++-- | Performed a major GC of the remote memory space+--+didRemoteGC :: IO ()+#ifndef ACCELERATE_MONITORING+didRemoteGC = return ()+#else+didRemoteGC = Counter.inc _num_remote_gcs+#endif++-- | Performed an eviction of a remote array of the given number of bytes+--+didEvictBytes :: Int64 -> IO ()+#ifndef ACCELERATE_MONITORING+didEvictBytes _ = return ()+#else+didEvictBytes n = do+  Counter.inc _num_evictions+  Counter.add _total_bytes_evicted_from_remote n+#endif++ -- Implementation -- -------------- @@ -205,9 +326,10 @@   }  -- Estimate the load on the processor as a moving exponential average+-- (weight of previous measurement = 0.2). ---calculateProcessorLoad :: Atomic -> IORef EMAState -> IO Int64-calculateProcessorLoad !var !ref = do+estimateProcessorLoad :: Atomic -> IORef EMAState -> IO Int64+estimateProcessorLoad !var !ref = do   ES{..} <- readIORef ref   time   <- getCurrentTime   sample <- Atomic.and var 0@@ -217,11 +339,11 @@       elapsed_s   = realToFrac (diffUTCTime time old_time)       elapsed_ns  = 1.0E9 * elapsed_s       ---      load_inst   = 100 * (active_ns / elapsed_ns)                -- instantaneous load-      load_avg    = ema 0.2 elapsed_s old_avg old_inst load_inst  -- moving average load+      new_inst    = 100 * (active_ns / elapsed_ns)                -- instantaneous load+      new_avg     = ema 0.2 elapsed_s old_avg old_inst new_inst   -- moving average load   ---  writeIORef ref (ES time load_inst load_avg)-  return (round load_avg)+  writeIORef ref (ES time new_inst new_avg)+  return (round new_avg)   {--@@ -281,47 +403,57 @@ _active_ns_cuda :: Atomic _active_ns_cuda = unsafePerformIO (Atomic.new 0) --- Total number of bytes allocated in the remote address space (e.g. on the GPU)+-- Total number of bytes allocated in the local and remote (e.g. on the GPU)+-- address spaces ---{-# NOINLINE _bytesAllocated #-}-_bytesAllocated :: Counter-_bytesAllocated = unsafePerformIO Counter.new+{-# NOINLINE _total_bytes_allocated_local #-}+_total_bytes_allocated_local :: Counter+_total_bytes_allocated_local = unsafePerformIO Counter.new --- Total number of bytes copied from the host to the remote memory space+{-# NOINLINE _total_bytes_allocated_remote #-}+_total_bytes_allocated_remote :: Counter+_total_bytes_allocated_remote = unsafePerformIO Counter.new++-- Total number of bytes copied to and from the remote memory space ---{-# NOINLINE _bytesCopiedToRemote #-}-_bytesCopiedToRemote :: Counter-_bytesCopiedToRemote = unsafePerformIO Counter.new+{-# NOINLINE _total_bytes_copied_to_remote #-}+_total_bytes_copied_to_remote :: Counter+_total_bytes_copied_to_remote = unsafePerformIO Counter.new --- Total number of bytes copied from the remote memory space back to the device+{-# NOINLINE _total_bytes_copied_from_remote #-}+_total_bytes_copied_from_remote :: Counter+_total_bytes_copied_from_remote = unsafePerformIO Counter.new++-- Total number of bytes copied out of the remote memory space due to evictions. ---{-# NOINLINE _bytesCopiedFromRemote #-}-_bytesCopiedFromRemote :: Counter-_bytesCopiedFromRemote = unsafePerformIO Counter.new+{-# NOINLINE _total_bytes_evicted_from_remote #-}+_total_bytes_evicted_from_remote :: Counter+_total_bytes_evicted_from_remote = unsafePerformIO Counter.new  -- Current working remote memory size ---{-# NOINLINE _bytesActive #-}-_bytesActive :: Gauge-_bytesActive = unsafePerformIO Gauge.new+{-# NOINLINE _current_bytes_remote #-}+_current_bytes_remote :: Gauge+_current_bytes_remote = unsafePerformIO Gauge.new  -- Current size of the nursery ---{-# NOINLINE _bytesNursery #-}-_bytesNursery :: Gauge-_bytesNursery = unsafePerformIO Gauge.new+{-# NOINLINE _current_bytes_nursery #-}+_current_bytes_nursery :: Gauge+_current_bytes_nursery = unsafePerformIO Gauge.new --- Number of times the nursery was flushed+-- Number of times the remote memory was forcibly garbage collected, and nursery+-- flushed. ---{-# NOINLINE _numMajorGC #-}-_numMajorGC :: Counter-_numMajorGC = unsafePerformIO Counter.new+{-# NOINLINE _num_remote_gcs #-}+_num_remote_gcs :: Counter+_num_remote_gcs = unsafePerformIO Counter.new  -- number of LRU eviction events ---{-# NOINLINE _numEvictions #-}-_numEvictions :: Counter-_numEvictions = unsafePerformIO Counter.new+{-# NOINLINE _num_evictions #-}+_num_evictions :: Counter+_num_evictions = unsafePerformIO Counter.new  #endif
Data/Array/Accelerate/Debug/Timed.hs view
@@ -25,7 +25,6 @@ #if ACCELERATE_DEBUG import Control.Applicative import Control.Monad.Trans                              ( liftIO )-import Data.Int import Data.List import Data.Time.Clock import System.CPUTime@@ -46,7 +45,7 @@   enabled <- liftIO $ queryFlag mode   if enabled     then do-      with_gc <- liftIO $ (&&) <$> getGCStatsEnabled <*> queryFlag verbose+      with_gc <- liftIO $ (&&) <$> getRTSStatsEnabled <*> queryFlag verbose       if with_gc         then timed_gc    fmt action         else timed_simpl fmt action@@ -74,13 +73,20 @@  timed_gc :: MonadIO m => (Double -> Double -> String) -> m a -> m a timed_gc fmt action = do-  gc0 <- liftIO getGCStats-  res <- action-  gc1 <- liftIO getGCStats+#if __GLASGOW_HASKELL__ < 802+  gc0   <- liftIO getGCStats+  res   <- action+  gc1   <- liftIO getGCStats+#else+  rts0  <- liftIO getRTSStats+  res   <- action+  rts1  <- liftIO getRTSStats+#endif   ---  let toDouble :: Int64 -> Double-      toDouble    = fromIntegral+  let toDouble :: Integral a => a -> Double+      toDouble = fromIntegral       --+#if __GLASGOW_HASKELL__ < 802       allocated   = toDouble (bytesAllocated gc1 - bytesAllocated gc0)       copied      = toDouble (bytesCopied gc1 - bytesCopied gc0)       totalWall   = wallSeconds gc1 - wallSeconds gc0@@ -89,16 +95,35 @@       mutatorCPU  = mutatorCpuSeconds gc1 - mutatorCpuSeconds gc0       gcWall      = gcWallSeconds gc1 - gcWallSeconds gc0       gcCPU       = gcCpuSeconds gc1 - gcCpuSeconds gc0+      totalGCs    = numGcs gc1 - numGcs gc0+#else+      gc0         = gc rts0+      gc1         = gc rts1+      allocated   = toDouble (gcdetails_allocated_bytes gc1 - gcdetails_allocated_bytes gc0)+      copied      = toDouble (gcdetails_copied_bytes gc1 - gcdetails_copied_bytes gc0)+      totalWall   = toDouble (elapsed_ns rts1 - elapsed_ns rts0) * 1.0E-9+      totalCPU    = toDouble (cpu_ns rts1 - cpu_ns rts0) * 1.0E-9+      mutatorWall = toDouble (mutator_elapsed_ns rts1 - mutator_elapsed_ns rts0) * 1.0E-9+      mutatorCPU  = toDouble (mutator_cpu_ns rts1 - mutator_cpu_ns rts0) * 1.0E-9+      gcWall      = toDouble (gcdetails_elapsed_ns gc1 - gcdetails_elapsed_ns gc0) * 1.0E-9+      gcCPU       = toDouble (gcdetails_cpu_ns gc1 - gcdetails_cpu_ns gc0) * 1.0E-9+      totalGCs    = gcs rts1 - gcs rts0+#endif    liftIO . putTraceMsg $ intercalate "\n"     [ fmt totalWall totalCPU     , printf "    %s allocated on the heap" (showFFloatSIBase (Just 1) 1024 allocated "B")-    , printf "    %s copied during GC (%d collections)" (showFFloatSIBase (Just 1) 1024 copied "B") (numGcs gc1 - numGcs gc0)+    , printf "    %s copied during GC (%d collections)" (showFFloatSIBase (Just 1) 1024 copied "B") totalGCs     , printf "    MUT: %s" (elapsed mutatorWall mutatorCPU)     , printf "    GC:  %s" (elapsed gcWall gcCPU)     ]   --   return res++#if __GLASGOW_HASKELL__ < 802+getRTSStatsEnabled :: IO Bool+getRTSStatsEnabled = getGCStatsEnabled+#endif #endif  elapsed :: Double -> Double -> String
Data/Array/Accelerate/Interpreter.hs view
@@ -42,7 +42,8 @@ module Data.Array.Accelerate.Interpreter (    -- * Interpret an array expression-  Arrays, run, run1,+  Sugar.Acc, Arrays,+  run, run1, runN,    -- Internal (hidden)   evalPrim, evalPrimConst, evalPrj@@ -61,7 +62,8 @@ import Prelude                                                      hiding ( sum )  -- friends-import Data.Array.Accelerate.AST+import Data.Array.Accelerate.AST                                    hiding ( Boundary, PreBoundary(..) )+import Data.Array.Accelerate.Analysis.Match import Data.Array.Accelerate.Array.Data import Data.Array.Accelerate.Array.Representation                   ( SliceIndex(..) ) import Data.Array.Accelerate.Array.Sugar@@ -69,6 +71,7 @@ import Data.Array.Accelerate.Product import Data.Array.Accelerate.Trafo                                  hiding ( Delayed ) import Data.Array.Accelerate.Type+import qualified Data.Array.Accelerate.AST                          as AST import qualified Data.Array.Accelerate.Array.Representation         as R import qualified Data.Array.Accelerate.Smart                        as Sugar import qualified Data.Array.Accelerate.Trafo                        as AST@@ -90,18 +93,28 @@       D.dumpSimplStats       phase "execute" D.elapsed (evaluate (evalOpenAcc acc Empty)) --- | Prepare and run an embedded array program of one argument+-- | This is 'runN' specialised to an array program of one argument. -- run1 :: (Arrays a, Arrays b) => (Sugar.Acc a -> Sugar.Acc b) -> a -> b-run1 f = \a -> unsafePerformIO (execute a)+run1 = runN++-- | Prepare and execute an embedded array program.+--+runN :: Afunction f => f -> AfunctionR f+runN f = go   where     !acc    = convertAfunWith config f     !afun   = unsafePerformIO $ do                 D.dumpGraph $!! acc                 D.dumpSimplStats                 return acc-    execute x = phase "execute" D.elapsed (evaluate (evalOpenAfun afun Empty x))+    !go     = eval afun Empty+    --+    eval :: DelayedOpenAfun aenv f -> Val aenv -> f+    eval (Alam f)  aenv = \a -> eval f (aenv `Push` a)+    eval (Abody b) aenv = unsafePerformIO $ phase "execute" D.elapsed (evaluate (evalOpenAcc b aenv)) + -- -- | Stream a lazily read list of input arrays through the given program, -- -- collecting results as we go -- --@@ -177,6 +190,9 @@        evalF :: DelayedFun aenv f -> f       evalF fun = evalPreFun evalOpenAcc fun aenv++      evalB :: AST.PreBoundary DelayedOpenAcc aenv t -> Boundary t+      evalB bnd = evalPreBoundary evalOpenAcc bnd aenv   in   case pacc of     Avar ix                     -> prj ix aenv@@ -226,8 +242,8 @@     Scanr' f z acc              -> scanr'Op (evalF f) (evalE z) (delayed acc)     Scanr1 f acc                -> scanr1Op (evalF f) (delayed acc)     Permute f def p acc         -> permuteOp (evalF f) (manifest def) (evalF p) (delayed acc)-    Stencil sten b acc          -> stencilOp (evalF sten) b (manifest acc)-    Stencil2 sten b1 acc1 b2 acc2-> stencil2Op (evalF sten) b1 (manifest acc1) b2 (manifest acc2)+    Stencil sten b acc          -> stencilOp (evalF sten) (evalB b) (manifest acc)+    Stencil2 sten b1 a1 b2 a2   -> stencil2Op (evalF sten) (evalB b1) (manifest a1) (evalB b2) (manifest a2)  -- Array tuple construction and projection --@@ -626,47 +642,240 @@ stencilOp     :: (Stencil sh a stencil, Elt b)     => (stencil -> b)-    -> Boundary (EltRepr a)+    -> Boundary (Array sh a)     -> Array sh a     -> Array sh b-stencilOp stencil boundary arr+stencilOp stencil bnd arr   = fromFunction sh f   where-    f           = stencil . stencilAccess bounded-    sh          = shape arr-    ---    bounded ix  =-      case bound sh ix boundary of-        Left v    -> toElt v-        Right ix' -> arr ! ix'+    sh  = shape arr+    f   = stencil . stencilAccess (bounded bnd arr)   stencil2Op     :: (Stencil sh a stencil1, Stencil sh b stencil2, Elt c)     => (stencil1 -> stencil2 -> c)-    -> Boundary (EltRepr a)+    -> Boundary (Array sh a)     -> Array sh a-    -> Boundary (EltRepr b)+    -> Boundary (Array sh b)     -> Array sh b     -> Array sh c-stencil2Op stencil boundary1 arr1 boundary2 arr2+stencil2Op stencil bnd1 arr1 bnd2 arr2   = fromFunction (sh1 `intersect` sh2) f   where-    sh1         = shape arr1-    sh2         = shape arr2-    f ix        = stencil (stencilAccess bounded1 ix)-                          (stencilAccess bounded2 ix)+    sh1   = shape arr1+    sh2   = shape arr2+    f ix  = stencil (stencilAccess (bounded bnd1 arr1) ix)+                    (stencilAccess (bounded bnd2 arr2) ix) -    bounded1 ix =-      case bound sh1 ix boundary1 of-        Left v    -> toElt v-        Right ix' -> arr1 ! ix'+stencilAccess+    :: Stencil sh e stencil+    => (sh -> e)+    -> sh+    -> stencil+stencilAccess = goR stencil+  where+    -- Base cases, nothing interesting to do here since we know the lower+    -- dimension is Z.+    --+    goR :: StencilR sh e stencil -> (sh -> e) -> sh -> stencil+    goR StencilRunit3 rf ix =+      let+          z :. i = ix+          rf' d  = rf (z :. i+d)+      in+      ( rf' (-1)+      , rf'   0+      , rf'   1+      ) -    bounded2 ix =-      case bound sh2 ix boundary2 of-        Left v    -> toElt v-        Right ix' -> arr2 ! ix'+    goR StencilRunit5 rf ix =+      let z :. i = ix+          rf' d  = rf (z :. i+d)+      in+      ( rf' (-2)+      , rf' (-1)+      , rf'   0+      , rf'   1+      , rf'   2+      ) +    goR StencilRunit7 rf ix =+      let z :. i = ix+          rf' d  = rf (z :. i+d)+      in+      ( rf' (-3)+      , rf' (-2)+      , rf' (-1)+      , rf'   0+      , rf'   1+      , rf'   2+      , rf'   3+      )++    goR StencilRunit9 rf ix =+      let z :. i = ix+          rf' d  = rf (z :. i+d)+      in+      ( rf' (-4)+      , rf' (-3)+      , rf' (-2)+      , rf' (-1)+      , rf'   0+      , rf'   1+      , rf'   2+      , rf'   3+      , rf'   4+      )++    -- Recursive cases. Note that because the stencil pattern is defined with+    -- cons ordering, whereas shapes (and indices) are defined as a snoc-list,+    -- when we recurse on the stencil structure we must manipulate the+    -- _left-most_ index component.+    --+    goR (StencilRtup3 s1 s2 s3) rf ix =+      let (i, ix') = uncons ix+          rf' d ds = rf (cons (i+d) ds)+      in+      ( goR s1 (rf' (-1)) ix'+      , goR s2 (rf'   0)  ix'+      , goR s3 (rf'   1)  ix'+      )++    goR (StencilRtup5 s1 s2 s3 s4 s5) rf ix =+      let (i, ix') = uncons ix+          rf' d ds = rf (cons (i+d) ds)+      in+      ( goR s1 (rf' (-2)) ix'+      , goR s2 (rf' (-1)) ix'+      , goR s3 (rf'   0)  ix'+      , goR s4 (rf'   1)  ix'+      , goR s5 (rf'   2)  ix'+      )++    goR (StencilRtup7 s1 s2 s3 s4 s5 s6 s7) rf ix =+      let (i, ix') = uncons ix+          rf' d ds = rf (cons (i+d) ds)+      in+      ( goR s1 (rf' (-3)) ix'+      , goR s2 (rf' (-2)) ix'+      , goR s3 (rf' (-1)) ix'+      , goR s4 (rf'   0)  ix'+      , goR s5 (rf'   1)  ix'+      , goR s6 (rf'   2)  ix'+      , goR s7 (rf'   3)  ix'+      )++    goR (StencilRtup9 s1 s2 s3 s4 s5 s6 s7 s8 s9) rf ix =+      let (i, ix') = uncons ix+          rf' d ds = rf (cons (i+d) ds)+      in+      ( goR s1 (rf' (-4)) ix'+      , goR s2 (rf' (-3)) ix'+      , goR s3 (rf' (-2)) ix'+      , goR s4 (rf' (-1)) ix'+      , goR s5 (rf'   0)  ix'+      , goR s6 (rf'   1)  ix'+      , goR s7 (rf'   2)  ix'+      , goR s8 (rf'   3)  ix'+      , goR s9 (rf'   4)  ix'+      )++    -- Add a left-most component to an index+    --+    cons :: forall sh. Shape sh => Int -> sh -> (sh :. Int)+    cons ix extent = toElt $ go (eltType (undefined::sh)) (fromElt extent)+      where+        go :: TupleType t -> t -> (t, Int)+        go UnitTuple         ()       = ((), ix)+        go (PairTuple th tz) (sh, sz)+          | SingleTuple t <- tz+          , Just Refl     <- matchScalarType t (scalarType :: ScalarType Int)+          = (go th sh, sz)+        go _ _+          = $internalError "cons" "expected index with Int components"++    -- Remove the left-most index of an index, and return the remainder+    --+    uncons :: forall sh. Shape sh => sh :. Int -> (Int, sh)+    uncons extent = let (i,ix) = go (eltType (undefined::(sh:.Int))) (fromElt extent)+                    in  (i, toElt ix)+      where+        go :: TupleType (t, Int) -> (t, Int) -> (Int, t)+        go (PairTuple UnitTuple _)           ((), v) = (v, ())+        go (PairTuple t1@(PairTuple _ t2) _) (v1,v3)+          | SingleTuple t <- t2+          , Just Refl     <- matchScalarType t (scalarType :: ScalarType Int)+          = let (i, v1') = go t1 v1+            in  (i, (v1', v3))+        go _ _+          = $internalError "uncons" "expected index with Int components"+++bounded+    :: (Shape sh, Elt e)+    => Boundary (Array sh e)+    -> Array sh e+    -> sh+    -> e+bounded bnd arr ix =+  if inside (shape arr) ix+    then arr ! ix+    else+      case bnd of+        Function f -> f ix+        Constant v -> toElt v+        _          -> arr ! bound (shape arr) ix++  where+    -- Whether the index (second argument) is inside the bounds of the given+    -- shape (first argument).+    --+    inside :: forall sh. Shape sh => sh -> sh -> Bool+    inside sh1 ix1 = go (eltType (undefined::sh)) (fromElt sh1) (fromElt ix1)+      where+        go :: TupleType t -> t -> t -> Bool+        go UnitTuple          ()       ()      = True+        go (PairTuple tsh ti) (sh, sz) (ih,iz)+          = if go ti sz iz+              then go tsh sh ih+              else False+        go (SingleTuple t) sz iz+          | Just Refl <- matchScalarType t (scalarType :: ScalarType Int)+          = if iz < 0 || iz >= sz+              then False+              else True+          --+          | otherwise+          = $internalError "inside" "expected index with Int components"++    -- Return the index (second argument), updated to obey the given boundary+    -- conditions when outside the bounds of the given shape (first argument)+    --+    bound :: forall sh. Shape sh => sh -> sh -> sh+    bound sh1 ix1 = toElt $ go (eltType (undefined::sh)) (fromElt sh1) (fromElt ix1)+      where+        go :: TupleType t -> t -> t -> t+        go UnitTuple          ()       ()       = ()+        go (PairTuple tsh ti) (sh, sz) (ih, iz) = (go tsh sh ih, go ti sz iz)+        go (SingleTuple t)    sz       iz+          | Just Refl <- matchScalarType t (scalarType :: ScalarType Int)+          = let i | iz < 0    = case bnd of+                                  Clamp  -> 0+                                  Mirror -> -iz+                                  Wrap   -> sz + iz+                                  _      -> $internalError "bound" "unexpected boundary condition"+                  | iz >= sz  = case bnd of+                                  Clamp  -> sz - 1+                                  Mirror -> sz - (iz - sz + 2)+                                  Wrap   -> iz - sz+                                  _      -> $internalError "bound" "unexpected boundary condition"+                  | otherwise = iz+            in i+          | otherwise+          = $internalError "bound" "expected index with Int components"++ -- toSeqOp :: forall slix sl dim co e proxy. (Elt slix, Shape sl, Shape dim, Elt e) --         => SliceIndex (EltRepr slix) --                       (EltRepr sl)@@ -678,6 +887,28 @@ -- toSeqOp sliceIndex _ arr = map (sliceOp sliceIndex arr :: slix -> Array sl e) --                                (enumSlices sliceIndex (shape arr)) ++-- Stencil boundary conditions+-- ---------------------------++data Boundary t where+  Clamp    :: Boundary t+  Mirror   :: Boundary t+  Wrap     :: Boundary t+  Constant :: Elt t => EltRepr t -> Boundary (Array sh t)+  Function :: (Shape sh, Elt e) => (sh -> e) -> Boundary (Array sh e)+++evalPreBoundary :: EvalAcc acc -> AST.PreBoundary acc aenv t -> Val aenv -> Boundary t+evalPreBoundary evalAcc bnd aenv =+  case bnd of+    AST.Clamp      -> Clamp+    AST.Mirror     -> Mirror+    AST.Wrap       -> Wrap+    AST.Constant v -> Constant v+    AST.Function f -> Function (evalPreFun evalAcc f aenv)++ -- Scalar expression evaluation -- ---------------------------- @@ -845,6 +1076,7 @@ evalPrim (PrimCeiling         ta tb) = evalCeiling ta tb evalPrim (PrimAtan2              ty) = evalAtan2 ty evalPrim (PrimIsNaN              ty) = evalIsNaN ty+evalPrim (PrimIsInfinite         ty) = evalIsInfinite ty evalPrim (PrimLt                 ty) = evalLt ty evalPrim (PrimGt                 ty) = evalGt ty evalPrim (PrimLtEq               ty) = evalLtEq ty@@ -1034,6 +1266,9 @@  evalIsNaN :: FloatingType a -> (a -> Bool) evalIsNaN ty | FloatingDict <- floatingDict ty = isNaN++evalIsInfinite :: FloatingType a -> (a -> Bool)+evalIsInfinite ty | FloatingDict <- floatingDict ty = isInfinite   -- Methods of Num
Data/Array/Accelerate/Language.hs view
@@ -68,8 +68,10 @@   stencil, stencil2,    -- ** Stencil specification-  Boundary(..), Stencil,+  Boundary, Stencil,+  clamp, mirror, wrap, function, +   -- ** Common stencil types   Stencil3, Stencil5, Stencil7, Stencil9,   Stencil3x3, Stencil5x3, Stencil3x5, Stencil5x5,@@ -106,14 +108,19 @@ ) where  -- friends-import Data.Array.Accelerate.Array.Sugar                hiding ((!), ignore, shape, size, toIndex, fromIndex, intersect, union)-import Data.Array.Accelerate.Classes+import Data.Array.Accelerate.Array.Sugar                            hiding ( (!), ignore, shape, size, toIndex, fromIndex, intersect, union ) import Data.Array.Accelerate.Smart import Data.Array.Accelerate.Type-import qualified Data.Array.Accelerate.Array.Sugar      as Sugar+import qualified Data.Array.Accelerate.Array.Sugar                  as Sugar +import Data.Array.Accelerate.Classes.Eq+import Data.Array.Accelerate.Classes.Fractional+import Data.Array.Accelerate.Classes.Integral+import Data.Array.Accelerate.Classes.Num+import Data.Array.Accelerate.Classes.Ord+ -- standard libraries-import Prelude                                          ( ($), (.) )+import Prelude                                                      ( ($), (.) )   -- Array introduction@@ -279,7 +286,7 @@ -- -- > precondition: shapeSize sh == shapeSize sh' ----- If the argument array is manifest in memory, 'reshape' is a NOP. If the+-- If the argument array is manifest in memory, 'reshape' is a no-op. If the -- argument is to be fused into a subsequent operation, 'reshape' corresponds to -- an index transformation in the fused code. --@@ -293,9 +300,9 @@ -- Extraction of sub-arrays -- ------------------------ --- | Index an array with a /generalised/ array index, supplied as the--- second argument. The result is a new array (possibly a singleton)--- containing the selected dimensions (`All`s) in their entirety.+-- | Index an array with a /generalised/ array index, supplied as the second+-- argument. The result is a new array (possibly a singleton) containing the+-- selected dimensions ('All's) in their entirety. -- -- 'slice' is the opposite of 'replicate', and can be used to /cut out/ entire -- dimensions. For example, for the two dimensional array 'mat':@@ -362,10 +369,17 @@ -- Map-like functions -- ------------------ --- | Apply the given function element-wise to an array.+-- | Apply the given function element-wise to an array. Denotationally we have: -- -- > map f [x1, x2, ... xn] = [f x1, f x2, ... f xn] --+-- >>> let xs = fromList (Z:.10) [0..]+-- >>> xs+-- Vector (Z :. 10) [0,1,2,3,4,5,6,7,8,9]+--+-- >>> map (+1) (use xs)+-- Vector (Z :. 10) [1,2,3,4,5,6,7,8,9,10]+-- map :: (Shape sh, Elt a, Elt b)     => (Exp a -> Exp b)     -> Acc (Array sh a)@@ -376,6 +390,28 @@ -- of the resulting array is the intersection of the extents of the two source -- arrays. --+-- >>> let xs = fromList (Z:.3:.5) [0..]+-- >>> xs+-- Matrix (Z :. 3 :. 5)+--   [ 0, 1, 2, 3, 4,+--     5, 6, 7, 8, 9,+--    10,11,12,13,14]+--+-- >>> let ys = fromList (Z:.5:.10) [1..]+-- >>> ys+-- Matrix (Z :. 5 :. 10)+--   [ 1, 2, 3, 4, 5, 6, 7, 8, 9,10,+--    11,12,13,14,15,16,17,18,19,20,+--    21,22,23,24,25,26,27,28,29,30,+--    31,32,33,34,35,36,37,38,39,40,+--    41,42,43,44,45,46,47,48,49,50]+--+-- >>> zipWith (+) (use xs) (use ys)+-- Matrix (Z :. 3 :. 5)+--   [ 1, 3, 5, 7, 9,+--    16,18,20,22,24,+--    31,33,35,37,39]+-- zipWith :: (Shape sh, Elt a, Elt b, Elt c)         => (Exp a -> Exp b -> Exp c)         -> Acc (Array sh a)@@ -558,8 +594,8 @@        => (Exp a -> Exp a -> Exp a)        -> Exp a        -> Acc (Array (sh:.Int) a)-       -> (Acc (Array (sh:.Int) a), Acc (Array sh a))-scanl' = unatup2 . Acc $$$ Scanl'+       -> Acc (Array (sh:.Int) a, Array sh a)+scanl' = Acc $$$ Scanl'  -- | Data.List style left-to-right scan along the innermost dimension without an -- initial value (aka inclusive scan). The array must not be empty. The first@@ -567,7 +603,8 @@ -- -- > scanl1 f e arr = tail (scanl f e arr) ----- >>> scanl (+) (use $ fromList (Z:.4:.10) [0..])+-- >>> let mat = fromList (Z:.4:.10) [0..]+-- >>> scanl (+) (use mat) -- Matrix (Z :. 4 :. 10) --   [  0,  1,  3,   6,  10,  15,  21,  28,  36,  45, --     10, 21, 33,  46,  60,  75,  91, 108, 126, 145,@@ -595,8 +632,8 @@        => (Exp a -> Exp a -> Exp a)        -> Exp a        -> Acc (Array (sh:.Int) a)-       -> (Acc (Array (sh:.Int) a), Acc (Array sh a))-scanr' = unatup2 . Acc $$$ Scanr'+       -> Acc (Array (sh:.Int) a, Array sh a)+scanr' = Acc $$$ Scanr'  -- | Right-to-left variant of 'scanl1'. --@@ -620,6 +657,9 @@ -- that are mapped to the magic value 'ignore' by the permutation function are -- dropped. --+-- The combination function is given the new value being permuted as its first+-- argument, and the current value of the array as its second.+-- -- For example, we can use 'permute' to compute the occurrence count (histogram) -- for an array of values in the range @[0,10)@: --@@ -634,6 +674,25 @@ -- >>> histogram (use xs) -- Vector (Z :. 10) [2,4,4,3,2,2,0,0,2,1] --+-- As a second example, note that the dimensionality of the source and+-- destination arrays can differ. In this way, we can use 'permute' to create an+-- identity matrix by overwriting elements along the diagonal:+--+-- > identity :: Num a => Exp Int -> Acc (Array DIM2 a)+-- > identity n =+-- >   let zeros = fill (index2 n n) 0+-- >       ones  = fill (index1 n)   1+-- >   in+-- >   permute const zeros (\(unindex1 -> i) -> index2 i i) ones+--+-- >>> identity 5+-- Matrix (Z :. 5 :. 5)+--   [1,0,0,0,0,+--    0,1,0,0,0,+--    0,0,1,0,0,+--    0,0,0,1,0,+--    0,0,0,0,1]+-- -- [/Note:/] -- -- Regarding array fusion:@@ -647,6 +706,9 @@ -- --   3. The array of source values can fuse into the permutation operation. --+--   4. If the array of default values is only used once, it will be updated+--      in-place.+-- permute     :: (Shape sh, Shape sh', Elt a)     => (Exp a -> Exp a -> Exp a)        -- ^ combination function@@ -756,8 +818,8 @@ -- -- > s33 :: Stencil3x3 a -> Exp a -- > s33 ((_,t,_)---       ,(l,c,r)---       ,(_,b,_)) = ...+-- >     ,(l,c,r)+-- >     ,(_,b,_)) = ... -- -- ...where @c@ is again the focal point and @t@, @b@, @l@ and @r@ are the -- elements to the top, bottom, left, and right of the focal point, respectively@@ -781,16 +843,16 @@ -- > gaussian = [0.06136,0.24477,0.38774,0.24477,0.06136] -- > -- > blur :: Num a => Acc (Array DIM2 a) -> Acc (Array DIM2 a)--- > blur = stencil (convolve5x1 gaussian) Clamp--- >      . stencil (convolve1x5 gaussian) Clamp+-- > blur = stencil (convolve5x1 gaussian) clamp+-- >      . stencil (convolve1x5 gaussian) clamp -- stencil     :: (Stencil sh a stencil, Elt b)     => (stencil -> Exp b)                     -- ^ stencil function-    -> Boundary a                             -- ^ boundary condition+    -> Boundary (Array sh a)                  -- ^ boundary condition     -> Acc (Array sh a)                       -- ^ source array     -> Acc (Array sh b)                       -- ^ destination array-stencil = Acc $$$ Stencil+stencil f (Boundary b) a = Acc $ Stencil f b a  -- | Map a binary stencil of an array. The extent of the resulting array is the -- intersection of the extents of the two source arrays. This is the stencil@@ -799,14 +861,70 @@ stencil2     :: (Stencil sh a stencil1, Stencil sh b stencil2, Elt c)     => (stencil1 -> stencil2 -> Exp c)        -- ^ binary stencil function-    -> Boundary a                             -- ^ boundary condition #1+    -> Boundary (Array sh a)                  -- ^ boundary condition #1     -> Acc (Array sh a)                       -- ^ source array #1-    -> Boundary b                             -- ^ boundary condition #2+    -> Boundary (Array sh b)                  -- ^ boundary condition #2     -> Acc (Array sh b)                       -- ^ source array #2     -> Acc (Array sh c)                       -- ^ destination array-stencil2 = Acc $$$$$ Stencil2+stencil2 f (Boundary b1) a1 (Boundary b2) a2 = Acc $ Stencil2 f b1 a1 b2 a2 +-- | Boundary condition where elements of the stencil which would be+-- out-of-bounds are instead clamped to the edges of the array.+--+-- In the following 3x3 stencil, the out-of-bounds element @b@ will instead+-- return the value at position @c@:+--+-- >   +------------++-- >   |a           |+-- >  b|cd          |+-- >   |e           |+-- >   +------------++--+clamp :: Boundary (Array sh e)+clamp = Boundary Clamp +-- | Stencil boundary condition where coordinates beyond the array extent are+-- instead mirrored+--+-- In the following 5x3 stencil, the out-of-bounds element @c@ will instead+-- return the value at position @d@, and similarly the element at @b@ will+-- return the value at @e@:+--+-- >   +------------++-- >   |a           |+-- > bc|def         |+-- >   |g           |+-- >   +------------++--+mirror :: Boundary (Array sh e)+mirror = Boundary Mirror++-- | Stencil boundary condition where coordinates beyond the array extent+-- instead wrap around the array.+--+-- In the following 3x3 stencil, the out of bounds elements will be read as in+-- the pattern on the right.+--+-- >  a bc+-- >   +------------+      +------------++-- >  d|ef          |      |ef         d|+-- >  g|hi          |  ->  |hi         g|+-- >   |            |      |bc         a|+-- >   +------------+      +------------++--+wrap :: Boundary (Array sh e)+wrap = Boundary Wrap++-- | Stencil boundary condition where the given function is applied to any+-- outlying coordinates.+--+function+    :: (Shape sh, Elt e)+    => (Exp sh -> Exp e)+    -> Boundary (Array sh e)+function = Boundary . Function++ {-- -- Sequence operations -- ------------------@@ -923,7 +1041,7 @@ -- In case the operation is being executed on a backend which does not support -- this foreign implementation, the fallback implementation is used instead, -- which itself could be a foreign implementation for a (presumably) different--- backend, or an implementation of pure Accelerate. In this way, multiple+-- backend, or an implementation in pure Accelerate. In this way, multiple -- foreign implementations can be supplied, and will be tested for suitability -- against the target backend in sequence. --@@ -968,6 +1086,9 @@ -- > (acc1 >-> acc2) arrs = let tmp = acc1 arrs -- >                        in  tmp `seq` acc2 tmp --+-- For an example use of this operation see the 'Data.Array.Accelerate.compute'+-- function.+-- infixl 1 >-> (>->) :: (Arrays a, Arrays b, Arrays c) => (Acc a -> Acc b) -> (Acc b -> Acc c) -> (Acc a -> Acc c) (>->) = Acc $$$ Pipe@@ -978,6 +1099,9 @@  -- | An array-level if-then-else construct. --+-- Enabling the @RebindableSyntax@ extension will allow you to use the standard+-- if-then-else syntax instead.+-- acond :: Arrays a       => Exp Bool               -- ^ if-condition       -> Acc a                  -- ^ then-array@@ -1000,8 +1124,16 @@ -- Shapes and indices -- ------------------ --- | Get the innermost dimension of a shape+-- | Get the innermost dimension of a shape. --+-- The innermost dimension (right-most component of the shape) is the index of+-- the array which varies most rapidly, and corresponds to elements of the array+-- which are adjacent in memory.+--+-- Another way to think of this is, for example when writing nested loops over+-- an array in C, this index corresponds to the index iterated over by the+-- innermost nested loop.+-- indexHead :: (Slice sh, Elt a) => Exp (sh :. a) -> Exp a indexHead = Exp . IndexHead @@ -1040,6 +1172,9 @@ -- ------------  -- | A scalar-level if-then-else construct.+--+-- Enabling the @RebindableSyntax@ extension will allow you to use the standard+-- if-then-else syntax instead. -- cond :: Elt t      => Exp Bool                -- ^ condition
Data/Array/Accelerate/Lifetime.hs view
@@ -61,6 +61,7 @@  -- | Construct a new 'Lifetime' from the given value. --+{-# INLINE newLifetime #-} newLifetime :: a -> IO (Lifetime a) newLifetime a = do   ref  <- newIORef []@@ -72,6 +73,7 @@ -- throughout its execution. It is important to not let the value /leak/ outside -- the function, either by returning it or by lazy IO. --+{-# INLINE withLifetime #-} withLifetime :: Lifetime a -> (a -> IO b) -> IO b withLifetime (Lifetime ref _ a) f = do   r <- f a@@ -81,6 +83,7 @@ -- | Ensure that the lifetime is alive at the given place in a sequence of IO -- actions. Does not force the payload. --+{-# INLINE touchLifetime #-} touchLifetime :: Lifetime a -> IO () touchLifetime (Lifetime ref _ _) = touchIORef ref @@ -138,6 +141,7 @@ -- 'Lifetime' is still reachable, the finalizers may fire, potentially -- invalidating the value. --+{-# INLINE unsafeGetValue #-} unsafeGetValue :: Lifetime a -> a unsafeGetValue (Lifetime _ _ a) = a @@ -151,6 +155,7 @@ -- Touch an 'IORef', ensuring that it is alive at this point in a sequence of IO -- actions. --+{-# INLINE touchIORef #-} touchIORef :: IORef a -> IO () touchIORef r = IO $ \s -> case touch# r s of s' -> (# s', () #)
Data/Array/Accelerate/Prelude.hs view
@@ -112,17 +112,21 @@ import Data.Typeable                                                ( gcast ) import GHC.Base                                                     ( Constraint ) import Prelude                                                      ( (.), ($), Maybe(..), const, id, fromInteger, flip, undefined, fail )-import qualified Prelude                                            as P  -- friends import Data.Array.Accelerate.Analysis.Match import Data.Array.Accelerate.Array.Sugar                            hiding ( (!), ignore, shape, size, intersect, toIndex, fromIndex )-import Data.Array.Accelerate.Classes import Data.Array.Accelerate.Language import Data.Array.Accelerate.Lift import Data.Array.Accelerate.Smart import Data.Array.Accelerate.Type +import Data.Array.Accelerate.Classes.Eq+import Data.Array.Accelerate.Classes.FromIntegral+import Data.Array.Accelerate.Classes.Integral+import Data.Array.Accelerate.Classes.Num+import Data.Array.Accelerate.Classes.Ord+ import Data.Array.Accelerate.Data.Bits  @@ -131,6 +135,17 @@  -- | Pair each element with its index --+-- >>> let xs = fromList (Z:.5) [0..]+-- >>> indexed (use xs)+-- Vector (Z :. 5) [(Z :. 0,0.0),(Z :. 1,1.0),(Z :. 2,2.0),(Z :. 3,3.0),(Z :. 4,4.0)]+--+-- >>> let mat = fromList (Z:.3:.4) [0..]+-- >>> indexed (use mat)+-- Matrix (Z :. 3 :. 4)+--   [(Z :. 0 :. 0,0.0),(Z :. 0 :. 1,1.0), (Z :. 0 :. 2,2.0), (Z :. 0 :. 3,3.0),+--    (Z :. 1 :. 0,4.0),(Z :. 1 :. 1,5.0), (Z :. 1 :. 2,6.0), (Z :. 1 :. 3,7.0),+--    (Z :. 2 :. 0,8.0),(Z :. 2 :. 1,9.0),(Z :. 2 :. 2,10.0),(Z :. 2 :. 3,11.0)]+-- indexed :: (Shape sh, Elt a) => Acc (Array sh a) -> Acc (Array sh (sh, a)) indexed xs = zip (generate (shape xs) id) xs @@ -145,25 +160,27 @@  -- | Zip three arrays with the given function, analogous to 'zipWith'. ---zipWith3 :: (Shape sh, Elt a, Elt b, Elt c, Elt d)-         => (Exp a -> Exp b -> Exp c -> Exp d)-         -> Acc (Array sh a)-         -> Acc (Array sh b)-         -> Acc (Array sh c)-         -> Acc (Array sh d)+zipWith3+    :: (Shape sh, Elt a, Elt b, Elt c, Elt d)+    => (Exp a -> Exp b -> Exp c -> Exp d)+    -> Acc (Array sh a)+    -> Acc (Array sh b)+    -> Acc (Array sh c)+    -> Acc (Array sh d) zipWith3 f as bs cs   = generate (shape as `intersect` shape bs `intersect` shape cs)              (\ix -> f (as ! ix) (bs ! ix) (cs ! ix))  -- | Zip four arrays with the given function, analogous to 'zipWith'. ---zipWith4 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e)-         => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e)-         -> Acc (Array sh a)-         -> Acc (Array sh b)-         -> Acc (Array sh c)-         -> Acc (Array sh d)-         -> Acc (Array sh e)+zipWith4+    :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e)+    => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e)+    -> Acc (Array sh a)+    -> Acc (Array sh b)+    -> Acc (Array sh c)+    -> Acc (Array sh d)+    -> Acc (Array sh e) zipWith4 f as bs cs ds   = generate (shape as `intersect` shape bs `intersect`               shape cs `intersect` shape ds)@@ -171,14 +188,15 @@  -- | Zip five arrays with the given function, analogous to 'zipWith'. ---zipWith5 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f)-         => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f)-         -> Acc (Array sh a)-         -> Acc (Array sh b)-         -> Acc (Array sh c)-         -> Acc (Array sh d)-         -> Acc (Array sh e)-         -> Acc (Array sh f)+zipWith5+    :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f)+    => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f)+    -> Acc (Array sh a)+    -> Acc (Array sh b)+    -> Acc (Array sh c)+    -> Acc (Array sh d)+    -> Acc (Array sh e)+    -> Acc (Array sh f) zipWith5 f as bs cs ds es   = generate (shape as `intersect` shape bs `intersect` shape cs                        `intersect` shape ds `intersect` shape es)@@ -186,15 +204,16 @@  -- | Zip six arrays with the given function, analogous to 'zipWith'. ---zipWith6 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g)-         => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f -> Exp g)-         -> Acc (Array sh a)-         -> Acc (Array sh b)-         -> Acc (Array sh c)-         -> Acc (Array sh d)-         -> Acc (Array sh e)-         -> Acc (Array sh f)-         -> Acc (Array sh g)+zipWith6+    :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g)+    => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f -> Exp g)+    -> Acc (Array sh a)+    -> Acc (Array sh b)+    -> Acc (Array sh c)+    -> Acc (Array sh d)+    -> Acc (Array sh e)+    -> Acc (Array sh f)+    -> Acc (Array sh g) zipWith6 f as bs cs ds es fs   = generate (shape as `intersect` shape bs `intersect` shape cs                        `intersect` shape ds `intersect` shape es@@ -203,16 +222,17 @@  -- | Zip seven arrays with the given function, analogous to 'zipWith'. ---zipWith7 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h)-         => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f -> Exp g -> Exp h)-         -> Acc (Array sh a)-         -> Acc (Array sh b)-         -> Acc (Array sh c)-         -> Acc (Array sh d)-         -> Acc (Array sh e)-         -> Acc (Array sh f)-         -> Acc (Array sh g)-         -> Acc (Array sh h)+zipWith7+    :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h)+    => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f -> Exp g -> Exp h)+    -> Acc (Array sh a)+    -> Acc (Array sh b)+    -> Acc (Array sh c)+    -> Acc (Array sh d)+    -> Acc (Array sh e)+    -> Acc (Array sh f)+    -> Acc (Array sh g)+    -> Acc (Array sh h) zipWith7 f as bs cs ds es fs gs   = generate (shape as `intersect` shape bs `intersect` shape cs                        `intersect` shape ds `intersect` shape es@@ -221,17 +241,18 @@  -- | Zip eight arrays with the given function, analogous to 'zipWith'. ---zipWith8 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i)-         => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f -> Exp g -> Exp h -> Exp i)-         -> Acc (Array sh a)-         -> Acc (Array sh b)-         -> Acc (Array sh c)-         -> Acc (Array sh d)-         -> Acc (Array sh e)-         -> Acc (Array sh f)-         -> Acc (Array sh g)-         -> Acc (Array sh h)-         -> Acc (Array sh i)+zipWith8+    :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i)+    => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f -> Exp g -> Exp h -> Exp i)+    -> Acc (Array sh a)+    -> Acc (Array sh b)+    -> Acc (Array sh c)+    -> Acc (Array sh d)+    -> Acc (Array sh e)+    -> Acc (Array sh f)+    -> Acc (Array sh g)+    -> Acc (Array sh h)+    -> Acc (Array sh i) zipWith8 f as bs cs ds es fs gs hs   = generate (shape as `intersect` shape bs `intersect` shape cs                        `intersect` shape ds `intersect` shape es@@ -241,18 +262,19 @@  -- | Zip nine arrays with the given function, analogous to 'zipWith'. ---zipWith9 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j)-         => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f -> Exp g -> Exp h -> Exp i -> Exp j)-         -> Acc (Array sh a)-         -> Acc (Array sh b)-         -> Acc (Array sh c)-         -> Acc (Array sh d)-         -> Acc (Array sh e)-         -> Acc (Array sh f)-         -> Acc (Array sh g)-         -> Acc (Array sh h)-         -> Acc (Array sh i)-         -> Acc (Array sh j)+zipWith9+    :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j)+    => (Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f -> Exp g -> Exp h -> Exp i -> Exp j)+    -> Acc (Array sh a)+    -> Acc (Array sh b)+    -> Acc (Array sh c)+    -> Acc (Array sh d)+    -> Acc (Array sh e)+    -> Acc (Array sh f)+    -> Acc (Array sh g)+    -> Acc (Array sh h)+    -> Acc (Array sh i)+    -> Acc (Array sh j) zipWith9 f as bs cs ds es fs gs hs is   = generate (shape as `intersect` shape bs `intersect` shape cs                        `intersect` shape ds `intersect` shape es@@ -263,11 +285,12 @@  -- | Zip two arrays with a function that also takes the element index ---izipWith :: (Shape sh, Elt a, Elt b, Elt c)-         => (Exp sh -> Exp a -> Exp b -> Exp c)-         -> Acc (Array sh a)-         -> Acc (Array sh b)-         -> Acc (Array sh c)+izipWith+    :: (Shape sh, Elt a, Elt b, Elt c)+    => (Exp sh -> Exp a -> Exp b -> Exp c)+    -> Acc (Array sh a)+    -> Acc (Array sh b)+    -> Acc (Array sh c) izipWith f as bs   = generate (shape as `intersect` shape bs)              (\ix -> f ix (as ! ix) (bs ! ix))@@ -275,12 +298,13 @@ -- | Zip three arrays with a function that also takes the element index, -- analogous to 'izipWith'. ---izipWith3 :: (Shape sh, Elt a, Elt b, Elt c, Elt d)-          => (Exp sh -> Exp a -> Exp b -> Exp c -> Exp d)-          -> Acc (Array sh a)-          -> Acc (Array sh b)-          -> Acc (Array sh c)-          -> Acc (Array sh d)+izipWith3+    :: (Shape sh, Elt a, Elt b, Elt c, Elt d)+    => (Exp sh -> Exp a -> Exp b -> Exp c -> Exp d)+    -> Acc (Array sh a)+    -> Acc (Array sh b)+    -> Acc (Array sh c)+    -> Acc (Array sh d) izipWith3 f as bs cs   = generate (shape as `intersect` shape bs `intersect` shape cs)              (\ix -> f ix (as ! ix) (bs ! ix) (cs ! ix))@@ -288,13 +312,14 @@ -- | Zip four arrays with the given function that also takes the element index, -- analogous to 'zipWith'. ---izipWith4 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e)-          => (Exp sh -> Exp a -> Exp b -> Exp c -> Exp d -> Exp e)-          -> Acc (Array sh a)-          -> Acc (Array sh b)-          -> Acc (Array sh c)-          -> Acc (Array sh d)-          -> Acc (Array sh e)+izipWith4+    :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e)+    => (Exp sh -> Exp a -> Exp b -> Exp c -> Exp d -> Exp e)+    -> Acc (Array sh a)+    -> Acc (Array sh b)+    -> Acc (Array sh c)+    -> Acc (Array sh d)+    -> Acc (Array sh e) izipWith4 f as bs cs ds   = generate (shape as `intersect` shape bs `intersect`               shape cs `intersect` shape ds)@@ -303,14 +328,15 @@ -- | Zip five arrays with the given function that also takes the element index, -- analogous to 'zipWith'. ---izipWith5 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f)-          => (Exp sh -> Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f)-          -> Acc (Array sh a)-          -> Acc (Array sh b)-          -> Acc (Array sh c)-          -> Acc (Array sh d)-          -> Acc (Array sh e)-          -> Acc (Array sh f)+izipWith5+    :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f)+    => (Exp sh -> Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f)+    -> Acc (Array sh a)+    -> Acc (Array sh b)+    -> Acc (Array sh c)+    -> Acc (Array sh d)+    -> Acc (Array sh e)+    -> Acc (Array sh f) izipWith5 f as bs cs ds es   = generate (shape as `intersect` shape bs `intersect` shape cs                        `intersect` shape ds `intersect` shape es)@@ -319,15 +345,16 @@ -- | Zip six arrays with the given function that also takes the element index, -- analogous to 'zipWith'. ---izipWith6 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g)-          => (Exp sh -> Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f -> Exp g)-          -> Acc (Array sh a)-          -> Acc (Array sh b)-          -> Acc (Array sh c)-          -> Acc (Array sh d)-          -> Acc (Array sh e)-          -> Acc (Array sh f)-          -> Acc (Array sh g)+izipWith6+    :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g)+    => (Exp sh -> Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f -> Exp g)+    -> Acc (Array sh a)+    -> Acc (Array sh b)+    -> Acc (Array sh c)+    -> Acc (Array sh d)+    -> Acc (Array sh e)+    -> Acc (Array sh f)+    -> Acc (Array sh g) izipWith6 f as bs cs ds es fs   = generate (shape as `intersect` shape bs `intersect` shape cs                        `intersect` shape ds `intersect` shape es@@ -337,16 +364,17 @@ -- | Zip seven arrays with the given function that also takes the element -- index, analogous to 'zipWith'. ---izipWith7 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h)-          => (Exp sh -> Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f -> Exp g -> Exp h)-          -> Acc (Array sh a)-          -> Acc (Array sh b)-          -> Acc (Array sh c)-          -> Acc (Array sh d)-          -> Acc (Array sh e)-          -> Acc (Array sh f)-          -> Acc (Array sh g)-          -> Acc (Array sh h)+izipWith7+    :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h)+    => (Exp sh -> Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f -> Exp g -> Exp h)+    -> Acc (Array sh a)+    -> Acc (Array sh b)+    -> Acc (Array sh c)+    -> Acc (Array sh d)+    -> Acc (Array sh e)+    -> Acc (Array sh f)+    -> Acc (Array sh g)+    -> Acc (Array sh h) izipWith7 f as bs cs ds es fs gs   = generate (shape as `intersect` shape bs `intersect` shape cs                        `intersect` shape ds `intersect` shape es@@ -356,17 +384,18 @@ -- | Zip eight arrays with the given function that also takes the element -- index, analogous to 'zipWith'. ---izipWith8 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i)-          => (Exp sh -> Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f -> Exp g -> Exp h -> Exp i)-          -> Acc (Array sh a)-          -> Acc (Array sh b)-          -> Acc (Array sh c)-          -> Acc (Array sh d)-          -> Acc (Array sh e)-          -> Acc (Array sh f)-          -> Acc (Array sh g)-          -> Acc (Array sh h)-          -> Acc (Array sh i)+izipWith8+    :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i)+    => (Exp sh -> Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f -> Exp g -> Exp h -> Exp i)+    -> Acc (Array sh a)+    -> Acc (Array sh b)+    -> Acc (Array sh c)+    -> Acc (Array sh d)+    -> Acc (Array sh e)+    -> Acc (Array sh f)+    -> Acc (Array sh g)+    -> Acc (Array sh h)+    -> Acc (Array sh i) izipWith8 f as bs cs ds es fs gs hs   = generate (shape as `intersect` shape bs `intersect` shape cs                        `intersect` shape ds `intersect` shape es@@ -377,18 +406,19 @@ -- | Zip nine arrays with the given function that also takes the element index, -- analogous to 'zipWith'. ---izipWith9 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j)-          => (Exp sh -> Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f -> Exp g -> Exp h -> Exp i -> Exp j)-          -> Acc (Array sh a)-          -> Acc (Array sh b)-          -> Acc (Array sh c)-          -> Acc (Array sh d)-          -> Acc (Array sh e)-          -> Acc (Array sh f)-          -> Acc (Array sh g)-          -> Acc (Array sh h)-          -> Acc (Array sh i)-          -> Acc (Array sh j)+izipWith9+    :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j)+    => (Exp sh -> Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp f -> Exp g -> Exp h -> Exp i -> Exp j)+    -> Acc (Array sh a)+    -> Acc (Array sh b)+    -> Acc (Array sh c)+    -> Acc (Array sh d)+    -> Acc (Array sh e)+    -> Acc (Array sh f)+    -> Acc (Array sh g)+    -> Acc (Array sh h)+    -> Acc (Array sh i)+    -> Acc (Array sh j) izipWith9 f as bs cs ds es fs gs hs is   = generate (shape as `intersect` shape bs `intersect` shape cs                        `intersect` shape ds `intersect` shape es@@ -494,14 +524,14 @@ -- | The converse of 'zip', but the shape of the two results is identical to the -- shape of the argument. ----- If the argument array is manifest in memory, 'unzip' is a NOP.+-- If the argument array is manifest in memory, 'unzip' is a no-op. -- unzip :: (Shape sh, Elt a, Elt b)       => Acc (Array sh (a, b))       -> (Acc (Array sh a), Acc (Array sh b)) unzip arr = (map fst arr, map snd arr) --- | Take an array of triples and return three arrays, analogous to unzip.+-- | Take an array of triples and return three arrays, analogous to 'unzip'. -- unzip3 :: (Shape sh, Elt a, Elt b, Elt c)        => Acc (Array sh (a, b, c))@@ -513,7 +543,7 @@     get3 x = let (_,_,c) = untup3 x in c  --- | Take an array of quadruples and return four arrays, analogous to unzip.+-- | Take an array of quadruples and return four arrays, analogous to 'unzip'. -- unzip4 :: (Shape sh, Elt a, Elt b, Elt c, Elt d)        => Acc (Array sh (a, b, c, d))@@ -525,7 +555,7 @@     get3 x = let (_,_,c,_) = untup4 x in c     get4 x = let (_,_,_,d) = untup4 x in d --- | Take an array of 5-tuples and return five arrays, analogous to unzip.+-- | Take an array of 5-tuples and return five arrays, analogous to 'unzip'. -- unzip5 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e)        => Acc (Array sh (a, b, c, d, e))@@ -538,7 +568,7 @@     get4 x = let (_,_,_,d,_) = untup5 x in d     get5 x = let (_,_,_,_,e) = untup5 x in e --- | Take an array of 6-tuples and return six arrays, analogous to unzip.+-- | Take an array of 6-tuples and return six arrays, analogous to 'unzip'. -- unzip6 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f)        => Acc (Array sh (a, b, c, d, e, f))@@ -553,7 +583,7 @@     get5 x = let (_,_,_,_,e,_) = untup6 x in e     get6 x = let (_,_,_,_,_,f) = untup6 x in f --- | Take an array of 7-tuples and return seven arrays, analogous to unzip.+-- | Take an array of 7-tuples and return seven arrays, analogous to 'unzip'. -- unzip7 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g)        => Acc (Array sh (a, b, c, d, e, f, g))@@ -572,7 +602,7 @@     get6 x = let (_,_,_,_,_,f,_) = untup7 x in f     get7 x = let (_,_,_,_,_,_,g) = untup7 x in g --- | Take an array of 8-tuples and return eight arrays, analogous to unzip.+-- | Take an array of 8-tuples and return eight arrays, analogous to 'unzip'. -- unzip8 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h)        => Acc (Array sh (a, b, c, d, e, f, g, h))@@ -592,7 +622,7 @@     get7 x = let (_,_,_,_,_,_,g,_) = untup8 x in g     get8 x = let (_,_,_,_,_,_,_,h) = untup8 x in h --- | Take an array of 8-tuples and return eight arrays, analogous to unzip.+-- | Take an array of 8-tuples and return eight arrays, analogous to 'unzip'. -- unzip9 :: (Shape sh, Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i)        => Acc (Array sh (a, b, c, d, e, f, g, h, i))@@ -629,21 +659,23 @@ -- >>> foldAll (+) 0 (use mat) -- Scalar Z [1225] ---foldAll :: (Shape sh, Elt a)-        => (Exp a -> Exp a -> Exp a)-        -> Exp a-        -> Acc (Array sh a)-        -> Acc (Scalar a)+foldAll+    :: (Shape sh, Elt a)+    => (Exp a -> Exp a -> Exp a)+    -> Exp a+    -> Acc (Array sh a)+    -> Acc (Scalar a) foldAll f e arr = fold f e (flatten arr)  -- | Variant of 'foldAll' that requires the reduced array to be non-empty and--- doesn't need an default value. The first argument must be an /associative/+-- does not need a default value. The first argument must be an /associative/ -- function. ---fold1All :: (Shape sh, Elt a)-         => (Exp a -> Exp a -> Exp a)-         -> Acc (Array sh a)-         -> Acc (Scalar a)+fold1All+    :: (Shape sh, Elt a)+    => (Exp a -> Exp a -> Exp a)+    -> Acc (Array sh a)+    -> Acc (Scalar a) fold1All f arr = fold1 f (flatten arr)  @@ -653,121 +685,185 @@ -- Leave the results of these as scalar arrays to make it clear that these are -- array computations, and thus can not be nested. --- | Check if all elements satisfy a predicate+-- | Check if all elements along the innermost dimension satisfy a predicate. --+-- >>> let mat = fromList (Z :. 4 :. 10) [1,2,3,4,5,6,7,8,9,10,1,1,1,1,1,2,2,2,2,2,2,4,6,8,10,12,14,16,18,20,1,3,5,7,9,11,13,15,17,19] :: Array DIM2 Int+-- >>> mat+-- Matrix (Z :. 4 :. 10)+--   [ 1, 2, 3, 4,  5,  6,  7,  8,  9, 10,+--     1, 1, 1, 1,  1,  2,  2,  2,  2,  2,+--     2, 4, 6, 8, 10, 12, 14, 16, 18, 20,+--     1, 3, 5, 7,  9, 11, 13, 15, 17, 19]+--+-- >>> all even (use mat)+-- Vector (Z :. 4) [False,False,True,False]+-- all :: (Shape sh, Elt e)     => (Exp e -> Exp Bool)-    -> Acc (Array sh e)-    -> Acc (Scalar Bool)+    -> Acc (Array (sh:.Int) e)+    -> Acc (Array sh Bool) all f = and . map f --- | Check if any element satisfies the predicate+-- | Check if any element along the innermost dimension satisfies the predicate. --+-- >>> let mat = fromList (Z :. 4 :. 10) [1,2,3,4,5,6,7,8,9,10,1,1,1,1,1,2,2,2,2,2,2,4,6,8,10,12,14,16,18,20,1,3,5,7,9,11,13,15,17,19] :: Array DIM2 Int+-- >>> mat+-- Matrix (Z :. 4 :. 10)+--   [ 1, 2, 3, 4,  5,  6,  7,  8,  9, 10,+--     1, 1, 1, 1,  1,  2,  2,  2,  2,  2,+--     2, 4, 6, 8, 10, 12, 14, 16, 18, 20,+--     1, 3, 5, 7,  9, 11, 13, 15, 17, 19]+--+-- >>> any even (use mat)+-- Vector (Z :. 4) [True,True,True,False]+-- any :: (Shape sh, Elt e)     => (Exp e -> Exp Bool)-    -> Acc (Array sh e)-    -> Acc (Scalar Bool)+    -> Acc (Array (sh:.Int) e)+    -> Acc (Array sh Bool) any f = or . map f --- | Check if all elements are 'True'+-- | Check if all elements along the innermost dimension are 'True'. -- and :: Shape sh-    => Acc (Array sh Bool)-    -> Acc (Scalar Bool)-and = foldAll (&&) (constant True)+    => Acc (Array (sh:.Int) Bool)+    -> Acc (Array sh Bool)+and = fold (&&) (constant True) --- | Check if any element is 'True'+-- | Check if any element along the innermost dimension is 'True'. -- or :: Shape sh-   => Acc (Array sh Bool)-   -> Acc (Scalar Bool)-or = foldAll (||) (constant False)+   => Acc (Array (sh:.Int) Bool)+   -> Acc (Array sh Bool)+or = fold (||) (constant False) --- | Compute the sum of elements+-- | Compute the sum of elements along the innermost dimension of the array. To+-- find the sum of the entire array, 'flatten' it first. --+-- >>> let mat = fromList (Z:.2:.5) [0..]+-- Vector (Z :. 2) [10,35]+-- sum :: (Shape sh, Num e)-    => Acc (Array sh e)-    -> Acc (Scalar e)-sum = foldAll (+) 0+    => Acc (Array (sh:.Int) e)+    -> Acc (Array sh e)+sum = fold (+) 0 --- | Compute the product of the elements+-- | Compute the product of the elements along the innermost dimension of the+-- array. To find the product of the entire array, 'flatten' it first. ---product :: (Shape sh, Num e)-        => Acc (Array sh e)-        -> Acc (Scalar e)-product = foldAll (*) 1+-- >>> let mat = fromList (Z:.2:.5) [0..]+-- Vector (Z :. 2) [0,15120]+--+product+    :: (Shape sh, Num e)+    => Acc (Array (sh:.Int) e)+    -> Acc (Array sh e)+product = fold (*) 1 --- | Yield the minimum element of an array. The array must not be empty.+-- | Yield the minimum element along the innermost dimension of the array. To+-- find find the minimum element of the entire array, 'flatten' it first. ---minimum :: (Shape sh, Ord e)-        => Acc (Array sh e)-        -> Acc (Scalar e)-minimum = fold1All min+-- The array must not be empty. See also 'fold1'.+--+-- >>> let mat = fromList (Z :. 3 :. 4) [1,4,3,8, 0,2,8,4, 7,9,8,8]+-- >>> mat+-- Matrix (Z :. 3 :. 4)+--   [ 1, 4, 3, 8,+--     0, 2, 8, 4,+--     7, 9, 8, 8]+--+-- >>> minimum (use mat)+-- Vector (Z :. 3) [1,0,7]+--+minimum+    :: (Shape sh, Ord e)+    => Acc (Array (sh:.Int) e)+    -> Acc (Array sh e)+minimum = fold1 min --- | Yield the maximum element of an array. The array must not be empty.+-- | Yield the maximum element along the innermost dimension of the array. To+-- find the maximum element of the entire array, 'flatten' it first. ---maximum :: (Shape sh, Ord e)-        => Acc (Array sh e)-        -> Acc (Scalar e)-maximum = fold1All max+-- The array must not be empty. See also 'fold1'.+--+-- >>> let mat = fromList (Z :. 3 :. 4) [1,4,3,8, 0,2,8,4, 7,9,8,8]+-- >>> mat+-- Matrix (Z :. 3 :. 4)+--   [ 1, 4, 3, 8,+--     0, 2, 8, 4,+--     7, 9, 8, 8]+--+-- >>> maximum (use mat)+-- Vector (Z :. 3) [8,8,9]+--+maximum+    :: (Shape sh, Ord e)+    => Acc (Array (sh:.Int) e)+    -> Acc (Array sh e)+maximum = fold1 max   -- Composite scans -- --------------- --- | Left-to-right prescan (aka exclusive scan).  As for 'scan', the first--- argument must be an /associative/ function.  Denotationally, we have+-- | Left-to-right pre-scan (aka exclusive scan). As for 'scan', the first+-- argument must be an /associative/ function. Denotationally, we have: ----- > prescanl f e = Prelude.fst . scanl' f e+-- > prescanl f e = afst . scanl' f e -- -- >>> let vec = fromList (Z:.10) [1..10] -- >>> prescanl (+) 0 (use vec)--- Vector (Z :. 10) [0,0,1,3,6,10,15,21,28,36]+-- Vector (Z :. 10) [0,1,3,6,10,15,21,28,36,45] ---prescanl :: (Shape sh, Elt a)-         => (Exp a -> Exp a -> Exp a)-         -> Exp a-         -> Acc (Array (sh:.Int) a)-         -> Acc (Array (sh:.Int) a)-prescanl f e = P.fst . scanl' f e+prescanl+    :: (Shape sh, Elt a)+    => (Exp a -> Exp a -> Exp a)+    -> Exp a+    -> Acc (Array (sh:.Int) a)+    -> Acc (Array (sh:.Int) a)+prescanl f e = afst . scanl' f e --- | Left-to-right postscan, a variant of 'scanl1' with an initial value. As+-- | Left-to-right post-scan, a variant of 'scanl1' with an initial value. As -- with 'scanl1', the array must not be empty. Denotationally, we have: -- -- > postscanl f e = map (e `f`) . scanl1 f -- -- >>> let vec = fromList (Z:.10) [1..10] -- >>> postscanl (+) 42 (use vec)--- Vector (Z :. 10) [42,43,45,48,52,57,63,70,78,87]+-- Vector (Z :. 10) [43,45,48,52,57,63,70,78,87,97] ---postscanl :: (Shape sh, Elt a)-          => (Exp a -> Exp a -> Exp a)-          -> Exp a-          -> Acc (Array (sh:.Int) a)-          -> Acc (Array (sh:.Int) a)+postscanl+    :: (Shape sh, Elt a)+    => (Exp a -> Exp a -> Exp a)+    -> Exp a+    -> Acc (Array (sh:.Int) a)+    -> Acc (Array (sh:.Int) a) postscanl f e = map (e `f`) . scanl1 f --- |Right-to-left prescan (aka exclusive scan).  As for 'scan', the first argument must be an--- /associative/ function.  Denotationally, we have+-- | Right-to-left pre-scan (aka exclusive scan). As for 'scan', the first+-- argument must be an /associative/ function. Denotationally, we have: ----- > prescanr f e = Prelude.fst . scanr' f e+-- > prescanr f e = afst . scanr' f e ---prescanr :: (Shape sh, Elt a)-         => (Exp a -> Exp a -> Exp a)-         -> Exp a-         -> Acc (Array (sh:.Int) a)-         -> Acc (Array (sh:.Int) a)-prescanr f e = P.fst . scanr' f e+prescanr+    :: (Shape sh, Elt a)+    => (Exp a -> Exp a -> Exp a)+    -> Exp a+    -> Acc (Array (sh:.Int) a)+    -> Acc (Array (sh:.Int) a)+prescanr f e = afst . scanr' f e --- |Right-to-left postscan, a variant of 'scanr1' with an initial value.  Denotationally, we have+-- | Right-to-left postscan, a variant of 'scanr1' with an initial value.+-- Denotationally, we have: -- -- > postscanr f e = map (e `f`) . scanr1 f ---postscanr :: (Shape sh, Elt a)-          => (Exp a -> Exp a -> Exp a)-          -> Exp a-          -> Acc (Array (sh:.Int) a)-          -> Acc (Array (sh:.Int) a)+postscanr+    :: (Shape sh, Elt a)+    => (Exp a -> Exp a -> Exp a)+    -> Exp a+    -> Acc (Array (sh:.Int) a)+    -> Acc (Array (sh:.Int) a) postscanr f e = map (`f` e) . scanr1 f  @@ -901,7 +997,7 @@     -- index of each segment.     --     seg'        = map (+1) seg-    tails       = zipWith (+) seg . P.fst $ scanl' (+) 0 seg'+    tails       = zipWith (+) seg $ prescanl (+) 0 seg'     sums        = backpermute                     (lift (indexTail (shape arr') :. length seg))                     (\ix -> let sz:.i = unlift ix :: Exp sh :. Exp Int@@ -969,8 +1065,7 @@     -> Acc (Segments i)     -> Acc (Array (sh:.Int) e) scanl1Seg f arr seg-  = P.snd-  . unzip+  = map snd   . scanl1 (segmented f)   $ zip (replicate (lift (indexTail (shape arr) :. All)) (mkHeadFlags seg)) arr @@ -1103,7 +1198,7 @@      -- reduction values     seg'        = map (+1) seg-    heads       = P.fst $ scanl' (+) 0 seg'+    heads       = prescanl (+) 0 seg'     sums        = backpermute                     (lift (indexTail (shape arr') :. length seg))                     (\ix -> let sz:.i = unlift ix :: Exp sh :. Exp Int@@ -1150,8 +1245,7 @@     -> Acc (Segments i)     -> Acc (Array (sh:.Int) e) scanr1Seg f arr seg-  = P.snd-  . unzip+  = map snd   . scanr1 (flip (segmented f))   $ zip (replicate (lift (indexTail (shape arr) :. All)) (mkTailFlags seg)) arr @@ -1201,7 +1295,7 @@   = init   $ permute (+) zeros (\ix -> index1' (offset ! ix)) ones   where-    (offset, len)       = scanl' (+) 0 seg+    (offset, len)       = unlift (scanl' (+) 0 seg)     zeros               = fill (index1' $ the len + 1) 0     ones                = fill (index1  $ size offset) 1 @@ -1216,7 +1310,7 @@   = init   $ permute (+) zeros (\ix -> index1' (the len - 1 - offset ! ix)) ones   where-    (offset, len)       = scanr' (+) 0 seg+    (offset, len)       = unlift (scanr' (+) 0 seg)     zeros               = fill (index1' $ the len + 1) 0     ones                = fill (index1  $ size offset) 1 @@ -1262,7 +1356,7 @@   | Just Refl <- matchShapeType (undefined::sh) (undefined::DIM1)   = a flatten a-  = reshape (index1 $ size a) a+  = reshape (index1 (size a)) a   -- Enumeration and filling@@ -1270,6 +1364,9 @@  -- | Create an array where all elements are the same value. --+-- >>> let zeros = fill (Z:.10) 0+-- Vector (Z :. 10) [0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0]+-- fill :: (Shape sh, Elt e) => Exp sh -> Exp e -> Acc (Array sh e) fill sh c = generate sh (const c) @@ -1402,7 +1499,7 @@   | Just Refl <- matchShapeType (undefined::sh) (undefined::Z)   = let         keep            = map p arr-        (target, len)   = scanl' (+) 0 (map boolToInt keep)+        (target, len)   = unlift $ scanl' (+) 0 (map boolToInt keep)         prj ix          = keep!ix ? ( index1 (target!ix), ignore )         dummy           = backpermute (index1 (the len)) id arr         result          = permute const dummy prj arr@@ -1415,8 +1512,8 @@   = let         sz              = indexTail (shape arr)         keep            = map p arr-        (target, len)   = scanl' (+) 0 (map boolToInt keep)-        (offset, valid) = scanl' (+) 0 (flatten len)+        (target, len)   = unlift $ scanl' (+) 0 (map boolToInt keep)+        (offset, valid) = unlift $ scanl' (+) 0 (flatten len)         prj ix          = if keep!ix                             then index1 $ offset!index1 (toIndex sz (indexTail ix)) + target!ix                             else ignore@@ -1759,7 +1856,8 @@ -- | Infix version of 'acond'. If the predicate evaluates to 'True', the first -- component of the tuple is returned, else the second. ----- See also: 'ifThenElse'.+-- Enabling the @RebindableSyntax@ extension will allow you to use the standard+-- if-then-else syntax instead. -- infix 0 ?| (?|) :: Arrays a => Exp Bool -> (Acc a, Acc a) -> Acc a@@ -1768,7 +1866,8 @@ -- | An infix version of 'cond'. If the predicate evaluates to 'True', the first -- component of the tuple is returned, else the second. ----- See also: 'ifThenElse'.+-- Enabling the @RebindableSyntax@ extension will allow you to use the standard+-- if-then-else syntax instead. -- infix 0 ? (?) :: Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t@@ -1806,11 +1905,12 @@  -- | Repeatedly apply a function a fixed number of times ---iterate :: forall a. Elt a-        => Exp Int-        -> (Exp a -> Exp a)-        -> Exp a-        -> Exp a+iterate+    :: forall a. Elt a+    => Exp Int+    -> (Exp a -> Exp a)+    -> Exp a+    -> Exp a iterate n f z   = let step :: (Exp Int, Exp a) -> (Exp Int, Exp a)         step (i, acc)   = ( i+1, f acc )@@ -1847,6 +1947,7 @@ fst e = let (x, _::Exp b) = unlift e in x  -- |Extract the first component of an array pair.+{-# NOINLINE[1] afst #-} afst :: forall a b. (Arrays a, Arrays b) => Acc (a, b) -> Acc a afst a = let (x, _::Acc b) = unlift a in x @@ -1873,34 +1974,36 @@ -- Shapes and indices -- ------------------ --- |The one index for a rank-0 array.+-- | The one index for a rank-0 array. -- index0 :: Exp Z index0 = lift Z --- |Turn an 'Int' expression into a rank-1 indexing expression.+-- | Turn an 'Int' expression into a rank-1 indexing expression. -- index1 :: Elt i => Exp i -> Exp (Z :. i) index1 i = lift (Z :. i) --- |Turn a rank-1 indexing expression into an 'Int' expression.+-- | Turn a rank-1 indexing expression into an 'Int' expression. -- unindex1 :: Elt i => Exp (Z :. i) -> Exp i unindex1 ix = let Z :. i = unlift ix in i  -- | Creates a rank-2 index from two Exp Int`s ---index2 :: (Elt i, Slice (Z :. i))-       => Exp i-       -> Exp i-       -> Exp (Z :. i :. i)+index2+    :: (Elt i, Slice (Z :. i))+    => Exp i+    -> Exp i+    -> Exp (Z :. i :. i) index2 i j = lift (Z :. i :. j)  -- | Destructs a rank-2 index to an Exp tuple of two Int`s. ---unindex2 :: forall i. (Elt i, Slice (Z :. i))-         => Exp (Z :. i :. i)-         -> Exp (i, i)+unindex2+    :: forall i. (Elt i, Slice (Z :. i))+    => Exp (Z :. i :. i)+    -> Exp (i, i) unindex2 ix   = let Z :. i :. j = unlift ix :: Z :. Exp i :. Exp i     in  lift (i, j)
Data/Array/Accelerate/Pretty/Graphviz.hs view
@@ -42,9 +42,8 @@ import qualified Data.HashSet                           as Set  -- friends-import Data.Array.Accelerate.AST                        ( PreOpenAcc(..), PreOpenAfun(..), PreOpenFun(..), PreOpenExp(..), Idx(..) )-import Data.Array.Accelerate.Array.Sugar                ( Array, Elt, EltRepr, Tuple(..), Atuple(..), arrays, toElt, strForeign )-import Data.Array.Accelerate.Type                       ( Boundary(..) )+import Data.Array.Accelerate.AST                        ( PreOpenAcc(..), PreOpenAfun(..), PreOpenFun(..), PreOpenExp(..), PreBoundary(..), Idx(..) )+import Data.Array.Accelerate.Array.Sugar                ( Array, Shape, Elt, Tuple(..), Atuple(..), arrays, toElt, strForeign ) import Data.Array.Accelerate.Error import Data.Array.Accelerate.Trafo.Base import Data.Array.Accelerate.Pretty.Print@@ -249,10 +248,9 @@     Scanr1 f xs             -> "scanr1"      .$ [ ppF f, ppA xs ]     Permute f dfts p xs     -> "permute"     .$ [ ppF f, ppA dfts, ppF p, ppA xs ]     Backpermute sh p xs     -> "backpermute" .$ [ ppSh sh, ppF p, ppA xs ]-    Stencil sten bndy xs    -> "stencil"     .$ [ ppF sten, ppB xs bndy, ppA xs ]+    Stencil sten bndy xs    -> "stencil"     .$ [ ppF sten, ppB bndy, ppA xs ]     Stencil2 sten bndy1 acc1 bndy2 acc2-                            -> "stencil2"    .$ [ ppF sten, ppB acc1 bndy1, ppA acc1,-                                                            ppB acc2 bndy2, ppA acc2 ]+                            -> "stencil2"    .$ [ ppF sten, ppB bndy1, ppA acc1, ppB bndy2, ppA acc2 ]     Aforeign ff _afun xs    -> "aforeign"    .$ [ return (PDoc (text (strForeign ff)) []), {- ppAf afun, -} ppA xs ]     -- Collect{}               -> error "Collect" @@ -312,14 +310,14 @@       PDoc d v <- "Delayed" `fmt` [ ppSh sh, ppF f ]       return    $ PDoc (parens d) v -    ppB :: forall sh e. Elt e-        => {-dummy-} DelayedOpenAcc aenv (Array sh e)-        -> Boundary (EltRepr e)+    ppB :: forall sh e. (Shape sh, Elt e)+        => PreBoundary DelayedOpenAcc aenv (Array sh e)         -> Dot PDoc-    ppB _ Clamp        = return (PDoc "Clamp"  [])-    ppB _ Mirror       = return (PDoc "Mirror" [])-    ppB _ Wrap         = return (PDoc "Wrap"   [])-    ppB _ (Constant e) = return (PDoc (parens $ "Constant" <+> text (show (toElt e :: e))) [])+    ppB Clamp        = return (PDoc "Clamp"  [])+    ppB Mirror       = return (PDoc "Mirror" [])+    ppB Wrap         = return (PDoc "Wrap"   [])+    ppB (Constant e) = return (PDoc (parens $ "Constant" <+> text (show (toElt e :: e))) [])+    ppB (Function f) = "Function" `fmt` [ ppF f ]      ppF :: DelayedFun aenv t -> Dot PDoc     ppF = return . uncurry PDoc . (parens . prettyDelayedFun aenv' &&& fvF)
Data/Array/Accelerate/Pretty/Print.hs view
@@ -50,10 +50,9 @@ import Text.PrettyPrint  -- friends+import Data.Array.Accelerate.AST                        hiding ( Val(..), prj ) import Data.Array.Accelerate.Array.Sugar                hiding ( tuple ) import Data.Array.Accelerate.Product-import Data.Array.Accelerate.AST                        hiding ( Val(..), prj )-import Data.Array.Accelerate.Type   -- Pretty printing@@ -115,14 +114,14 @@     ppAF :: PreOpenAfun acc aenv f -> Doc     ppAF = parens . prettyPreOpenAfun prettyAcc aenv -    ppB :: forall sh e. Elt e-        => {-dummy-} acc aenv (Array sh e)-        -> Boundary (EltRepr e)+    ppB :: forall sh e. (Shape sh, Elt e)+        => PreBoundary acc aenv (Array sh e)         -> Doc-    ppB _ Clamp        = text "Clamp"-    ppB _ Mirror       = text "Mirror"-    ppB _ Wrap         = text "Wrap"-    ppB _ (Constant e) = parens $ text "Constant" <+> text (show (toElt e :: e))+    ppB Clamp        = text "clamp"+    ppB Mirror       = text "mirror"+    ppB Wrap         = text "wrap"+    ppB (Constant e) = parens $ text "constant" <+> text (show (toElt e :: e))+    ppB (Function f) = ppF f      -- pretty print a named array operation with its arguments     name .$ docs = wrap $ hang (text name) 2 (sep docs)@@ -171,10 +170,9 @@     pp (Permute f dfts p acc)   = "permute"     .$ [ ppF f, ppA dfts, ppF p, ppA acc ]     pp (Backpermute sh p acc)   = "backpermute" .$ [ ppSh sh, ppF p, ppA acc ]     pp (Aforeign ff _afun acc)  = "aforeign"    .$ [ text (strForeign ff), {- ppAf afun, -} ppA acc ]-    pp (Stencil sten bndy acc)  = "stencil"     .$ [ ppF sten, ppB acc bndy, ppA acc ]+    pp (Stencil sten bndy acc)  = "stencil"     .$ [ ppF sten, ppB bndy, ppA acc ]     pp (Stencil2 sten bndy1 acc1 bndy2 acc2)-                                = "stencil2"    .$ [ ppF sten, ppB acc1 bndy1, ppA acc1,-                                                               ppB acc2 bndy2, ppA acc2 ]+                                = "stencil2"    .$ [ ppF sten, ppB bndy1, ppA acc1, ppB bndy2, ppA acc2 ]      -- pp (Collect s)              = wrap $ hang (text "collect") 2     --                                    $ encloseSep lbrace rbrace semi@@ -463,6 +461,7 @@ prettyPrim PrimCeiling{}            = (False, text "ceiling") prettyPrim PrimAtan2{}              = (False, text "atan2") prettyPrim PrimIsNaN{}              = (False, text "isNaN")+prettyPrim PrimIsInfinite{}         = (False, text "isInfinite") prettyPrim PrimLt{}                 = (True,  text "<") prettyPrim PrimGt{}                 = (True,  text ">") prettyPrim PrimLtEq{}               = (True,  text "<=")
Data/Array/Accelerate/Product.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE ConstraintKinds       #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE GADTs                 #-}-{-# LANGUAGE KindSignatures        #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies          #-} {-# LANGUAGE UndecidableInstances  #-}@@ -29,6 +28,7 @@   TupleIdx(..), IsProduct(..), ProdR(..)  ) where+  -- |Type-safe projection indices for tuples. --
Data/Array/Accelerate/Smart.hs view
@@ -28,1604 +28,1924 @@ module Data.Array.Accelerate.Smart (    -- * HOAS AST-  Acc(..), PreAcc(..), Exp(..), PreExp(..), Boundary(..), Stencil(..), Level,--  -- * Smart constructors for literals-  constant,--  -- * Smart constructors and destructors for tuples-  tup2, tup3, tup4, tup5, tup6, tup7, tup8, tup9, tup10, tup11, tup12, tup13, tup14, tup15,-  untup2, untup3, untup4, untup5, untup6, untup7, untup8, untup9, untup10, untup11, untup12, untup13, untup14, untup15,--  atup2, atup3, atup4, atup5, atup6, atup7, atup8, atup9, atup10, atup11, atup12, atup13, atup14, atup15,-  unatup2, unatup3, unatup4, unatup5, unatup6, unatup7, unatup8, unatup9, unatup10, unatup11, unatup12, unatup13, unatup14, unatup15,--  -- * Smart constructors for constants-  mkMinBound, mkMaxBound, mkPi,-  mkSin, mkCos, mkTan,-  mkAsin, mkAcos, mkAtan,-  mkSinh, mkCosh, mkTanh,-  mkAsinh, mkAcosh, mkAtanh,-  mkExpFloating, mkSqrt, mkLog,-  mkFPow, mkLogBase,-  mkTruncate, mkRound, mkFloor, mkCeiling,-  mkAtan2,--  -- * Smart constructors for primitive functions-  mkAdd, mkSub, mkMul, mkNeg, mkAbs, mkSig, mkQuot, mkRem, mkQuotRem, mkIDiv, mkMod, mkDivMod,-  mkBAnd, mkBOr, mkBXor, mkBNot, mkBShiftL, mkBShiftR, mkBRotateL, mkBRotateR, mkPopCount, mkCountLeadingZeros, mkCountTrailingZeros,-  mkFDiv, mkRecip, mkLt, mkGt, mkLtEq, mkGtEq, mkEq, mkNEq, mkMax, mkMin,-  mkLAnd, mkLOr, mkLNot, mkIsNaN,--  -- * Smart constructors for type coercion functions-  mkOrd, mkChr, mkBoolToInt, mkFromIntegral, mkToFloating, mkBitcast, mkUnsafeCoerce,--  -- * Auxiliary functions-  ($$), ($$$), ($$$$), ($$$$$),--  -- Debugging-  showPreAccOp, showPreExpOp,--) where---- standard library-import Prelude                                  hiding ( exp )-import Data.List-import Data.Typeable---- friends-import Data.Array.Accelerate.Type-import Data.Array.Accelerate.Array.Sugar-import Data.Array.Accelerate.Product-import Data.Array.Accelerate.AST                hiding ( PreOpenAcc(..), OpenAcc(..), Acc-                                                       , PreOpenExp(..), OpenExp, PreExp, Exp-                                                       , Stencil(..)-                                                       , showPreAccOp, showPreExpOp )-import qualified Data.Array.Accelerate.AST      as AST---- Array computations--- ---------------------- | Accelerate is an /embedded language/ that distinguishes between vanilla--- arrays (e.g. in Haskell memory on the CPU) and embedded arrays (e.g. in--- device memory on a GPU), as well as the computations on both of these. Since--- Accelerate is an embedded language, programs written in Accelerate are not--- compiled by the Haskell compiler (GHC). Rather, each Accelerate backend is--- a /runtime compiler/ which generates and executes parallel SIMD code of the--- target language at application /runtime/.------ The type constructor 'Acc' represents embedded collective array operations.--- A term of type @Acc a@ is an Accelerate program which, once executed, will--- produce a value of type 'a' (an 'Array' or a tuple of 'Arrays'). Collective--- operations of type @Acc a@ comprise many /scalar expressions/, wrapped in--- type constructor 'Exp', which will be executed in parallel. Although--- collective operations comprise many scalar operations executed in parallel,--- scalar operations /cannot/ initiate new collective operations: this--- stratification between scalar operations in 'Exp' and array operations in--- 'Acc' helps statically exclude /nested data parallelism/, which is difficult--- to execute efficiently on constrained hardware such as GPUs.------ For example, to compute a vector dot product we could write:------ > dotp :: Num a => Vector a -> Vector a -> Acc (Scalar a)--- > dotp xs ys =--- >   let--- >       xs' = use xs--- >       ys' = use ys--- >   in--- >   fold (+) 0 ( zipWith (*) xs' ys' )------ The function @dotp@ consumes two one-dimensional arrays ('Vector's) of--- values, and produces a single ('Scalar') result as output. As the return type--- is wrapped in the type 'Acc', we see that it is an embedded Accelerate--- computation - it will be evaluated in the /object/ language of dynamically--- generated parallel code, rather than the /meta/ language of vanilla Haskell.------ As the arguments to @dotp@ are plain Haskell arrays, to make these available--- to Accelerate computations they must be embedded with the--- 'Data.Array.Accelerate.Language.use' function.------ An Accelerate backend is used to evaluate the embedded computation and return--- the result back to vanilla Haskell. Calling the 'run' function of a backend--- will generate code for the target architecture, compile, and execute it. For--- example, the following backends are available:------  * <http://hackage.haskell.org/package/accelerate-llvm-native accelerate-llvm-native>: for execution on multicore CPUs---  * <http://hackage.haskell.org/package/accelerate-llvm-ptx accelerate-llvm-ptx>: for execution on NVIDIA CUDA-capable GPUs------ See also 'Exp', which encapsulates embedded /scalar/ computations.------ [/Fusion:/]------ Array computations of type 'Acc' will be subject to /array fusion/;--- Accelerate will combine individual 'Acc' computations into a single--- computation, which reduces the number of traversals over the input data and--- thus improves performance. As such, it is often useful to have some intuition--- on when fusion should occur.------ The main idea is to first partition array operations into two categories:------   1. Element-wise operations, such as 'Data.Array.Accelerate.map',---      'Data.Array.Accelerate.generate', and---      'Data.Array.Accelerate.backpermute'. Each element of these operations---      can be computed independently of all others.------   2. Collective operations such as 'Data.Array.Accelerate.fold',---      'Data.Array.Accelerate.scanl', and 'Data.Array.Accelerate.stencil'. To---      compute each output element of these operations requires reading---      multiple elements from the input array(s).------ Element-wise operations fuse together whenever the consumer operation uses--- a single element of the input array. Element-wise operations can both fuse--- their inputs into themselves, as well be fused into later operations. Both--- these examples should fuse into a single loop:------ > map -> reverse -> reshape -> map -> map------ > map -> backpermute ->--- >                       zipWith -> map--- >           generate ->------ If the consumer operation uses more than one element of the input array--- (typically, via 'Data.Array.Accelerate.generate' indexing an array multiple--- times), then the input array will be completely evaluated first; no fusion--- occurs in this case, because fusing the first operation into the second--- implies duplicating work.------ On the other hand, collective operations can fuse their input arrays into--- themselves, but on output always evaluate to an array; collective operations--- will not be fused into a later step. For example:------ >      use ->--- >             zipWith -> fold |-> map--- > generate ->------ Here the element-wise sequence ('Data.Array.Accelerate.use'--- + 'Data.Array.Accelerate.generate' + 'Data.Array.Accelerate.zipWith') will--- fuse into a single operation, which then fuses into the collective--- 'Data.Array.Accelerate.fold' operation. At this point in the program the--- 'Data.Array.Accelerate.fold' must now be evaluated. In the final step the--- 'Data.Array.Accelerate.map' reads in the array produced by--- 'Data.Array.Accelerate.fold'. As there is no fusion between the--- 'Data.Array.Accelerate.fold' and 'Data.Array.Accelerate.map' steps, this--- program consists of two "loops"; one for the 'Data.Array.Accelerate.use'--- + 'Data.Array.Accelerate.generate' + 'Data.Array.Accelerate.zipWith'--- + 'Data.Array.Accelerate.fold' step, and one for the final--- 'Data.Array.Accelerate.map' step.------ You can see how many operations will be executed in the fused program by--- 'Show'-ing the 'Acc' program, or by using the debugging option @-ddump-dot@--- to save the program as a graphviz DOT file.------ As a special note, the operations 'Data.Array.Accelerate.unzip' and--- 'Data.Array.Accelerate.reshape', when applied to a real array, are executed--- in constant time, so in this situation these operations will not be fused.------ [/Tips:/]------  * Since 'Acc' represents embedded computations that will only be executed---    when evaluated by a backend, we can programatically generate these---    computations using the meta language Haskell; for example, unrolling loops---    or embedding input values into the generated code.------  * It is usually best to keep all intermediate computations in 'Acc', and---    only 'run' the computation at the very end to produce the final result.---    This enables optimisations between intermediate results (e.g. array---    fusion) and, if the target architecture has a separate memory space as is---    the case of GPUs, to prevent excessive data transfers.----newtype Acc a = Acc (PreAcc Acc Exp a)-deriving instance Typeable Acc----- The level of lambda-bound variables. The root has level 0; then it increases with each bound--- variable — i.e., it is the same as the size of the environment at the defining occurrence.----type Level = Int---- | Array-valued collective computations without a recursive knot----data PreAcc acc exp as where-    -- Needed for conversion to de Bruijn form-  Atag          :: Arrays as-                => Level                        -- environment size at defining occurrence-                -> PreAcc acc exp as--  Pipe          :: (Arrays as, Arrays bs, Arrays cs)-                => (Acc as -> acc bs)-                -> (Acc bs -> acc cs)-                -> acc as-                -> PreAcc acc exp cs--  Aforeign      :: (Arrays as, Arrays bs, Foreign asm)-                => asm (as -> bs)-                -> (Acc as -> Acc bs)-                -> acc as-                -> PreAcc acc exp bs--  Acond         :: Arrays as-                => exp Bool-                -> acc as-                -> acc as-                -> PreAcc acc exp as--  Awhile        :: Arrays arrs-                => (Acc arrs -> acc (Scalar Bool))-                -> (Acc arrs -> acc arrs)-                -> acc arrs-                -> PreAcc acc exp arrs--  Atuple        :: (Arrays arrs, IsAtuple arrs)-                => Atuple acc (TupleRepr arrs)-                -> PreAcc acc exp arrs--  Aprj          :: (Arrays arrs, IsAtuple arrs, Arrays a)-                => TupleIdx (TupleRepr arrs) a-                ->        acc     arrs-                -> PreAcc acc exp a--  Use           :: Arrays arrs-                => arrs-                -> PreAcc acc exp arrs--  Unit          :: Elt e-                => exp e-                -> PreAcc acc exp (Scalar e)--  Generate      :: (Shape sh, Elt e)-                => exp sh-                -> (Exp sh -> exp e)-                -> PreAcc acc exp (Array sh e)--  Reshape       :: (Shape sh, Shape sh', Elt e)-                => exp sh-                -> acc (Array sh' e)-                -> PreAcc acc exp (Array sh e)--  Replicate     :: (Slice slix, Elt e)-                => exp slix-                -> acc            (Array (SliceShape slix) e)-                -> PreAcc acc exp (Array (FullShape  slix) e)--  Slice         :: (Slice slix, Elt e)-                => acc            (Array (FullShape  slix) e)-                -> exp slix-                -> PreAcc acc exp (Array (SliceShape slix) e)--  Map           :: (Shape sh, Elt e, Elt e')-                => (Exp e -> exp e')-                -> acc (Array sh e)-                -> PreAcc acc exp (Array sh e')--  ZipWith       :: (Shape sh, Elt e1, Elt e2, Elt e3)-                => (Exp e1 -> Exp e2 -> exp e3)-                -> acc (Array sh e1)-                -> acc (Array sh e2)-                -> PreAcc acc exp (Array sh e3)--  Fold          :: (Shape sh, Elt e)-                => (Exp e -> Exp e -> exp e)-                -> exp e-                -> acc (Array (sh:.Int) e)-                -> PreAcc acc exp (Array sh e)--  Fold1         :: (Shape sh, Elt e)-                => (Exp e -> Exp e -> exp e)-                -> acc (Array (sh:.Int) e)-                -> PreAcc acc exp (Array sh e)--  FoldSeg       :: (Shape sh, Elt e, Elt i, IsIntegral i)-                => (Exp e -> Exp e -> exp e)-                -> exp e-                -> acc (Array (sh:.Int) e)-                -> acc (Segments i)-                -> PreAcc acc exp (Array (sh:.Int) e)--  Fold1Seg      :: (Shape sh, Elt e, Elt i, IsIntegral i)-                => (Exp e -> Exp e -> exp e)-                -> acc (Array (sh:.Int) e)-                -> acc (Segments i)-                -> PreAcc acc exp (Array (sh:.Int) e)--  Scanl         :: (Shape sh, Elt e)-                => (Exp e -> Exp e -> exp e)-                -> exp e-                -> acc (Array (sh :. Int) e)-                -> PreAcc acc exp (Array (sh :. Int) e)--  Scanl'        :: (Shape sh, Elt e)-                => (Exp e -> Exp e -> exp e)-                -> exp e-                -> acc (Array (sh :. Int) e)-                -> PreAcc acc exp (Array (sh :. Int) e, Array sh e)--  Scanl1        :: (Shape sh, Elt e)-                => (Exp e -> Exp e -> exp e)-                -> acc (Array (sh :. Int) e)-                -> PreAcc acc exp (Array (sh :. Int) e)--  Scanr         :: (Shape sh, Elt e)-                => (Exp e -> Exp e -> exp e)-                -> exp e-                -> acc (Array (sh :. Int) e)-                -> PreAcc acc exp (Array (sh :. Int) e)--  Scanr'        :: (Shape sh, Elt e)-                => (Exp e -> Exp e -> exp e)-                -> exp e-                -> acc (Array (sh :. Int) e)-                -> PreAcc acc exp (Array (sh :. Int) e, Array sh e)--  Scanr1        :: (Shape sh, Elt e)-                => (Exp e -> Exp e -> exp e)-                -> acc (Array (sh :. Int) e)-                -> PreAcc acc exp (Array (sh :. Int) e)--  Permute       :: (Shape sh, Shape sh', Elt e)-                => (Exp e -> Exp e -> exp e)-                -> acc (Array sh' e)-                -> (Exp sh -> exp sh')-                -> acc (Array sh e)-                -> PreAcc acc exp (Array sh' e)--  Backpermute   :: (Shape sh, Shape sh', Elt e)-                => exp sh'-                -> (Exp sh' -> exp sh)-                -> acc (Array sh e)-                -> PreAcc acc exp (Array sh' e)--  Stencil       :: (Shape sh, Elt a, Elt b, Stencil sh a stencil)-                => (stencil -> exp b)-                -> Boundary a-                -> acc (Array sh a)-                -> PreAcc acc exp (Array sh b)--  Stencil2      :: (Shape sh, Elt a, Elt b, Elt c,-                   Stencil sh a stencil1, Stencil sh b stencil2)-                => (stencil1 -> stencil2 -> exp c)-                -> Boundary a-                -> acc (Array sh a)-                -> Boundary b-                -> acc (Array sh b)-                -> PreAcc acc exp (Array sh c)--  -- Collect       :: Arrays arrs-  --               => seq arrs-  --               -> PreAcc acc seq exp arrs---{---data PreSeq acc seq exp arrs where-  -- Convert the given Haskell-list of arrays to a sequence.-  StreamIn :: Arrays a-           => [a]-           -> PreSeq acc seq exp [a]--  -- Convert the given array to a sequence.-  -- Example:-  -- slix = Z :. All :. Split :. All :. All :. Split-  --              ^       ^       ^      ^      ^-  --              |        \     /      /       |-  --              |         \___/______/_______ Iteration space.-  --              |            /      /-  --           Element________/______/-  --            shape.-  ---  ToSeq :: ( Elt e-           , Slice slix-           , Division slsix-           , DivisionSlice slsix ~ slix-           , Typeable (FullShape slix)-           , Typeable (SliceShape slix)-           )-        => slsix-        -> acc (Array (FullShape slix) e)-        -> PreSeq acc seq exp [Array (SliceShape slix) e]--  -- Apply the given the given function to all elements of the given sequence.-  MapSeq :: (Arrays a, Arrays b)-         => (Acc a -> acc b)-         -> seq [a]-         -> PreSeq acc seq exp [b]--  -- Apply a given binary function pairwise to all elements of the given sequences.-  -- The length of the result is the length of the shorter of the two argument-  -- arrays.-  ZipWithSeq :: (Arrays a, Arrays b, Arrays c)-             => (Acc a -> Acc b -> acc c)-             -> seq [a]-             -> seq [b]-             -> PreSeq acc seq exp [c]--  -- ScanSeq (+) a0 x. Scan a sequence x by combining each element-  -- using the given binary operation (+). (+) must be associative:-  ---  --   Forall a b c. (a + b) + c = a + (b + c),-  ---  -- and a0 must be the identity element for (+):-  ---  --   Forall a. a0 + a = a = a + a0.-  ---  ScanSeq :: Elt a-          => (Exp a -> Exp a -> exp a)-          -> exp a-          -> seq [Scalar a]-          -> PreSeq acc seq exp [Scalar a]--  -- FoldSeq (+) a0 x. Fold a sequence x by combining each element-  -- using the given binary operation (+). (+) must be associative:-  ---  --   Forall a b c. (a + b) + c = a + (b + c),-  ---  -- and a0 must be the identity element for (+):-  ---  --   Forall a. a0 + a = a = a + a0.-  ---  FoldSeq :: Elt a-          => (Exp a -> Exp a -> exp a)-          -> exp a-          -> seq [Scalar a]-          -> PreSeq acc seq exp (Scalar a)--  -- FoldSeqFlatten f a0 x. A specialized version of FoldSeqAct-  -- where reduction with the companion operator corresponds to-  -- flattening. f must be semi-associative, with vecotor append (++)-  -- as the companion operator:-  ---  --   Forall b s1 a2 sh2 a2.-  --     f (f b sh1 a1) sh2 a2 = f b (sh1 ++ sh2) (a1 ++ a2).-  ---  -- It is common to ignore the shape vectors, yielding the usual-  -- semi-associativity law:-  ---  --   f b a _ = b + a,-  ---  -- for some (+) satisfying:-  ---  --   Forall b a1 a2. (b + a1) + a2 = b + (a1 ++ a2).-  ---  FoldSeqFlatten :: (Arrays a, Shape sh, Elt e)-                 => (Acc a -> Acc (Vector sh) -> Acc (Vector e) -> acc a)-                 -> acc a-                 -> seq [Array sh e]-                 -> PreSeq acc seq exp a--  -- Tuple up the results of a sequence computation. Note that the Arrays-  -- constraint requires that the elements of the tuple are Arrays, not-  -- streams ([]).-  Stuple :: (Arrays arrs, IsAtuple arrs)-         => Atuple (seq) (TupleRepr arrs)-         -> PreSeq acc seq exp arrs---- |Array-valued sequence computations----newtype Seq a = Seq (PreSeq Acc Seq Exp a)--deriving instance Typeable Seq---}----- Embedded expressions of the surface language--- ------------------------------------------------ HOAS expressions mirror the constructors of 'AST.OpenExp', but with the 'Tag'--- constructor instead of variables in the form of de Bruijn indices. Moreover,--- HOAS expression use n-tuples and the type class 'Elt' to constrain element--- types, whereas 'AST.OpenExp' uses nested pairs and the GADT 'TupleType'.------- | The type 'Exp' represents embedded scalar expressions. The collective--- operations of Accelerate 'Acc' consist of many scalar expressions executed in--- data-parallel.------ Note that scalar expressions can not initiate new collective operations:--- doing so introduces /nested data parallelism/, which is difficult to execute--- efficiently on constrained hardware such as GPUs, and is thus currently--- unsupported.----newtype Exp t = Exp (PreExp Acc Exp t)--deriving instance Typeable Exp---- | Scalar expressions to parametrise collective array operations, themselves parameterised over--- the type of collective array operations.----data PreExp acc exp t where-    -- Needed for conversion to de Bruijn form-  Tag           :: Elt t-                => Level                        -- environment size at defining occurrence-                -> PreExp acc exp t--  -- All the same constructors as 'AST.Exp'-  Const         :: Elt t-                => t-                -> PreExp acc exp t--  Tuple         :: (Elt t, IsTuple t)-                => Tuple exp (TupleRepr t)-                -> PreExp acc exp t--  Prj           :: (Elt t, IsTuple t, Elt e)-                => TupleIdx (TupleRepr t) e-                -> exp t-                -> PreExp acc exp e--  IndexNil      :: PreExp acc exp Z--  IndexCons     :: (Slice sl, Elt a)-                => exp sl-                -> exp a-                -> PreExp acc exp (sl:.a)--  IndexHead     :: (Slice sl, Elt a)-                => exp (sl:.a)-                -> PreExp acc exp a--  IndexTail     :: (Slice sl, Elt a)-                => exp (sl:.a)-                -> PreExp acc exp sl--  IndexAny      :: Shape sh-                => PreExp acc exp (Any sh)--  ToIndex       :: Shape sh-                => exp sh-                -> exp sh-                -> PreExp acc exp Int--  FromIndex     :: Shape sh-                => exp sh-                -> exp Int-                -> PreExp acc exp sh--  Cond          :: Elt t-                => exp Bool-                -> exp t-                -> exp t-                -> PreExp acc exp t--  While         :: Elt t-                => (Exp t -> exp Bool)-                -> (Exp t -> exp t)-                -> exp t-                -> PreExp acc exp t--  PrimConst     :: Elt t-                => PrimConst t-                -> PreExp acc exp t--  PrimApp       :: (Elt a, Elt r)-                => PrimFun (a -> r)-                -> exp a-                -> PreExp acc exp r--  Index         :: (Shape sh, Elt t)-                => acc (Array sh t)-                -> exp sh-                -> PreExp acc exp t--  LinearIndex   :: (Shape sh, Elt t)-                => acc (Array sh t)-                -> exp Int-                -> PreExp acc exp t--  Shape         :: (Shape sh, Elt e)-                => acc (Array sh e)-                -> PreExp acc exp sh--  ShapeSize     :: Shape sh-                => exp sh-                -> PreExp acc exp Int--  Intersect     :: Shape sh-                => exp sh-                -> exp sh-                -> PreExp acc exp sh--  Union         :: Shape sh-                => exp sh-                -> exp sh-                -> PreExp acc exp sh--  Foreign       :: (Elt x, Elt y, Foreign asm)-                => asm (x -> y)-                -> (Exp x -> Exp y) -- RCE: Using Exp instead of exp to aid in sharing recovery.-                -> exp x-                -> PreExp acc exp y----- Smart constructors and destructors for array tuples--- -----------------------------------------------------atup2 :: (Arrays a, Arrays b) => (Acc a, Acc b) -> Acc (a, b)-atup2 (a, b) = Acc $ Atuple (NilAtup `SnocAtup` a `SnocAtup` b)--atup3 :: (Arrays a, Arrays b, Arrays c) => (Acc a, Acc b, Acc c) -> Acc (a, b, c)-atup3 (a, b, c) = Acc $ Atuple (NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c)--atup4 :: (Arrays a, Arrays b, Arrays c, Arrays d)-      => (Acc a, Acc b, Acc c, Acc d) -> Acc (a, b, c, d)-atup4 (a, b, c, d)-  = Acc $ Atuple (NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d)--atup5 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e)-      => (Acc a, Acc b, Acc c, Acc d, Acc e) -> Acc (a, b, c, d, e)-atup5 (a, b, c, d, e)-  = Acc $ Atuple $-      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d `SnocAtup` e--atup6 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f)-      => (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f) -> Acc (a, b, c, d, e, f)-atup6 (a, b, c, d, e, f)-  = Acc $ Atuple $-      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c-              `SnocAtup` d `SnocAtup` e `SnocAtup` f--atup7 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g)-      => (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g)-      -> Acc (a, b, c, d, e, f, g)-atup7 (a, b, c, d, e, f, g)-  = Acc $ Atuple $-      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c-              `SnocAtup` d `SnocAtup` e `SnocAtup` f `SnocAtup` g--atup8 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h)-      => (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h)-      -> Acc (a, b, c, d, e, f, g, h)-atup8 (a, b, c, d, e, f, g, h)-  = Acc $ Atuple $-      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d-              `SnocAtup` e `SnocAtup` f `SnocAtup` g `SnocAtup` h--atup9 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i)-      => (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i)-      -> Acc (a, b, c, d, e, f, g, h, i)-atup9 (a, b, c, d, e, f, g, h, i)-  = Acc $ Atuple $-      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d-              `SnocAtup` e `SnocAtup` f `SnocAtup` g `SnocAtup` h `SnocAtup` i--atup10 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j)-       => (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i, Acc j)-       -> Acc (a, b, c, d, e, f, g, h, i, j)-atup10 (a, b, c, d, e, f, g, h, i, j)-  = Acc $ Atuple $-      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d `SnocAtup` e-              `SnocAtup` f `SnocAtup` g `SnocAtup` h `SnocAtup` i `SnocAtup` j--atup11 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k)-       => (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i, Acc j, Acc k)-       -> Acc (a, b, c, d, e, f, g, h, i, j, k)-atup11 (a, b, c, d, e, f, g, h, i, j, k)-  = Acc $ Atuple $-      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d `SnocAtup` e-              `SnocAtup` f `SnocAtup` g `SnocAtup` h `SnocAtup` i `SnocAtup` j `SnocAtup` k--atup12 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k, Arrays l)-       => (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i, Acc j, Acc k, Acc l)-       -> Acc (a, b, c, d, e, f, g, h, i, j, k, l)-atup12 (a, b, c, d, e, f, g, h, i, j, k, l)-  = Acc $ Atuple $-      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d `SnocAtup` e `SnocAtup` f-              `SnocAtup` g `SnocAtup` h `SnocAtup` i `SnocAtup` j `SnocAtup` k `SnocAtup` l--atup13 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k, Arrays l, Arrays m)-       => (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i, Acc j, Acc k, Acc l, Acc m)-       -> Acc (a, b, c, d, e, f, g, h, i, j, k, l, m)-atup13 (a, b, c, d, e, f, g, h, i, j, k, l, m)-  = Acc $ Atuple $-      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d `SnocAtup` e `SnocAtup` f-              `SnocAtup` g `SnocAtup` h `SnocAtup` i `SnocAtup` j `SnocAtup` k `SnocAtup` l `SnocAtup` m--atup14 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k, Arrays l, Arrays m, Arrays n)-       => (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i, Acc j, Acc k, Acc l, Acc m, Acc n)-       -> Acc (a, b, c, d, e, f, g, h, i, j, k, l, m, n)-atup14 (a, b, c, d, e, f, g, h, i, j, k, l, m, n)-  = Acc $ Atuple $-      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d `SnocAtup` e `SnocAtup` f `SnocAtup` g-              `SnocAtup` h `SnocAtup` i `SnocAtup` j `SnocAtup` k `SnocAtup` l `SnocAtup` m `SnocAtup` n--atup15 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k, Arrays l, Arrays m, Arrays n, Arrays o)-       => (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i, Acc j, Acc k, Acc l, Acc m, Acc n, Acc o)-       -> Acc (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)-atup15 (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)-  = Acc $ Atuple $-      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d `SnocAtup` e `SnocAtup` f `SnocAtup` g-              `SnocAtup` h `SnocAtup` i `SnocAtup` j `SnocAtup` k `SnocAtup` l `SnocAtup` m `SnocAtup` n `SnocAtup` o--unatup2 :: (Arrays a, Arrays b) => Acc (a, b) -> (Acc a, Acc b)-unatup2 e =-  ( Acc $ SuccTupIdx ZeroTupIdx `Aprj` e-  , Acc $ ZeroTupIdx `Aprj` e )--unatup3 :: (Arrays a, Arrays b, Arrays c) => Acc (a, b, c) -> (Acc a, Acc b, Acc c)-unatup3 e =-  ( Acc $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Aprj` e-  , Acc $ SuccTupIdx ZeroTupIdx `Aprj` e-  , Acc $ ZeroTupIdx `Aprj` e )--unatup4-    :: (Arrays a, Arrays b, Arrays c, Arrays d)-    => Acc (a, b, c, d) -> (Acc a, Acc b, Acc c, Acc d)-unatup4 e =-  ( Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Aprj` e-  , Acc $ SuccTupIdx ZeroTupIdx `Aprj` e-  , Acc $ ZeroTupIdx `Aprj` e )--unatup5-    :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e)-    => Acc (a, b, c, d, e) -> (Acc a, Acc b, Acc c, Acc d, Acc e)-unatup5 e =-  ( Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Aprj` e-  , Acc $ SuccTupIdx ZeroTupIdx `Aprj` e-  , Acc $ ZeroTupIdx `Aprj` e )--unatup6-    :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f)-    => Acc (a, b, c, d, e, f) -> (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f)-unatup6 e =-  ( Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Aprj` e-  , Acc $ SuccTupIdx ZeroTupIdx `Aprj` e-  , Acc $ ZeroTupIdx `Aprj` e )--unatup7-    :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g)-    => Acc (a, b, c, d, e, f, g) -> (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g)-unatup7 e =-  ( Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Aprj` e-  , Acc $ SuccTupIdx ZeroTupIdx `Aprj` e-  , Acc $ ZeroTupIdx `Aprj` e )--unatup8-    :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h)-    => Acc (a, b, c, d, e, f, g, h) -> (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h)-unatup8 e =-  ( Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Aprj` e-  , Acc $ SuccTupIdx ZeroTupIdx `Aprj` e-  , Acc $ ZeroTupIdx `Aprj` e )--unatup9-    :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i)-    => Acc (a, b, c, d, e, f, g, h, i) -> (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i)-unatup9 e =-  ( Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Aprj` e-  , Acc $ SuccTupIdx ZeroTupIdx `Aprj` e-  , Acc $ ZeroTupIdx `Aprj` e )--unatup10 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j)-         => Acc (a, b, c, d, e, f, g, h, i, j) -> (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i, Acc j)-unatup10 e =-  ( Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Aprj` e-  , Acc $ SuccTupIdx ZeroTupIdx `Aprj` e-  , Acc $ ZeroTupIdx `Aprj` e)--unatup11 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k)-         => Acc (a, b, c, d, e, f, g, h, i, j, k) -> (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i, Acc j, Acc k)-unatup11 e =-  ( Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Aprj` e-  , Acc $ SuccTupIdx ZeroTupIdx `Aprj` e-  , Acc $ ZeroTupIdx `Aprj` e)--unatup12 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k, Arrays l)-         => Acc (a, b, c, d, e, f, g, h, i, j, k, l) -> (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i, Acc j, Acc k, Acc l)-unatup12 e =-  ( Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Aprj` e-  , Acc $ SuccTupIdx ZeroTupIdx `Aprj` e-  , Acc $ ZeroTupIdx `Aprj` e)--unatup13 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k, Arrays l, Arrays m)-         => Acc (a, b, c, d, e, f, g, h, i, j, k, l, m) -> (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i, Acc j, Acc k, Acc l, Acc m)-unatup13 e =-  ( Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Aprj` e-  , Acc $ SuccTupIdx ZeroTupIdx `Aprj` e-  , Acc $ ZeroTupIdx `Aprj` e)--unatup14 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k, Arrays l, Arrays m, Arrays n)-         => Acc (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -> (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i, Acc j, Acc k, Acc l, Acc m, Acc n)-unatup14 e =-  ( Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))))))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Aprj` e-  , Acc $ SuccTupIdx ZeroTupIdx `Aprj` e-  , Acc $ ZeroTupIdx `Aprj` e)--unatup15 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k, Arrays l, Arrays m, Arrays n, Arrays o)-         => Acc (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -> (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i, Acc j, Acc k, Acc l, Acc m, Acc n, Acc o)-unatup15 e =-  ( Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))))))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))))))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Aprj` e-  , Acc $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Aprj` e-  , Acc $ SuccTupIdx ZeroTupIdx `Aprj` e-  , Acc $ ZeroTupIdx `Aprj` e)------ Smart constructors for stencil reification--- ---------------------------------------------- Stencil reification------ In the AST representation, we turn the stencil type from nested tuples of Accelerate expressions--- into an Accelerate expression whose type is a tuple nested in the same manner.  This enables us--- to represent the stencil function as a unary function (which also only needs one de Bruijn--- index). The various positions in the stencil are accessed via tuple indices (i.e., projections).--class (Elt (StencilRepr sh stencil), AST.Stencil sh a (StencilRepr sh stencil))-  => Stencil sh a stencil where-  type StencilRepr sh stencil :: *-  stencilPrj :: sh{-dummy-} -> a{-dummy-} -> Exp (StencilRepr sh stencil) -> stencil---- DIM1-instance Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e) where-  type StencilRepr DIM1 (Exp e, Exp e, Exp e)-    = (e, e, e)-  stencilPrj _ _ s = (Exp $ Prj tix2 s,-                      Exp $ Prj tix1 s,-                      Exp $ Prj tix0 s)-instance Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e) where-  type StencilRepr DIM1 (Exp e, Exp e, Exp e, Exp e, Exp e)-    = (e, e, e, e, e)-  stencilPrj _ _ s = (Exp $ Prj tix4 s,-                      Exp $ Prj tix3 s,-                      Exp $ Prj tix2 s,-                      Exp $ Prj tix1 s,-                      Exp $ Prj tix0 s)-instance Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e) where-  type StencilRepr DIM1 (Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e)-    = (e, e, e, e, e, e, e)-  stencilPrj _ _ s = (Exp $ Prj tix6 s,-                      Exp $ Prj tix5 s,-                      Exp $ Prj tix4 s,-                      Exp $ Prj tix3 s,-                      Exp $ Prj tix2 s,-                      Exp $ Prj tix1 s,-                      Exp $ Prj tix0 s)-instance Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e)-  where-  type StencilRepr DIM1 (Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e)-    = (e, e, e, e, e, e, e, e, e)-  stencilPrj _ _ s = (Exp $ Prj tix8 s,-                      Exp $ Prj tix7 s,-                      Exp $ Prj tix6 s,-                      Exp $ Prj tix5 s,-                      Exp $ Prj tix4 s,-                      Exp $ Prj tix3 s,-                      Exp $ Prj tix2 s,-                      Exp $ Prj tix1 s,-                      Exp $ Prj tix0 s)---- DIM(n+1)-instance (Stencil (sh:.Int) a row2,-          Stencil (sh:.Int) a row1,-          Stencil (sh:.Int) a row0) => Stencil (sh:.Int:.Int) a (row2, row1, row0) where-  type StencilRepr (sh:.Int:.Int) (row2, row1, row0)-    = (StencilRepr (sh:.Int) row2, StencilRepr (sh:.Int) row1, StencilRepr (sh:.Int) row0)-  stencilPrj _ a s = (stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix2 s),-                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix1 s),-                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix0 s))-instance (Stencil (sh:.Int) a row1,-          Stencil (sh:.Int) a row2,-          Stencil (sh:.Int) a row3,-          Stencil (sh:.Int) a row4,-          Stencil (sh:.Int) a row5) => Stencil (sh:.Int:.Int) a (row1, row2, row3, row4, row5) where-  type StencilRepr (sh:.Int:.Int) (row1, row2, row3, row4, row5)-    = (StencilRepr (sh:.Int) row1, StencilRepr (sh:.Int) row2, StencilRepr (sh:.Int) row3,-       StencilRepr (sh:.Int) row4, StencilRepr (sh:.Int) row5)-  stencilPrj _ a s = (stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix4 s),-                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix3 s),-                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix2 s),-                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix1 s),-                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix0 s))-instance (Stencil (sh:.Int) a row1,-          Stencil (sh:.Int) a row2,-          Stencil (sh:.Int) a row3,-          Stencil (sh:.Int) a row4,-          Stencil (sh:.Int) a row5,-          Stencil (sh:.Int) a row6,-          Stencil (sh:.Int) a row7)-  => Stencil (sh:.Int:.Int) a (row1, row2, row3, row4, row5, row6, row7) where-  type StencilRepr (sh:.Int:.Int) (row1, row2, row3, row4, row5, row6, row7)-    = (StencilRepr (sh:.Int) row1, StencilRepr (sh:.Int) row2, StencilRepr (sh:.Int) row3,-       StencilRepr (sh:.Int) row4, StencilRepr (sh:.Int) row5, StencilRepr (sh:.Int) row6,-       StencilRepr (sh:.Int) row7)-  stencilPrj _ a s = (stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix6 s),-                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix5 s),-                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix4 s),-                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix3 s),-                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix2 s),-                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix1 s),-                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix0 s))-instance (Stencil (sh:.Int) a row1,-          Stencil (sh:.Int) a row2,-          Stencil (sh:.Int) a row3,-          Stencil (sh:.Int) a row4,-          Stencil (sh:.Int) a row5,-          Stencil (sh:.Int) a row6,-          Stencil (sh:.Int) a row7,-          Stencil (sh:.Int) a row8,-          Stencil (sh:.Int) a row9)-  => Stencil (sh:.Int:.Int) a (row1, row2, row3, row4, row5, row6, row7, row8, row9) where-  type StencilRepr (sh:.Int:.Int) (row1, row2, row3, row4, row5, row6, row7, row8, row9)-    = (StencilRepr (sh:.Int) row1, StencilRepr (sh:.Int) row2, StencilRepr (sh:.Int) row3,-       StencilRepr (sh:.Int) row4, StencilRepr (sh:.Int) row5, StencilRepr (sh:.Int) row6,-       StencilRepr (sh:.Int) row7, StencilRepr (sh:.Int) row8, StencilRepr (sh:.Int) row9)-  stencilPrj _ a s = (stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix8 s),-                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix7 s),-                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix6 s),-                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix5 s),-                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix4 s),-                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix3 s),-                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix2 s),-                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix1 s),-                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix0 s))---- Auxiliary tuple index constants----tix0 :: TupleIdx (t, s0) s0-tix0 = ZeroTupIdx--tix1 :: TupleIdx ((t, s1), s0) s1-tix1 = SuccTupIdx tix0--tix2 :: TupleIdx (((t, s2), s1), s0) s2-tix2 = SuccTupIdx tix1--tix3 :: TupleIdx ((((t, s3), s2), s1), s0) s3-tix3 = SuccTupIdx tix2--tix4 :: TupleIdx (((((t, s4), s3), s2), s1), s0) s4-tix4 = SuccTupIdx tix3--tix5 :: TupleIdx ((((((t, s5), s4), s3), s2), s1), s0) s5-tix5 = SuccTupIdx tix4--tix6 :: TupleIdx (((((((t, s6), s5), s4), s3), s2), s1), s0) s6-tix6 = SuccTupIdx tix5--tix7 :: TupleIdx ((((((((t, s7), s6), s5), s4), s3), s2), s1), s0) s7-tix7 = SuccTupIdx tix6--tix8 :: TupleIdx (((((((((t, s8), s7), s6), s5), s4), s3), s2), s1), s0) s8-tix8 = SuccTupIdx tix7--{----- Smart constructors for array tuples in sequence computations--- -----------------------------------------------------stup2 :: (Arrays a, Arrays b) => (Seq a, Seq b) -> Seq (a, b)-stup2 (a, b) = Seq $ Stuple (NilAtup `SnocAtup` a `SnocAtup` b)--stup3 :: (Arrays a, Arrays b, Arrays c) => (Seq a, Seq b, Seq c) -> Seq (a, b, c)-stup3 (a, b, c) = Seq $ Stuple (NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c)--stup4 :: (Arrays a, Arrays b, Arrays c, Arrays d)-      => (Seq a, Seq b, Seq c, Seq d) -> Seq (a, b, c, d)-stup4 (a, b, c, d)-  = Seq $ Stuple (NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d)--stup5 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e)-      => (Seq a, Seq b, Seq c, Seq d, Seq e) -> Seq (a, b, c, d, e)-stup5 (a, b, c, d, e)-  = Seq $ Stuple $-      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d `SnocAtup` e--stup6 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f)-      => (Seq a, Seq b, Seq c, Seq d, Seq e, Seq f) -> Seq (a, b, c, d, e, f)-stup6 (a, b, c, d, e, f)-  = Seq $ Stuple $-      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c-              `SnocAtup` d `SnocAtup` e `SnocAtup` f--stup7 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g)-      => (Seq a, Seq b, Seq c, Seq d, Seq e, Seq f, Seq g)-      -> Seq (a, b, c, d, e, f, g)-stup7 (a, b, c, d, e, f, g)-  = Seq $ Stuple $-      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c-              `SnocAtup` d `SnocAtup` e `SnocAtup` f `SnocAtup` g--stup8 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h)-      => (Seq a, Seq b, Seq c, Seq d, Seq e, Seq f, Seq g, Seq h)-      -> Seq (a, b, c, d, e, f, g, h)-stup8 (a, b, c, d, e, f, g, h)-  = Seq $ Stuple $-      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d-              `SnocAtup` e `SnocAtup` f `SnocAtup` g `SnocAtup` h--stup9 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i)-      => (Seq a, Seq b, Seq c, Seq d, Seq e, Seq f, Seq g, Seq h, Seq i)-      -> Seq (a, b, c, d, e, f, g, h, i)-stup9 (a, b, c, d, e, f, g, h, i)-  = Seq $ Stuple $-      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d-              `SnocAtup` e `SnocAtup` f `SnocAtup` g `SnocAtup` h `SnocAtup` i--stup10 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j)-       => (Seq a, Seq b, Seq c, Seq d, Seq e, Seq f, Seq g, Seq h, Seq i, Seq j)-       -> Seq (a, b, c, d, e, f, g, h, i, j)-stup10 (a, b, c, d, e, f, g, h, i, j)-  = Seq $ Stuple $-      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d `SnocAtup` e-              `SnocAtup` f `SnocAtup` g `SnocAtup` h `SnocAtup` i `SnocAtup` j--stup11 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k)-       => (Seq a, Seq b, Seq c, Seq d, Seq e, Seq f, Seq g, Seq h, Seq i, Seq j, Seq k)-       -> Seq (a, b, c, d, e, f, g, h, i, j, k)-stup11 (a, b, c, d, e, f, g, h, i, j, k)-  = Seq $ Stuple $-      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d `SnocAtup` e-              `SnocAtup` f `SnocAtup` g `SnocAtup` h `SnocAtup` i `SnocAtup` j `SnocAtup` k--stup12 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k, Arrays l)-       => (Seq a, Seq b, Seq c, Seq d, Seq e, Seq f, Seq g, Seq h, Seq i, Seq j, Seq k, Seq l)-       -> Seq (a, b, c, d, e, f, g, h, i, j, k, l)-stup12 (a, b, c, d, e, f, g, h, i, j, k, l)-  = Seq $ Stuple $-      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d `SnocAtup` e `SnocAtup` f-              `SnocAtup` g `SnocAtup` h `SnocAtup` i `SnocAtup` j `SnocAtup` k `SnocAtup` l--stup13 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k, Arrays l, Arrays m)-       => (Seq a, Seq b, Seq c, Seq d, Seq e, Seq f, Seq g, Seq h, Seq i, Seq j, Seq k, Seq l, Seq m)-       -> Seq (a, b, c, d, e, f, g, h, i, j, k, l, m)-stup13 (a, b, c, d, e, f, g, h, i, j, k, l, m)-  = Seq $ Stuple $-      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d `SnocAtup` e `SnocAtup` f-              `SnocAtup` g `SnocAtup` h `SnocAtup` i `SnocAtup` j `SnocAtup` k `SnocAtup` l `SnocAtup` m--stup14 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k, Arrays l, Arrays m, Arrays n)-       => (Seq a, Seq b, Seq c, Seq d, Seq e, Seq f, Seq g, Seq h, Seq i, Seq j, Seq k, Seq l, Seq m, Seq n)-       -> Seq (a, b, c, d, e, f, g, h, i, j, k, l, m, n)-stup14 (a, b, c, d, e, f, g, h, i, j, k, l, m, n)-  = Seq $ Stuple $-      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d `SnocAtup` e `SnocAtup` f `SnocAtup` g-              `SnocAtup` h `SnocAtup` i `SnocAtup` j `SnocAtup` k `SnocAtup` l `SnocAtup` m `SnocAtup` n--stup15 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k, Arrays l, Arrays m, Arrays n, Arrays o)-       => (Seq a, Seq b, Seq c, Seq d, Seq e, Seq f, Seq g, Seq h, Seq i, Seq j, Seq k, Seq l, Seq m, Seq n, Seq o)-       -> Seq (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)-stup15 (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)-  = Seq $ Stuple $-      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d `SnocAtup` e `SnocAtup` f `SnocAtup` g-              `SnocAtup` h `SnocAtup` i `SnocAtup` j `SnocAtup` k `SnocAtup` l `SnocAtup` m `SnocAtup` n `SnocAtup` o---}---- Smart constructor for literals------- | Scalar expression inlet: make a Haskell value available for processing in--- an Accelerate scalar expression.------ Note that this embeds the value directly into the expression. Depending on--- the backend used to execute the computation, this might not always be--- desirable. For example, a backend that does external code generation may--- embed this constant directly into the generated code, which means new code--- will need to be generated and compiled every time the value changes. In such--- cases, consider instead lifting scalar values into (singleton) arrays so that--- they can be passed as an input to the computation and thus the value can--- change without the need to generate fresh code.----constant :: Elt t => t -> Exp t-constant = Exp . Const---- Smart constructor and destructors for scalar tuples----tup2 :: (Elt a, Elt b) => (Exp a, Exp b) -> Exp (a, b)-tup2 (a, b) = Exp $ Tuple (NilTup `SnocTup` a `SnocTup` b)--tup3 :: (Elt a, Elt b, Elt c) => (Exp a, Exp b, Exp c) -> Exp (a, b, c)-tup3 (a, b, c) = Exp $ Tuple (NilTup `SnocTup` a `SnocTup` b `SnocTup` c)--tup4 :: (Elt a, Elt b, Elt c, Elt d)-     => (Exp a, Exp b, Exp c, Exp d) -> Exp (a, b, c, d)-tup4 (a, b, c, d)-  = Exp $ Tuple (NilTup `SnocTup` a `SnocTup` b `SnocTup` c `SnocTup` d)--tup5 :: (Elt a, Elt b, Elt c, Elt d, Elt e)-     => (Exp a, Exp b, Exp c, Exp d, Exp e) -> Exp (a, b, c, d, e)-tup5 (a, b, c, d, e)-  = Exp $ Tuple $-      NilTup `SnocTup` a `SnocTup` b `SnocTup` c `SnocTup` d `SnocTup` e--tup6 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f)-     => (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f) -> Exp (a, b, c, d, e, f)-tup6 (a, b, c, d, e, f)-  = Exp $ Tuple $-      NilTup `SnocTup` a `SnocTup` b `SnocTup` c `SnocTup` d `SnocTup` e `SnocTup` f--tup7 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g)-     => (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g)-     -> Exp (a, b, c, d, e, f, g)-tup7 (a, b, c, d, e, f, g)-  = Exp $ Tuple $-      NilTup `SnocTup` a `SnocTup` b `SnocTup` c-             `SnocTup` d `SnocTup` e `SnocTup` f `SnocTup` g--tup8 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h)-     => (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h)-     -> Exp (a, b, c, d, e, f, g, h)-tup8 (a, b, c, d, e, f, g, h)-  = Exp $ Tuple $-      NilTup `SnocTup` a `SnocTup` b `SnocTup` c `SnocTup` d-             `SnocTup` e `SnocTup` f `SnocTup` g `SnocTup` h--tup9 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i)-     => (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i)-     -> Exp (a, b, c, d, e, f, g, h, i)-tup9 (a, b, c, d, e, f, g, h, i)-  = Exp $ Tuple $-      NilTup `SnocTup` a `SnocTup` b `SnocTup` c `SnocTup` d-             `SnocTup` e `SnocTup` f `SnocTup` g `SnocTup` h `SnocTup` i--tup10 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j)-      => (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i, Exp j)-      -> Exp (a, b, c, d, e, f, g, h, i, j)-tup10 (a, b, c, d, e, f, g, h, i, j)-  = Exp $ Tuple $-      NilTup `SnocTup` a `SnocTup` b `SnocTup` c `SnocTup` d `SnocTup` e-             `SnocTup` f `SnocTup` g `SnocTup` h `SnocTup` i `SnocTup` j--tup11 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j, Elt k)-      => (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i, Exp j, Exp k)-      -> Exp (a, b, c, d, e, f, g, h, i, j, k)-tup11 (a, b, c, d, e, f, g, h, i, j, k)-  = Exp $ Tuple $-      NilTup `SnocTup` a `SnocTup` b `SnocTup` c `SnocTup` d `SnocTup` e-             `SnocTup` f `SnocTup` g `SnocTup` h `SnocTup` i `SnocTup` j `SnocTup` k--tup12 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j, Elt k, Elt l)-      => (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i, Exp j, Exp k, Exp l)-      -> Exp (a, b, c, d, e, f, g, h, i, j, k, l)-tup12 (a, b, c, d, e, f, g, h, i, j, k, l)-  = Exp $ Tuple $-      NilTup `SnocTup` a `SnocTup` b `SnocTup` c `SnocTup` d `SnocTup` e `SnocTup` f-             `SnocTup` g `SnocTup` h `SnocTup` i `SnocTup` j `SnocTup` k `SnocTup` l--tup13 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j, Elt k, Elt l, Elt m)-      => (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i, Exp j, Exp k, Exp l, Exp m)-      -> Exp (a, b, c, d, e, f, g, h, i, j, k, l, m)-tup13 (a, b, c, d, e, f, g, h, i, j, k, l, m)-  = Exp $ Tuple $-      NilTup `SnocTup` a `SnocTup` b `SnocTup` c `SnocTup` d `SnocTup` e `SnocTup` f-             `SnocTup` g `SnocTup` h `SnocTup` i `SnocTup` j `SnocTup` k `SnocTup` l `SnocTup` m--tup14 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j, Elt k, Elt l, Elt m, Elt n)-      => (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i, Exp j, Exp k, Exp l, Exp m, Exp n)-      -> Exp (a, b, c, d, e, f, g, h, i, j, k, l, m, n)-tup14 (a, b, c, d, e, f, g, h, i, j, k, l, m, n)-  = Exp $ Tuple $-      NilTup `SnocTup` a `SnocTup` b `SnocTup` c `SnocTup` d `SnocTup` e `SnocTup` f `SnocTup` g-             `SnocTup` h `SnocTup` i `SnocTup` j `SnocTup` k `SnocTup` l `SnocTup` m `SnocTup` n--tup15 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j, Elt k, Elt l, Elt m, Elt n, Elt o)-      => (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i, Exp j, Exp k, Exp l, Exp m, Exp n, Exp o)-      -> Exp (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)-tup15 (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)-  = Exp $ Tuple $-      NilTup `SnocTup` a `SnocTup` b `SnocTup` c `SnocTup` d `SnocTup` e `SnocTup` f `SnocTup` g-             `SnocTup` h `SnocTup` i `SnocTup` j `SnocTup` k `SnocTup` l `SnocTup` m `SnocTup` n `SnocTup` o--untup2 :: (Elt a, Elt b) => Exp (a, b) -> (Exp a, Exp b)-untup2 e =-  ( Exp $ SuccTupIdx ZeroTupIdx `Prj` e-  , Exp $ ZeroTupIdx `Prj` e )--untup3 :: (Elt a, Elt b, Elt c) => Exp (a, b, c) -> (Exp a, Exp b, Exp c)-untup3 e =-  ( Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` e-  , Exp $ SuccTupIdx ZeroTupIdx `Prj` e-  , Exp $ ZeroTupIdx `Prj` e)--untup4 :: (Elt a, Elt b, Elt c, Elt d)-       => Exp (a, b, c, d) -> (Exp a, Exp b, Exp c, Exp d)-untup4 e =-  ( Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` e-  , Exp $ SuccTupIdx ZeroTupIdx `Prj` e-  , Exp $ ZeroTupIdx `Prj` e)--untup5 :: (Elt a, Elt b, Elt c, Elt d, Elt e)-       => Exp (a, b, c, d, e) -> (Exp a, Exp b, Exp c, Exp d, Exp e)-untup5 e =-  ( Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` e-  , Exp $ SuccTupIdx ZeroTupIdx `Prj` e-  , Exp $ ZeroTupIdx `Prj` e)--untup6 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f)-       => Exp (a, b, c, d, e, f) -> (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f)-untup6 e =-  ( Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` e-  , Exp $ SuccTupIdx ZeroTupIdx `Prj` e-  , Exp $ ZeroTupIdx `Prj` e)--untup7 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g)-       => Exp (a, b, c, d, e, f, g) -> (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g)-untup7 e =-  ( Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` e-  , Exp $ SuccTupIdx ZeroTupIdx `Prj` e-  , Exp $ ZeroTupIdx `Prj` e)--untup8 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h)-       => Exp (a, b, c, d, e, f, g, h) -> (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h)-untup8 e =-  ( Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` e-  , Exp $ SuccTupIdx ZeroTupIdx `Prj` e-  , Exp $ ZeroTupIdx `Prj` e)--untup9 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i)-       => Exp (a, b, c, d, e, f, g, h, i) -> (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i)-untup9 e =-  ( Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` e-  , Exp $ SuccTupIdx ZeroTupIdx `Prj` e-  , Exp $ ZeroTupIdx `Prj` e)--untup10 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j)-        => Exp (a, b, c, d, e, f, g, h, i, j) -> (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i, Exp j)-untup10 e =-  ( Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` e-  , Exp $ SuccTupIdx ZeroTupIdx `Prj` e-  , Exp $ ZeroTupIdx `Prj` e)--untup11 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j, Elt k)-        => Exp (a, b, c, d, e, f, g, h, i, j, k) -> (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i, Exp j, Exp k)-untup11 e =-  ( Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` e-  , Exp $ SuccTupIdx ZeroTupIdx `Prj` e-  , Exp $ ZeroTupIdx `Prj` e)--untup12 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j, Elt k, Elt l)-        => Exp (a, b, c, d, e, f, g, h, i, j, k, l) -> (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i, Exp j, Exp k, Exp l)-untup12 e =-  ( Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` e-  , Exp $ SuccTupIdx ZeroTupIdx `Prj` e-  , Exp $ ZeroTupIdx `Prj` e)--untup13 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j, Elt k, Elt l, Elt m)-        => Exp (a, b, c, d, e, f, g, h, i, j, k, l, m) -> (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i, Exp j, Exp k, Exp l, Exp m)-untup13 e =-  ( Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` e-  , Exp $ SuccTupIdx ZeroTupIdx `Prj` e-  , Exp $ ZeroTupIdx `Prj` e)--untup14 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j, Elt k, Elt l, Elt m, Elt n)-        => Exp (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -> (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i, Exp j, Exp k, Exp l, Exp m, Exp n)-untup14 e =-  ( Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))))))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` e-  , Exp $ SuccTupIdx ZeroTupIdx `Prj` e-  , Exp $ ZeroTupIdx `Prj` e)--untup15 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j, Elt k, Elt l, Elt m, Elt n, Elt o)-        => Exp (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -> (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i, Exp j, Exp k, Exp l, Exp m, Exp n, Exp o)-untup15 e =-  ( Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))))))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))))))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Prj` e-  , Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` e-  , Exp $ SuccTupIdx ZeroTupIdx `Prj` e-  , Exp $ ZeroTupIdx `Prj` e)---- Smart constructor for constants-----mkMinBound :: (Elt t, IsBounded t) => Exp t-mkMinBound = Exp $ PrimConst (PrimMinBound boundedType)--mkMaxBound :: (Elt t, IsBounded t) => Exp t-mkMaxBound = Exp $ PrimConst (PrimMaxBound boundedType)--mkPi :: (Elt r, IsFloating r) => Exp r-mkPi = Exp $ PrimConst (PrimPi floatingType)----- Smart constructors for primitive applications------- Operators from Floating--mkSin :: (Elt t, IsFloating t) => Exp t -> Exp t-mkSin x = Exp $ PrimSin floatingType `PrimApp` x--mkCos :: (Elt t, IsFloating t) => Exp t -> Exp t-mkCos x = Exp $ PrimCos floatingType `PrimApp` x--mkTan :: (Elt t, IsFloating t) => Exp t -> Exp t-mkTan x = Exp $ PrimTan floatingType `PrimApp` x--mkAsin :: (Elt t, IsFloating t) => Exp t -> Exp t-mkAsin x = Exp $ PrimAsin floatingType `PrimApp` x--mkAcos :: (Elt t, IsFloating t) => Exp t -> Exp t-mkAcos x = Exp $ PrimAcos floatingType `PrimApp` x--mkAtan :: (Elt t, IsFloating t) => Exp t -> Exp t-mkAtan x = Exp $ PrimAtan floatingType `PrimApp` x--mkSinh :: (Elt t, IsFloating t) => Exp t -> Exp t-mkSinh x = Exp $ PrimSinh floatingType `PrimApp` x--mkCosh :: (Elt t, IsFloating t) => Exp t -> Exp t-mkCosh x = Exp $ PrimCosh floatingType `PrimApp` x--mkTanh :: (Elt t, IsFloating t) => Exp t -> Exp t-mkTanh x = Exp $ PrimTanh floatingType `PrimApp` x--mkAsinh :: (Elt t, IsFloating t) => Exp t -> Exp t-mkAsinh x = Exp $ PrimAsinh floatingType `PrimApp` x--mkAcosh :: (Elt t, IsFloating t) => Exp t -> Exp t-mkAcosh x = Exp $ PrimAcosh floatingType `PrimApp` x--mkAtanh :: (Elt t, IsFloating t) => Exp t -> Exp t-mkAtanh x = Exp $ PrimAtanh floatingType `PrimApp` x--mkExpFloating :: (Elt t, IsFloating t) => Exp t -> Exp t-mkExpFloating x = Exp $ PrimExpFloating floatingType `PrimApp` x--mkSqrt :: (Elt t, IsFloating t) => Exp t -> Exp t-mkSqrt x = Exp $ PrimSqrt floatingType `PrimApp` x--mkLog :: (Elt t, IsFloating t) => Exp t -> Exp t-mkLog x = Exp $ PrimLog floatingType `PrimApp` x--mkFPow :: (Elt t, IsFloating t) => Exp t -> Exp t -> Exp t-mkFPow x y = Exp $ PrimFPow floatingType `PrimApp` tup2 (x, y)--mkLogBase :: (Elt t, IsFloating t) => Exp t -> Exp t -> Exp t-mkLogBase x y = Exp $ PrimLogBase floatingType `PrimApp` tup2 (x, y)---- Operators from Num--mkAdd :: (Elt t, IsNum t) => Exp t -> Exp t -> Exp t-mkAdd x y = Exp $ PrimAdd numType `PrimApp` tup2 (x, y)--mkSub :: (Elt t, IsNum t) => Exp t -> Exp t -> Exp t-mkSub x y = Exp $ PrimSub numType `PrimApp` tup2 (x, y)--mkMul :: (Elt t, IsNum t) => Exp t -> Exp t -> Exp t-mkMul x y = Exp $ PrimMul numType `PrimApp` tup2 (x, y)--mkNeg :: (Elt t, IsNum t) => Exp t -> Exp t-mkNeg x = Exp $ PrimNeg numType `PrimApp` x--mkAbs :: (Elt t, IsNum t) => Exp t -> Exp t-mkAbs x = Exp $ PrimAbs numType `PrimApp` x--mkSig :: (Elt t, IsNum t) => Exp t -> Exp t-mkSig x = Exp $ PrimSig numType `PrimApp` x---- Operators from Integral--mkQuot :: (Elt t, IsIntegral t) => Exp t -> Exp t -> Exp t-mkQuot x y = Exp $ PrimQuot integralType `PrimApp` tup2 (x, y)--mkRem :: (Elt t, IsIntegral t) => Exp t -> Exp t -> Exp t-mkRem x y = Exp $ PrimRem integralType `PrimApp` tup2 (x, y)--mkQuotRem :: (Elt t, IsIntegral t) => Exp t -> Exp t -> (Exp t, Exp t)-mkQuotRem x y = untup2 $ Exp $ PrimQuotRem integralType `PrimApp` tup2 (x ,y)--mkIDiv :: (Elt t, IsIntegral t) => Exp t -> Exp t -> Exp t-mkIDiv x y = Exp $ PrimIDiv integralType `PrimApp` tup2 (x, y)--mkMod :: (Elt t, IsIntegral t) => Exp t -> Exp t -> Exp t-mkMod x y = Exp $ PrimMod integralType `PrimApp` tup2 (x, y)--mkDivMod :: (Elt t, IsIntegral t) => Exp t -> Exp t -> (Exp t, Exp t)-mkDivMod x y = untup2 $ Exp $ PrimDivMod integralType `PrimApp` tup2 (x ,y)----- Operators from Bits and FiniteBits--mkBAnd :: (Elt t, IsIntegral t) => Exp t -> Exp t -> Exp t-mkBAnd x y = Exp $ PrimBAnd integralType `PrimApp` tup2 (x, y)--mkBOr :: (Elt t, IsIntegral t) => Exp t -> Exp t -> Exp t-mkBOr x y = Exp $ PrimBOr integralType `PrimApp` tup2 (x, y)--mkBXor :: (Elt t, IsIntegral t) => Exp t -> Exp t -> Exp t-mkBXor x y = Exp $ PrimBXor integralType `PrimApp` tup2 (x, y)--mkBNot :: (Elt t, IsIntegral t) => Exp t -> Exp t-mkBNot x = Exp $ PrimBNot integralType `PrimApp` x--mkBShiftL :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t-mkBShiftL x i = Exp $ PrimBShiftL integralType `PrimApp` tup2 (x, i)--mkBShiftR :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t-mkBShiftR x i = Exp $ PrimBShiftR integralType `PrimApp` tup2 (x, i)--mkBRotateL :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t-mkBRotateL x i = Exp $ PrimBRotateL integralType `PrimApp` tup2 (x, i)--mkBRotateR :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t-mkBRotateR x i = Exp $ PrimBRotateR integralType `PrimApp` tup2 (x, i)--mkPopCount :: (Elt t, IsIntegral t) => Exp t -> Exp Int-mkPopCount x = Exp $ PrimPopCount integralType `PrimApp` x--mkCountLeadingZeros :: (Elt t, IsIntegral t) => Exp t -> Exp Int-mkCountLeadingZeros x = Exp $ PrimCountLeadingZeros integralType `PrimApp` x--mkCountTrailingZeros :: (Elt t, IsIntegral t) => Exp t -> Exp Int-mkCountTrailingZeros x = Exp $ PrimCountTrailingZeros integralType `PrimApp` x----- Operators from Fractional--mkFDiv :: (Elt t, IsFloating t) => Exp t -> Exp t -> Exp t-mkFDiv x y = Exp $ PrimFDiv floatingType `PrimApp` tup2 (x, y)--mkRecip :: (Elt t, IsFloating t) => Exp t -> Exp t-mkRecip x = Exp $ PrimRecip floatingType `PrimApp` x---- Operators from RealFrac--mkTruncate :: (Elt a, Elt b, IsFloating a, IsIntegral b) => Exp a -> Exp b-mkTruncate x = Exp $ PrimTruncate floatingType integralType `PrimApp` x--mkRound :: (Elt a, Elt b, IsFloating a, IsIntegral b) => Exp a -> Exp b-mkRound x = Exp $ PrimRound floatingType integralType `PrimApp` x--mkFloor :: (Elt a, Elt b, IsFloating a, IsIntegral b) => Exp a -> Exp b-mkFloor x = Exp $ PrimFloor floatingType integralType `PrimApp` x--mkCeiling :: (Elt a, Elt b, IsFloating a, IsIntegral b) => Exp a -> Exp b-mkCeiling x = Exp $ PrimCeiling floatingType integralType `PrimApp` x---- Operators from RealFloat--mkAtan2 :: (Elt t, IsFloating t) => Exp t -> Exp t -> Exp t-mkAtan2 x y = Exp $ PrimAtan2 floatingType `PrimApp` tup2 (x, y)--mkIsNaN :: (Elt t, IsFloating t) => Exp t -> Exp Bool-mkIsNaN x = Exp $ PrimIsNaN floatingType `PrimApp` x+  Acc(..), PreAcc(..), Exp(..), PreExp(..), Boundary(..), PreBoundary(..), Stencil(..), Level,++  -- * Smart constructors for literals+  constant,++  -- * Smart constructors and destructors for tuples+  tup2, tup3, tup4, tup5, tup6, tup7, tup8, tup9, tup10, tup11, tup12, tup13, tup14, tup15,+  untup2, untup3, untup4, untup5, untup6, untup7, untup8, untup9, untup10, untup11, untup12, untup13, untup14, untup15,++  atup2, atup3, atup4, atup5, atup6, atup7, atup8, atup9, atup10, atup11, atup12, atup13, atup14, atup15,+  unatup2, unatup3, unatup4, unatup5, unatup6, unatup7, unatup8, unatup9, unatup10, unatup11, unatup12, unatup13, unatup14, unatup15,++  -- * Smart constructors for constants+  mkMinBound, mkMaxBound, mkPi,+  mkSin, mkCos, mkTan,+  mkAsin, mkAcos, mkAtan,+  mkSinh, mkCosh, mkTanh,+  mkAsinh, mkAcosh, mkAtanh,+  mkExpFloating, mkSqrt, mkLog,+  mkFPow, mkLogBase,+  mkTruncate, mkRound, mkFloor, mkCeiling,+  mkAtan2,++  -- * Smart constructors for primitive functions+  mkAdd, mkSub, mkMul, mkNeg, mkAbs, mkSig, mkQuot, mkRem, mkQuotRem, mkIDiv, mkMod, mkDivMod,+  mkBAnd, mkBOr, mkBXor, mkBNot, mkBShiftL, mkBShiftR, mkBRotateL, mkBRotateR, mkPopCount, mkCountLeadingZeros, mkCountTrailingZeros,+  mkFDiv, mkRecip, mkLt, mkGt, mkLtEq, mkGtEq, mkEq, mkNEq, mkMax, mkMin,+  mkLAnd, mkLOr, mkLNot, mkIsNaN, mkIsInfinite,++  -- * Smart constructors for type coercion functions+  mkOrd, mkChr, mkBoolToInt, mkFromIntegral, mkToFloating, mkBitcast, mkUnsafeCoerce,++  -- * Auxiliary functions+  ($$), ($$$), ($$$$), ($$$$$),++  -- Debugging+  showPreAccOp, showPreExpOp,++) where++-- standard library+import Prelude                                  hiding ( exp )+import Data.List+import Data.Typeable++-- friends+import Data.Array.Accelerate.Type+import Data.Array.Accelerate.Array.Sugar+import Data.Array.Accelerate.Product+import Data.Array.Accelerate.AST                hiding ( PreOpenAcc(..), OpenAcc(..), Acc+                                                       , PreOpenExp(..), OpenExp, PreExp, Exp+                                                       , Stencil(..), PreBoundary(..), Boundary+                                                       , showPreAccOp, showPreExpOp )+import qualified Data.Array.Accelerate.AST      as AST++-- Array computations+-- ------------------++-- | Accelerate is an /embedded language/ that distinguishes between vanilla+-- arrays (e.g. in Haskell memory on the CPU) and embedded arrays (e.g. in+-- device memory on a GPU), as well as the computations on both of these. Since+-- Accelerate is an embedded language, programs written in Accelerate are not+-- compiled by the Haskell compiler (GHC). Rather, each Accelerate backend is+-- a /runtime compiler/ which generates and executes parallel SIMD code of the+-- target language at application /runtime/.+--+-- The type constructor 'Acc' represents embedded collective array operations.+-- A term of type @Acc a@ is an Accelerate program which, once executed, will+-- produce a value of type 'a' (an 'Array' or a tuple of 'Arrays'). Collective+-- operations of type @Acc a@ comprise many /scalar expressions/, wrapped in+-- type constructor 'Exp', which will be executed in parallel. Although+-- collective operations comprise many scalar operations executed in parallel,+-- scalar operations /cannot/ initiate new collective operations: this+-- stratification between scalar operations in 'Exp' and array operations in+-- 'Acc' helps statically exclude /nested data parallelism/, which is difficult+-- to execute efficiently on constrained hardware such as GPUs.+--+-- For example, to compute a vector dot product we could write:+--+-- > dotp :: Num a => Vector a -> Vector a -> Acc (Scalar a)+-- > dotp xs ys =+-- >   let+-- >       xs' = use xs+-- >       ys' = use ys+-- >   in+-- >   fold (+) 0 ( zipWith (*) xs' ys' )+--+-- The function @dotp@ consumes two one-dimensional arrays ('Vector's) of+-- values, and produces a single ('Scalar') result as output. As the return type+-- is wrapped in the type 'Acc', we see that it is an embedded Accelerate+-- computation - it will be evaluated in the /object/ language of dynamically+-- generated parallel code, rather than the /meta/ language of vanilla Haskell.+--+-- As the arguments to @dotp@ are plain Haskell arrays, to make these available+-- to Accelerate computations they must be embedded with the+-- 'Data.Array.Accelerate.Language.use' function.+--+-- An Accelerate backend is used to evaluate the embedded computation and return+-- the result back to vanilla Haskell. Calling the 'run' function of a backend+-- will generate code for the target architecture, compile, and execute it. For+-- example, the following backends are available:+--+--  * <http://hackage.haskell.org/package/accelerate-llvm-native accelerate-llvm-native>: for execution on multicore CPUs+--  * <http://hackage.haskell.org/package/accelerate-llvm-ptx accelerate-llvm-ptx>: for execution on NVIDIA CUDA-capable GPUs+--+-- See also 'Exp', which encapsulates embedded /scalar/ computations.+--+-- [/Fusion:/]+--+-- Array computations of type 'Acc' will be subject to /array fusion/;+-- Accelerate will combine individual 'Acc' computations into a single+-- computation, which reduces the number of traversals over the input data and+-- thus improves performance. As such, it is often useful to have some intuition+-- on when fusion should occur.+--+-- The main idea is to first partition array operations into two categories:+--+--   1. Element-wise operations, such as 'Data.Array.Accelerate.map',+--      'Data.Array.Accelerate.generate', and+--      'Data.Array.Accelerate.backpermute'. Each element of these operations+--      can be computed independently of all others.+--+--   2. Collective operations such as 'Data.Array.Accelerate.fold',+--      'Data.Array.Accelerate.scanl', and 'Data.Array.Accelerate.stencil'. To+--      compute each output element of these operations requires reading+--      multiple elements from the input array(s).+--+-- Element-wise operations fuse together whenever the consumer operation uses+-- a single element of the input array. Element-wise operations can both fuse+-- their inputs into themselves, as well be fused into later operations. Both+-- these examples should fuse into a single loop:+--+-- > map -> reverse -> reshape -> map -> map+--+-- > map -> backpermute ->+-- >                       zipWith -> map+-- >           generate ->+--+-- If the consumer operation uses more than one element of the input array+-- (typically, via 'Data.Array.Accelerate.generate' indexing an array multiple+-- times), then the input array will be completely evaluated first; no fusion+-- occurs in this case, because fusing the first operation into the second+-- implies duplicating work.+--+-- On the other hand, collective operations can fuse their input arrays into+-- themselves, but on output always evaluate to an array; collective operations+-- will not be fused into a later step. For example:+--+-- >      use ->+-- >             zipWith -> fold |-> map+-- > generate ->+--+-- Here the element-wise sequence ('Data.Array.Accelerate.use'+-- + 'Data.Array.Accelerate.generate' + 'Data.Array.Accelerate.zipWith') will+-- fuse into a single operation, which then fuses into the collective+-- 'Data.Array.Accelerate.fold' operation. At this point in the program the+-- 'Data.Array.Accelerate.fold' must now be evaluated. In the final step the+-- 'Data.Array.Accelerate.map' reads in the array produced by+-- 'Data.Array.Accelerate.fold'. As there is no fusion between the+-- 'Data.Array.Accelerate.fold' and 'Data.Array.Accelerate.map' steps, this+-- program consists of two "loops"; one for the 'Data.Array.Accelerate.use'+-- + 'Data.Array.Accelerate.generate' + 'Data.Array.Accelerate.zipWith'+-- + 'Data.Array.Accelerate.fold' step, and one for the final+-- 'Data.Array.Accelerate.map' step.+--+-- You can see how many operations will be executed in the fused program by+-- 'Show'-ing the 'Acc' program, or by using the debugging option @-ddump-dot@+-- to save the program as a graphviz DOT file.+--+-- As a special note, the operations 'Data.Array.Accelerate.unzip' and+-- 'Data.Array.Accelerate.reshape', when applied to a real array, are executed+-- in constant time, so in this situation these operations will not be fused.+--+-- [/Tips:/]+--+--  * Since 'Acc' represents embedded computations that will only be executed+--    when evaluated by a backend, we can programatically generate these+--    computations using the meta language Haskell; for example, unrolling loops+--    or embedding input values into the generated code.+--+--  * It is usually best to keep all intermediate computations in 'Acc', and+--    only 'run' the computation at the very end to produce the final result.+--    This enables optimisations between intermediate results (e.g. array+--    fusion) and, if the target architecture has a separate memory space as is+--    the case of GPUs, to prevent excessive data transfers.+--+newtype Acc a = Acc (PreAcc Acc Exp a)+deriving instance Typeable Acc+++-- The level of lambda-bound variables. The root has level 0; then it increases with each bound+-- variable — i.e., it is the same as the size of the environment at the defining occurrence.+--+type Level = Int++-- | Array-valued collective computations without a recursive knot+--+data PreAcc acc exp as where+    -- Needed for conversion to de Bruijn form+  Atag          :: Arrays as+                => Level                        -- environment size at defining occurrence+                -> PreAcc acc exp as++  Pipe          :: (Arrays as, Arrays bs, Arrays cs)+                => (Acc as -> acc bs)+                -> (Acc bs -> acc cs)+                -> acc as+                -> PreAcc acc exp cs++  Aforeign      :: (Arrays as, Arrays bs, Foreign asm)+                => asm (as -> bs)+                -> (Acc as -> Acc bs)+                -> acc as+                -> PreAcc acc exp bs++  Acond         :: Arrays as+                => exp Bool+                -> acc as+                -> acc as+                -> PreAcc acc exp as++  Awhile        :: Arrays arrs+                => (Acc arrs -> acc (Scalar Bool))+                -> (Acc arrs -> acc arrs)+                -> acc arrs+                -> PreAcc acc exp arrs++  Atuple        :: (Arrays arrs, IsAtuple arrs)+                => Atuple acc (TupleRepr arrs)+                -> PreAcc acc exp arrs++  Aprj          :: (Arrays arrs, IsAtuple arrs, Arrays a)+                => TupleIdx (TupleRepr arrs) a+                ->        acc     arrs+                -> PreAcc acc exp a++  Use           :: Arrays arrs+                => arrs+                -> PreAcc acc exp arrs++  Unit          :: Elt e+                => exp e+                -> PreAcc acc exp (Scalar e)++  Generate      :: (Shape sh, Elt e)+                => exp sh+                -> (Exp sh -> exp e)+                -> PreAcc acc exp (Array sh e)++  Reshape       :: (Shape sh, Shape sh', Elt e)+                => exp sh+                -> acc (Array sh' e)+                -> PreAcc acc exp (Array sh e)++  Replicate     :: (Slice slix, Elt e)+                => exp slix+                -> acc            (Array (SliceShape slix) e)+                -> PreAcc acc exp (Array (FullShape  slix) e)++  Slice         :: (Slice slix, Elt e)+                => acc            (Array (FullShape  slix) e)+                -> exp slix+                -> PreAcc acc exp (Array (SliceShape slix) e)++  Map           :: (Shape sh, Elt e, Elt e')+                => (Exp e -> exp e')+                -> acc (Array sh e)+                -> PreAcc acc exp (Array sh e')++  ZipWith       :: (Shape sh, Elt e1, Elt e2, Elt e3)+                => (Exp e1 -> Exp e2 -> exp e3)+                -> acc (Array sh e1)+                -> acc (Array sh e2)+                -> PreAcc acc exp (Array sh e3)++  Fold          :: (Shape sh, Elt e)+                => (Exp e -> Exp e -> exp e)+                -> exp e+                -> acc (Array (sh:.Int) e)+                -> PreAcc acc exp (Array sh e)++  Fold1         :: (Shape sh, Elt e)+                => (Exp e -> Exp e -> exp e)+                -> acc (Array (sh:.Int) e)+                -> PreAcc acc exp (Array sh e)++  FoldSeg       :: (Shape sh, Elt e, Elt i, IsIntegral i)+                => (Exp e -> Exp e -> exp e)+                -> exp e+                -> acc (Array (sh:.Int) e)+                -> acc (Segments i)+                -> PreAcc acc exp (Array (sh:.Int) e)++  Fold1Seg      :: (Shape sh, Elt e, Elt i, IsIntegral i)+                => (Exp e -> Exp e -> exp e)+                -> acc (Array (sh:.Int) e)+                -> acc (Segments i)+                -> PreAcc acc exp (Array (sh:.Int) e)++  Scanl         :: (Shape sh, Elt e)+                => (Exp e -> Exp e -> exp e)+                -> exp e+                -> acc (Array (sh :. Int) e)+                -> PreAcc acc exp (Array (sh :. Int) e)++  Scanl'        :: (Shape sh, Elt e)+                => (Exp e -> Exp e -> exp e)+                -> exp e+                -> acc (Array (sh :. Int) e)+                -> PreAcc acc exp (Array (sh :. Int) e, Array sh e)++  Scanl1        :: (Shape sh, Elt e)+                => (Exp e -> Exp e -> exp e)+                -> acc (Array (sh :. Int) e)+                -> PreAcc acc exp (Array (sh :. Int) e)++  Scanr         :: (Shape sh, Elt e)+                => (Exp e -> Exp e -> exp e)+                -> exp e+                -> acc (Array (sh :. Int) e)+                -> PreAcc acc exp (Array (sh :. Int) e)++  Scanr'        :: (Shape sh, Elt e)+                => (Exp e -> Exp e -> exp e)+                -> exp e+                -> acc (Array (sh :. Int) e)+                -> PreAcc acc exp (Array (sh :. Int) e, Array sh e)++  Scanr1        :: (Shape sh, Elt e)+                => (Exp e -> Exp e -> exp e)+                -> acc (Array (sh :. Int) e)+                -> PreAcc acc exp (Array (sh :. Int) e)++  Permute       :: (Shape sh, Shape sh', Elt e)+                => (Exp e -> Exp e -> exp e)+                -> acc (Array sh' e)+                -> (Exp sh -> exp sh')+                -> acc (Array sh e)+                -> PreAcc acc exp (Array sh' e)++  Backpermute   :: (Shape sh, Shape sh', Elt e)+                => exp sh'+                -> (Exp sh' -> exp sh)+                -> acc (Array sh e)+                -> PreAcc acc exp (Array sh' e)++  Stencil       :: (Shape sh, Elt a, Elt b, Stencil sh a stencil)+                => (stencil -> exp b)+                -> PreBoundary acc exp (Array sh a)+                -> acc (Array sh a)+                -> PreAcc acc exp (Array sh b)++  Stencil2      :: (Shape sh, Elt a, Elt b, Elt c, Stencil sh a stencil1, Stencil sh b stencil2)+                => (stencil1 -> stencil2 -> exp c)+                -> PreBoundary acc exp (Array sh a)+                -> acc (Array sh a)+                -> PreBoundary acc exp (Array sh b)+                -> acc (Array sh b)+                -> PreAcc acc exp (Array sh c)++  -- Collect       :: Arrays arrs+  --               => seq arrs+  --               -> PreAcc acc seq exp arrs+++{--+data PreSeq acc seq exp arrs where+  -- Convert the given Haskell-list of arrays to a sequence.+  StreamIn :: Arrays a+           => [a]+           -> PreSeq acc seq exp [a]++  -- Convert the given array to a sequence.+  -- Example:+  -- slix = Z :. All :. Split :. All :. All :. Split+  --              ^       ^       ^      ^      ^+  --              |        \     /      /       |+  --              |         \___/______/_______ Iteration space.+  --              |            /      /+  --           Element________/______/+  --            shape.+  --+  ToSeq :: ( Elt e+           , Slice slix+           , Division slsix+           , DivisionSlice slsix ~ slix+           , Typeable (FullShape slix)+           , Typeable (SliceShape slix)+           )+        => slsix+        -> acc (Array (FullShape slix) e)+        -> PreSeq acc seq exp [Array (SliceShape slix) e]++  -- Apply the given the given function to all elements of the given sequence.+  MapSeq :: (Arrays a, Arrays b)+         => (Acc a -> acc b)+         -> seq [a]+         -> PreSeq acc seq exp [b]++  -- Apply a given binary function pairwise to all elements of the given sequences.+  -- The length of the result is the length of the shorter of the two argument+  -- arrays.+  ZipWithSeq :: (Arrays a, Arrays b, Arrays c)+             => (Acc a -> Acc b -> acc c)+             -> seq [a]+             -> seq [b]+             -> PreSeq acc seq exp [c]++  -- ScanSeq (+) a0 x. Scan a sequence x by combining each element+  -- using the given binary operation (+). (+) must be associative:+  --+  --   Forall a b c. (a + b) + c = a + (b + c),+  --+  -- and a0 must be the identity element for (+):+  --+  --   Forall a. a0 + a = a = a + a0.+  --+  ScanSeq :: Elt a+          => (Exp a -> Exp a -> exp a)+          -> exp a+          -> seq [Scalar a]+          -> PreSeq acc seq exp [Scalar a]++  -- FoldSeq (+) a0 x. Fold a sequence x by combining each element+  -- using the given binary operation (+). (+) must be associative:+  --+  --   Forall a b c. (a + b) + c = a + (b + c),+  --+  -- and a0 must be the identity element for (+):+  --+  --   Forall a. a0 + a = a = a + a0.+  --+  FoldSeq :: Elt a+          => (Exp a -> Exp a -> exp a)+          -> exp a+          -> seq [Scalar a]+          -> PreSeq acc seq exp (Scalar a)++  -- FoldSeqFlatten f a0 x. A specialized version of FoldSeqAct+  -- where reduction with the companion operator corresponds to+  -- flattening. f must be semi-associative, with vecotor append (++)+  -- as the companion operator:+  --+  --   Forall b s1 a2 sh2 a2.+  --     f (f b sh1 a1) sh2 a2 = f b (sh1 ++ sh2) (a1 ++ a2).+  --+  -- It is common to ignore the shape vectors, yielding the usual+  -- semi-associativity law:+  --+  --   f b a _ = b + a,+  --+  -- for some (+) satisfying:+  --+  --   Forall b a1 a2. (b + a1) + a2 = b + (a1 ++ a2).+  --+  FoldSeqFlatten :: (Arrays a, Shape sh, Elt e)+                 => (Acc a -> Acc (Vector sh) -> Acc (Vector e) -> acc a)+                 -> acc a+                 -> seq [Array sh e]+                 -> PreSeq acc seq exp a++  -- Tuple up the results of a sequence computation. Note that the Arrays+  -- constraint requires that the elements of the tuple are Arrays, not+  -- streams ([]).+  Stuple :: (Arrays arrs, IsAtuple arrs)+         => Atuple (seq) (TupleRepr arrs)+         -> PreSeq acc seq exp arrs++-- |Array-valued sequence computations+--+newtype Seq a = Seq (PreSeq Acc Seq Exp a)++deriving instance Typeable Seq+--}+++-- Embedded expressions of the surface language+-- --------------------------------------------++-- HOAS expressions mirror the constructors of 'AST.OpenExp', but with the 'Tag'+-- constructor instead of variables in the form of de Bruijn indices. Moreover,+-- HOAS expression use n-tuples and the type class 'Elt' to constrain element+-- types, whereas 'AST.OpenExp' uses nested pairs and the GADT 'TupleType'.+--++-- | The type 'Exp' represents embedded scalar expressions. The collective+-- operations of Accelerate 'Acc' consist of many scalar expressions executed in+-- data-parallel.+--+-- Note that scalar expressions can not initiate new collective operations:+-- doing so introduces /nested data parallelism/, which is difficult to execute+-- efficiently on constrained hardware such as GPUs, and is thus currently+-- unsupported.+--+newtype Exp t = Exp (PreExp Acc Exp t)++deriving instance Typeable Exp++-- | Scalar expressions to parametrise collective array operations, themselves parameterised over+-- the type of collective array operations.+--+data PreExp acc exp t where+    -- Needed for conversion to de Bruijn form+  Tag           :: Elt t+                => Level                        -- environment size at defining occurrence+                -> PreExp acc exp t++  -- All the same constructors as 'AST.Exp'+  Const         :: Elt t+                => t+                -> PreExp acc exp t++  Tuple         :: (Elt t, IsTuple t)+                => Tuple exp (TupleRepr t)+                -> PreExp acc exp t++  Prj           :: (Elt t, IsTuple t, Elt e)+                => TupleIdx (TupleRepr t) e+                -> exp t+                -> PreExp acc exp e++  IndexNil      :: PreExp acc exp Z++  IndexCons     :: (Slice sl, Elt a)+                => exp sl+                -> exp a+                -> PreExp acc exp (sl:.a)++  IndexHead     :: (Slice sl, Elt a)+                => exp (sl:.a)+                -> PreExp acc exp a++  IndexTail     :: (Slice sl, Elt a)+                => exp (sl:.a)+                -> PreExp acc exp sl++  IndexAny      :: Shape sh+                => PreExp acc exp (Any sh)++  ToIndex       :: Shape sh+                => exp sh+                -> exp sh+                -> PreExp acc exp Int++  FromIndex     :: Shape sh+                => exp sh+                -> exp Int+                -> PreExp acc exp sh++  Cond          :: Elt t+                => exp Bool+                -> exp t+                -> exp t+                -> PreExp acc exp t++  While         :: Elt t+                => (Exp t -> exp Bool)+                -> (Exp t -> exp t)+                -> exp t+                -> PreExp acc exp t++  PrimConst     :: Elt t+                => PrimConst t+                -> PreExp acc exp t++  PrimApp       :: (Elt a, Elt r)+                => PrimFun (a -> r)+                -> exp a+                -> PreExp acc exp r++  Index         :: (Shape sh, Elt t)+                => acc (Array sh t)+                -> exp sh+                -> PreExp acc exp t++  LinearIndex   :: (Shape sh, Elt t)+                => acc (Array sh t)+                -> exp Int+                -> PreExp acc exp t++  Shape         :: (Shape sh, Elt e)+                => acc (Array sh e)+                -> PreExp acc exp sh++  ShapeSize     :: Shape sh+                => exp sh+                -> PreExp acc exp Int++  Intersect     :: Shape sh+                => exp sh+                -> exp sh+                -> PreExp acc exp sh++  Union         :: Shape sh+                => exp sh+                -> exp sh+                -> PreExp acc exp sh++  Foreign       :: (Elt x, Elt y, Foreign asm)+                => asm (x -> y)+                -> (Exp x -> Exp y) -- RCE: Using Exp instead of exp to aid in sharing recovery.+                -> exp x+                -> PreExp acc exp y+++-- Smart constructors and destructors for array tuples+-- ---------------------------------------------------++atup2 :: (Arrays a, Arrays b)+      => (Acc a, Acc b)+      -> Acc (a, b)+atup2 (a, b)+  = Acc+  $ Atuple+  $ NilAtup `SnocAtup` a+            `SnocAtup` b++atup3 :: (Arrays a, Arrays b, Arrays c)+      => (Acc a, Acc b, Acc c)+      -> Acc (a, b, c)+atup3 (a, b, c)+  = Acc $ Atuple+  $ NilAtup `SnocAtup` a+            `SnocAtup` b+            `SnocAtup` c++atup4 :: (Arrays a, Arrays b, Arrays c, Arrays d)+      => (Acc a, Acc b, Acc c, Acc d)+      -> Acc (a, b, c, d)+atup4 (a, b, c, d)+  = Acc+  $ Atuple+  $ NilAtup `SnocAtup` a+            `SnocAtup` b+            `SnocAtup` c+            `SnocAtup` d++atup5 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e)+      => (Acc a, Acc b, Acc c, Acc d, Acc e)+      -> Acc (a, b, c, d, e)+atup5 (a, b, c, d, e)+  = Acc+  $ Atuple+  $ NilAtup `SnocAtup` a+            `SnocAtup` b+            `SnocAtup` c+            `SnocAtup` d+            `SnocAtup` e++atup6 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f)+      => (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f)+      -> Acc (a, b, c, d, e, f)+atup6 (a, b, c, d, e, f)+  = Acc+  $ Atuple+  $ NilAtup `SnocAtup` a+            `SnocAtup` b+            `SnocAtup` c+            `SnocAtup` d+            `SnocAtup` e+            `SnocAtup` f++atup7 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g)+      => (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g)+      -> Acc (a, b, c, d, e, f, g)+atup7 (a, b, c, d, e, f, g)+  = Acc+  $ Atuple+  $ NilAtup `SnocAtup` a+            `SnocAtup` b+            `SnocAtup` c+            `SnocAtup` d+            `SnocAtup` e+            `SnocAtup` f+            `SnocAtup` g++atup8 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h)+      => (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h)+      -> Acc (a, b, c, d, e, f, g, h)+atup8 (a, b, c, d, e, f, g, h)+  = Acc+  $ Atuple+  $ NilAtup `SnocAtup` a+            `SnocAtup` b+            `SnocAtup` c+            `SnocAtup` d+            `SnocAtup` e+            `SnocAtup` f+            `SnocAtup` g+            `SnocAtup` h++atup9 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i)+      => (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i)+      -> Acc (a, b, c, d, e, f, g, h, i)+atup9 (a, b, c, d, e, f, g, h, i)+  = Acc+  $ Atuple+  $ NilAtup `SnocAtup` a+            `SnocAtup` b+            `SnocAtup` c+            `SnocAtup` d+            `SnocAtup` e+            `SnocAtup` f+            `SnocAtup` g+            `SnocAtup` h+            `SnocAtup` i++atup10 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j)+       => (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i, Acc j)+       -> Acc (a, b, c, d, e, f, g, h, i, j)+atup10 (a, b, c, d, e, f, g, h, i, j)+  = Acc+  $ Atuple+  $ NilAtup `SnocAtup` a+            `SnocAtup` b+            `SnocAtup` c+            `SnocAtup` d+            `SnocAtup` e+            `SnocAtup` f+            `SnocAtup` g+            `SnocAtup` h+            `SnocAtup` i+            `SnocAtup` j++atup11 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k)+       => (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i, Acc j, Acc k)+       -> Acc (a, b, c, d, e, f, g, h, i, j, k)+atup11 (a, b, c, d, e, f, g, h, i, j, k)+  = Acc+  $ Atuple+  $ NilAtup `SnocAtup` a+            `SnocAtup` b+            `SnocAtup` c+            `SnocAtup` d+            `SnocAtup` e+            `SnocAtup` f+            `SnocAtup` g+            `SnocAtup` h+            `SnocAtup` i+            `SnocAtup` j+            `SnocAtup` k++atup12 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k, Arrays l)+       => (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i, Acc j, Acc k, Acc l)+       -> Acc (a, b, c, d, e, f, g, h, i, j, k, l)+atup12 (a, b, c, d, e, f, g, h, i, j, k, l)+  = Acc+  $ Atuple+  $ NilAtup `SnocAtup` a+            `SnocAtup` b+            `SnocAtup` c+            `SnocAtup` d+            `SnocAtup` e+            `SnocAtup` f+            `SnocAtup` g+            `SnocAtup` h+            `SnocAtup` i+            `SnocAtup` j+            `SnocAtup` k+            `SnocAtup` l++atup13 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k, Arrays l, Arrays m)+       => (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i, Acc j, Acc k, Acc l, Acc m)+       -> Acc (a, b, c, d, e, f, g, h, i, j, k, l, m)+atup13 (a, b, c, d, e, f, g, h, i, j, k, l, m)+  = Acc+  $ Atuple+  $ NilAtup `SnocAtup` a+            `SnocAtup` b+            `SnocAtup` c+            `SnocAtup` d+            `SnocAtup` e+            `SnocAtup` f+            `SnocAtup` g+            `SnocAtup` h+            `SnocAtup` i+            `SnocAtup` j+            `SnocAtup` k+            `SnocAtup` l+            `SnocAtup` m++atup14 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k, Arrays l, Arrays m, Arrays n)+       => (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i, Acc j, Acc k, Acc l, Acc m, Acc n)+       -> Acc (a, b, c, d, e, f, g, h, i, j, k, l, m, n)+atup14 (a, b, c, d, e, f, g, h, i, j, k, l, m, n)+  = Acc+  $ Atuple+  $ NilAtup `SnocAtup` a+            `SnocAtup` b+            `SnocAtup` c+            `SnocAtup` d+            `SnocAtup` e+            `SnocAtup` f+            `SnocAtup` g+            `SnocAtup` h+            `SnocAtup` i+            `SnocAtup` j+            `SnocAtup` k+            `SnocAtup` l+            `SnocAtup` m+            `SnocAtup` n++atup15 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k, Arrays l, Arrays m, Arrays n, Arrays o)+       => (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i, Acc j, Acc k, Acc l, Acc m, Acc n, Acc o)+       -> Acc (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)+atup15 (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)+  = Acc+  $ Atuple+  $ NilAtup `SnocAtup` a+            `SnocAtup` b+            `SnocAtup` c+            `SnocAtup` d+            `SnocAtup` e+            `SnocAtup` f+            `SnocAtup` g+            `SnocAtup` h+            `SnocAtup` i+            `SnocAtup` j+            `SnocAtup` k+            `SnocAtup` l+            `SnocAtup` m+            `SnocAtup` n+            `SnocAtup` o++unatup2 :: (Arrays a, Arrays b)+        => Acc (a, b)+        -> (Acc a, Acc b)+unatup2 e =+  ( Acc $ tix1 `Aprj` e+  , Acc $ tix0 `Aprj` e )++unatup3 :: (Arrays a, Arrays b, Arrays c)+        => Acc (a, b, c)+        -> (Acc a, Acc b, Acc c)+unatup3 e =+  ( Acc $ tix2 `Aprj` e+  , Acc $ tix1 `Aprj` e+  , Acc $ tix0 `Aprj` e )++unatup4+    :: (Arrays a, Arrays b, Arrays c, Arrays d)+    => Acc (a, b, c, d)+    -> (Acc a, Acc b, Acc c, Acc d)+unatup4 e =+  ( Acc $ tix3 `Aprj` e+  , Acc $ tix2 `Aprj` e+  , Acc $ tix1 `Aprj` e+  , Acc $ tix0 `Aprj` e )++unatup5+    :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e)+    => Acc (a, b, c, d, e)+    -> (Acc a, Acc b, Acc c, Acc d, Acc e)+unatup5 e =+  ( Acc $ tix4 `Aprj` e+  , Acc $ tix3 `Aprj` e+  , Acc $ tix2 `Aprj` e+  , Acc $ tix1 `Aprj` e+  , Acc $ tix0 `Aprj` e )++unatup6+    :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f)+    => Acc (a, b, c, d, e, f)+    -> (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f)+unatup6 e =+  ( Acc $ tix5 `Aprj` e+  , Acc $ tix4 `Aprj` e+  , Acc $ tix3 `Aprj` e+  , Acc $ tix2 `Aprj` e+  , Acc $ tix1 `Aprj` e+  , Acc $ tix0 `Aprj` e )++unatup7+    :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g)+    => Acc (a, b, c, d, e, f, g)+    -> (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g)+unatup7 e =+  ( Acc $ tix6 `Aprj` e+  , Acc $ tix5 `Aprj` e+  , Acc $ tix4 `Aprj` e+  , Acc $ tix3 `Aprj` e+  , Acc $ tix2 `Aprj` e+  , Acc $ tix1 `Aprj` e+  , Acc $ tix0 `Aprj` e )++unatup8+    :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h)+    => Acc (a, b, c, d, e, f, g, h)+    -> (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h)+unatup8 e =+  ( Acc $ tix7 `Aprj` e+  , Acc $ tix6 `Aprj` e+  , Acc $ tix5 `Aprj` e+  , Acc $ tix4 `Aprj` e+  , Acc $ tix3 `Aprj` e+  , Acc $ tix2 `Aprj` e+  , Acc $ tix1 `Aprj` e+  , Acc $ tix0 `Aprj` e )++unatup9+    :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i)+    => Acc (a, b, c, d, e, f, g, h, i)+    -> (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i)+unatup9 e =+  ( Acc $ tix8 `Aprj` e+  , Acc $ tix7 `Aprj` e+  , Acc $ tix6 `Aprj` e+  , Acc $ tix5 `Aprj` e+  , Acc $ tix4 `Aprj` e+  , Acc $ tix3 `Aprj` e+  , Acc $ tix2 `Aprj` e+  , Acc $ tix1 `Aprj` e+  , Acc $ tix0 `Aprj` e )++unatup10+    :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j)+    => Acc (a, b, c, d, e, f, g, h, i, j)+    -> (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i, Acc j)+unatup10 e =+  ( Acc $ tix9 `Aprj` e+  , Acc $ tix8 `Aprj` e+  , Acc $ tix7 `Aprj` e+  , Acc $ tix6 `Aprj` e+  , Acc $ tix5 `Aprj` e+  , Acc $ tix4 `Aprj` e+  , Acc $ tix3 `Aprj` e+  , Acc $ tix2 `Aprj` e+  , Acc $ tix1 `Aprj` e+  , Acc $ tix0 `Aprj` e )++unatup11+    :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k)+    => Acc (a, b, c, d, e, f, g, h, i, j, k)+    -> (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i, Acc j, Acc k)+unatup11 e =+  ( Acc $ tix10 `Aprj` e+  , Acc $ tix9  `Aprj` e+  , Acc $ tix8  `Aprj` e+  , Acc $ tix7  `Aprj` e+  , Acc $ tix6  `Aprj` e+  , Acc $ tix5  `Aprj` e+  , Acc $ tix4  `Aprj` e+  , Acc $ tix3  `Aprj` e+  , Acc $ tix2  `Aprj` e+  , Acc $ tix1  `Aprj` e+  , Acc $ tix0  `Aprj` e )++unatup12+    :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k, Arrays l)+    => Acc (a, b, c, d, e, f, g, h, i, j, k, l)+    -> (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i, Acc j, Acc k, Acc l)+unatup12 e =+  ( Acc $ tix11 `Aprj` e+  , Acc $ tix10 `Aprj` e+  , Acc $ tix9  `Aprj` e+  , Acc $ tix8  `Aprj` e+  , Acc $ tix7  `Aprj` e+  , Acc $ tix6  `Aprj` e+  , Acc $ tix5  `Aprj` e+  , Acc $ tix4  `Aprj` e+  , Acc $ tix3  `Aprj` e+  , Acc $ tix2  `Aprj` e+  , Acc $ tix1  `Aprj` e+  , Acc $ tix0  `Aprj` e )++unatup13+    :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k, Arrays l, Arrays m)+    => Acc (a, b, c, d, e, f, g, h, i, j, k, l, m)+    -> (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i, Acc j, Acc k, Acc l, Acc m)+unatup13 e =+  ( Acc $ tix12 `Aprj` e+  , Acc $ tix11 `Aprj` e+  , Acc $ tix10 `Aprj` e+  , Acc $ tix9  `Aprj` e+  , Acc $ tix8  `Aprj` e+  , Acc $ tix7  `Aprj` e+  , Acc $ tix6  `Aprj` e+  , Acc $ tix5  `Aprj` e+  , Acc $ tix4  `Aprj` e+  , Acc $ tix3  `Aprj` e+  , Acc $ tix2  `Aprj` e+  , Acc $ tix1  `Aprj` e+  , Acc $ tix0  `Aprj` e )++unatup14+    :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k, Arrays l, Arrays m, Arrays n)+    => Acc (a, b, c, d, e, f, g, h, i, j, k, l, m, n)+    -> (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i, Acc j, Acc k, Acc l, Acc m, Acc n)+unatup14 e =+  ( Acc $ tix13 `Aprj` e+  , Acc $ tix12 `Aprj` e+  , Acc $ tix11 `Aprj` e+  , Acc $ tix10 `Aprj` e+  , Acc $ tix9  `Aprj` e+  , Acc $ tix8  `Aprj` e+  , Acc $ tix7  `Aprj` e+  , Acc $ tix6  `Aprj` e+  , Acc $ tix5  `Aprj` e+  , Acc $ tix4  `Aprj` e+  , Acc $ tix3  `Aprj` e+  , Acc $ tix2  `Aprj` e+  , Acc $ tix1  `Aprj` e+  , Acc $ tix0  `Aprj` e )++unatup15+    :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k, Arrays l, Arrays m, Arrays n, Arrays o)+    => Acc (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)+    -> (Acc a, Acc b, Acc c, Acc d, Acc e, Acc f, Acc g, Acc h, Acc i, Acc j, Acc k, Acc l, Acc m, Acc n, Acc o)+unatup15 e =+  ( Acc $ tix14 `Aprj` e+  , Acc $ tix13 `Aprj` e+  , Acc $ tix12 `Aprj` e+  , Acc $ tix11 `Aprj` e+  , Acc $ tix10 `Aprj` e+  , Acc $ tix9  `Aprj` e+  , Acc $ tix8  `Aprj` e+  , Acc $ tix7  `Aprj` e+  , Acc $ tix6  `Aprj` e+  , Acc $ tix5  `Aprj` e+  , Acc $ tix4  `Aprj` e+  , Acc $ tix3  `Aprj` e+  , Acc $ tix2  `Aprj` e+  , Acc $ tix1  `Aprj` e+  , Acc $ tix0  `Aprj` e )+++-- Smart constructors for stencils+-- -------------------------------++-- | Boundary condition specification for stencil operations+--+newtype Boundary t = Boundary (PreBoundary Acc Exp t)++data PreBoundary acc exp t where+  Clamp     :: PreBoundary acc exp t+  Mirror    :: PreBoundary acc exp t+  Wrap      :: PreBoundary acc exp t++  Constant  :: Elt e+            => e+            -> PreBoundary acc exp (Array sh e)++  Function  :: (Shape sh, Elt e)+            => (Exp sh -> exp e)+            -> PreBoundary acc exp (Array sh e)+++-- Stencil reification+--+-- In the AST representation, we turn the stencil type from nested tuples of Accelerate expressions+-- into an Accelerate expression whose type is a tuple nested in the same manner.  This enables us+-- to represent the stencil function as a unary function (which also only needs one de Bruijn+-- index). The various positions in the stencil are accessed via tuple indices (i.e., projections).+--+class (Elt (StencilRepr sh stencil), AST.Stencil sh a (StencilRepr sh stencil)) => Stencil sh a stencil where+  type StencilRepr sh stencil :: *+  stencilPrj :: {-dummy-} sh+             -> {-dummy-} a+             -> Exp (StencilRepr sh stencil)+             -> stencil++-- DIM1+instance Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e) where+  type StencilRepr DIM1 (Exp e, Exp e, Exp e)+    = (e, e, e)+  stencilPrj _ _ s = (Exp $ Prj tix2 s,+                      Exp $ Prj tix1 s,+                      Exp $ Prj tix0 s)++instance Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e) where+  type StencilRepr DIM1 (Exp e, Exp e, Exp e, Exp e, Exp e)+    = (e, e, e, e, e)+  stencilPrj _ _ s = (Exp $ Prj tix4 s,+                      Exp $ Prj tix3 s,+                      Exp $ Prj tix2 s,+                      Exp $ Prj tix1 s,+                      Exp $ Prj tix0 s)++instance Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e) where+  type StencilRepr DIM1 (Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e)+    = (e, e, e, e, e, e, e)+  stencilPrj _ _ s = (Exp $ Prj tix6 s,+                      Exp $ Prj tix5 s,+                      Exp $ Prj tix4 s,+                      Exp $ Prj tix3 s,+                      Exp $ Prj tix2 s,+                      Exp $ Prj tix1 s,+                      Exp $ Prj tix0 s)++instance Elt e => Stencil DIM1 e (Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e)+  where+  type StencilRepr DIM1 (Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e, Exp e)+    = (e, e, e, e, e, e, e, e, e)+  stencilPrj _ _ s = (Exp $ Prj tix8 s,+                      Exp $ Prj tix7 s,+                      Exp $ Prj tix6 s,+                      Exp $ Prj tix5 s,+                      Exp $ Prj tix4 s,+                      Exp $ Prj tix3 s,+                      Exp $ Prj tix2 s,+                      Exp $ Prj tix1 s,+                      Exp $ Prj tix0 s)++-- DIM(n+1)+instance (Stencil (sh:.Int) a row2,+          Stencil (sh:.Int) a row1,+          Stencil (sh:.Int) a row0) => Stencil (sh:.Int:.Int) a (row2, row1, row0) where+  type StencilRepr (sh:.Int:.Int) (row2, row1, row0)+    = (StencilRepr (sh:.Int) row2, StencilRepr (sh:.Int) row1, StencilRepr (sh:.Int) row0)+  stencilPrj _ a s = (stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix2 s),+                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix1 s),+                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix0 s))++instance (Stencil (sh:.Int) a row1,+          Stencil (sh:.Int) a row2,+          Stencil (sh:.Int) a row3,+          Stencil (sh:.Int) a row4,+          Stencil (sh:.Int) a row5) => Stencil (sh:.Int:.Int) a (row1, row2, row3, row4, row5) where+  type StencilRepr (sh:.Int:.Int) (row1, row2, row3, row4, row5)+    = (StencilRepr (sh:.Int) row1, StencilRepr (sh:.Int) row2, StencilRepr (sh:.Int) row3,+       StencilRepr (sh:.Int) row4, StencilRepr (sh:.Int) row5)+  stencilPrj _ a s = (stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix4 s),+                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix3 s),+                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix2 s),+                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix1 s),+                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix0 s))++instance (Stencil (sh:.Int) a row1,+          Stencil (sh:.Int) a row2,+          Stencil (sh:.Int) a row3,+          Stencil (sh:.Int) a row4,+          Stencil (sh:.Int) a row5,+          Stencil (sh:.Int) a row6,+          Stencil (sh:.Int) a row7)+  => Stencil (sh:.Int:.Int) a (row1, row2, row3, row4, row5, row6, row7) where+  type StencilRepr (sh:.Int:.Int) (row1, row2, row3, row4, row5, row6, row7)+    = (StencilRepr (sh:.Int) row1, StencilRepr (sh:.Int) row2, StencilRepr (sh:.Int) row3,+       StencilRepr (sh:.Int) row4, StencilRepr (sh:.Int) row5, StencilRepr (sh:.Int) row6,+       StencilRepr (sh:.Int) row7)+  stencilPrj _ a s = (stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix6 s),+                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix5 s),+                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix4 s),+                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix3 s),+                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix2 s),+                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix1 s),+                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix0 s))++instance (Stencil (sh:.Int) a row1,+          Stencil (sh:.Int) a row2,+          Stencil (sh:.Int) a row3,+          Stencil (sh:.Int) a row4,+          Stencil (sh:.Int) a row5,+          Stencil (sh:.Int) a row6,+          Stencil (sh:.Int) a row7,+          Stencil (sh:.Int) a row8,+          Stencil (sh:.Int) a row9)+  => Stencil (sh:.Int:.Int) a (row1, row2, row3, row4, row5, row6, row7, row8, row9) where+  type StencilRepr (sh:.Int:.Int) (row1, row2, row3, row4, row5, row6, row7, row8, row9)+    = (StencilRepr (sh:.Int) row1, StencilRepr (sh:.Int) row2, StencilRepr (sh:.Int) row3,+       StencilRepr (sh:.Int) row4, StencilRepr (sh:.Int) row5, StencilRepr (sh:.Int) row6,+       StencilRepr (sh:.Int) row7, StencilRepr (sh:.Int) row8, StencilRepr (sh:.Int) row9)+  stencilPrj _ a s = (stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix8 s),+                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix7 s),+                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix6 s),+                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix5 s),+                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix4 s),+                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix3 s),+                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix2 s),+                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix1 s),+                      stencilPrj (undefined::(sh:.Int)) a (Exp $ Prj tix0 s))++-- Auxiliary tuple index constants+--+tix0 :: TupleIdx (t, s0) s0+tix0 = ZeroTupIdx++tix1 :: TupleIdx ((t, s1), s0) s1+tix1 = SuccTupIdx tix0++tix2 :: TupleIdx (((t, s2), s1), s0) s2+tix2 = SuccTupIdx tix1++tix3 :: TupleIdx ((((t, s3), s2), s1), s0) s3+tix3 = SuccTupIdx tix2++tix4 :: TupleIdx (((((t, s4), s3), s2), s1), s0) s4+tix4 = SuccTupIdx tix3++tix5 :: TupleIdx ((((((t, s5), s4), s3), s2), s1), s0) s5+tix5 = SuccTupIdx tix4++tix6 :: TupleIdx (((((((t, s6), s5), s4), s3), s2), s1), s0) s6+tix6 = SuccTupIdx tix5++tix7 :: TupleIdx ((((((((t, s7), s6), s5), s4), s3), s2), s1), s0) s7+tix7 = SuccTupIdx tix6++tix8 :: TupleIdx (((((((((t, s8), s7), s6), s5), s4), s3), s2), s1), s0) s8+tix8 = SuccTupIdx tix7++tix9 :: TupleIdx ((((((((((t, s9), s8), s7), s6), s5), s4), s3), s2), s1), s0) s9+tix9 = SuccTupIdx tix8++tix10 :: TupleIdx (((((((((((t, s10), s9), s8), s7), s6), s5), s4), s3), s2), s1), s0) s10+tix10 = SuccTupIdx tix9++tix11 :: TupleIdx ((((((((((((t, s11), s10), s9), s8), s7), s6), s5), s4), s3), s2), s1), s0) s11+tix11 = SuccTupIdx tix10++tix12 :: TupleIdx (((((((((((((t, s12), s11), s10), s9), s8), s7), s6), s5), s4), s3), s2), s1), s0) s12+tix12 = SuccTupIdx tix11++tix13 :: TupleIdx ((((((((((((((t, s13), s12), s11), s10), s9), s8), s7), s6), s5), s4), s3), s2), s1), s0) s13+tix13 = SuccTupIdx tix12++tix14 :: TupleIdx (((((((((((((((t, s14), s13), s12), s11), s10), s9), s8), s7), s6), s5), s4), s3), s2), s1), s0) s14+tix14 = SuccTupIdx tix13++{--+-- Smart constructors for array tuples in sequence computations+-- ---------------------------------------------------++stup2 :: (Arrays a, Arrays b) => (Seq a, Seq b) -> Seq (a, b)+stup2 (a, b) = Seq $ Stuple (NilAtup `SnocAtup` a `SnocAtup` b)++stup3 :: (Arrays a, Arrays b, Arrays c) => (Seq a, Seq b, Seq c) -> Seq (a, b, c)+stup3 (a, b, c) = Seq $ Stuple (NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c)++stup4 :: (Arrays a, Arrays b, Arrays c, Arrays d)+      => (Seq a, Seq b, Seq c, Seq d) -> Seq (a, b, c, d)+stup4 (a, b, c, d)+  = Seq $ Stuple (NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d)++stup5 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e)+      => (Seq a, Seq b, Seq c, Seq d, Seq e) -> Seq (a, b, c, d, e)+stup5 (a, b, c, d, e)+  = Seq $ Stuple $+      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d `SnocAtup` e++stup6 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f)+      => (Seq a, Seq b, Seq c, Seq d, Seq e, Seq f) -> Seq (a, b, c, d, e, f)+stup6 (a, b, c, d, e, f)+  = Seq $ Stuple $+      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c+              `SnocAtup` d `SnocAtup` e `SnocAtup` f++stup7 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g)+      => (Seq a, Seq b, Seq c, Seq d, Seq e, Seq f, Seq g)+      -> Seq (a, b, c, d, e, f, g)+stup7 (a, b, c, d, e, f, g)+  = Seq $ Stuple $+      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c+              `SnocAtup` d `SnocAtup` e `SnocAtup` f `SnocAtup` g++stup8 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h)+      => (Seq a, Seq b, Seq c, Seq d, Seq e, Seq f, Seq g, Seq h)+      -> Seq (a, b, c, d, e, f, g, h)+stup8 (a, b, c, d, e, f, g, h)+  = Seq $ Stuple $+      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d+              `SnocAtup` e `SnocAtup` f `SnocAtup` g `SnocAtup` h++stup9 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i)+      => (Seq a, Seq b, Seq c, Seq d, Seq e, Seq f, Seq g, Seq h, Seq i)+      -> Seq (a, b, c, d, e, f, g, h, i)+stup9 (a, b, c, d, e, f, g, h, i)+  = Seq $ Stuple $+      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d+              `SnocAtup` e `SnocAtup` f `SnocAtup` g `SnocAtup` h `SnocAtup` i++stup10 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j)+       => (Seq a, Seq b, Seq c, Seq d, Seq e, Seq f, Seq g, Seq h, Seq i, Seq j)+       -> Seq (a, b, c, d, e, f, g, h, i, j)+stup10 (a, b, c, d, e, f, g, h, i, j)+  = Seq $ Stuple $+      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d `SnocAtup` e+              `SnocAtup` f `SnocAtup` g `SnocAtup` h `SnocAtup` i `SnocAtup` j++stup11 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k)+       => (Seq a, Seq b, Seq c, Seq d, Seq e, Seq f, Seq g, Seq h, Seq i, Seq j, Seq k)+       -> Seq (a, b, c, d, e, f, g, h, i, j, k)+stup11 (a, b, c, d, e, f, g, h, i, j, k)+  = Seq $ Stuple $+      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d `SnocAtup` e+              `SnocAtup` f `SnocAtup` g `SnocAtup` h `SnocAtup` i `SnocAtup` j `SnocAtup` k++stup12 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k, Arrays l)+       => (Seq a, Seq b, Seq c, Seq d, Seq e, Seq f, Seq g, Seq h, Seq i, Seq j, Seq k, Seq l)+       -> Seq (a, b, c, d, e, f, g, h, i, j, k, l)+stup12 (a, b, c, d, e, f, g, h, i, j, k, l)+  = Seq $ Stuple $+      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d `SnocAtup` e `SnocAtup` f+              `SnocAtup` g `SnocAtup` h `SnocAtup` i `SnocAtup` j `SnocAtup` k `SnocAtup` l++stup13 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k, Arrays l, Arrays m)+       => (Seq a, Seq b, Seq c, Seq d, Seq e, Seq f, Seq g, Seq h, Seq i, Seq j, Seq k, Seq l, Seq m)+       -> Seq (a, b, c, d, e, f, g, h, i, j, k, l, m)+stup13 (a, b, c, d, e, f, g, h, i, j, k, l, m)+  = Seq $ Stuple $+      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d `SnocAtup` e `SnocAtup` f+              `SnocAtup` g `SnocAtup` h `SnocAtup` i `SnocAtup` j `SnocAtup` k `SnocAtup` l `SnocAtup` m++stup14 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k, Arrays l, Arrays m, Arrays n)+       => (Seq a, Seq b, Seq c, Seq d, Seq e, Seq f, Seq g, Seq h, Seq i, Seq j, Seq k, Seq l, Seq m, Seq n)+       -> Seq (a, b, c, d, e, f, g, h, i, j, k, l, m, n)+stup14 (a, b, c, d, e, f, g, h, i, j, k, l, m, n)+  = Seq $ Stuple $+      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d `SnocAtup` e `SnocAtup` f `SnocAtup` g+              `SnocAtup` h `SnocAtup` i `SnocAtup` j `SnocAtup` k `SnocAtup` l `SnocAtup` m `SnocAtup` n++stup15 :: (Arrays a, Arrays b, Arrays c, Arrays d, Arrays e, Arrays f, Arrays g, Arrays h, Arrays i, Arrays j, Arrays k, Arrays l, Arrays m, Arrays n, Arrays o)+       => (Seq a, Seq b, Seq c, Seq d, Seq e, Seq f, Seq g, Seq h, Seq i, Seq j, Seq k, Seq l, Seq m, Seq n, Seq o)+       -> Seq (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)+stup15 (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)+  = Seq $ Stuple $+      NilAtup `SnocAtup` a `SnocAtup` b `SnocAtup` c `SnocAtup` d `SnocAtup` e `SnocAtup` f `SnocAtup` g+              `SnocAtup` h `SnocAtup` i `SnocAtup` j `SnocAtup` k `SnocAtup` l `SnocAtup` m `SnocAtup` n `SnocAtup` o+--}++-- Smart constructor for literals+--++-- | Scalar expression inlet: make a Haskell value available for processing in+-- an Accelerate scalar expression.+--+-- Note that this embeds the value directly into the expression. Depending on+-- the backend used to execute the computation, this might not always be+-- desirable. For example, a backend that does external code generation may+-- embed this constant directly into the generated code, which means new code+-- will need to be generated and compiled every time the value changes. In such+-- cases, consider instead lifting scalar values into (singleton) arrays so that+-- they can be passed as an input to the computation and thus the value can+-- change without the need to generate fresh code.+--+constant :: Elt t => t -> Exp t+constant = Exp . Const++-- Smart constructor and destructors for scalar tuples+--+tup2 :: (Elt a, Elt b) => (Exp a, Exp b) -> Exp (a, b)+tup2 (a, b)+  = Exp+  $ Tuple+  $ NilTup `SnocTup` a+           `SnocTup` b++tup3 :: (Elt a, Elt b, Elt c)+     => (Exp a, Exp b, Exp c)+     -> Exp (a, b, c)+tup3 (a, b, c)+  = Exp+  $ Tuple+  $ NilTup `SnocTup` a+           `SnocTup` b+           `SnocTup` c++tup4 :: (Elt a, Elt b, Elt c, Elt d)+     => (Exp a, Exp b, Exp c, Exp d)+     -> Exp (a, b, c, d)+tup4 (a, b, c, d)+  = Exp+  $ Tuple+  $ NilTup `SnocTup` a+           `SnocTup` b+           `SnocTup` c+           `SnocTup` d++tup5 :: (Elt a, Elt b, Elt c, Elt d, Elt e)+     => (Exp a, Exp b, Exp c, Exp d, Exp e)+     -> Exp (a, b, c, d, e)+tup5 (a, b, c, d, e)+  = Exp+  $ Tuple+  $ NilTup `SnocTup` a+           `SnocTup` b+           `SnocTup` c+           `SnocTup` d+           `SnocTup` e++tup6 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f)+     => (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f)+     -> Exp (a, b, c, d, e, f)+tup6 (a, b, c, d, e, f)+  = Exp+  $ Tuple+  $ NilTup `SnocTup` a+           `SnocTup` b+           `SnocTup` c+           `SnocTup` d+           `SnocTup` e+           `SnocTup` f++tup7 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g)+     => (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g)+     -> Exp (a, b, c, d, e, f, g)+tup7 (a, b, c, d, e, f, g)+  = Exp+  $ Tuple+  $ NilTup `SnocTup` a+           `SnocTup` b+           `SnocTup` c+           `SnocTup` d+           `SnocTup` e+           `SnocTup` f+           `SnocTup` g++tup8 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h)+     => (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h)+     -> Exp (a, b, c, d, e, f, g, h)+tup8 (a, b, c, d, e, f, g, h)+  = Exp+  $ Tuple+  $ NilTup `SnocTup` a+           `SnocTup` b+           `SnocTup` c+           `SnocTup` d+           `SnocTup` e+           `SnocTup` f+           `SnocTup` g+           `SnocTup` h++tup9 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i)+     => (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i)+     -> Exp (a, b, c, d, e, f, g, h, i)+tup9 (a, b, c, d, e, f, g, h, i)+  = Exp+  $ Tuple+  $ NilTup `SnocTup` a+           `SnocTup` b+           `SnocTup` c+           `SnocTup` d+           `SnocTup` e+           `SnocTup` f+           `SnocTup` g+           `SnocTup` h+           `SnocTup` i++tup10 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j)+      => (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i, Exp j)+      -> Exp (a, b, c, d, e, f, g, h, i, j)+tup10 (a, b, c, d, e, f, g, h, i, j)+  = Exp+  $ Tuple+  $ NilTup `SnocTup` a+           `SnocTup` b+           `SnocTup` c+           `SnocTup` d+           `SnocTup` e+           `SnocTup` f+           `SnocTup` g+           `SnocTup` h+           `SnocTup` i+           `SnocTup` j++tup11 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j, Elt k)+      => (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i, Exp j, Exp k)+      -> Exp (a, b, c, d, e, f, g, h, i, j, k)+tup11 (a, b, c, d, e, f, g, h, i, j, k)+  = Exp+  $ Tuple+  $ NilTup `SnocTup` a+           `SnocTup` b+           `SnocTup` c+           `SnocTup` d+           `SnocTup` e+           `SnocTup` f+           `SnocTup` g+           `SnocTup` h+           `SnocTup` i+           `SnocTup` j+           `SnocTup` k++tup12 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j, Elt k, Elt l)+      => (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i, Exp j, Exp k, Exp l)+      -> Exp (a, b, c, d, e, f, g, h, i, j, k, l)+tup12 (a, b, c, d, e, f, g, h, i, j, k, l)+  = Exp+  $ Tuple+  $ NilTup `SnocTup` a+           `SnocTup` b+           `SnocTup` c+           `SnocTup` d+           `SnocTup` e+           `SnocTup` f+           `SnocTup` g+           `SnocTup` h+           `SnocTup` i+           `SnocTup` j+           `SnocTup` k+           `SnocTup` l++tup13 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j, Elt k, Elt l, Elt m)+      => (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i, Exp j, Exp k, Exp l, Exp m)+      -> Exp (a, b, c, d, e, f, g, h, i, j, k, l, m)+tup13 (a, b, c, d, e, f, g, h, i, j, k, l, m)+  = Exp+  $ Tuple+  $ NilTup `SnocTup` a+           `SnocTup` b+           `SnocTup` c+           `SnocTup` d+           `SnocTup` e+           `SnocTup` f+           `SnocTup` g+           `SnocTup` h+           `SnocTup` i+           `SnocTup` j+           `SnocTup` k+           `SnocTup` l+           `SnocTup` m++tup14 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j, Elt k, Elt l, Elt m, Elt n)+      => (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i, Exp j, Exp k, Exp l, Exp m, Exp n)+      -> Exp (a, b, c, d, e, f, g, h, i, j, k, l, m, n)+tup14 (a, b, c, d, e, f, g, h, i, j, k, l, m, n)+  = Exp+  $ Tuple+  $ NilTup `SnocTup` a+           `SnocTup` b+           `SnocTup` c+           `SnocTup` d+           `SnocTup` e+           `SnocTup` f+           `SnocTup` g+           `SnocTup` h+           `SnocTup` i+           `SnocTup` j+           `SnocTup` k+           `SnocTup` l+           `SnocTup` m+           `SnocTup` n++tup15 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j, Elt k, Elt l, Elt m, Elt n, Elt o)+      => (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i, Exp j, Exp k, Exp l, Exp m, Exp n, Exp o)+      -> Exp (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)+tup15 (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)+  = Exp+  $ Tuple+  $ NilTup `SnocTup` a+           `SnocTup` b+           `SnocTup` c+           `SnocTup` d+           `SnocTup` e+           `SnocTup` f+           `SnocTup` g+           `SnocTup` h+           `SnocTup` i+           `SnocTup` j+           `SnocTup` k+           `SnocTup` l+           `SnocTup` m+           `SnocTup` n+           `SnocTup` o++untup2 :: (Elt a, Elt b) => Exp (a, b) -> (Exp a, Exp b)+untup2 e =+  ( Exp $ tix1 `Prj` e+  , Exp $ tix0 `Prj` e )++untup3 :: (Elt a, Elt b, Elt c) => Exp (a, b, c) -> (Exp a, Exp b, Exp c)+untup3 e =+  ( Exp $ tix2 `Prj` e+  , Exp $ tix1 `Prj` e+  , Exp $ tix0 `Prj` e )++untup4 :: (Elt a, Elt b, Elt c, Elt d)+       => Exp (a, b, c, d)+       -> (Exp a, Exp b, Exp c, Exp d)+untup4 e =+  ( Exp $ tix3 `Prj` e+  , Exp $ tix2 `Prj` e+  , Exp $ tix1 `Prj` e+  , Exp $ tix0 `Prj` e )++untup5 :: (Elt a, Elt b, Elt c, Elt d, Elt e)+       => Exp (a, b, c, d, e)+       -> (Exp a, Exp b, Exp c, Exp d, Exp e)+untup5 e =+  ( Exp $ tix4 `Prj` e+  , Exp $ tix3 `Prj` e+  , Exp $ tix2 `Prj` e+  , Exp $ tix1 `Prj` e+  , Exp $ tix0 `Prj` e )++untup6 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f)+       => Exp (a, b, c, d, e, f)+       -> (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f)+untup6 e =+  ( Exp $ tix5 `Prj` e+  , Exp $ tix4 `Prj` e+  , Exp $ tix3 `Prj` e+  , Exp $ tix2 `Prj` e+  , Exp $ tix1 `Prj` e+  , Exp $ tix0 `Prj` e )++untup7 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g)+       => Exp (a, b, c, d, e, f, g)+       -> (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g)+untup7 e =+  ( Exp $ tix6 `Prj` e+  , Exp $ tix5 `Prj` e+  , Exp $ tix4 `Prj` e+  , Exp $ tix3 `Prj` e+  , Exp $ tix2 `Prj` e+  , Exp $ tix1 `Prj` e+  , Exp $ tix0 `Prj` e )++untup8 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h)+       => Exp (a, b, c, d, e, f, g, h)+       -> (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h)+untup8 e =+  ( Exp $ tix7 `Prj` e+  , Exp $ tix6 `Prj` e+  , Exp $ tix5 `Prj` e+  , Exp $ tix4 `Prj` e+  , Exp $ tix3 `Prj` e+  , Exp $ tix2 `Prj` e+  , Exp $ tix1 `Prj` e+  , Exp $ tix0 `Prj` e )++untup9 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i)+       => Exp (a, b, c, d, e, f, g, h, i)+       -> (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i)+untup9 e =+  ( Exp $ tix8 `Prj` e+  , Exp $ tix7 `Prj` e+  , Exp $ tix6 `Prj` e+  , Exp $ tix5 `Prj` e+  , Exp $ tix4 `Prj` e+  , Exp $ tix3 `Prj` e+  , Exp $ tix2 `Prj` e+  , Exp $ tix1 `Prj` e+  , Exp $ tix0 `Prj` e )++untup10 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j)+        => Exp (a, b, c, d, e, f, g, h, i, j)+        -> (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i, Exp j)+untup10 e =+  ( Exp $ tix9 `Prj` e+  , Exp $ tix8 `Prj` e+  , Exp $ tix7 `Prj` e+  , Exp $ tix6 `Prj` e+  , Exp $ tix5 `Prj` e+  , Exp $ tix4 `Prj` e+  , Exp $ tix3 `Prj` e+  , Exp $ tix2 `Prj` e+  , Exp $ tix1 `Prj` e+  , Exp $ tix0 `Prj` e )++untup11 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j, Elt k)+        => Exp (a, b, c, d, e, f, g, h, i, j, k)+        -> (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i, Exp j, Exp k)+untup11 e =+  ( Exp $ tix10 `Prj` e+  , Exp $ tix9  `Prj` e+  , Exp $ tix8  `Prj` e+  , Exp $ tix7  `Prj` e+  , Exp $ tix6  `Prj` e+  , Exp $ tix5  `Prj` e+  , Exp $ tix4  `Prj` e+  , Exp $ tix3  `Prj` e+  , Exp $ tix2  `Prj` e+  , Exp $ tix1  `Prj` e+  , Exp $ tix0  `Prj` e )++untup12 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j, Elt k, Elt l)+        => Exp (a, b, c, d, e, f, g, h, i, j, k, l)+        -> (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i, Exp j, Exp k, Exp l)+untup12 e =+  ( Exp $ tix11 `Prj` e+  , Exp $ tix10 `Prj` e+  , Exp $ tix9  `Prj` e+  , Exp $ tix8  `Prj` e+  , Exp $ tix7  `Prj` e+  , Exp $ tix6  `Prj` e+  , Exp $ tix5  `Prj` e+  , Exp $ tix4  `Prj` e+  , Exp $ tix3  `Prj` e+  , Exp $ tix2  `Prj` e+  , Exp $ tix1  `Prj` e+  , Exp $ tix0  `Prj` e )++untup13 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j, Elt k, Elt l, Elt m)+        => Exp (a, b, c, d, e, f, g, h, i, j, k, l, m)+        -> (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i, Exp j, Exp k, Exp l, Exp m)+untup13 e =+  ( Exp $ tix12 `Prj` e+  , Exp $ tix11 `Prj` e+  , Exp $ tix10 `Prj` e+  , Exp $ tix9  `Prj` e+  , Exp $ tix8  `Prj` e+  , Exp $ tix7  `Prj` e+  , Exp $ tix6  `Prj` e+  , Exp $ tix5  `Prj` e+  , Exp $ tix4  `Prj` e+  , Exp $ tix3  `Prj` e+  , Exp $ tix2  `Prj` e+  , Exp $ tix1  `Prj` e+  , Exp $ tix0  `Prj` e )++untup14 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j, Elt k, Elt l, Elt m, Elt n)+        => Exp (a, b, c, d, e, f, g, h, i, j, k, l, m, n)+        -> (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i, Exp j, Exp k, Exp l, Exp m, Exp n)+untup14 e =+  ( Exp $ tix13 `Prj` e+  , Exp $ tix12 `Prj` e+  , Exp $ tix11 `Prj` e+  , Exp $ tix10 `Prj` e+  , Exp $ tix9  `Prj` e+  , Exp $ tix8  `Prj` e+  , Exp $ tix7  `Prj` e+  , Exp $ tix6  `Prj` e+  , Exp $ tix5  `Prj` e+  , Exp $ tix4  `Prj` e+  , Exp $ tix3  `Prj` e+  , Exp $ tix2  `Prj` e+  , Exp $ tix1  `Prj` e+  , Exp $ tix0  `Prj` e )++untup15 :: (Elt a, Elt b, Elt c, Elt d, Elt e, Elt f, Elt g, Elt h, Elt i, Elt j, Elt k, Elt l, Elt m, Elt n, Elt o)+        => Exp (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)+        -> (Exp a, Exp b, Exp c, Exp d, Exp e, Exp f, Exp g, Exp h, Exp i, Exp j, Exp k, Exp l, Exp m, Exp n, Exp o)+untup15 e =+  ( Exp $ tix14 `Prj` e+  , Exp $ tix13 `Prj` e+  , Exp $ tix12 `Prj` e+  , Exp $ tix11 `Prj` e+  , Exp $ tix10 `Prj` e+  , Exp $ tix9  `Prj` e+  , Exp $ tix8  `Prj` e+  , Exp $ tix7  `Prj` e+  , Exp $ tix6  `Prj` e+  , Exp $ tix5  `Prj` e+  , Exp $ tix4  `Prj` e+  , Exp $ tix3  `Prj` e+  , Exp $ tix2  `Prj` e+  , Exp $ tix1  `Prj` e+  , Exp $ tix0  `Prj` e )+++-- Smart constructor for constants+--++mkMinBound :: (Elt t, IsBounded t) => Exp t+mkMinBound = Exp $ PrimConst (PrimMinBound boundedType)++mkMaxBound :: (Elt t, IsBounded t) => Exp t+mkMaxBound = Exp $ PrimConst (PrimMaxBound boundedType)++mkPi :: (Elt r, IsFloating r) => Exp r+mkPi = Exp $ PrimConst (PrimPi floatingType)+++-- Smart constructors for primitive applications+--++-- Operators from Floating++mkSin :: (Elt t, IsFloating t) => Exp t -> Exp t+mkSin x = Exp $ PrimSin floatingType `PrimApp` x++mkCos :: (Elt t, IsFloating t) => Exp t -> Exp t+mkCos x = Exp $ PrimCos floatingType `PrimApp` x++mkTan :: (Elt t, IsFloating t) => Exp t -> Exp t+mkTan x = Exp $ PrimTan floatingType `PrimApp` x++mkAsin :: (Elt t, IsFloating t) => Exp t -> Exp t+mkAsin x = Exp $ PrimAsin floatingType `PrimApp` x++mkAcos :: (Elt t, IsFloating t) => Exp t -> Exp t+mkAcos x = Exp $ PrimAcos floatingType `PrimApp` x++mkAtan :: (Elt t, IsFloating t) => Exp t -> Exp t+mkAtan x = Exp $ PrimAtan floatingType `PrimApp` x++mkSinh :: (Elt t, IsFloating t) => Exp t -> Exp t+mkSinh x = Exp $ PrimSinh floatingType `PrimApp` x++mkCosh :: (Elt t, IsFloating t) => Exp t -> Exp t+mkCosh x = Exp $ PrimCosh floatingType `PrimApp` x++mkTanh :: (Elt t, IsFloating t) => Exp t -> Exp t+mkTanh x = Exp $ PrimTanh floatingType `PrimApp` x++mkAsinh :: (Elt t, IsFloating t) => Exp t -> Exp t+mkAsinh x = Exp $ PrimAsinh floatingType `PrimApp` x++mkAcosh :: (Elt t, IsFloating t) => Exp t -> Exp t+mkAcosh x = Exp $ PrimAcosh floatingType `PrimApp` x++mkAtanh :: (Elt t, IsFloating t) => Exp t -> Exp t+mkAtanh x = Exp $ PrimAtanh floatingType `PrimApp` x++mkExpFloating :: (Elt t, IsFloating t) => Exp t -> Exp t+mkExpFloating x = Exp $ PrimExpFloating floatingType `PrimApp` x++mkSqrt :: (Elt t, IsFloating t) => Exp t -> Exp t+mkSqrt x = Exp $ PrimSqrt floatingType `PrimApp` x++mkLog :: (Elt t, IsFloating t) => Exp t -> Exp t+mkLog x = Exp $ PrimLog floatingType `PrimApp` x++mkFPow :: (Elt t, IsFloating t) => Exp t -> Exp t -> Exp t+mkFPow x y = Exp $ PrimFPow floatingType `PrimApp` tup2 (x, y)++mkLogBase :: (Elt t, IsFloating t) => Exp t -> Exp t -> Exp t+mkLogBase x y = Exp $ PrimLogBase floatingType `PrimApp` tup2 (x, y)++-- Operators from Num++mkAdd :: (Elt t, IsNum t) => Exp t -> Exp t -> Exp t+mkAdd x y = Exp $ PrimAdd numType `PrimApp` tup2 (x, y)++mkSub :: (Elt t, IsNum t) => Exp t -> Exp t -> Exp t+mkSub x y = Exp $ PrimSub numType `PrimApp` tup2 (x, y)++mkMul :: (Elt t, IsNum t) => Exp t -> Exp t -> Exp t+mkMul x y = Exp $ PrimMul numType `PrimApp` tup2 (x, y)++mkNeg :: (Elt t, IsNum t) => Exp t -> Exp t+mkNeg x = Exp $ PrimNeg numType `PrimApp` x++mkAbs :: (Elt t, IsNum t) => Exp t -> Exp t+mkAbs x = Exp $ PrimAbs numType `PrimApp` x++mkSig :: (Elt t, IsNum t) => Exp t -> Exp t+mkSig x = Exp $ PrimSig numType `PrimApp` x++-- Operators from Integral++mkQuot :: (Elt t, IsIntegral t) => Exp t -> Exp t -> Exp t+mkQuot x y = Exp $ PrimQuot integralType `PrimApp` tup2 (x, y)++mkRem :: (Elt t, IsIntegral t) => Exp t -> Exp t -> Exp t+mkRem x y = Exp $ PrimRem integralType `PrimApp` tup2 (x, y)++mkQuotRem :: (Elt t, IsIntegral t) => Exp t -> Exp t -> (Exp t, Exp t)+mkQuotRem x y = untup2 $ Exp $ PrimQuotRem integralType `PrimApp` tup2 (x ,y)++mkIDiv :: (Elt t, IsIntegral t) => Exp t -> Exp t -> Exp t+mkIDiv x y = Exp $ PrimIDiv integralType `PrimApp` tup2 (x, y)++mkMod :: (Elt t, IsIntegral t) => Exp t -> Exp t -> Exp t+mkMod x y = Exp $ PrimMod integralType `PrimApp` tup2 (x, y)++mkDivMod :: (Elt t, IsIntegral t) => Exp t -> Exp t -> (Exp t, Exp t)+mkDivMod x y = untup2 $ Exp $ PrimDivMod integralType `PrimApp` tup2 (x ,y)+++-- Operators from Bits and FiniteBits++mkBAnd :: (Elt t, IsIntegral t) => Exp t -> Exp t -> Exp t+mkBAnd x y = Exp $ PrimBAnd integralType `PrimApp` tup2 (x, y)++mkBOr :: (Elt t, IsIntegral t) => Exp t -> Exp t -> Exp t+mkBOr x y = Exp $ PrimBOr integralType `PrimApp` tup2 (x, y)++mkBXor :: (Elt t, IsIntegral t) => Exp t -> Exp t -> Exp t+mkBXor x y = Exp $ PrimBXor integralType `PrimApp` tup2 (x, y)++mkBNot :: (Elt t, IsIntegral t) => Exp t -> Exp t+mkBNot x = Exp $ PrimBNot integralType `PrimApp` x++mkBShiftL :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t+mkBShiftL x i = Exp $ PrimBShiftL integralType `PrimApp` tup2 (x, i)++mkBShiftR :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t+mkBShiftR x i = Exp $ PrimBShiftR integralType `PrimApp` tup2 (x, i)++mkBRotateL :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t+mkBRotateL x i = Exp $ PrimBRotateL integralType `PrimApp` tup2 (x, i)++mkBRotateR :: (Elt t, IsIntegral t) => Exp t -> Exp Int -> Exp t+mkBRotateR x i = Exp $ PrimBRotateR integralType `PrimApp` tup2 (x, i)++mkPopCount :: (Elt t, IsIntegral t) => Exp t -> Exp Int+mkPopCount x = Exp $ PrimPopCount integralType `PrimApp` x++mkCountLeadingZeros :: (Elt t, IsIntegral t) => Exp t -> Exp Int+mkCountLeadingZeros x = Exp $ PrimCountLeadingZeros integralType `PrimApp` x++mkCountTrailingZeros :: (Elt t, IsIntegral t) => Exp t -> Exp Int+mkCountTrailingZeros x = Exp $ PrimCountTrailingZeros integralType `PrimApp` x+++-- Operators from Fractional++mkFDiv :: (Elt t, IsFloating t) => Exp t -> Exp t -> Exp t+mkFDiv x y = Exp $ PrimFDiv floatingType `PrimApp` tup2 (x, y)++mkRecip :: (Elt t, IsFloating t) => Exp t -> Exp t+mkRecip x = Exp $ PrimRecip floatingType `PrimApp` x++-- Operators from RealFrac++mkTruncate :: (Elt a, Elt b, IsFloating a, IsIntegral b) => Exp a -> Exp b+mkTruncate x = Exp $ PrimTruncate floatingType integralType `PrimApp` x++mkRound :: (Elt a, Elt b, IsFloating a, IsIntegral b) => Exp a -> Exp b+mkRound x = Exp $ PrimRound floatingType integralType `PrimApp` x++mkFloor :: (Elt a, Elt b, IsFloating a, IsIntegral b) => Exp a -> Exp b+mkFloor x = Exp $ PrimFloor floatingType integralType `PrimApp` x++mkCeiling :: (Elt a, Elt b, IsFloating a, IsIntegral b) => Exp a -> Exp b+mkCeiling x = Exp $ PrimCeiling floatingType integralType `PrimApp` x++-- Operators from RealFloat++mkAtan2 :: (Elt t, IsFloating t) => Exp t -> Exp t -> Exp t+mkAtan2 x y = Exp $ PrimAtan2 floatingType `PrimApp` tup2 (x, y)++mkIsNaN :: (Elt t, IsFloating t) => Exp t -> Exp Bool+mkIsNaN x = Exp $ PrimIsNaN floatingType `PrimApp` x++mkIsInfinite :: (Elt t, IsFloating t) => Exp t -> Exp Bool+mkIsInfinite x = Exp $ PrimIsInfinite floatingType `PrimApp` x  -- FIXME: add missing operations from Floating, RealFrac & RealFloat
Data/Array/Accelerate/Trafo.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE CPP                  #-} {-# LANGUAGE FlexibleContexts     #-} {-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE MonoLocalBinds       #-} {-# LANGUAGE RecordWildCards      #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-}@@ -20,10 +21,16 @@   -- * HOAS -> de Bruijn conversion   Phase(..), phases, -  convertAcc,  convertAccWith,+  -- ** Array computations+  convertAcc, convertAccWith,++  -- ** Array functions+  Afunction, AfunctionR,   convertAfun, convertAfunWith,-  -- convertSeq,  convertSeqWith, +  -- ** Sequence computations+  -- convertSeq, convertSeqWith,+   -- * Fusion   module Data.Array.Accelerate.Trafo.Fusion,   -- DelayedSeq(..), Extend(..),@@ -33,6 +40,9 @@    -- * Term equality   Match(..), (:~:)(..),++  -- ** Auxiliary+  matchDelayedOpenAcc, hashDelayedOpenAcc,  ) where
Data/Array/Accelerate/Trafo/Algebra.hs view
@@ -147,6 +147,7 @@       PrimFloor ta tb           -> evalFloor ta tb x env       PrimCeiling ta tb         -> evalCeiling ta tb x env       PrimIsNaN ty              -> evalIsNaN ty x env+      PrimIsInfinite ty         -> evalIsInfinite ty x env       PrimLt ty                 -> evalLt ty x env       PrimGt ty                 -> evalGt ty x env       PrimLtEq ty               -> evalLtEq ty x env@@ -601,6 +602,9 @@  evalIsNaN :: FloatingType a -> a :-> Bool evalIsNaN ty | FloatingDict <- floatingDict ty = eval1 isNaN++evalIsInfinite :: FloatingType a -> a :-> Bool+evalIsInfinite ty | FloatingDict <- floatingDict ty = eval1 isInfinite   -- Relational & Equality
Data/Array/Accelerate/Trafo/Base.hs view
@@ -36,6 +36,7 @@   DelayedAfun, DelayedOpenAfun,   DelayedExp, DelayedFun, DelayedOpenExp, DelayedOpenFun,   -- DelayedSeq(..), DelayedOpenSeq,+  matchDelayedOpenAcc, hashDelayedOpenAcc,    -- Environments   Gamma(..), incExp, prjExp, lookupExp,@@ -57,6 +58,7 @@  -- friends import Data.Array.Accelerate.AST                        hiding ( Val(..) )+import Data.Array.Accelerate.Analysis.Hash import Data.Array.Accelerate.Analysis.Match import Data.Array.Accelerate.Array.Sugar                ( Array, Arrays, Shape, Elt ) import Data.Array.Accelerate.Error@@ -183,9 +185,9 @@   {-# INLINEABLE hashAcc   #-}   {-# INLINEABLE matchAcc  #-}   {-# INLINEABLE prettyAcc #-}-  hashAcc                 = hashDelayed-  matchAcc                = matchDelayed-  prettyAcc               = prettyDelayed+  hashAcc                 = hashDelayedOpenAcc+  matchAcc                = matchDelayedOpenAcc+  prettyAcc               = prettyDelayedOpenAcc  instance NFData (DelayedOpenAfun aenv t) where   rnf = rnfPreOpenAfun rnfDelayedOpenAcc@@ -196,24 +198,24 @@ -- instance NFData (DelayedSeq t) where --   rnf = rnfDelayedSeq -hashDelayed :: HashAcc DelayedOpenAcc-hashDelayed (Manifest pacc)     = hash "Manifest" `hashWithSalt` hashPreOpenAcc hashAcc pacc-hashDelayed Delayed{..}         = hash "Delayed"  `hashE` extentD `hashF` indexD `hashF` linearIndexD+hashDelayedOpenAcc :: HashAcc DelayedOpenAcc+hashDelayedOpenAcc (Manifest pacc)     = $(hashQ "Manifest") `hashWithSalt` hashPreOpenAcc hashAcc pacc+hashDelayedOpenAcc Delayed{..}         = $(hashQ "Delayed")  `hashE` extentD `hashF` indexD `hashF` linearIndexD   where     hashE salt = hashWithSalt salt . hashPreOpenExp hashAcc     hashF salt = hashWithSalt salt . hashPreOpenFun hashAcc -matchDelayed :: MatchAcc DelayedOpenAcc-matchDelayed (Manifest pacc1) (Manifest pacc2)+matchDelayedOpenAcc :: MatchAcc DelayedOpenAcc+matchDelayedOpenAcc (Manifest pacc1) (Manifest pacc2)   = matchPreOpenAcc matchAcc hashAcc pacc1 pacc2 -matchDelayed (Delayed sh1 ix1 lx1) (Delayed sh2 ix2 lx2)+matchDelayedOpenAcc (Delayed sh1 ix1 lx1) (Delayed sh2 ix2 lx2)   | Just Refl <- matchPreOpenExp matchAcc hashAcc sh1 sh2   , Just Refl <- matchPreOpenFun matchAcc hashAcc ix1 ix2   , Just Refl <- matchPreOpenFun matchAcc hashAcc lx1 lx2   = Just Refl -matchDelayed _ _+matchDelayedOpenAcc _ _   = Nothing  rnfDelayedOpenAcc :: DelayedOpenAcc aenv t -> ()@@ -242,18 +244,18 @@ -- -- > let a0 = <...> in map f a0 ---prettyDelayed :: PrettyAcc DelayedOpenAcc-prettyDelayed wrap aenv acc = case acc of-  Manifest pacc         -> prettyPreOpenAcc prettyDelayed wrap aenv pacc+prettyDelayedOpenAcc :: PrettyAcc DelayedOpenAcc+prettyDelayedOpenAcc wrap aenv acc = case acc of+  Manifest pacc         -> prettyPreOpenAcc prettyDelayedOpenAcc wrap aenv pacc   Delayed sh f _     | Shape a           <- sh     , Just Refl         <- match f (Lam (Body (Index a (Var ZeroIdx))))-    -> prettyDelayed wrap aenv a+    -> prettyDelayedOpenAcc wrap aenv a      | otherwise     -> wrap $ hang (text "Delayed") 2-            $ sep [ prettyPreExp prettyDelayed parens aenv sh-                  , parens (prettyPreFun prettyDelayed aenv f)+            $ sep [ prettyPreExp prettyDelayedOpenAcc parens aenv sh+                  , parens (prettyPreFun prettyDelayedOpenAcc aenv f)                   ]
Data/Array/Accelerate/Trafo/Fusion.hs view
@@ -197,8 +197,8 @@     Scanr1 f a              -> Scanr1   (cvtF f) (delayed fuseAcc a)     Scanr' f z a            -> Scanr'   (cvtF f) (cvtE z) (delayed fuseAcc a)     Permute f d p a         -> Permute  (cvtF f) (manifest fuseAcc d) (cvtF p) (delayed fuseAcc a)-    Stencil f x a           -> Stencil  (cvtF f) x (manifest fuseAcc a)-    Stencil2 f x a y b      -> Stencil2 (cvtF f) x (manifest fuseAcc a) y (manifest fuseAcc b)+    Stencil f x a           -> Stencil  (cvtF f) (cvtB x) (manifest fuseAcc a)+    Stencil2 f x a y b      -> Stencil2 (cvtF f) (cvtB x) (manifest fuseAcc a) (cvtB y) (manifest fuseAcc b)     -- Collect s               -> Collect  (cvtS s)      where@@ -233,6 +233,13 @@       cvtE :: OpenExp env aenv t -> DelayedOpenExp env aenv t       cvtE = convertOpenExp fuseAcc +      cvtB :: Boundary aenv t -> PreBoundary DelayedOpenAcc aenv t+      cvtB Clamp        = Clamp+      cvtB Mirror       = Mirror+      cvtB Wrap         = Wrap+      cvtB (Constant v) = Constant v+      cvtB (Function f) = Function (cvtF f)+ convertOpenExp :: Bool -> OpenExp env aenv t -> DelayedOpenExp env aenv t convertOpenExp fuseAcc exp =   case exp of@@ -435,8 +442,8 @@     Scanr1 f a          -> embed  (into  Scanr1        (cvtF f)) a     Scanr' f z a        -> embed  (into2 Scanr'        (cvtF f) (cvtE z)) a     Permute f d p a     -> embed2 (into2 permute       (cvtF f) (cvtF p)) d a-    Stencil f x a       -> lift   (into (stencil x)    (cvtF f)) a-    Stencil2 f x a y b  -> lift2  (into (stencil2 x y) (cvtF f)) a b+    Stencil f x a       -> lift   (into2 Stencil       (cvtF f) (cvtB x)) a+    Stencil2 f x a y b  -> lift2  (into3 stencil2      (cvtF f) (cvtB x) (cvtB y)) a b    where     -- If fusion is not enabled, force terms to the manifest representation@@ -460,18 +467,24 @@     -- Helpers to shuffle the order of arguments to a constructor     --     permute f p d a     = Permute f d p a-    stencil x f a       = Stencil f x a-    stencil2 x y f a b  = Stencil2 f x a y b+    stencil2 f x y a b  = Stencil2 f x a y b      -- Conversions for closed scalar functions and expressions. This just     -- applies scalar simplifications.     ---    cvtF :: PreFun acc aenv t -> PreFun acc aenv t+    cvtF :: PreFun acc aenv' t -> PreFun acc aenv' t     cvtF = simplify -    cvtE :: Elt t =>PreExp acc aenv' t -> PreExp acc aenv' t+    cvtE :: Elt t => PreExp acc aenv' t -> PreExp acc aenv' t     cvtE = simplify +    cvtB :: PreBoundary acc aenv' t -> PreBoundary acc aenv' t+    cvtB Clamp        = Clamp+    cvtB Mirror       = Mirror+    cvtB Wrap         = Wrap+    cvtB (Constant c) = Constant c+    cvtB (Function f) = Function (cvtF f)+     -- Helpers to embed and fuse delayed terms     --     into :: Sink f => (f env' a -> b) -> f env a -> Extend acc env env' -> b@@ -481,6 +494,10 @@           => (f1 env' a -> f2 env' b -> c) -> f1 env a -> f2 env b -> Extend acc env env' -> c     into2 op a b env = op (sink env a) (sink env b) +    into3 :: (Sink f1, Sink f2, Sink f3)+          => (f1 env' a -> f2 env' b -> f3 env' c -> d) -> f1 env a -> f2 env b -> f3 env c -> Extend acc env env' -> d+    into3 op a b c env = op (sink env a) (sink env b) (sink env c)+     fuse :: Arrays as          => (forall aenv'. Extend acc aenv aenv' -> Cunctation acc aenv' as -> Cunctation acc aenv' bs)          ->       acc aenv as@@ -859,16 +876,16 @@  compute' :: (Kit acc, Arrays arrs) => Cunctation acc aenv arrs -> PreOpenAcc acc aenv arrs compute' cc = case simplify cc of-  Done v                                        -> Avar v-  Yield sh f                                    -> Generate sh f+  Done v                                              -> Avar v+  Yield sh f                                          -> Generate sh f   Step sh p f v-    | Just Refl <- match sh (arrayShape v)+    | Just Refl <- match sh (simplify (arrayShape v))     , Just Refl <- isIdentity p-    , Just Refl <- isIdentity f                 -> Avar v-    | Just Refl <- match sh (arrayShape v)-    , Just Refl <- isIdentity p                 -> Map f (avarIn v)-    | Just Refl <- isIdentity f                 -> Backpermute sh p (avarIn v)-    | otherwise                                 -> Transform sh p f (avarIn v)+    , Just Refl <- isIdentity f                       -> Avar v+    | Just Refl <- match sh (simplify (arrayShape v))+    , Just Refl <- isIdentity p                       -> Map f (avarIn v)+    | Just Refl <- isIdentity f                       -> Backpermute sh p (avarIn v)+    | otherwise                                       -> Transform sh p f (avarIn v)   -- Evaluate a delayed computation and tie the recursive knot@@ -1359,8 +1376,8 @@         Scanr1 f a              -> Scanr1 (cvtF f) (cvtA a)         Scanr' f z a            -> Scanr' (cvtF f) (cvtE z) (cvtA a)         Permute f d p a         -> Permute (cvtF f) (cvtA d) (cvtF p) (cvtA a)-        Stencil f x a           -> Stencil (cvtF f) x (cvtA a)-        Stencil2 f x a y b      -> Stencil2 (cvtF f) x (cvtA a) y (cvtA b)+        Stencil f x a           -> Stencil (cvtF f) (cvtB x) (cvtA a)+        Stencil2 f x a y b      -> Stencil2 (cvtF f) (cvtB x) (cvtA a) (cvtB y) (cvtA b)         -- Collect seq             -> Collect (cvtSeq seq)        where@@ -1372,6 +1389,13 @@          cvtF :: PreFun acc aenv s -> PreFun acc aenv s         cvtF = replaceF sh' f' avar++        cvtB :: PreBoundary acc aenv s -> PreBoundary acc aenv s+        cvtB Clamp        = Clamp+        cvtB Mirror       = Mirror+        cvtB Wrap         = Wrap+        cvtB (Constant c) = Constant c+        cvtB (Function f) = Function (cvtF f)          cvtAT :: Atuple (acc aenv) s -> Atuple (acc aenv) s         cvtAT NilAtup          = NilAtup
Data/Array/Accelerate/Trafo/Sharing.hs view
@@ -56,7 +56,7 @@ import Data.Array.Accelerate.Array.Sugar                as Sugar import Data.Array.Accelerate.AST                        hiding ( PreOpenAcc(..), OpenAcc(..), Acc                                                                , PreOpenExp(..), OpenExp, PreExp, Exp-                                                               , Stencil(..)+                                                               , PreBoundary(..), Boundary, Stencil(..)                                                                , showPreAccOp, showPreExpOp ) import qualified Data.Array.Accelerate.AST              as AST import qualified Data.Array.Accelerate.Debug            as Debug@@ -301,13 +301,13 @@       Backpermute newDim perm acc -> AST.Backpermute (cvtE newDim) (cvtF1 perm) (cvtA acc)       Stencil stencil boundary acc         -> AST.Stencil (convertSharingStencilFun1 config acc alyt aenv' stencil)-                       (convertBoundary boundary)+                       (convertSharingBoundary config alyt aenv' boundary)                        (cvtA acc)       Stencil2 stencil bndy1 acc1 bndy2 acc2         -> AST.Stencil2 (convertSharingStencilFun2 config acc1 acc2 alyt aenv' stencil)-                        (convertBoundary bndy1)+                        (convertSharingBoundary config alyt aenv' bndy1)                         (cvtA acc1)-                        (convertBoundary bndy2)+                        (convertSharingBoundary config alyt aenv' bndy2)                         (cvtA acc2)       -- Collect seq -> AST.Collect (convertSharingSeq config alyt EmptyLayout aenv' [] seq) @@ -517,11 +517,23 @@  -- | Convert a boundary condition ---convertBoundary :: Elt e => Boundary e -> Boundary (EltRepr e)-convertBoundary Clamp        = Clamp-convertBoundary Mirror       = Mirror-convertBoundary Wrap         = Wrap-convertBoundary (Constant e) = Constant (fromElt e)+convertSharingBoundary+    :: forall aenv t.+       Config+    -> Layout aenv aenv+    -> [StableSharingAcc]+    -> PreBoundary ScopedAcc ScopedExp t+    -> AST.PreBoundary AST.OpenAcc aenv t+convertSharingBoundary config alyt aenv = cvt+  where+    cvt :: PreBoundary ScopedAcc ScopedExp t -> AST.Boundary aenv t+    cvt bndy =+      case bndy of+        Clamp       -> AST.Clamp+        Mirror      -> AST.Mirror+        Wrap        -> AST.Wrap+        Constant v  -> AST.Constant $ fromElt v+        Function f  -> AST.Function $ convertSharingFun1 config alyt aenv f   -- Smart constructors to represent AST forms@@ -1237,6 +1249,20 @@     traverseExp :: Typeable e => Level -> Exp e -> IO (RootExp e, Int)     traverseExp = makeOccMapExp config accOccMap +    traverseBoundary+        :: Level+        -> PreBoundary Acc Exp t+        -> IO (PreBoundary UnscopedAcc RootExp t, Int)+    traverseBoundary lvl bndy =+      case bndy of+        Clamp      -> return (Clamp, 0)+        Mirror     -> return (Mirror, 0)+        Wrap       -> return (Wrap, 0)+        Constant v -> return (Constant v, 0)+        Function f -> do+          (f', h) <- traverseFun1 lvl f+          return (Function f', h)+     -- traverseSeq :: forall arrs. Typeable arrs     --             => Level -> Seq arrs     --             -> IO (RootSeq arrs, Int)@@ -1346,15 +1372,18 @@                                              return (Backpermute e' p' acc', h1 `max` h2 `max` h3 + 1)             Stencil s bnd acc           -> reconstruct $ do                                              (s'  , h1) <- makeOccMapStencil1 config accOccMap acc lvl s-                                             (acc', h2) <- traverseAcc lvl acc-                                             return (Stencil s' bnd acc', h1 `max` h2 + 1)+                                             (bnd', h2) <- traverseBoundary lvl bnd+                                             (acc', h3) <- traverseAcc lvl acc+                                             return (Stencil s' bnd' acc', h1 `max` h2 `max` h3 + 1)             Stencil2 s bnd1 acc1                        bnd2 acc2        -> reconstruct $ do                                              (s'   , h1) <- makeOccMapStencil2 config accOccMap acc1 acc2 lvl s-                                             (acc1', h2) <- traverseAcc lvl acc1-                                             (acc2', h3) <- traverseAcc lvl acc2-                                             return (Stencil2 s' bnd1 acc1' bnd2 acc2',-                                                     h1 `max` h2 `max` h3 + 1)+                                             (bnd1', h2) <- traverseBoundary lvl bnd1+                                             (acc1', h3) <- traverseAcc lvl acc1+                                             (bnd2', h4) <- traverseBoundary lvl bnd2+                                             (acc2', h5) <- traverseAcc lvl acc2+                                             return (Stencil2 s' bnd1' acc1' bnd2' acc2',+                                                     h1 `max` h2 `max` h3 `max` h4 `max` h5 + 1)             -- Collect s                   -> reconstruct $ do             --                                  (s', h) <- traverseSeq lvl s             --                                  return (Collect s', h + 1)@@ -2185,17 +2214,20 @@                                        (accCount1 +++ accCount2 +++ accCount3)           Stencil st bnd acc      -> let                                        (st' , accCount1) = scopesStencil1 acc st-                                       (acc', accCount2) = scopesAcc      acc+                                       (bnd', accCount2) = scopesBoundary bnd+                                       (acc', accCount3) = scopesAcc acc                                      in-                                     reconstruct (Stencil st' bnd acc') (accCount1 +++ accCount2)+                                     reconstruct (Stencil st' bnd' acc') (accCount1 +++ accCount2 +++ accCount3)           Stencil2 st bnd1 acc1 bnd2 acc2                                   -> let                                        (st'  , accCount1) = scopesStencil2 acc1 acc2 st-                                       (acc1', accCount2) = scopesAcc acc1-                                       (acc2', accCount3) = scopesAcc acc2+                                       (bnd1', accCount2) = scopesBoundary bnd1+                                       (acc1', accCount3) = scopesAcc acc1+                                       (bnd2', accCount4) = scopesBoundary bnd2+                                       (acc2', accCount5) = scopesAcc acc2                                      in-                                     reconstruct (Stencil2 st' bnd1 acc1' bnd2 acc2')-                                       (accCount1 +++ accCount2 +++ accCount3)+                                     reconstruct (Stencil2 st' bnd1' acc1' bnd2' acc2')+                                       (accCount1 +++ accCount2 +++ accCount3 +++ accCount4 +++ accCount5)           -- Collect seq             -> let           --                              (seq', accCount1) = scopesSeq seq           --                            in@@ -2406,7 +2438,18 @@       where         (body, counts) = scopesExp (stencilFun undefined undefined) +    scopesBoundary :: PreBoundary UnscopedAcc RootExp t+                   -> (PreBoundary ScopedAcc ScopedExp t, NodeCounts)+    scopesBoundary bndy =+      case bndy of+        Clamp      -> (Clamp, noNodeCounts)+        Mirror     -> (Mirror, noNodeCounts)+        Wrap       -> (Wrap, noNodeCounts)+        Constant v -> (Constant v, noNodeCounts)+        Function f -> let (body, counts) = scopesFun1 f+                      in  (Function body, counts) + determineScopesExp     :: Config     -> OccMap Acc@@ -2794,6 +2837,7 @@ --     environment for de Bruijn conversion will have a duplicate entry, and hence, be of the wrong --     size, which is fatal. (The 'buildInitialEnv*' functions will already bail out.) --+{-# NOINLINE recoverSharingAcc #-} recoverSharingAcc     :: Typeable a     => Config@@ -2801,7 +2845,6 @@     -> [Level]          -- The tags of newly introduced free array variables     -> Acc a     -> (ScopedAcc a, [StableSharingAcc])-{-# NOINLINE recoverSharingAcc #-} recoverSharingAcc config alvl avars acc   = let (acc', occMap)           = unsafePerformIO             -- to enable stable pointers; this is safe as explained above@@ -2810,6 +2853,7 @@     determineScopesAcc config avars occMap acc'  +{-# NOINLINE recoverSharingExp #-} recoverSharingExp     :: Typeable e     => Config@@ -2817,7 +2861,6 @@     -> [Level]          -- The tags of newly introduced free scalar variables     -> Exp e     -> (ScopedExp e, [StableSharingExp])-{-# NOINLINE recoverSharingExp #-} recoverSharingExp config lvl fvar exp   = let         (rootExp, accOccMap) = unsafePerformIO $ do@@ -2834,12 +2877,12 @@   {--+{-# NOINLINE recoverSharingSeq #-} recoverSharingSeq     :: Typeable e     => Config     -> Seq e     -> (ScopedSeq e, [StableSharingSeq])-{-# NOINLINE recoverSharingSeq #-} recoverSharingSeq config seq   = let         (rootSeq, accOccMap) = unsafePerformIO $ do
Data/Array/Accelerate/Trafo/Simplify.hs view
@@ -37,6 +37,7 @@  -- friends import Data.Array.Accelerate.AST                        hiding ( prj )+import Data.Array.Accelerate.Analysis.Match import Data.Array.Accelerate.Analysis.Shape import Data.Array.Accelerate.Error import Data.Array.Accelerate.Product@@ -45,7 +46,7 @@ import Data.Array.Accelerate.Trafo.Shrink import Data.Array.Accelerate.Trafo.Substitution import Data.Array.Accelerate.Type-import Data.Array.Accelerate.Array.Sugar                ( Elt, Shape, Slice, toElt, fromElt, (:.)(..)+import Data.Array.Accelerate.Array.Sugar                ( Array, Elt(eltType), Shape, Slice, toElt, fromElt, Z(..), (:.)(..)                                                         , Tuple(..), IsTuple, fromTuple, TupleRepr, shapeToList ) import qualified Data.Array.Accelerate.Debug            as Stats @@ -237,7 +238,7 @@           (v, fx) = evalPrimApp env f x'       Index a sh                -> Index a <$> cvtE sh       LinearIndex a i           -> LinearIndex a <$> cvtE i-      Shape a                   -> pure $ Shape a+      Shape a                   -> shape a       ShapeSize sh              -> shapeSize (cvtE sh)       Intersect s t             -> cvtE s `intersect` cvtE t       Union s t                 -> cvtE s `union` cvtE t@@ -391,6 +392,13 @@     indexTail (_, IndexCons sl _)       = Stats.ruleFired "indexTail/indexCons" $ yes sl     indexTail sh                        = IndexTail <$> sh +    shape :: forall sh t. (Shape sh, Elt t) => acc aenv (Array sh t) -> (Any, PreOpenExp acc env aenv sh)+    shape _+      | Just Refl <- matchTupleType (eltType (undefined::sh)) (eltType (undefined::Z))+      = Stats.ruleFired "shape/Z" $ yes (Const (fromElt Z))+    shape a+      = pure $ Shape a+     shapeSize :: forall sh. Shape sh => (Any, PreOpenExp acc env aenv sh) -> (Any, PreOpenExp acc env aenv Int)     shapeSize (_, Const c) = Stats.ruleFired "shapeSize/const" $ yes (Const (product (shapeToList (toElt c :: sh))))     shapeSize sh           = ShapeSize <$> sh@@ -671,6 +679,7 @@             PrimFloor            f i -> travFloatingType f +++ travIntegralType i             PrimCeiling          f i -> travFloatingType f +++ travIntegralType i             PrimIsNaN              t -> travFloatingType t+            PrimIsInfinite         t -> travFloatingType t             PrimAtan2              t -> travFloatingType t             PrimLt                 t -> travScalarType t             PrimGt                 t -> travScalarType t
Data/Array/Accelerate/Trafo/Substitution.hs view
@@ -260,6 +260,16 @@   {-# INLINEABLE weaken #-}   weaken k = Stats.substitution "weaken" . rebuildA (Avar . k) +instance RebuildableAcc acc => Sink (PreBoundary acc) where+  {-# INLINEABLE weaken #-}+  weaken k bndy =+    case bndy of+      Clamp      -> Clamp+      Mirror     -> Mirror+      Wrap       -> Wrap+      Constant c -> Constant c+      Function f -> Function (weaken k f)+ instance Sink OpenAcc where   {-# INLINEABLE weaken #-}   weaken k = Stats.substitution "weaken" . rebuildA (Avar . k)@@ -495,8 +505,8 @@     Scanr1 f a              -> Scanr1       <$> rebuildFun k (pure . IE) av f <*> k av a     Permute f1 a1 f2 a2     -> Permute      <$> rebuildFun k (pure . IE) av f1 <*> k av a1 <*> rebuildFun k (pure . IE) av f2 <*> k av a2     Backpermute sh f a      -> Backpermute  <$> rebuildPreOpenExp k (pure . IE) av sh <*> rebuildFun k (pure . IE) av f <*> k av a-    Stencil f b a           -> Stencil      <$> rebuildFun k (pure . IE) av f <*> pure b <*> k av a-    Stencil2 f b1 a1 b2 a2  -> Stencil2     <$> rebuildFun k (pure . IE) av f <*> pure b1 <*> k av a1 <*> pure b2 <*> k av a2+    Stencil f b a           -> Stencil      <$> rebuildFun k (pure . IE) av f <*> rebuildBoundary k av b  <*> k av a+    Stencil2 f b1 a1 b2 a2  -> Stencil2     <$> rebuildFun k (pure . IE) av f <*> rebuildBoundary k av b1 <*> k av a1 <*> rebuildBoundary k av b2 <*> k av a2     -- Collect seq             -> Collect      <$> rebuildSeq k av seq     Aforeign ff afun as     -> Aforeign ff afun <$> k av as @@ -523,6 +533,21 @@   case atup of     NilAtup      -> pure NilAtup     SnocAtup t a -> SnocAtup <$> rebuildAtup k av t <*> k av a++{-# INLINEABLE rebuildBoundary #-}+rebuildBoundary+    :: (Applicative f, SyntacticAcc fa)+    => RebuildAcc acc+    -> (forall t'. Arrays t' => Idx aenv t' -> f (fa acc aenv' t'))+    -> PreBoundary acc aenv t+    -> f (PreBoundary acc aenv' t)+rebuildBoundary k av bndy =+  case bndy of+    Clamp       -> pure Clamp+    Mirror      -> pure Mirror+    Wrap        -> pure Wrap+    Constant v  -> pure (Constant v)+    Function f  -> Function <$> rebuildFun k (pure . IE) av f  {-- {-# INLINEABLE rebuildSeq #-}
Data/Array/Accelerate/Type.hs view
@@ -3,7 +3,6 @@ {-# LANGUAGE DeriveDataTypeable   #-} {-# LANGUAGE FlexibleInstances    #-} {-# LANGUAGE GADTs                #-}-{-# LANGUAGE StandaloneDeriving   #-} {-# LANGUAGE TemplateHaskell      #-} {-# LANGUAGE TypeFamilies         #-} {-# LANGUAGE TypeOperators        #-}@@ -83,6 +82,7 @@   CLLong, CULLong, CFloat, CDouble)   -- in the future, CHalf + -- Scalar types -- ------------ @@ -104,6 +104,7 @@   NonNumDict :: ( Bounded a, Enum a, Eq a, Ord a, Show a, Storable a )              => NonNumDict a + -- Scalar type representation -- @@ -212,10 +213,6 @@   show (NumScalarType ty)    = show ty   show (NonNumScalarType ty) = show ty -instance Show (TupleType a) where-  show UnitTuple = "()"-  show (SingleTuple scalarTy) = show scalarTy-  show (PairTuple a b) = "("++show a++", "++show b++")"  -- Querying scalar type representations --@@ -592,7 +589,12 @@   SingleTuple :: ScalarType a               -> TupleType a   PairTuple   :: TupleType a -> TupleType b -> TupleType (a, b) +instance Show (TupleType a) where+  show UnitTuple              = "()"+  show (SingleTuple scalarTy) = show scalarTy+  show (PairTuple a b)        = "("++show a++", "++show b++")" + -- Type-level bit sizes -- -------------------- @@ -643,23 +645,11 @@                                     64 -> [t| 64 |]                                     _  -> error "I don't know what architecture I am"  ) - type instance BitSize CULong = $( case finiteBitSize (undefined::CULong) of                                     32 -> [t| 32 |]                                     64 -> [t| 64 |]                                     _  -> error "I don't know what architecture I am"  ) ---- Stencil support--- ------------------- |Boundary condition specification for stencil operations.----data Boundary a = Clamp               -- ^clamp coordinates to the extent of the array-                | Mirror              -- ^mirror coordinates beyond the array extent-                | Wrap                -- ^wrap coordinates around on each dimension-                | Constant a          -- ^use a constant value for outlying coordinates-                deriving (Show, Read)  {- -- Vector GPU data types
+ README.md view
@@ -0,0 +1,240 @@+An Embedded Language for Accelerated Array Computations+=======================================================++[![Build Status](https://travis-ci.org/AccelerateHS/accelerate.svg?branch=master)](https://travis-ci.org/AccelerateHS/accelerate)+[![Hackage](https://img.shields.io/hackage/v/accelerate.svg)](https://hackage.haskell.org/package/accelerate)++`Data.Array.Accelerate` defines an embedded language of array computations for high-performance computing in Haskell. Computations on multi-dimensional, regular arrays are expressed in the form of parameterised collective operations (such as maps, reductions, and permutations). These computations are online-compiled and executed on a range of architectures.++For more details, see our papers:++ * [Accelerating Haskell Array Codes with Multicore GPUs][CKLM+11]+ * [Optimising Purely Functional GPU Programs][MCKL13] ([slides][MCKL13-slides])+ * [Embedding Foreign Code][CMCK14]+ * [Type-safe Runtime Code Generation: Accelerate to LLVM][MCGN15] ([slides][MCGN15-slides]) ([video][MCGN15-video])++There are also slides from some fairly recent presentations:++ * [Embedded Languages for High-Performance Computing in Haskell][Embedded]+ * [GPGPU Programming in Haskell with Accelerate][YLJ13-slides] ([video][YLJ13-video]) ([workshop][YLJ13-workshop])++Chapter 6 of Simon Marlow's book [Parallel and Concurrent Programming in Haskell][Mar13] contains a tutorial introduction to Accelerate.++[Trevor's PhD thesis][Trevor-thesis] details the design and implementation of frontend optimisations and CUDA backend.+++**Table of Contents**++- [An Embedded Language for Accelerated Array Computations](#an-embedded-language-for-accelerated-array-computations)+  - [A simple example](#a-simple-example)+  - [Availability](#availability)+  - [Additional components](#additional-components)+  - [Requirements](#requirements)+  - [Documentation](#documentation)+  - [Examples](#examples)+  - [Mailing list and contacts](#mailing-list-and-contacts)+  - [Citing Accelerate](#citing-accelerate)+  - [What's missing?](#whats-missing)++A simple example+----------------++As a simple example, consider the computation of a dot product of two vectors of single-precision floating-point numbers:++    dotp :: Acc (Vector Float) -> Acc (Vector Float) -> Acc (Scalar Float)+    dotp xs ys = fold (+) 0 (zipWith (*) xs ys)++Except for the type, this code is almost the same as the corresponding Haskell code on lists of floats. The types indicate that the computation may be online-compiled for performance; for example, using `Data.Array.Accelerate.LLVM.PTX.run` it may be on-the-fly off-loaded to a GPU.++Availability+------------++Package accelerate is available from++ * Hackage: [accelerate][Hackage] - install with `cabal install accelerate`+ * GitHub: [AccelerateHS/accelerate][GitHub] - get the source with `git clone https://github.com/AccelerateHS/accelerate.git`. The easiest way to compile the source distributions is via the Haskell [stack](https://docs.haskellstack.org/en/stable/README/) tool.++Additional components+---------------------++The following supported add-ons are available as separate packages:++  * [accelerate-llvm-native][accelerate-llvm-native]: Backend targeting multicore CPUs+  * [accelerate-llvm-ptx][accelerate-llvm-ptx]: Backend targeting CUDA-enabled NVIDIA GPUs. Requires a GPU with compute capability 2.0 or greater (see the [table on Wikipedia][wiki-cc])+  * [accelerate-examples][accelerate-examples]: Computational kernels and applications showcasing the use of Accelerate as well as a regression test suite (supporting function and performance testing)+  * [accelerate-io][accelerate-io]: Fast conversion between Accelerate arrays and other array formats (for example, Repa and Vector)+  * [accelerate-fft][accelerate-fft]: Fast Fourier transform implementation, with FFI bindings to optimised implementations+  * [accelerate-blas][accelerate-blas]: BLAS and LAPACK operations, with FFI bindings to optimised implementations+  * [accelerate-bignum][accelerate-bignum]: Fixed-width large integer arithmetic+  * [colour-accelerate][colour-accelerate]: Colour representations in Accelerate (RGB, sRGB, HSV, and HSL)+  * [gloss-accelerate][gloss-accelerate]: Generate [gloss][gloss] pictures from Accelerate+  * [gloss-raster-accelerate][gloss-raster-accelerate]: Parallel rendering of raster images and animations+  * [lens-accelerate][lens-accelerate]: [Lens][lens] operators for Accelerate types+  * [linear-accelerate][linear-accelerate]: [Linear][linear] vector spaces in Accelerate+  * [mwc-random-accelerate][mwc-random-accelerate]: Generate Accelerate arrays filled with high quality pseudorandom numbers+  * [numeric-prelude-accelerate][numeric-prelude-accelerate]: Lifting the [numeric-prelude][numeric-prelude] to Accelerate++Install them from Hackage with `cabal install PACKAGENAME`.+++Documentation+-------------++  * Haddock documentation is included and linked with the individual package releases on [Hackage][Hackage].+  * Haddock documentation for in-development components can be found [here](http://tmcdonell-bot.github.io/accelerate-travis-buildbot/).+  * The idea behind the HOAS (higher-order abstract syntax) to de-Bruijn conversion used in the library is [described separately][HOAS-conv].++Examples+--------++### accelerate-examples++The [accelerate-examples][accelerate-examples] package provides a range of computational kernels and a few complete applications. To install these from Hackage, issue `cabal install accelerate-examples`. The examples include:++  * An implementation of [canny edge detection][wiki-canny]+  * An interactive [mandelbrot set][wiki-mandelbrot] generator+  * An [N-body simulation][wiki-nbody] of gravitational attraction between solid particles+  * An implementation of the [PageRank][wiki-pagerank] algorithm+  * A simple [ray-tracer][wiki-raytracing]+  * A particle based simulation of stable fluid flows+  * A cellular automata simulation+  * A "password recovery" tool, for dictionary lookup of MD5 hashes++[![Mandelbrot](http://i.imgur.com/5Tbsp1j.jpg "accelerate-mandelbrot")](http://i.imgur.com/RgXRqsc.jpg)+[![Raytracer](http://i.imgur.com/7ohhKm9.jpg "accelerate-ray")](http://i.imgur.com/ZNEGEJK.jpg)++<!--+<video width=400 height=300 controls=false autoplay loop>+  <source="http://www.cse.unsw.edu.au/~tmcdonell/images/ray.mp4" type="video/mp4">+</video>+-->+++### LULESH++[LULESH-accelerate][lulesh-accelerate] is in implementation of the Livermore Unstructured Lagrangian Explicit Shock Hydrodynamics (LULESH) mini-app. [LULESH][LULESH] represents a typical hydrodynamics code such as [ALE3D][ALE3D], but is a highly simplified application, hard-coded to solve the Sedov blast problem on an unstructured hexahedron mesh.++![LULESH mesh](https://codesign.llnl.gov/images/sedov-3d-LLNL.png)+++### Λ ○ λ (Lol)++Λ ○ λ ([Lol][lol]) is a general-purpose library for ring-based lattice cryptography. Lol has applications in, for example, symmetric-key somewhat-homomorphic encryption schemes. The [lol-accelerate][lol-accelerate] package provides an Accelerate backend for Lol.+++### Additional examples++Accelerate users have also built some substantial applications of their own.+Please feel free to add your own examples!++  * Henning Thielemann, [patch-image](http://hackage.haskell.org/package/patch-image): Combine a collage of overlapping images+  * apunktbau, [bildpunkt](https://github.com/abau/bildpunkt): A ray-marching distance field renderer+  * klarh, [hasdy](https://github.com/klarh/hasdy): Molecular dynamics in Haskell using Accelerate+  * Alexandros Gremm used Accelerate as part of the [2014 CSCS summer school](http://user.cscs.ch/blog/2014/cscs_usi_summer_school_2014_30_june_10_july_2014_in_serpiano_tessin/index.html) ([code](https://github.com/agremm/cscs))+++Mailing list and contacts+-------------------------++  * Mailing list: [`accelerate-haskell@googlegroups.com`](mailto:accelerate-haskell@googlegroups.com) (discussions on both use and development are welcome)+  * Sign up for the mailing list at the [Accelerate Google Groups page][Google-Group].+  * Bug reports and issues tracking: [GitHub project page][Issues].++The maintainers of Accelerate are Manuel M T Chakravarty <chak@cse.unsw.edu.au> and Trevor L McDonell <tmcdonell@cse.unsw.edu.au>.+++Citing Accelerate+-----------------++If you use Accelerate for academic research, you are encouraged (though not+required) to cite the following papers ([BibTeX](http://www.cse.unsw.edu.au/~tmcdonell/papers/accelerate.bib)):++  * Manuel M. T. Chakravarty, Gabriele Keller, Sean Lee, Trevor L. McDonell, and Vinod Grover.+    [Accelerating Haskell Array Codes with Multicore GPUs][CKLM+11].+    In _DAMP '11: Declarative Aspects of Multicore Programming_, ACM, 2011.++  * Trevor L. McDonell, Manuel M. T. Chakravarty, Gabriele Keller, and Ben Lippmeier.+    [Optimising Purely Functional GPU Programs][MCKL13].+    In _ICFP '13: The 18th ACM SIGPLAN International Conference on Functional Programming_, ACM, 2013.++  * Robert Clifton-Everest, Trevor L. McDonell, Manuel M. T. Chakravarty, and Gabriele Keller.+    [Embedding Foreign Code][CMCK14].+    In _PADL '14: The 16th International Symposium on Practical Aspects of Declarative Languages_, Springer-Verlag, LNCS, 2014.++  * Trevor L. McDonell, Manuel M. T. Chakravarty, Vinod Grover, and Ryan R. Newton.+    [Type-safe Runtime Code Generation: Accelerate to LLVM][MCGN15].+    In _Haskell '15: The 8th ACM SIGPLAN Symposium on Haskell_, ACM, 2015.++Accelerate is primarily developed by academics, so citations matter a lot to us.+As an added benefit, you increase Accelerate's exposure and potential user (and+developer!) base, which is a benefit to all users of Accelerate. Thanks in advance!+++What's missing?+---------------++Here is a list of features that are currently missing:++ * Preliminary API (parts of the API may still change in subsequent releases)++++  [CKLM+11]:                    http://www.cse.unsw.edu.au/~chak/papers/CKLM+11.html+  [MCKL13]:                     http://www.cse.unsw.edu.au/~chak/papers/MCKL13.html+  [MCKL13-slides]:              https://speakerdeck.com/tmcdonell/optimising-purely-functional-gpu-programs+  [CMCK14]:                     http://www.cse.unsw.edu.au/~chak/papers/CMCK14.html+  [MCGN15]:                     http://www.cse.unsw.edu.au/~chak/papers/MCGN15.html+  [MCGN15-slides]:              https://speakerdeck.com/tmcdonell/type-safe-runtime-code-generation-accelerate-to-llvm+  [MCGN15-video]:               https://www.youtube.com/watch?v=snXhXA5noVc+  [HIW'09]:                     https://wiki.haskell.org/HaskellImplementorsWorkshop+  [Mar13]:                      http://chimera.labs.oreilly.com/books/1230000000929+  [Embedded]:                   https://speakerdeck.com/mchakravarty/embedded-languages-for-high-performance-computing-in-haskell+  [Hackage]:                    http://hackage.haskell.org/package/accelerate+  [accelerate-cuda]:            https://github.com/AccelerateHS/accelerate-cuda+  [accelerate-examples]:        https://github.com/AccelerateHS/accelerate-examples+  [accelerate-io]:              https://github.com/AccelerateHS/accelerate-io+  [accelerate-fft]:             https://github.com/AccelerateHS/accelerate-fft+  [accelerate-blas]:            https://github.com/tmcdonell/accelerate-blas+  [accelerate-backend-kit]:     https://github.com/AccelerateHS/accelerate-backend-kit+  [accelerate-buildbot]:        https://github.com/AccelerateHS/accelerate-buildbot+  [accelerate-repa]:            https://github.com/blambo/accelerate-repa+  [accelerate-opencl]:          https://github.com/hiPERFIT/accelerate-opencl+  [accelerate-cabal]:           https://github.com/AccelerateHS/accelerate/accelerate.cabal+  [accelerate-cuda-cabal]:      https://github.com/AccelerateHS/accelerate-cuda/accelerate-cuda.cabal+  [accelerate-llvm]:            https://github.com/AccelerateHS/accelerate-llvm+  [accelerate-llvm-native]:     https://github.com/AccelerateHS/accelerate-llvm+  [accelerate-llvm-ptx]:        https://github.com/AccelerateHS/accelerate-llvm+  [accelerate-bignum]:          https://github.com/tmcdonell/accelerate-bignum+  [GitHub]:                     https://github.com/AccelerateHS/accelerate+  [Wiki]:                       https://github.com/AccelerateHS/accelerate/wiki+  [Issues]:                     https://github.com/AccelerateHS/accelerate/issues+  [Google-Group]:               http://groups.google.com/group/accelerate-haskell+  [HOAS-conv]:                  http://www.cse.unsw.edu.au/~chak/haskell/term-conv/+  [repa]:                       http://hackage.haskell.org/package/repa+  [wiki-cc]:                    https://en.wikipedia.org/wiki/CUDA#Supported_GPUs+  [YLJ13-video]:                http://youtu.be/ARqE4yT2Z0o+  [YLJ13-slides]:               https://speakerdeck.com/tmcdonell/gpgpu-programming-in-haskell-with-accelerate+  [YLJ13-workshop]:             https://speakerdeck.com/tmcdonell/gpgpu-programming-in-haskell-with-accelerate-workshop+  [wiki-canny]:                 https://en.wikipedia.org/wiki/Canny_edge_detector+  [wiki-mandelbrot]:            https://en.wikipedia.org/wiki/Mandelbrot_set+  [wiki-nbody]:                 https://en.wikipedia.org/wiki/N-body+  [wiki-raytracing]:            https://en.wikipedia.org/wiki/Ray_tracing+  [wiki-pagerank]:              https://en.wikipedia.org/wiki/Pagerank+  [Trevor-thesis]:              http://www.cse.unsw.edu.au/~tmcdonell/papers/TrevorMcDonell_PhD_submission.pdf+  [colour-accelerate]:          https://github.com/tmcdonell/colour-accelerate+  [gloss]:                      https://hackage.haskell.org/package/gloss+  [gloss-accelerate]:           https://github.com/tmcdonell/gloss-accelerate+  [gloss-raster-accelerate]:    https://github.com/tmcdonell/gloss-raster-accelerate+  [lens]:                       https://hackage.haskell.org/package/lens+  [lens-accelerate]:            https://github.com/tmcdonell/lens-accelerate+  [linear]:                     https://hackage.haskell.org/package/linear+  [linear-accelerate]:          https://github.com/tmcdonell/linear-accelerate+  [mwc-random-accelerate]:      https://github.com/tmcdonell/mwc-random-accelerate+  [numeric-prelude]:            https://hackage.haskell.org/package/numeric-prelude+  [numeric-prelude-accelerate]: https://github.com/tmcdonell/numeric-prelude-accelerate+  [LULESH]:                     https://codesign.llnl.gov/lulesh.php+  [ALE3D]:                      https://wci.llnl.gov/simulation/computer-codes/ale3d+  [lulesh-accelerate]:          https://github.com/tmcdonell/lulesh-accelerate+  [lol]:                        https://hackage.haskell.org/package/lol+  [lol-accelerate]:             https://github.com/tmcdonell/lol-accelerate+
accelerate.cabal view
@@ -1,5 +1,5 @@ Name:                   accelerate-Version:                1.0.0.0+Version:                1.1.0.0 Cabal-version:          >= 1.8 Tested-with:            GHC >= 7.8 Build-type:             Simple@@ -39,10 +39,6 @@       greater. See the following table for supported GPUs:       <http://en.wikipedia.org/wiki/CUDA#Supported_GPUs>   .-    * @accelerate-cuda@: Backend targeting CUDA-enabled NVIDIA GPUs. Requires-      a GPU with compute compatibility 1.2 or greater. /NOTE: This backend is-      being deprecated in favour of @accelerate-llvm-ptx@./-  .     * @accelerate-examples@: Computational kernels and applications showcasing       the use of Accelerate as well as a regression test suite, supporting       function and performance testing.@@ -129,7 +125,9 @@ Category:               Compilers/Interpreters, Concurrency, Data, Parallelism Stability:              Experimental -Extra-source-files:     changelog.md+Extra-source-files:+    README.md+    CHANGELOG.md  Flag debug   Default:              False@@ -154,6 +152,8 @@     .       * @flush-cache@: Clear any persistent caches on program startup (False).     .+      * @force-recomp@: Force recompilation of array programs (False).+    .       * @fast-math@: Allow algebraically equivalent transformations which may         change floating point results (e.g., reassociate) (True).     .@@ -206,8 +206,13 @@   Description:     Enable hooks for monitoring the running application using EKG. Implies     @debug@ mode. In order to view the metrics, your application will need to-    initialise the EKG server like so:+    call @Data.Array.Accelerate.Debug.beginMonitoring@ before running any+    Accelerate computations. This will launch the server on the local machine at+    port 8000.     .+    Alternatively, if you wish to configure the EKG monitoring server you can+    initialise it like so:+    .     > import Data.Array.Accelerate.Debug     >     > import System.Metrics@@ -223,7 +228,7 @@     >   ...     .     Note that, as with any program utilising EKG, in order to collect Haskell GC-    statistics collection, you must either run the program with:+    statistics, you must either run the program with:     .     > +RTS -T -RTS     .@@ -246,7 +251,7 @@  Library   Build-depends:-          base                          >= 4.7 && < 4.10+          base                          >= 4.7 && < 4.11         , base-orphans                  >= 0.3         , containers                    >= 0.3         , deepseq                       >= 1.3@@ -278,6 +283,7 @@          -- For backend development         Data.Array.Accelerate.AST+        Data.Array.Accelerate.Analysis.Hash         Data.Array.Accelerate.Analysis.Match         Data.Array.Accelerate.Analysis.Shape         Data.Array.Accelerate.Analysis.Stencil@@ -303,6 +309,7 @@    Other-modules:         Data.Atomic+        Data.Array.Accelerate.Analysis.Hash.TH         Data.Array.Accelerate.Array.Lifted         Data.Array.Accelerate.Array.Remote.Nursery         Data.Array.Accelerate.Classes@@ -383,6 +390,10 @@   if impl(ghc >= 8.0)     ghc-options:        -freduction-depth=35 +  if impl(ghc < 7.10)+    build-depends:+          th-lift-instances             >= 0.1+   -- Don't add the extensions list here. Instead, place individual LANGUAGE   -- pragmas in the files that require a specific extension. This means the   -- project loads in GHCi, and avoids extension clashes.@@ -395,7 +406,7 @@  source-repository this   Type:                 git-  Tag:                  1.0.0.0+  Tag:                  1.1.0.0   Location:             git://github.com/AccelerateHS/accelerate.git  -- vim: nospell
− changelog.md 
@@ -1,90 +0,0 @@-1.0.0.0--  * Many API and internal changes--  * Bug fixes and other enhancements--0.15.0.0--  * Bug fixes and performance improvements.--0.14.0.0--  * New iteration constructs.--  * Additional Prelude-like functions.--  * Improved code generation and fusion optimisation.--  * Concurrent kernel execution in the CUDA backend.--  * Bug fixes.--0.13.0.0--  * New array fusion optimisation.--  * New foreign function interface for array and scalar expressions.--  * Additional Prelude-like functions.--  * New example programs.--  * Bug fixes and performance improvements.--0.12.0.0--  * Full sharing recovery in scalar expressions and array computations.--  * Two new example applications in package `accelerate-examples`: Real-time-    Canny edge detection and an interactive fluid flow simulator (both including-    a graphical frontend).--  * Bug fixes.--0.11.0.0--  * New Prelude-like functions `zip*`, `unzip*`, `fill`, `enumFrom*`, `tail`,-    `init`, `drop`, `take`, `slit`, `gather*`, `scatter*`, and `shapeSize`.--  * New simplified AST (in package `accelerate-backend-kit`) for backend writers-    who want to avoid the complexities of the type-safe AST.--0.10.0.0--  * Complete sharing recovery for scalar expressions (but currently disabled by-    default).--  * Also bug fixes in array sharing recovery and a few new convenience-    functions.--0.9.0.0--  * Streaming computations--  * Precompilation--  * Repa-style array indices--  * Additional collective operations supported by the CUDA backend: `stencil`s,-    more `scan`s, rank-polymorphic `fold`, `generate`.--  * Conversions to other array formats--  * Bug fixes--0.8.1.0--  * Bug fixes and some performance tweaks.--0.8.0.0--  * More collective operations supported by the CUDA backend: `replicate`,-    `slice` and `foldSeg`. Frontend and interpreter support for `stencil`.--  * Bug fixes.--0.7.1.0--  * Initial release of the CUDA backend-